-- |
-- Module      : Streamly.Internal.Data.Stream.StreamD.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.
--
-- Ultimately these operations should be supported by Unfolds, Pipes and Folds,
-- and this module may become redundant.

-- The zipWithM combinator in this module has been adapted from the vector
-- package (c) Roman Leshchinskiy.
--
module Streamly.Internal.Data.Stream.StreamD.Nesting
    (
    -- * Generate
    -- | Combining streams to generate streams.

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

    -- *** Appending
    -- | Append a stream after another. A special case of concatMap or
    -- unfoldMany.
      AppendState(..)
    , append

    -- *** Interleaving
    -- | Interleave elements from two streams alternately. A special case of
    -- unfoldManyInterleave.
    , InterleaveState(..)
    , interleave
    , interleaveMin
    , interleaveSuffix
    , interleaveInfix

    -- *** Scheduling
    -- | Execute streams alternately irrespective of whether they generate
    -- elements or not. Note 'interleave' would execute a stream until it
    -- yields an element. A special case of unfoldManyRoundRobin.
    , roundRobin -- interleaveFair?/ParallelFair

    -- *** Zipping
    -- | Zip corresponding elements of two streams.
    , zipWith
    , zipWithM

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

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

    -- *** ConcatMap
    -- | Generate streams by mapping a stream generator on each element of an
    -- input stream, append the resulting streams and flatten.
    , concatMap
    , concatMapM

    -- *** ConcatUnfold
    -- | Generate streams by using an unfold on each element of an input
    -- stream, append the resulting streams and flatten. A special case of
    -- gintercalate.
    , unfoldMany
    , ConcatUnfoldInterleaveState (..)
    , unfoldManyInterleave
    , unfoldManyRoundRobin

    -- *** Interpose
    -- | Like unfoldMany but intersperses an effect between the streams. A
    -- special case of gintercalate.
    , interpose
    , interposeSuffix

    -- *** Intercalate
    -- | Like unfoldMany but intersperses streams from another source between
    -- the streams from the first source.
    , gintercalate
    , gintercalateSuffix

    -- * 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 m a b) -> t m a -> t m b
    -- @

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

    -- ** Parsing
    -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or
    -- unfoldMany. 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
    , parseIterate

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

    -- ** Splitting
    -- | A special case of parsing.
    , wordsBy
    , splitOnSeq
    , splitOnSuffixSeq

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

#include "inline.hs"

import Control.Exception (assert)
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Bits (shiftR, shiftL, (.|.), (.&.))
#if __GLASGOW_HASKELL__ >= 801
import Data.Functor.Identity ( Identity )
#endif
import Data.Word (Word32)
import Foreign.Storable (Storable(..))
import Fusion.Plugin.Types (Fuse(..))
import GHC.Types (SPEC(..))

import Streamly.Internal.Data.Array.Foreign.Type (Array(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Parser (ParseError(..))
import Streamly.Internal.Data.Unfold.Type (Unfold(..))

import qualified Streamly.Internal.Data.Array.Foreign.Type as A
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser.ParserD as PRD
import qualified Streamly.Internal.Ring.Foreign as RB

import Streamly.Internal.Data.Stream.StreamD.Type
import Streamly.Internal.Data.SVar

import Prelude hiding (concatMap, mapM, zipWith)

------------------------------------------------------------------------------
-- Appending
------------------------------------------------------------------------------

data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2

-- Note that this could be much faster compared to the CPS stream. However, as
-- the number of streams being composed increases this may become expensive.
-- Need to see where the breaking point is between the two.
--
{-# INLINE_NORMAL append #-}
append :: Monad m => Stream m a -> Stream m a -> Stream m a
append :: Stream m a -> Stream m a -> Stream m a
append (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1) (Stream State Stream m a -> s -> m (Step s a)
step2 s
state2) =
    (State Stream m a
 -> AppendState s s -> m (Step (AppendState s s) a))
-> AppendState s s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m a -> AppendState s s -> m (Step (AppendState s s) a)
step (s -> AppendState s s
forall s1 s2. s1 -> AppendState s1 s2
AppendFirst s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State Stream m a -> AppendState s s -> m (Step (AppendState s s) a)
step State Stream m a
gst (AppendFirst s
st) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st
        Step (AppendState s s) a -> m (Step (AppendState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (AppendState s s) a -> m (Step (AppendState s s) a))
-> Step (AppendState s s) a -> m (Step (AppendState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> AppendState s s -> Step (AppendState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> AppendState s s
forall s1 s2. s1 -> AppendState s1 s2
AppendFirst s
s)
            Skip s
s -> AppendState s s -> Step (AppendState s s) a
forall s a. s -> Step s a
Skip (s -> AppendState s s
forall s1 s2. s1 -> AppendState s1 s2
AppendFirst s
s)
            Step s a
Stop -> AppendState s s -> Step (AppendState s s) a
forall s a. s -> Step s a
Skip (s -> AppendState s s
forall s1 s2. s2 -> AppendState s1 s2
AppendSecond s
state2)

    step State Stream m a
gst (AppendSecond s
st) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st
        Step (AppendState s s) a -> m (Step (AppendState s s) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (AppendState s s) a -> m (Step (AppendState s s) a))
-> Step (AppendState s s) a -> m (Step (AppendState s s) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
s -> a -> AppendState s s -> Step (AppendState s s) a
forall s a. a -> s -> Step s a
Yield a
a (s -> AppendState s s
forall s1 s2. s2 -> AppendState s1 s2
AppendSecond s
s)
            Skip s
s -> AppendState s s -> Step (AppendState s s) a
forall s a. s -> Step s a
Skip (s -> AppendState s s
forall s1 s2. s2 -> AppendState s1 s2
AppendSecond s
s)
            Step s a
Stop -> Step (AppendState s s) a
forall s a. Step s a
Stop

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

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

{-# INLINE_NORMAL interleave #-}
interleave :: Monad m => Stream m a -> Stream m a -> Stream m a
interleave :: Stream m a -> Stream m a -> Stream m a
interleave (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1) (Stream State Stream m a -> s -> m (Step s a)
step2 s
state2) =
    (State Stream m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State Stream m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveFirstOnly s
st1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveSecondOnly s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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

{-# INLINE_NORMAL interleaveMin #-}
interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveMin :: Stream m a -> Stream m a -> Stream m a
interleaveMin (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1) (Stream State Stream m a -> s -> m (Step s a)
step2 s
state2) =
    (State Stream m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State Stream m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
_ (InterleaveFirstOnly s
_) =  m (Step (InterleaveState s s) a)
forall a. HasCallStack => a
undefined
    step State Stream m a
_ (InterleaveSecondOnly s
_) =  m (Step (InterleaveState s s) a)
forall a. HasCallStack => a
undefined

{-# INLINE_NORMAL interleaveSuffix #-}
interleaveSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveSuffix :: Stream m a -> Stream m a -> Stream m a
interleaveSuffix (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1) (Stream State Stream m a -> s -> m (Step s a)
step2 s
state2) =
    (State Stream m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State Stream m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveFirstOnly s
st1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
_ (InterleaveSecondOnly s
_) =  m (Step (InterleaveState s s) a)
forall a. HasCallStack => a
undefined

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

{-# INLINE_NORMAL interleaveInfix #-}
interleaveInfix :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveInfix :: Stream m a -> Stream m a -> Stream m a
interleaveInfix (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1) (Stream State Stream m a -> s -> m (Step s a)
step2 s
state2) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m a
-> InterleaveInfixState s s a
-> m (Step (InterleaveInfixState s s a) a)
step State Stream m a
gst (InterleaveInfixFirst s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) 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 Stream m a
gst (InterleaveInfixSecondBuf s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) 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 Stream m a
gst (InterleaveInfixSecondYield s
st1 s
st2 a
x) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) 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 Stream m a
_ (InterleaveInfixFirstYield s
st1 s
st2 a
x) = do
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) 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 Stream m a
gst (InterleaveInfixFirstOnly s
st1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) 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

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

{-# INLINE_NORMAL roundRobin #-}
roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a
roundRobin :: Stream m a -> Stream m a -> Stream m a
roundRobin (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1) (Stream State Stream m a -> s -> m (Step s a)
step2 s
state2) =
    (State Stream m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step State Stream m a
gst (InterleaveFirst s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveSecond s
st1 s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveSecondOnly s
st2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step2 State Stream m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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 Stream m a
gst (InterleaveFirstOnly s
st1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 State Stream m a
gst s
st1
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) 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

------------------------------------------------------------------------------
-- Zipping
------------------------------------------------------------------------------

{-# INLINE_NORMAL zipWithM #-}
zipWithM :: Monad m
    => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
zipWithM :: (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
zipWithM a -> b -> m c
f (Stream State Stream m a -> s -> m (Step s a)
stepa s
ta) (Stream State Stream m b -> s -> m (Step s b)
stepb s
tb) = (State Stream m c -> (s, s, Maybe a) -> m (Step (s, s, Maybe a) c))
-> (s, s, Maybe a) -> Stream m c
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c -> (s, s, Maybe a) -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a.
State Stream m a -> (s, s, Maybe a) -> m (Step (s, s, Maybe a) c)
step (s
ta, s
tb, Maybe a
forall a. Maybe a
Nothing)
  where
    {-# INLINE_LATE step #-}
    step :: State Stream m a -> (s, s, Maybe a) -> m (Step (s, s, Maybe a) c)
step State Stream m a
gst (s
sa, s
sb, Maybe a
Nothing) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepa (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
sa
        Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c))
-> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall a b. (a -> b) -> a -> b
$
          case Step s a
r of
            Yield a
x s
sa' -> (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. s -> Step s a
Skip (s
sa', s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Skip s
sa'    -> (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. s -> Step s a
Skip (s
sa', s
sb, Maybe a
forall a. Maybe a
Nothing)
            Step s a
Stop        -> Step (s, s, Maybe a) c
forall s a. Step s a
Stop

    step State Stream m a
gst (s
sa, s
sb, Just a
x) = do
        Step s b
r <- State Stream m b -> s -> m (Step s b)
stepb (State Stream m a -> State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
sb
        case Step s b
r of
            Yield b
y s
sb' -> do
                c
z <- a -> b -> m c
f a
x b
y
                Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c))
-> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall a b. (a -> b) -> a -> b
$ c -> (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. a -> s -> Step s a
Yield c
z (s
sa, s
sb', Maybe a
forall a. Maybe a
Nothing)
            Skip s
sb' -> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c))
-> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall a b. (a -> b) -> a -> b
$ (s, s, Maybe a) -> Step (s, s, Maybe a) c
forall s a. s -> Step s a
Skip (s
sa, s
sb', a -> Maybe a
forall a. a -> Maybe a
Just a
x)
            Step s b
Stop     -> Step (s, s, Maybe a) c -> m (Step (s, s, Maybe a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (s, s, Maybe a) c
forall s a. Step s a
Stop

#if __GLASGOW_HASKELL__ >= 801
{-# RULES "zipWithM xs xs"
    forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}
#endif

{-# INLINE zipWith #-}
zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith :: (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c
zipWith a -> b -> c
f = (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c
zipWithM (\a
a b
b -> c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b -> c
f a
a b
b))

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

{-# INLINE_NORMAL mergeByM #-}
mergeByM
    :: (Monad m)
    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeByM :: (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeByM a -> a -> m Ordering
cmp (Stream State Stream m a -> s -> m (Step s a)
stepa s
ta) (Stream State Stream m a -> s -> m (Step s a)
stepb s
tb) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m a
-> (Maybe s, Maybe s, Maybe a, Maybe a)
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
step State Stream m a
gst (Just s
sa, Maybe s
sb, Maybe a
Nothing, Maybe a
b) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepa State Stream 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 (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 Stream m a
gst (Maybe s
sa, Just s
sb, Maybe a
a, Maybe a
Nothing) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
stepb State Stream 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 (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 Stream 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 (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 Stream 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 (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 Stream 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 (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 Stream 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 (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

{-# INLINE mergeBy #-}
mergeBy
    :: (Monad m)
    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeBy :: (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 (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)

------------------------------------------------------------------------------
-- Combine N Streams - unfoldMany
------------------------------------------------------------------------------

data ConcatUnfoldInterleaveState o i =
      ConcatUnfoldInterleaveOuter o [i]
    | ConcatUnfoldInterleaveInner o [i]
    | ConcatUnfoldInterleaveInnerL [i] [i]
    | ConcatUnfoldInterleaveInnerR [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.
--
{-# INLINE_NORMAL unfoldManyInterleave #-}
unfoldManyInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b
unfoldManyInterleave :: Unfold m a b -> Stream m a -> Stream m b
unfoldManyInterleave (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State Stream m a -> s -> m (Step s a)
ostep s
ost) =
    (State Stream m b
 -> ConcatUnfoldInterleaveState s s
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> ConcatUnfoldInterleaveState s s -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a.
State Stream 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 Stream m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step State Stream m a
gst (ConcatUnfoldInterleaveOuter s
o [s]
ls) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
ostep (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 (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 (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 Stream m a
_ (ConcatUnfoldInterleaveInner s
_ []) = m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. HasCallStack => a
undefined
    step State Stream 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 (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 Stream m a
_ (ConcatUnfoldInterleaveInnerL [] []) = Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatUnfoldInterleaveState s s) b
forall s a. Step s a
Stop
    step State Stream m a
_ (ConcatUnfoldInterleaveInnerL [] [s]
rs) =
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 Stream 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 (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 Stream m a
_ (ConcatUnfoldInterleaveInnerR [] []) = Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatUnfoldInterleaveState s s) b
forall s a. Step s a
Stop
    step State Stream m a
_ (ConcatUnfoldInterleaveInnerR [s]
ls []) =
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 Stream 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 (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)

-- 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 unfoldManyInterleave this one switches streams on Skips.
--
{-# INLINE_NORMAL unfoldManyRoundRobin #-}
unfoldManyRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b
unfoldManyRoundRobin :: Unfold m a b -> Stream m a -> Stream m b
unfoldManyRoundRobin (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State Stream m a -> s -> m (Step s a)
ostep s
ost) =
    (State Stream m b
 -> ConcatUnfoldInterleaveState s s
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> ConcatUnfoldInterleaveState s s -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a.
State Stream 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 Stream m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step State Stream m a
gst (ConcatUnfoldInterleaveOuter s
o [s]
ls) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
ostep (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 (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
ConcatUnfoldInterleaveInner s
o' [s]
ls)
            Step s a
Stop -> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 Stream m a
_ (ConcatUnfoldInterleaveInner s
o []) =
            Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 [])

    step State Stream 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 (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
ConcatUnfoldInterleaveOuter 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 Stream m a
_ (ConcatUnfoldInterleaveInnerL [] []) = Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatUnfoldInterleaveState s s) b
forall s a. Step s a
Stop
    step State Stream m a
_ (ConcatUnfoldInterleaveInnerL [] [s]
rs) =
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 Stream 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 (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]
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
ConcatUnfoldInterleaveInnerL [s]
ls [s]
rs)

    step State Stream m a
_ (ConcatUnfoldInterleaveInnerR [] []) = Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatUnfoldInterleaveState s s) b
forall s a. Step s a
Stop
    step State Stream m a
_ (ConcatUnfoldInterleaveInnerR [s]
ls []) =
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
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 Stream 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 (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
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
ConcatUnfoldInterleaveInnerR [s]
ls [s]
rs)

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

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

-- 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
-- behvaior for now.
{-# INLINE_NORMAL interposeSuffix #-}
interposeSuffix
    :: Monad m
    => m c -> Unfold m b c -> Stream m b -> Stream m c
interposeSuffix :: m c -> Unfold m b c -> Stream m b -> Stream m c
interposeSuffix
    m c
action
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State Stream m b -> s -> m (Step s b)
step1 s
state1) =
    (State Stream m c
 -> InterposeSuffixState s s
 -> m (Step (InterposeSuffixState s s) c))
-> InterposeSuffixState s s -> Stream m c
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
forall (m :: * -> *) a.
State Stream 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 Stream m a
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
step State Stream m a
gst (InterposeSuffixFirst s
s1) = do
        Step s b
r <- State Stream m b -> s -> m (Step s b)
step1 (State Stream m a -> State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
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 (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 (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 Stream 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 (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 Stream m a
_ (InterposeSuffixSecond s
s1) = do
        c
r <- m c
action
        Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
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)

{-# 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).
{-# INLINE_NORMAL interpose #-}
interpose :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c
interpose :: m c -> Unfold m b c -> Stream m b -> Stream m c
interpose
    m c
action
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State Stream m b -> s -> m (Step s b)
step1 s
state1) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c
-> InterposeState s s Any -> m (Step (InterposeState s s Any) c)
forall (m :: * -> *) a a a.
State Stream 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 Stream m a
-> InterposeState s s a -> m (Step (InterposeState s s a) c)
step State Stream m a
gst (InterposeFirst s
s1) = do
        Step s b
r <- State Stream m b -> s -> m (Step s b)
step1 (State Stream m a -> State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
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 (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 (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 Stream 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 (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 Stream m a
gst (InterposeFirstInject s
s1) = do
        Step s b
r <- State Stream m b -> s -> m (Step s b)
step1 (State Stream m a -> State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
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 (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 (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 Stream 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 (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)
    -}

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

-- | Interleave streams (full streams, not the elements) unfolded from two
-- input streams and concat. Stop when the first stream stops. If the second
-- stream ends before the first one then first stream still keeps running alone
-- without any interleaving with the second stream.
--
--    [a1, a2, ... an]                   [b1, b2 ...]
-- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]
-- => [streamA1, streamB1, streamA2...StreamAn, streamBn]
-- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]
--
{-# INLINE_NORMAL gintercalateSuffix #-}
gintercalateSuffix
    :: Monad m
    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalateSuffix :: Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalateSuffix
    (Unfold s -> m (Step s c)
istep1 a -> m s
inject1) (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1)
    (Unfold s -> m (Step s c)
istep2 b -> m s
inject2) (Stream State Stream m b -> s -> m (Step s b)
step2 s
state2) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
forall (m :: * -> *) a.
State Stream 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 Stream m a
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
step State Stream m a
gst (ICUFirst s
s1 s
s2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (ICUState s s s s) c) -> m (Step (ICUState s s s s) c)
`seq` Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
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 (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 a
Stop -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
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 Stream m a
gst (ICUFirstOnly s
s1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (ICUState s s s s) c) -> m (Step (ICUState s s s s) c)
`seq` Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
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 (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 a
Stop -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
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 Stream 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 (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 Stream 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 (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 Stream m a
gst (ICUSecond s
s1 s
s2) = do
        Step s b
r <- State Stream m b -> s -> m (Step s b)
step2 (State Stream m a -> State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (ICUState s s s s) c) -> m (Step (ICUState s s s s) c)
`seq` Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
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 (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 b
Stop -> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
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 Stream 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 (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 Stream m a
_ (ICUSecondOnly s
_s2) = m (Step (ICUState s s s s) c)
forall a. HasCallStack => a
undefined
    step State Stream m a
_ (ICUSecondOnlyInner s
_s2 s
_i2) = m (Step (ICUState s s s s) c)
forall a. HasCallStack => a
undefined

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

-- | Interleave streams (full streams, not the elements) unfolded from two
-- input streams and concat. Stop when the first stream stops. If the second
-- stream ends before the first one then first stream still keeps running alone
-- without any interleaving with the second stream.
--
--    [a1, a2, ... an]                   [b1, b2 ...]
-- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]
-- => [streamA1, streamB1, streamA2...StreamAn, streamBn]
-- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]
--
{-# INLINE_NORMAL gintercalate #-}
gintercalate
    :: Monad m
    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalate :: Unfold m a c
-> Stream m a -> Unfold m b c -> Stream m b -> Stream m c
gintercalate
    (Unfold s -> m (Step s c)
istep1 a -> m s
inject1) (Stream State Stream m a -> s -> m (Step s a)
step1 s
state1)
    (Unfold s -> m (Step s c)
istep2 b -> m s
inject2) (Stream State Stream m b -> s -> m (Step s b)
step2 s
state2) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m c
-> ICALState s s s s Any -> m (Step (ICALState s s s s Any) c)
forall (m :: * -> *) a a a.
State Stream 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 Stream m a
-> ICALState s s s s a -> m (Step (ICALState s s s s a) c)
step State Stream m a
gst (ICALFirst s
s1 s
s2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
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 (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 (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 Stream 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 (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 Stream m a
gst (ICALFirstOnly s
s1) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
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 (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 (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 Stream 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 (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 Stream m a
gst (ICALSecondInject s
s1 s
s2) = do
        Step s b
r <- State Stream m b -> s -> m (Step s b)
step2 (State Stream m a -> State Stream m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
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 (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 (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 Stream m a
gst (ICALFirstInject s
s1 s
s2 s
i2) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step1 (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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)
`seq` Step (ICALState s s s s a) c -> m (Step (ICALState s s s s a) c)
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 (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 (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 Stream 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 (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)
    -}

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

{-# 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)
    | FIterYield b (FIterState s f m a b)
    | FIterStop

{-# INLINE_NORMAL foldIterateM #-}
foldIterateM ::
       Monad m => (b -> m (FL.Fold m a b)) -> b -> Stream m a -> Stream m b
foldIterateM :: (b -> m (Fold m a b)) -> b -> Stream m a -> Stream m b
foldIterateM b -> m (Fold m a b)
func b
seed0 (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream m b
 -> FIterState s b m a b -> m (Step (FIterState s b m a b) b))
-> FIterState s b m a b -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> FIterState s b m a b -> m (Step (FIterState s b m a b) b)
forall (m :: * -> *) a.
State Stream m a
-> FIterState s b m a b -> m (Step (FIterState s b m a b) b)
stepOuter (s -> b -> FIterState s b m a b
forall s f (m :: * -> *) a b. s -> f -> FIterState s f m a b
FIterInit s
state b
seed0)

    where

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

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

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

{-# ANN type ParseChunksState Fuse #-}
data ParseChunksState x inpBuf st pst =
      ParseChunksInit inpBuf st
    | ParseChunksInitLeftOver inpBuf
    | ParseChunksStream st inpBuf !pst
    | ParseChunksBuf inpBuf st inpBuf !pst
    | ParseChunksYield x (ParseChunksState x inpBuf st pst)

{-# INLINE_NORMAL parseMany #-}
parseMany
    :: MonadThrow m
    => PRD.Parser m a b
    -> Stream m a
    -> Stream m b
parseMany :: Parser m a b -> Stream m a -> Stream m b
parseMany (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract) (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream m b
 -> ParseChunksState b [a] s s
 -> m (Step (ParseChunksState b [a] s s) b))
-> ParseChunksState b [a] s s -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> ParseChunksState b [a] s s
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a.
State Stream m a
-> ParseChunksState b [a] s s
-> m (Step (ParseChunksState b [a] s s) b)
stepOuter ([a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [] s
state)

    where

    {-# INLINE_LATE stepOuter #-}
    -- Buffer is empty, get the first element from the stream, initialize the
    -- fold and then go to stream processing loop.
    stepOuter :: State Stream m a
-> ParseChunksState b [a] s s
-> m (Step (ParseChunksState b [a] s s) b)
stepOuter State Stream m a
gst (ParseChunksInit [] s
st) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                Initial s b
res <- m (Initial s b)
initial
                case Initial s b
res of
                    PRD.IPartial s
ps ->
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a
x] s
s [] s
ps
                    PRD.IDone b
pb ->
                        let next :: ParseChunksState x [a] s pst
next = [a] -> s -> ParseChunksState x [a] s pst
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [a
x] s
s
                         in Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
pb ParseChunksState b [a] s s
forall x pst. ParseChunksState x [a] s pst
next
                    PRD.IError String
err -> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Step (ParseChunksState b [a] s s) b))
-> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
            Skip s
s -> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [] s
s
            Step s a
Stop   -> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ParseChunksState b [a] s s) b
forall s a. Step s a
Stop

    -- Buffer is not empty, go to buffered processing loop
    stepOuter State Stream m a
_ (ParseChunksInit [a]
src s
st) = do
        Initial s b
res <- m (Initial s b)
initial
        case Initial s b
res of
            PRD.IPartial s
ps ->
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
src s
st [] s
ps
            PRD.IDone b
pb ->
                let next :: ParseChunksState x [a] s pst
next = [a] -> s -> ParseChunksState x [a] s pst
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [a]
src s
st
                 in Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
pb ParseChunksState b [a] s s
forall x pst. ParseChunksState x [a] s pst
next
            PRD.IError String
err -> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Step (ParseChunksState b [a] s s) b))
-> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    -- XXX we just discard any leftover input at the end
    stepOuter State Stream m a
_ (ParseChunksInitLeftOver [a]
_) = Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ParseChunksState b [a] s s) b
forall s a. Step s a
Stop

    -- Buffer is empty, process elements from the stream
    stepOuter State Stream m a
gst (ParseChunksStream s
st [a]
buf s
pst) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
                case Step s b
pRes of
                    PR.Partial Int
0 s
pst1 ->
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStream s
s [] s
pst1
                    PR.Partial Int
n s
pst1 -> do
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
src s
s [] s
pst1
                    PR.Continue Int
0 s
pst1 ->
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStream s
s (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf) s
pst1
                    PR.Continue Int
n s
pst1 -> do
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
src s
s [a]
buf1 s
pst1
                    PR.Done Int
0 b
b -> do
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$
                            b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [] s
s)
                    PR.Done Int
n b
b -> do
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf))
                        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$
                            b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [a]
src s
s)
                    PR.Error String
err -> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Step (ParseChunksState b [a] s s) b))
-> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
            Skip s
s -> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStream s
s [a]
buf s
pst
            Step s a
Stop   -> do
                b
b <- s -> m b
extract s
pst
                let src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
buf
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$
                    b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([a] -> ParseChunksState b [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [a]
src)

    -- go back to stream processing mode
    stepOuter State Stream m a
_ (ParseChunksBuf [] s
s [a]
buf s
pst) =
        Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStream s
s [a]
buf s
pst

    -- buffered processing loop
    stepOuter State Stream m a
_ (ParseChunksBuf (a
x:[a]
xs) s
s [a]
buf s
pst) = do
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
        case Step s b
pRes of
            PR.Partial Int
0 s
pst1 ->
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
xs s
s [] s
pst1
            PR.Partial Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
src s
s [] s
pst1
            PR.Continue Int
0 s
pst1 ->
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
xs s
s (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf) s
pst1
            PR.Continue Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ [a] -> s -> [a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [a]
src s
s [a]
buf1 s
pst1
            PR.Done Int
0 b
b ->
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [a]
xs s
s)
            PR.Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b
forall s a. s -> Step s a
Skip (ParseChunksState b [a] s s -> Step (ParseChunksState b [a] s s) b)
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall a b. (a -> b) -> a -> b
$ b -> ParseChunksState b [a] s s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([a] -> s -> ParseChunksState b [a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [a]
src s
s)
            PR.Error String
err -> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Step (ParseChunksState b [a] s s) b))
-> ParseError -> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    stepOuter State Stream m a
_ (ParseChunksYield b
a ParseChunksState b [a] s s
next) = Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [a] s s) b
 -> m (Step (ParseChunksState b [a] s s) b))
-> Step (ParseChunksState b [a] s s) b
-> m (Step (ParseChunksState b [a] s s) b)
forall a b. (a -> b) -> a -> b
$ b
-> ParseChunksState b [a] s s
-> Step (ParseChunksState b [a] s s) b
forall s a. a -> s -> Step s a
Yield b
a ParseChunksState b [a] s s
next

{-# ANN type ConcatParseState Fuse #-}
data ConcatParseState b inpBuf st p m a =
      ConcatParseInit inpBuf st p
    | ConcatParseInitLeftOver inpBuf
    | forall s. ConcatParseStream st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)
    | forall s. ConcatParseBuf inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m b)
    | ConcatParseYield b (ConcatParseState b inpBuf st p m a)

{-# INLINE_NORMAL parseIterate #-}
parseIterate
    :: MonadThrow m
    => (b -> PRD.Parser m a b)
    -> b
    -> Stream m a
    -> Stream m b
parseIterate :: (b -> Parser m a b) -> b -> Stream m a -> Stream m b
parseIterate b -> Parser m a b
func b
seed (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream m b
 -> ConcatParseState b [a] s (Parser m a b) m a
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> ConcatParseState b [a] s (Parser m a b) m a -> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> ConcatParseState b [a] s (Parser m a b) m a
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a.
State Stream m a
-> ConcatParseState b [a] s (Parser m a b) m a
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
stepOuter ([a]
-> s -> Parser m a b -> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState b inpBuf st p m a
ConcatParseInit [] s
state (b -> Parser m a b
func b
seed))

    where

    {-# INLINE_LATE stepOuter #-}
    -- Buffer is empty, go to stream processing loop
    stepOuter :: State Stream m a
-> ConcatParseState b [a] s (Parser m a b) m a
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
stepOuter State Stream m a
_ (ConcatParseInit [] s
st (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract)) = do
        Initial s b
res <- m (Initial s b)
initial
        case Initial s b
res of
            PRD.IPartial s
ps ->
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseStream s
st [] s -> a -> m (Step s b)
pstep s
ps s -> m b
extract
            PRD.IDone b
pb ->
                let next :: ConcatParseState b [a] s (Parser m a b) m a
next = [a]
-> s -> Parser m a b -> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState b inpBuf st p m a
ConcatParseInit [] s
st (b -> Parser m a b
func b
pb)
                 in Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ b
-> ConcatParseState b [a] s (Parser m a b) m a
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
b
-> ConcatParseState b inpBuf st p m a
-> ConcatParseState b inpBuf st p m a
ConcatParseYield b
pb ConcatParseState b [a] s (Parser m a b) m a
forall b a (m :: * -> *) a.
ConcatParseState b [a] s (Parser m a b) m a
next
            PRD.IError String
err -> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    -- Buffer is not empty, go to buffered processing loop
    stepOuter State Stream m a
_ (ConcatParseInit [a]
src s
st
                    (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract)) = do
        Initial s b
res <- m (Initial s b)
initial
        case Initial s b
res of
            PRD.IPartial s
ps ->
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseBuf [a]
src s
st [] s -> a -> m (Step s b)
pstep s
ps s -> m b
extract
            PRD.IDone b
pb ->
                let next :: ConcatParseState b [a] s (Parser m a b) m a
next = [a]
-> s -> Parser m a b -> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState b inpBuf st p m a
ConcatParseInit [a]
src s
st (b -> Parser m a b
func b
pb)
                 in Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ b
-> ConcatParseState b [a] s (Parser m a b) m a
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
b
-> ConcatParseState b inpBuf st p m a
-> ConcatParseState b inpBuf st p m a
ConcatParseYield b
pb ConcatParseState b [a] s (Parser m a b) m a
forall b (m :: * -> *) a.
ConcatParseState b [a] s (Parser m a b) m a
next
            PRD.IError String
err -> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    -- XXX we just discard any leftover input at the end
    stepOuter State Stream m a
_ (ConcatParseInitLeftOver [a]
_) = Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. Step s a
Stop

    -- Buffer is empty process elements from the stream
    stepOuter State Stream m a
gst (ConcatParseStream s
st [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m b
extract) = do
        Step s a
r <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
                case Step s b
pRes of
                    PR.Partial Int
0 s
pst1 ->
                        Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseStream s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m b
extract
                    PR.Partial Int
n s
pst1 -> do
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseBuf [a]
src s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m b
extract
                    -- PR.Continue 0 pst1 ->
                    --     return $ Skip $ ConcatParseStream s (x:buf) pst1
                    PR.Continue Int
n s
pst1 -> do
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                            src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                        Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseBuf [a]
src s
s [a]
buf1 s -> a -> m (Step s b)
pstep s
pst1 s -> m b
extract
                    -- XXX Specialize for Stop 0 common case?
                    PR.Done Int
n b
b -> do
                        Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf))
                        Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$
                            b
-> ConcatParseState b [a] s (Parser m a b) m a
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
b
-> ConcatParseState b inpBuf st p m a
-> ConcatParseState b inpBuf st p m a
ConcatParseYield b
b ([a]
-> s -> Parser m a b -> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState b inpBuf st p m a
ConcatParseInit [a]
src s
s (b -> Parser m a b
func b
b))
                    PR.Error String
err -> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
            Skip s
s -> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseStream s
s [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m b
extract
            Step s a
Stop   -> do
                b
b <- s -> m b
extract s
pst
                let src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
buf
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ b
-> ConcatParseState b [a] s (Parser m a b) m a
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
b
-> ConcatParseState b inpBuf st p m a
-> ConcatParseState b inpBuf st p m a
ConcatParseYield b
b ([a] -> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState b inpBuf st p m a
ConcatParseInitLeftOver [a]
src)

    -- go back to stream processing mode
    stepOuter State Stream m a
_ (ConcatParseBuf [] s
s [a]
buf s -> a -> m (Step s b)
pstep s
ps s -> m b
extract) =
        Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseStream s
s [a]
buf s -> a -> m (Step s b)
pstep s
ps s -> m b
extract

    -- buffered processing loop
    stepOuter State Stream m a
_ (ConcatParseBuf (a
x:[a]
xs) s
s [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m b
extract) = do
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
        case Step s b
pRes of
            PR.Partial Int
0 s
pst1 ->
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseBuf [a]
xs s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m b
extract
            PR.Partial Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [a]
src0 = Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseBuf [a]
src s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m b
extract
         -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1
            PR.Continue Int
n s
pst1 -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([a]
src0, [a]
buf1) = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m b)
-> ConcatParseState b inpBuf st p m a
ConcatParseBuf [a]
src s
s [a]
buf1 s -> a -> m (Step s b)
pstep s
pst1 s -> m b
extract
            -- XXX Specialize for Stop 0 common case?
            PR.Done Int
n b
b -> do
                Bool -> m () -> m ()
forall a. HasCallStack => Bool -> a -> a
assert (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src :: [a]
src = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse (Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
Prelude.take Int
n (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf)) [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
xs
                Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. s -> Step s a
Skip (ConcatParseState b [a] s (Parser m a b) m a
 -> Step (ConcatParseState b [a] s (Parser m a b) m a) b)
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall a b. (a -> b) -> a -> b
$ b
-> ConcatParseState b [a] s (Parser m a b) m a
-> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
b
-> ConcatParseState b inpBuf st p m a
-> ConcatParseState b inpBuf st p m a
ConcatParseYield b
b
                                    ([a]
-> s -> Parser m a b -> ConcatParseState b [a] s (Parser m a b) m a
forall b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState b inpBuf st p m a
ConcatParseInit [a]
src s
s (b -> Parser m a b
func b
b))
            PR.Error String
err -> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> ParseError
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    stepOuter State Stream m a
_ (ConcatParseYield b
a ConcatParseState b [a] s (Parser m a b) m a
next) = Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatParseState b [a] s (Parser m a b) m a) b
 -> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b))
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
-> m (Step (ConcatParseState b [a] s (Parser m a b) m a) b)
forall a b. (a -> b) -> a -> b
$ b
-> ConcatParseState b [a] s (Parser m a b) m a
-> Step (ConcatParseState b [a] s (Parser m a b) m a) b
forall s a. a -> s -> Step s a
Yield b
a ConcatParseState b [a] s (Parser m a b) m a
next

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

{-# INLINE_NORMAL groupsBy #-}
groupsBy :: Monad m
    => (a -> a -> Bool)
    -> Fold m a b
    -> Stream m a
    -> Stream m b
{-
groupsBy eq fld = parseMany (PRD.groupBy eq fld)
-}
groupsBy :: (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
groupsBy a -> a -> Bool
cmp (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
done) (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> GroupByState s s a Any -> m (Step (GroupByState s s a Any) b)
forall (m :: * -> *) a b b.
State Stream 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 Stream m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter State Stream 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 (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 Stream m a
gst (GroupingDo s
st s
fs) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (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 (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 -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
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 Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
x a
prev
                    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 (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
done s
acc
                        Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
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 -> s -> m b
done s
acc m b
-> (b -> m (Step (GroupByState s fs a b) b))
-> m (Step (GroupByState s fs a b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
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 Stream 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 (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 Stream 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 (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 Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
x a
prev
                    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 (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
done s
acc
                        Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
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 -> s -> m b
done s
acc m b
-> (b -> m (Step (GroupByState s fs a b) b))
-> m (Step (GroupByState s fs a b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
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 Stream m a
_ (GroupingYield b
_ GroupByState s s a b
_) = String -> m (Step (GroupByState s s a b) b)
forall a. HasCallStack => String -> a
error String
"groupsBy: Unreachable"
    stepOuter State Stream m a
_ GroupByState s s a b
GroupingDone = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (GroupByState s s a b) b
forall s a. Step s a
Stop

{-# 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 :: (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
done) (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a.
State Stream 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 Stream m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter State Stream 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 (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 Stream m a
gst (GroupingDo s
st s
fs) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (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 (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 -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
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 Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (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
done s
acc
                        Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
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 -> s -> m b
done s
acc m b
-> (b -> m (Step (GroupByState s fs a b) b))
-> m (Step (GroupByState s fs a b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
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 Stream 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 (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 Stream 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 (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: groupsBy 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 Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (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 <- done 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
done s
acc
                        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
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 -> s -> m b
done s
acc m b
-> (b -> m (Step (GroupByState s s a b) b))
-> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
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 Stream 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 (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 Stream m a
_ GroupByState s s a b
GroupingDone = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
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)

{-# INLINE_NORMAL wordsBy #-}
wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b
wordsBy :: (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
done) (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
forall (m :: * -> *) a.
State Stream 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 Stream m a
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
stepOuter State Stream 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 (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 Stream m a
gst (WordsByDo s
st s
fs) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (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 (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 (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      -> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
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 Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 <- done 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
done s
acc
                        Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
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 (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 -> s -> m b
done s
acc m b
-> (b -> m (Step (WordsByState s s b) b))
-> m (Step (WordsByState s s b) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
r -> Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
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 Stream m a
_ WordsByState s s b
WordsByDone = Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (WordsByState s s b) b
forall s a. Step s a
Stop

    stepOuter State Stream m a
_ (WordsByYield b
b WordsByState s s b
next) = Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
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

{-
-- 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 rb rh ck w fs s b x =
      SplitOnSeqInit
    | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)
    | SplitOnSeqDone

    | SplitOnSeqEmpty !fs s

    | SplitOnSeqSingle !fs s x

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

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

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

{-# INLINE_NORMAL splitOnSeq #-}
splitOnSeq
    :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)
    => Array a
    -> Fold m a b
    -> Stream m a
    -> Stream m b
splitOnSeq :: Array a -> Fold m a b -> Stream m a -> Stream m b
splitOnSeq Array a
patArr (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
done) (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream m b
 -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a.
State Stream m a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
stepOuter SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x. SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqInit

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Storable a => Array a -> Int
A.length Array a
patArr
    maxIndex :: Int
maxIndex = Int
patLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    elemBits :: Int
elemBits = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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. Storable 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. Storable 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 :: s -> m (Step s a)
skip = Step s a -> m (Step s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s a -> m (Step s a)) -> (s -> Step s a) -> s -> m (Step s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step s a
forall s a. s -> Step s a
Skip

    nextAfterInit :: (fs -> SplitOnSeqState rb rh ck w fs s b x)
-> Step fs b -> SplitOnSeqState rb rh ck w fs s b x
nextAfterInit fs -> SplitOnSeqState 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 rb rh ck w fs s b x
nextGen fs
s
            FL.Done b
b -> b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
b ((fs -> SplitOnSeqState rb rh ck w fs s b x)
-> SplitOnSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
(fs -> SplitOnSeqState rb rh ck w fs s b x)
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqReinit fs -> SplitOnSeqState rb rh ck w fs s b x
nextGen)

    {-# INLINE yieldProceed #-}
    yieldProceed :: (s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState 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 rb rh ck w s s b x) a))
-> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSeqState rb rh ck w s s b x
-> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState rb rh ck w s s b x
 -> m (Step (SplitOnSeqState rb rh ck w s s b x) a))
-> (Step s b -> SplitOnSeqState rb rh ck w s s b x)
-> Step s b
-> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b
-> SplitOnSeqState rb rh ck w s s b x
-> SplitOnSeqState rb rh ck w s s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
fs (SplitOnSeqState rb rh ck w s s b x
 -> SplitOnSeqState rb rh ck w s s b x)
-> (Step s b -> SplitOnSeqState rb rh ck w s s b x)
-> Step s b
-> SplitOnSeqState rb rh ck w s s b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SplitOnSeqState rb rh ck w s s b x)
-> Step s b -> SplitOnSeqState rb rh ck w s s b x
forall fs rb rh ck w s b x.
(fs -> SplitOnSeqState rb rh ck w fs s b x)
-> Step fs b -> SplitOnSeqState rb rh ck w fs s b x
nextAfterInit s -> SplitOnSeqState rb rh ck w s s b x
nextGen

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State Stream m a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
stepOuter State Stream m a
_ SplitOnSeqState (Ring a) (Ptr a) 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 ->
                if Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. s -> Step s a
Skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall a b. (a -> b) -> a -> b
$ s -> s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqEmpty s
acc s
state
                else if Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                     then do
                         a
pat <- 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
$ Array a -> Int -> IO a
forall a. Storable a => Array a -> Int -> IO a
A.unsafeIndexIO Array a
patArr Int
0
                         Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. s -> Step s a
Skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqSingle s
acc s
state a
pat
                     else if a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
patLen
                               Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word)
                          then Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. s -> Step s a
Skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall a b. (a -> b) -> a -> b
$ s -> s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqWordInit s
acc s
state
                          else do
                              (Ring a
rb, Ptr a
rhead) <- IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ring a, Ptr a) -> m (Ring a, Ptr a))
-> IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ring a, Ptr a)
forall a. Storable a => Int -> IO (Ring a, Ptr a)
RB.new Int
patLen
                              SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRInit Int
0 s
acc s
state Ring a
rb Ptr a
rhead
            FL.Done b
b -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
b SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x. SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqInit

    stepOuter State Stream m a
_ (SplitOnSeqYield b
x SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
next) = Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. a -> s -> Step s a
Yield b
x SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
next

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

    stepOuter State Stream m a
_ (SplitOnSeqReinit s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
nextGen) =
        m (Step s b)
initial m (Step s b)
-> (Step s b
    -> m (Step
            (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> (Step s b
    -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> Step s b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> Step s b -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w s b x.
(fs -> SplitOnSeqState rb rh ck w fs s b x)
-> Step fs b -> SplitOnSeqState rb rh ck w fs s b x
nextAfterInit s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
nextGen

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

    stepOuter State Stream m a
gst (SplitOnSeqEmpty s
acc s
st) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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
done s
acc1
                        FL.Done b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
                let jump :: fs -> SplitOnSeqState rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqEmpty fs
c s
s
                 in (s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w b x. fs -> SplitOnSeqState rb rh ck w fs s b x
jump b
b1
            Skip s
s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (s -> s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqEmpty s
acc s
s)
            Step s a
Stop -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. Step s a
Stop

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

    stepOuter State Stream m a
_ SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
SplitOnSeqDone = Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. Step s a
Stop

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

    stepOuter State Stream m a
gst (SplitOnSeqSingle s
fs s
st a
pat) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                let jump :: fs -> SplitOnSeqState rb rh ck w fs s b a
jump fs
c = fs -> s -> a -> SplitOnSeqState rb rh ck w fs s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState 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
done s
fs m b
-> (b
    -> m (Step
            (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w b. fs -> SplitOnSeqState 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 -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w b. fs -> SplitOnSeqState rb rh ck w fs s b a
jump s
fs1
                        FL.Done b
b -> (s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w b. fs -> SplitOnSeqState rb rh ck w fs s b a
jump b
b
            Skip s
s -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. s -> Step s a
Skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqSingle s
fs s
s a
pat
            Step s a
Stop -> do
                b
r <- s -> m b
done s
fs
                Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. s -> Step s a
Skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x. SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqDone

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

    stepOuter State Stream m a
_ (SplitOnSeqWordDone Int
0 s
fs Word
_) = do
        b
r <- s -> m b
done s
fs
        SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x. SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqDone
    stepOuter State Stream 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 (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Word
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState 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 rb rh ck Word fs s b x
jump fs
c = Int -> fs -> Word -> SplitOnSeqState rb rh ck Word fs s b x
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState 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 (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck s b x.
fs -> SplitOnSeqState rb rh ck Word fs s b x
jump b
b

    stepOuter State Stream m a
gst (SplitOnSeqWordInit s
fs s
st0) =
        SPEC
-> Int
-> Word
-> s
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck x a.
SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
go SPEC
SPEC Int
0 Word
0 s
st0

        where

        {-# INLINE go #-}
        go :: SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
go !SPEC
_ !Int
idx !Word
wrd !s
st = do
            Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqWordInit fs
c s
s
                            s -> m b
done s
fs m b
-> (b -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a))
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x. fs -> SplitOnSeqState rb rh ck w fs s b x
jump
                        else SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a))
-> SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Word -> s -> s -> SplitOnSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
w -> s -> fs -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqWordLoop Word
wrd1 s
s s
fs
                    else SPEC
-> Int
-> Word
-> s
-> m (Step (SplitOnSeqState 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 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 rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a))
-> SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqWordDone Int
idx s
fs Word
wrd
                    else do
                        b
r <- s -> m b
done s
fs
                        SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a))
-> SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState rb rh ck Word s s b x
-> SplitOnSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x. SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqDone

    stepOuter State Stream m a
gst (SplitOnSeqWordLoop Word
wrd0 s
st0 s
fs0) =
        SPEC
-> Word
-> s
-> s
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck x a.
SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState 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 (SplitOnSeqState rb rh ck Word s s b x) a)
go !SPEC
_ !Word
wrd !s
st !s
fs = do
            Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSeqState rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqWordInit 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
done s
fs1 m b
-> (b -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a))
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x. fs -> SplitOnSeqState rb rh ck w fs s b x
jump
                            else SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd1 s
s s
fs1
                        FL.Done b
b -> (s -> SplitOnSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x. fs -> SplitOnSeqState rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd s
s s
fs
                Step s a
Stop -> SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSeqState rb rh ck Word s s b x) a))
-> SplitOnSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqWordDone Int
patLen s
fs Word
wrd

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

    stepOuter State Stream m a
gst (SplitOnSeqKRInit Int
idx s
fs s
st Ring a
rb Ptr a
rh) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr a) -> m (Ptr a)) -> IO (Ptr a) -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
RB.unsafeInsert Ring a
rb Ptr a
rh a
x
                if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIndex
                then do
                    let fld :: (b -> a -> b) -> b -> Ring a -> b
fld = Ptr a -> (b -> a -> b) -> b -> Ring a -> b
forall a b.
Storable a =>
Ptr a -> (b -> a -> b) -> b -> Ring a -> b
RB.unsafeFoldRing (Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.ringBound Ring a
rb)
                    let !ringHash :: Word32
ringHash = (Word32 -> a -> Word32) -> Word32 -> Ring a -> Word32
forall b. (b -> a -> b) -> b -> Ring a -> b
fld Word32 -> a -> Word32
forall a. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Ring a
rb
                    if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                    then SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRCheck s
fs s
s Ring a
rb Ptr a
rh1
                    else SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> Word32
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> ck -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRLoop s
fs s
s Ring a
rb Ptr a
rh1 Word32
ringHash
                else SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRInit (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) s
fs s
s Ring a
rb Ptr a
rh1
            Skip s
s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRInit Int
idx s
fs s
s Ring a
rb Ptr a
rh
            Step s a
Stop -> do
                SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRDone Int
idx s
fs Ring a
rb (Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring 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 "rb" outside the loop.
    --
    stepOuter State Stream m a
gst (SplitOnSeqKRLoop s
fs0 s
st0 Ring a
rb Ptr a
rh0 Word32
cksum0) =
        SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall ck w x a.
SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
go SPEC
SPEC s
fs0 s
st0 Ptr a
rh0 Word32
cksum0

        where

        go :: SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
go !SPEC
_ !s
fs !s
st !Ptr a
rh !Word32
cksum = do
            Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    a
old <- 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
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
rh
                    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
                    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
                            Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
RB.unsafeInsert Ring a
rb Ptr a
rh a
x)
                            if Word32
cksum1 Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                            then SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
 -> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a))
-> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRCheck s
fs1 s
s Ring a
rb Ptr a
rh1
                            else SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
go SPEC
SPEC s
fs1 s
s Ptr a
rh1 Word32
cksum1
                        FL.Done b
b -> do
                            let rst :: Ptr a
rst = Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb
                                jump :: fs -> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int -> fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRInit Int
0 fs
c s
s Ring a
rb Ptr a
rst
                            (s -> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x)
-> b -> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
forall fs ck w b x.
fs -> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
go SPEC
SPEC s
fs s
s Ptr a
rh Word32
cksum
                Step s a
Stop -> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
 -> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a))
-> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) ck w s s b x
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRDone Int
patLen s
fs Ring a
rb Ptr a
rh

    -- 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 Stream m a
_ (SplitOnSeqKRCheck s
fs s
st Ring a
rb Ptr a
rh) = do
        if Ring a -> Ptr a -> Array a -> Bool
forall a. Ring a -> Ptr a -> Array a -> Bool
RB.unsafeEqArray Ring a
rb Ptr a
rh Array a
patArr
        then do
            b
r <- s -> m b
done s
fs
            let rst :: Ptr a
rst = Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb
                jump :: fs -> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int -> fs -> s -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRInit Int
0 fs
c s
st Ring a
rb Ptr a
rst
            (s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs ck w b x.
fs -> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
r
        else SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> Word32
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> ck -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRLoop s
fs s
st Ring a
rb Ptr a
rh Word32
patHash

    stepOuter State Stream m a
_ (SplitOnSeqKRDone Int
0 s
fs Ring a
_ Ptr a
_) = do
        b
r <- s -> m b
done s
fs
        SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSeqState rb rh ck w fs s b x
-> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqYield b
r SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x. SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqDone
    stepOuter State Stream m a
_ (SplitOnSeqKRDone Int
n s
fs Ring a
rb Ptr a
rh) = do
        a
old <- 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
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
rh
        let rh1 :: Ptr a
rh1 = Ring a -> Ptr a -> Ptr a
forall a. Storable a => Ring a -> Ptr a -> Ptr a
RB.advance Ring a
rb Ptr a
rh
        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 (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
fs1 Ring a
rb Ptr a
rh1
            FL.Done b
b -> do
                 let jump :: fs -> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> Ring a
-> Ptr a
-> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSeqState rb rh ck w fs s b x
SplitOnSeqKRDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) fs
c Ring a
rb Ptr a
rh1
                 (s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs ck w s b x.
fs -> SplitOnSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
b

{-# ANN type SplitOnSuffixSeqState Fuse #-}
data SplitOnSuffixSeqState rb rh ck w fs s b x =
      SplitOnSuffixSeqInit
    | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState 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 Int !fs s rb !rh
    | SplitOnSuffixSeqKRInit1 !fs s rb !rh
    | SplitOnSuffixSeqKRLoop fs s rb !rh !ck
    | SplitOnSuffixSeqKRCheck fs s rb !rh
    | SplitOnSuffixSeqKRDone Int !fs rb !rh

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

{-# INLINE_NORMAL splitOnSuffixSeq #-}
splitOnSuffixSeq
    :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)
    => Bool
    -> Array a
    -> Fold m a b
    -> Stream m a
    -> Stream m b
splitOnSuffixSeq :: 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
done) (Stream State Stream m a -> s -> m (Step s a)
step s
state) =
    (State Stream m b
 -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Stream m b
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream m b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a.
State Stream m a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
stepOuter SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqInit

    where

    patLen :: Int
patLen = Array a -> Int
forall a. Storable a => Array a -> Int
A.length Array a
patArr
    maxIndex :: Int
maxIndex = Int
patLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    elemBits :: Int
elemBits = a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
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. Storable 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 rb rh ck w fs s b x)
-> Step fs b -> SplitOnSuffixSeqState rb rh ck w fs s b x
nextAfterInit fs -> SplitOnSuffixSeqState 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 rb rh ck w fs s b x
nextGen fs
s
            FL.Done b
b ->
                b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
b ((fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
-> SplitOnSuffixSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
(fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqReinit fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
nextGen)

    {-# INLINE yieldProceed #-}
    yieldProceed :: (s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState 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 rb rh ck w s s b x) a))
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSuffixSeqState rb rh ck w s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState rb rh ck w s s b x
 -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a))
-> (Step s b -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> Step s b
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b
-> SplitOnSuffixSeqState rb rh ck w s s b x
-> SplitOnSuffixSeqState rb rh ck w s s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
fs (SplitOnSuffixSeqState rb rh ck w s s b x
 -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> (Step s b -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> Step s b
-> SplitOnSuffixSeqState rb rh ck w s s b x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> Step s b -> SplitOnSuffixSeqState rb rh ck w s s b x
forall fs rb rh ck w s b x.
(fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
-> Step fs b -> SplitOnSuffixSeqState rb rh ck w fs s b x
nextAfterInit s -> SplitOnSuffixSeqState rb rh ck w s s b x
nextGen

    -- For single element pattern case
    {-# INLINE processYieldSingle #-}
    processYieldSingle :: a
-> a
-> s
-> s
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a)
processYieldSingle a
pat a
x s
s s
fs = do
        let jump :: fs -> SplitOnSuffixSeqState rb rh ck w fs s b a
jump fs
c = fs -> s -> a -> SplitOnSuffixSeqState rb rh ck w fs s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState 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 (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
done s
fs1
                    FL.Done b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
            (s -> SplitOnSuffixSeqState rb rh ck w s s b a)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState rb rh ck w s s b a
forall fs rb rh ck w b.
fs -> SplitOnSuffixSeqState 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 rb rh ck w s s b a
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState rb rh ck w s s b a
 -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a))
-> SplitOnSuffixSeqState rb rh ck w s s b a
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a)
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> SplitOnSuffixSeqState rb rh ck w s s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqSingle s
fs1 s
s a
pat
                FL.Done b
b -> (s -> SplitOnSuffixSeqState rb rh ck w s s b a)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState rb rh ck w s s b a
forall fs rb rh ck w b.
fs -> SplitOnSuffixSeqState 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. Storable 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 :: s -> m (Step s a)
skip = Step s a -> m (Step s a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step s a -> m (Step s a)) -> (s -> Step s a) -> s -> m (Step s a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Step s a
forall s a. s -> Step s a
Skip

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State Stream m a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
stepOuter State Stream m a
_ SplitOnSuffixSeqState (Ring a) (Ptr a) 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 ->
                if Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqEmpty s
fs s
state
                else if Int
patLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
                     then do
                         a
pat <- 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
$ Array a -> Int -> IO a
forall a. Storable a => Array a -> Int -> IO a
A.unsafeIndexIO Array a
patArr Int
0
                         SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqSingleInit s
fs s
state a
pat
                     else if a -> Int
forall a. Storable a => a -> Int
sizeOf (a
forall a. HasCallStack => a
undefined :: a) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
patLen
                               Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int
forall a. Storable a => a -> Int
sizeOf (Word
forall a. HasCallStack => a
undefined :: Word)
                          then SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqWordInit s
fs s
state
                          else do
                              (Ring a
rb, Ptr a
rhead) <- IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ring a, Ptr a) -> m (Ring a, Ptr a))
-> IO (Ring a, Ptr a) -> m (Ring a, Ptr a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ring a, Ptr a)
forall a. Storable a => Int -> IO (Ring a, Ptr a)
RB.new Int
patLen
                              SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int
-> fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit Int
0 s
fs s
state Ring a
rb Ptr a
rhead
            FL.Done b
fb -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
fb SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqInit

    stepOuter State Stream m a
_ (SplitOnSuffixSeqYield b
x SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
next) = Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> Step
     (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> Step
     (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. a -> s -> Step s a
Yield b
x SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
next

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

    stepOuter State Stream m a
_ (SplitOnSuffixSeqReinit s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
nextGen) =
        m (Step s b)
initial m (Step s b)
-> (Step s b
    -> m (Step
            (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> (Step s b
    -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> Step s b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> Step s b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w s b x.
(fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)
-> Step fs b -> SplitOnSuffixSeqState rb rh ck w fs s b x
nextAfterInit s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
nextGen

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

    stepOuter State Stream m a
gst (SplitOnSuffixSeqEmpty s
acc s
st) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                let jump :: fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState 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
done s
fs
                        FL.Done b
b -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
                (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w b x.
fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump b
b1
            Skip s
s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (s
-> s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqEmpty s
acc s
s)
            Step s a
Stop -> Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. Step s a
Stop

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

    stepOuter State Stream m a
_ SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
SplitOnSuffixSeqDone = Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. Step s a
Stop

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

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

    stepOuter State Stream m a
gst (SplitOnSuffixSeqSingle s
fs s
st a
pat) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> a
-> a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s rb rh ck w a.
a
-> a
-> s
-> s
-> m (Step (SplitOnSuffixSeqState rb rh ck w s s b a) a)
processYieldSingle a
pat a
x s
s s
fs
            Skip s
s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> x -> SplitOnSuffixSeqState 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
done s
fs
                SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqDone

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

    stepOuter State Stream m a
_ (SplitOnSuffixSeqWordDone Int
0 s
fs Word
_) = do
        b
r <- s -> m b
done s
fs
        SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqDone
    stepOuter State Stream 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 (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Word
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState 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 rb rh ck Word fs s b x
jump fs
c = Int -> fs -> Word -> SplitOnSuffixSeqState rb rh ck Word fs s b x
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState 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 (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck s b x.
fs -> SplitOnSuffixSeqState rb rh ck Word fs s b x
jump b
b

    stepOuter State Stream m a
gst (SplitOnSuffixSeqWordInit s
fs0 s
st0) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream 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 (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 (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck x a.
SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState 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 rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqWordInit fs
c s
s
                        (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs rb rh ck w b x.
fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump b
b
            Skip s
s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (s
-> s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqWordInit s
fs0 s
s)
            Step s a
Stop -> Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState (Ring a) (Ptr a) 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 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 Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState 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 (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 ->
                            if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxIndex
                            then SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState 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
                            else 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 SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Word -> s -> s -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
w -> s -> fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqWordLoop Word
wrd1 s
s s
fs1
                            else do s -> m b
done s
fs m b
-> (b -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a))
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSuffixSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x.
fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump
                        FL.Done b
b -> (s -> SplitOnSuffixSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x.
fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Int
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
go SPEC
SPEC Int
idx Word
wrd s
s s
fs
                Step s a
Stop -> SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqWordDone Int
idx s
fs Word
wrd

    stepOuter State Stream m a
gst (SplitOnSuffixSeqWordLoop Word
wrd0 s
st0 s
fs0) =
        SPEC
-> Word
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck x a.
SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState 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 rb rh ck Word s s b x) a)
go !SPEC
_ !Word
wrd !s
st !s
fs = do
            Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump fs
c = fs -> s -> SplitOnSuffixSeqState rb rh ck w fs s b x
forall rb rh ck w fs s b x.
fs -> s -> SplitOnSuffixSeqState 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
done s
fs1 m b
-> (b -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a))
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (s -> SplitOnSuffixSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x.
fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump
                            else SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd1 s
s s
fs1
                        FL.Done b
b -> (s -> SplitOnSuffixSeqState rb rh ck Word s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall fs rb rh ck w b x.
fs -> SplitOnSuffixSeqState rb rh ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Word
-> s
-> s
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
go SPEC
SPEC Word
wrd s
s s
fs
                Step s a
Stop ->
                    if Word
wrd 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 Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a
forall s a. Step s a
Stop
                    else if Bool
withSep
                    then do
                        b
r <- s -> m b
done s
fs
                        SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState rb rh ck Word s s b x
-> SplitOnSuffixSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState rb rh ck Word s s b x
 -> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a))
-> SplitOnSuffixSeqState rb rh ck Word s s b x
-> m (Step (SplitOnSuffixSeqState rb rh ck Word s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Word -> SplitOnSuffixSeqState rb rh ck Word s s b x
forall rb rh ck w fs s b x.
Int -> fs -> w -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqWordDone Int
patLen s
fs Word
wrd

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

    stepOuter State Stream m a
gst (SplitOnSuffixSeqKRInit Int
idx0 s
fs s
st0 Ring a
rb Ptr a
rh0) = do
        Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st0
        case Step s a
res of
            Yield a
x s
s -> do
                Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr a) -> m (Ptr a)) -> IO (Ptr a) -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
RB.unsafeInsert Ring a
rb Ptr a
rh0 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 (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 (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit1 s
fs1 s
s Ring a
rb Ptr a
rh1
                    FL.Done b
b -> do
                        let rst :: Ptr a
rst = Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb
                            jump :: fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int
-> fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit Int
0 fs
c s
s Ring a
rb Ptr a
rst
                        (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs ck w b x.
fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
b
            Skip s
s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int
-> fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit Int
idx0 s
fs s
s Ring a
rb Ptr a
rh0
            Step s a
Stop -> Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b
forall s a. Step s a
Stop

    stepOuter State Stream m a
gst (SplitOnSuffixSeqKRInit1 s
fs0 s
st0 Ring a
rb Ptr a
rh0) = do
        SPEC
-> Int
-> Ptr a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall w x a.
SPEC
-> Int
-> Ptr a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
go SPEC
SPEC Int
1 Ptr a
rh0 s
st0 s
fs0

        where

        go :: SPEC
-> Int
-> Ptr a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
go !SPEC
_ !Int
idx !Ptr a
rh s
st !s
fs = do
            Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
RB.unsafeInsert Ring a
rb Ptr a
rh 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 (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 ->
                            if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
maxIndex
                            then SPEC
-> Int
-> Ptr a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
go SPEC
SPEC (Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Ptr a
rh1 s
s s
fs1
                            else SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall a b. (a -> b) -> a -> b
$
                                let fld :: (b -> a -> b) -> b -> Ring a -> b
fld = Ptr a -> (b -> a -> b) -> b -> Ring a -> b
forall a b.
Storable a =>
Ptr a -> (b -> a -> b) -> b -> Ring a -> b
RB.unsafeFoldRing (Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.ringBound Ring a
rb)
                                    !ringHash :: Word32
ringHash = (Word32 -> a -> Word32) -> Word32 -> Ring a -> Word32
forall b. (b -> a -> b) -> b -> Ring a -> b
fld Word32 -> a -> Word32
forall a. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Ring a
rb
                                 in if Word32
ringHash Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
patHash
                                    then s
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRCheck s
fs1 s
s Ring a
rb Ptr a
rh1
                                    else s
-> s
-> Ring a
-> Ptr a
-> Word32
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
forall rb rh ck w fs s b x.
fs
-> s -> rb -> rh -> ck -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRLoop
                                            s
fs1 s
s Ring a
rb Ptr a
rh1 Word32
ringHash
                        FL.Done b
b -> do
                            let rst :: Ptr a
rst = Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb
                                jump :: fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int
-> fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit Int
0 fs
c s
s Ring a
rb Ptr a
rst
                            (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
forall fs ck w b x.
fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> Int
-> Ptr a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
go SPEC
SPEC Int
idx Ptr a
rh s
s s
fs
                Step s a
Stop -> do
                    -- do not issue a blank segment when we end at pattern
                    if (Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIndex) Bool -> Bool -> Bool
&& Ring a -> Ptr a -> Array a -> Bool
forall a. Ring a -> Ptr a -> Array a -> Bool
RB.unsafeEqArray Ring a
rb Ptr a
rh Array a
patArr
                    then Step (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState (Ring a) (Ptr a) 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
done s
fs
                        SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 w s s b x
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRDone Int
idx s
fs Ring a
rb (Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb)

    stepOuter State Stream m a
gst (SplitOnSuffixSeqKRLoop s
fs0 s
st0 Ring a
rb Ptr a
rh0 Word32
cksum0) =
        SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall ck w x a.
SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
go SPEC
SPEC s
fs0 s
st0 Ptr a
rh0 Word32
cksum0

        where

        go :: SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
go !SPEC
_ !s
fs !s
st !Ptr a
rh !Word32
cksum = do
            Step s a
res <- State Stream m a -> s -> m (Step s a)
step (State Stream m a -> State Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    a
old <- 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
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
rh
                    Ptr a
rh1 <- IO (Ptr a) -> m (Ptr a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ring a -> Ptr a -> a -> IO (Ptr a)
forall a. Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)
RB.unsafeInsert Ring a
rb Ptr a
rh 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
                    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
-> Ptr a
-> Word32
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
go SPEC
SPEC s
fs1 s
s Ptr a
rh1 Word32
cksum1
                            else SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
forall rb rh ck w fs s b x.
fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRCheck s
fs1 s
s Ring a
rb Ptr a
rh1
                        FL.Done b
b -> do
                            let rst :: Ptr a
rst = Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb
                                jump :: fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int
-> fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit Int
0 fs
c s
s Ring a
rb Ptr a
rst
                            (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x)
-> b
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
forall fs ck w b x.
fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
b
                Skip s
s -> SPEC
-> s
-> s
-> Ptr a
-> Word32
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
go SPEC
SPEC s
fs s
s Ptr a
rh Word32
cksum
                Step s a
Stop ->
                    if Ring a -> Ptr a -> Array a -> Bool
forall a. Ring a -> Ptr a -> Array a -> Bool
RB.unsafeEqArray Ring a
rb Ptr a
rh Array a
patArr
                    then Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a
forall s a. Step s a
Stop
                    else if Bool
withSep
                    then do
                        b
r <- s -> m b
done s
fs
                        SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqDone
                    else SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
-> m (Step (SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x) a)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w s s b x
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRDone Int
patLen s
fs Ring a
rb Ptr a
rh

    stepOuter State Stream m a
_ (SplitOnSuffixSeqKRCheck s
fs s
st Ring a
rb Ptr a
rh) = do
        if Ring a -> Ptr a -> Array a -> Bool
forall a. Ring a -> Ptr a -> Array a -> Bool
RB.unsafeEqArray Ring a
rb Ptr a
rh Array a
patArr
        then do
            b
r <- s -> m b
done s
fs
            let rst :: Ptr a
rst = Ring a -> Ptr a
forall a. Ring a -> Ptr a
RB.startOf Ring a
rb
                jump :: fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int
-> fs -> s -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRInit Int
0 fs
c s
st Ring a
rb Ptr a
rst
            (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs ck w b x.
fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
r
        else SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ s
-> s
-> Ring a
-> Ptr a
-> Word32
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
fs
-> s -> rb -> rh -> ck -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRLoop s
fs s
st Ring a
rb Ptr a
rh Word32
patHash

    stepOuter State Stream m a
_ (SplitOnSuffixSeqKRDone Int
0 s
fs Ring a
_ Ptr a
_) = do
        b
r <- s -> m b
done s
fs
        SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ b
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
b
-> SplitOnSuffixSeqState rb rh ck w fs s b x
-> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqYield b
r SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqDone
    stepOuter State Stream m a
_ (SplitOnSuffixSeqKRDone Int
n s
fs Ring a
rb Ptr a
rh) = do
        a
old <- 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
$ Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
rh
        let rh1 :: Ptr a
rh1 = Ring a -> Ptr a -> Ptr a
forall a. Storable a => Ring a -> Ptr a -> Ptr a
RB.advance Ring a
rb Ptr a
rh
        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 (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall s a. s -> m (Step s a)
skip (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
 -> m (Step
         (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b))
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall a b. (a -> b) -> a -> b
$ Int
-> s
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) s
fs1 Ring a
rb Ptr a
rh1
            FL.Done b
b -> do
                let jump :: fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump fs
c = Int
-> fs
-> Ring a
-> Ptr a
-> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
forall rb rh ck w fs s b x.
Int -> fs -> rb -> rh -> SplitOnSuffixSeqState rb rh ck w fs s b x
SplitOnSuffixSeqKRDone (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) fs
c Ring a
rb Ptr a
rh1
                (s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a)
-> b
-> m (Step
        (SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a) b)
forall rb rh ck w s x a.
(s -> SplitOnSuffixSeqState rb rh ck w s s b x)
-> b -> m (Step (SplitOnSuffixSeqState rb rh ck w s s b x) a)
yieldProceed s -> SplitOnSuffixSeqState (Ring a) (Ptr a) Word32 Word s s b a
forall fs ck w s b x.
fs -> SplitOnSuffixSeqState (Ring a) (Ptr a) ck w fs s b x
jump b
b

------------------------------------------------------------------------------
-- 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 :: (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 Stream m (f a) -> s -> m (Step s (f a))
step1 s
state1) =
    ((State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step State Stream m (f a)
gst (SplitInitial s
st) = do
        Step s (f a)
r <- State Stream m (f a) -> s -> m (Step s (f a))
step1 State Stream 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 (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 (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 (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
$ Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop

    step State Stream m (f a)
gst (SplitBuffering s
st f a
buf) = do
        Step s (f a)
r <- State Stream m (f a) -> s -> m (Step s (f a))
step1 State Stream 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 (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 (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 (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 Stream 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 (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 Stream 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 (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 Stream m (f a)
_ SplitState s (f a)
SplitFinishing = Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f 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
$ 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, Eq (f a), Monoid (f a))
    => (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 :: (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 -> m (f a, Maybe (f a))
splitter f a -> f a -> m (f a)
joiner (Stream State Stream m (f a) -> s -> m (Step s (f a))
step1 s
state1) =
    ((State Stream 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 Stream m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State Stream 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 Stream m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step State Stream m (f a)
gst (SplitInitial s
st) = do
        Step s (f a)
r <- State Stream m (f a) -> s -> m (Step s (f a))
step1 State Stream 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 (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 (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 (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
$ Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop

    step State Stream m (f a)
gst (SplitBuffering s
st f a
buf) = do
        Step s (f a)
r <- State Stream m (f a) -> s -> m (Step s (f a))
step1 State Stream 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 (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 (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 (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
buf f a -> f a -> Bool
forall a. Eq a => a -> a -> Bool
== f a
forall a. Monoid a => a
mempty
                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 Stream 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 (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 Stream 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 (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 Stream m (f a)
_ SplitState s (f a)
SplitFinishing = Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (f a)) (f a)
forall s a. Step s a
Stop