{-# LANGUAGE CPP #-}
-- |
-- 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
    -- unfoldInterleave.
    , InterleaveState(..)
    , interleave
    , interleaveMin
    , interleaveFst
    , interleaveFstSuffix

    -- *** 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 unfoldRoundRobin.
    , roundRobin -- interleaveFair?/ParallelFair

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

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

    -- ** Combine N Streams
    -- | Functions generally ending in these shapes:
    --
    -- @
    -- concat: f (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 (..)
    , unfoldInterleave
    , unfoldRoundRobin

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

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

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

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

    -- ** 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
    , parseManyD
    , parseSequence
    , parseManyTill
    , parseIterate
    , parseIterateD

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

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

    -- XXX Implement these as folds or parsers instead.
    , splitOnSuffixSeqAny
    , splitOnPrefix
    , splitOnAny

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

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

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

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

import Streamly.Internal.Data.Array.Type (Array(..))
import Streamly.Internal.Data.Fold.Step (Step(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Parser (ParseError(..))
import Streamly.Internal.Data.Refold.Type (Refold(..))
import Streamly.Internal.Data.SVar.Type (adaptState)
import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))
import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)
import Streamly.Internal.Data.Unfold.Type (Unfold(..))

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

import Streamly.Internal.Data.Stream.StreamD.Transform
    (intersperse, intersperseMSuffix)
import Streamly.Internal.Data.Stream.StreamD.Type

import Prelude hiding (concatMap, mapM, zipWith)

#include "DocTestDataStream.hs"

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

data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2

-- | Fuses two streams sequentially, yielding all elements from the first
-- stream, and then all elements from the second stream.
--
-- >>> s1 = Stream.fromList [1,2]
-- >>> s2 = Stream.fromList [3,4]
-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2
-- [1,2,3,4]
--
-- This function should not be used to dynamically construct a stream. If a
-- stream is constructed by successive use of this function it would take
-- quadratic time complexity to consume the stream.
--
-- This function should only be used to statically fuse a stream with another
-- stream. Do not use this recursively or where it cannot be inlined.
--
-- See "Streamly.Data.StreamK" for an 'append' that can be used to
-- construct a stream recursively.
--
{-# 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 StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> AppendState s s -> m (Step (AppendState s s) a))
-> AppendState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> 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 StreamK m a
-> AppendState s s -> m (Step (AppendState s s) a)
step State StreamK m a
gst (AppendFirst s
st) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK 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 StreamK m a
gst (AppendSecond s
st) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK 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

-- | Interleaves two streams, yielding one element from each stream
-- alternately.  When one stream stops the rest of the other stream is used in
-- the output stream.
--
-- When joining many streams in a left associative manner earlier streams will
-- get exponential priority than the ones joining later. Because of exponential
-- weighting it can be used with 'concatMapWith' even on a large number of
-- streams.
--
{-# 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 StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

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

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

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

    step State StreamK m a
gst (InterleaveSecondOnly s
st2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step2 State StreamK m a
gst s
st2
        Step (InterleaveState s s) a -> m (Step (InterleaveState s s) a)
forall (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

-- | Like `interleave` but stops interleaving as soon as any of the two streams
-- stops.
--
{-# 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 StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

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

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

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

-- | Interleaves the outputs of two streams, yielding elements from each stream
-- alternately, starting from the first stream. As soon as the first stream
-- finishes, the output stops, discarding the remaining part of the second
-- stream. In this case, the last element in the resulting stream would be from
-- the second stream. If the second stream finishes early then the first stream
-- still continues to yield elements until it finishes.
--
-- >>> :set -XOverloadedStrings
-- >>> import Data.Functor.Identity (Identity)
-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char
-- fromList "a,b,c,"
-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char
-- fromList "a,bc"
--
-- 'interleaveFstSuffix' is a dual of 'interleaveFst'.
--
-- Do not use dynamically.
--
-- /Pre-release/
{-# INLINE_NORMAL interleaveFstSuffix #-}
interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveFstSuffix :: Stream m a -> Stream m a -> Stream m a
interleaveFstSuffix (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

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

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

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

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

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

-- | Interleaves the outputs of two streams, yielding elements from each stream
-- alternately, starting from the first stream and ending at the first stream.
-- If the second stream is longer than the first, elements from the second
-- stream are infixed with elements from the first stream. If the first stream
-- is longer then it continues yielding elements even after the second stream
-- has finished.
--
-- >>> :set -XOverloadedStrings
-- >>> import Data.Functor.Identity (Identity)
-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char
-- fromList "a,b,c"
-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char
-- fromList "a,bc"
--
-- 'interleaveFst' is a dual of 'interleaveFstSuffix'.
--
-- Do not use dynamically.
--
-- /Pre-release/
{-# INLINE_NORMAL interleaveFst #-}
interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a
interleaveFst :: Stream m a -> Stream m a -> Stream m a
interleaveFst (Stream State StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveInfixState s s a
 -> m (Step (InterleaveInfixState s s a) a))
-> InterleaveInfixState s s a -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveInfixState s s a
-> m (Step (InterleaveInfixState s s a) a)
step (s -> s -> InterleaveInfixState s s a
forall s1 s2 a. s1 -> s2 -> InterleaveInfixState s1 s2 a
InterleaveInfixFirst s
state1 s
state2)

    where

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

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

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

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

    step State StreamK m a
gst (InterleaveInfixFirstOnly s
st1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 State StreamK m a
gst s
st1
        Step (InterleaveInfixState s s a) a
-> m (Step (InterleaveInfixState s s a) a)
forall (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
------------------------------------------------------------------------------

-- | Schedule the execution of two streams in a fair round-robin manner,
-- executing each stream once, alternately. Execution of a stream may not
-- necessarily result in an output, a stream may choose to @Skip@ producing an
-- element until later giving the other stream a chance to run. Therefore, this
-- combinator fairly interleaves the execution of two streams rather than
-- fairly interleaving the output of the two streams. This can be useful in
-- co-operative multitasking without using explicit threads. This can be used
-- as an alternative to `async`.
--
-- Do not use dynamically.
--
-- /Pre-release/
{-# 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 StreamK m a -> s -> m (Step s a)
step1 s
state1) (Stream State StreamK m a -> s -> m (Step s a)
step2 s
state2) =
    (State StreamK m a
 -> InterleaveState s s -> m (Step (InterleaveState s s) a))
-> InterleaveState s s -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> InterleaveState s s -> m (Step (InterleaveState s s) a)
step (s -> s -> InterleaveState s s
forall s1 s2. s1 -> s2 -> InterleaveState s1 s2
InterleaveFirst s
state1 s
state2)

    where

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

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

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

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

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

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

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

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

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

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

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

    step State StreamK m a
_ (Maybe s
Nothing, Maybe s
Nothing, Maybe a
Nothing, Maybe a
Nothing) = Step (Maybe s, Maybe s, Maybe a, Maybe a) a
-> m (Step (Maybe s, Maybe s, Maybe a, Maybe a) a)
forall (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

-- | Merge two streams using a comparison function. The head elements of both
-- the streams are compared and the smaller of the two elements is emitted, if
-- both elements are equal then the element from the first stream is used
-- first.
--
-- If the streams are sorted in ascending order, the resulting stream would
-- also remain sorted in ascending order.
--
-- >>> s1 = Stream.fromList [1,3,5]
-- >>> s2 = Stream.fromList [2,4,6,8]
-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2
-- [1,2,3,4,5,6,8]
--
{-# INLINE mergeBy #-}
mergeBy
    :: (Monad m)
    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
mergeBy :: (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)

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

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

-------------------------------------------------------------------------------
-- Intersection of sorted streams
-------------------------------------------------------------------------------

-- Assuming the streams are sorted in ascending order
{-# INLINE_NORMAL intersectBySorted #-}
intersectBySorted :: Monad m
    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
intersectBySorted :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a
intersectBySorted a -> a -> Ordering
cmp (Stream State StreamK m a -> s -> m (Step s a)
stepa s
ta) (Stream State StreamK m a -> s -> m (Step s a)
stepb s
tb) =
    (State StreamK m a
 -> (s, s, Maybe a, Maybe a) -> m (Step (s, s, Maybe a, Maybe a) a))
-> (s, s, Maybe a, Maybe a) -> Stream m a
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m a
-> (s, s, Maybe a, Maybe a) -> m (Step (s, s, Maybe a, Maybe a) a)
step
        ( s
ta -- left stream state
        , s
tb -- right stream state
        , Maybe a
forall a. Maybe a
Nothing -- left value
        , Maybe a
forall a. Maybe a
Nothing -- right value
        )

    where

    {-# INLINE_LATE step #-}
    -- step 1, fetch the first value
    step :: State StreamK m a
-> (s, s, Maybe a, Maybe a) -> m (Step (s, s, Maybe a, Maybe a) a)
step State StreamK m a
gst (s
sa, s
sb, Maybe a
Nothing, Maybe a
b) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
stepa State StreamK m a
gst s
sa
        Step (s, s, Maybe a, Maybe a) a
-> m (Step (s, s, Maybe a, Maybe a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a, Maybe a) a
 -> m (Step (s, s, Maybe a, Maybe a) a))
-> Step (s, s, Maybe a, Maybe a) a
-> m (Step (s, s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ case Step s a
r of
            Yield a
a s
sa' -> (s, s, Maybe a, Maybe a) -> Step (s, s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (s
sa', s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
a, Maybe a
b) -- step 2/3
            Skip s
sa'    -> (s, s, Maybe a, Maybe a) -> Step (s, s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (s
sa', s
sb, Maybe a
forall a. Maybe a
Nothing, Maybe a
b)
            Step s a
Stop        -> Step (s, s, Maybe a, Maybe a) a
forall s a. Step s a
Stop

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

    -- step 3, compare the two values
    step State StreamK m a
_ (s
sa, s
sb, Just a
a, Just a
b) = do
        let res :: Ordering
res = a -> a -> Ordering
cmp a
a a
b
        Step (s, s, Maybe a, Maybe a) a
-> m (Step (s, s, Maybe a, Maybe a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (s, s, Maybe a, Maybe a) a
 -> m (Step (s, s, Maybe a, Maybe a) a))
-> Step (s, s, Maybe a, Maybe a) a
-> m (Step (s, s, Maybe a, Maybe a) a)
forall a b. (a -> b) -> a -> b
$ case Ordering
res of
            Ordering
GT -> (s, s, Maybe a, Maybe a) -> Step (s, s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (s
sa, s
sb, a -> Maybe a
forall a. a -> Maybe a
Just a
a, Maybe a
forall a. Maybe a
Nothing) -- step 2
            Ordering
LT -> (s, s, Maybe a, Maybe a) -> Step (s, s, Maybe a, Maybe a) a
forall s a. s -> Step s a
Skip (s
sa, s
sb, Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just a
b) -- step 1
            Ordering
EQ -> a -> (s, s, Maybe a, Maybe a) -> Step (s, s, Maybe a, Maybe a) a
forall s a. a -> s -> Step s a
Yield a
a (s
sa, s
sb, Maybe a
forall a. Maybe a
Nothing, a -> Maybe a
forall a. a -> Maybe a
Just a
b) -- step 1

------------------------------------------------------------------------------
-- 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.
--
-- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way
-- interleaving CPS combinator which behaves like unfoldInterleave. Instead
-- of pairing up the streams we just need to go yielding one element from each
-- stream and storing the remaining streams and then keep doing rounds through
-- those in a round robin fashion. This would be much like wAsync.

-- | This does not pair streams like mergeMapWith, instead, it goes through
-- each stream one by one and yields one element from each stream. After it
-- goes to the last stream it reverses the traversal to come back to the first
-- stream yielding elements from each stream on its way back to the first
-- stream and so on.
--
-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]
-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists
-- >>> Stream.fold Fold.toList interleaved
-- [1,2,3,4,5,5,4,3,2,1]
--
-- Note that this is order of magnitude more efficient than "mergeMapWith
-- interleave" because of fusion.
--
{-# INLINE_NORMAL unfoldInterleave #-}
unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b
unfoldInterleave :: Unfold m a b -> Stream m a -> Stream m b
unfoldInterleave (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> ConcatUnfoldInterleaveState s s
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> ConcatUnfoldInterleaveState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a.
State StreamK m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
ost [])

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step State StreamK m a
gst (ConcatUnfoldInterleaveOuter s
o [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
-> m (Step (ConcatUnfoldInterleaveState s s) b)
`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 StreamK m a
_ (ConcatUnfoldInterleaveInner s
_ []) = m (Step (ConcatUnfoldInterleaveState s s) b)
forall a. HasCallStack => a
undefined
    step State StreamK m a
_ (ConcatUnfoldInterleaveInner s
o (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ConcatUnfoldInterleaveState s s) b
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
r of
            Yield b
x s
s -> b
-> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. a -> s -> Step s a
Yield b
x (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
o (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls))
            Skip s
s    -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveInner s
o (s
ss -> [s] -> [s]
forall a. a -> [a] -> [a]
:[s]
ls))
            Step s b
Stop      -> ConcatUnfoldInterleaveState s s
-> Step (ConcatUnfoldInterleaveState s s) b
forall s a. s -> Step s a
Skip (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
o [s]
ls)

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

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

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

    step State StreamK m a
_ (ConcatUnfoldInterleaveInnerR [s]
ls (s
st:[s]
rs)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (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 unfoldInterleave this one switches streams on Skips.

-- | 'unfoldInterleave' switches to the next stream whenever a value from a
-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps
-- skipping for long time other streams won't get a chance to run.
-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each
-- stream fairly irrespective of whether it produces a value or not.
--
{-# INLINE_NORMAL unfoldRoundRobin #-}
unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b
unfoldRoundRobin :: Unfold m a b -> Stream m a -> Stream m b
unfoldRoundRobin (Unfold s -> m (Step s b)
istep a -> m s
inject) (Stream State StreamK m a -> s -> m (Step s a)
ostep s
ost) =
    (State StreamK m b
 -> ConcatUnfoldInterleaveState s s
 -> m (Step (ConcatUnfoldInterleaveState s s) b))
-> ConcatUnfoldInterleaveState s s -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (m :: * -> *) a.
State StreamK m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step (s -> [s] -> ConcatUnfoldInterleaveState s s
forall o i. o -> [i] -> ConcatUnfoldInterleaveState o i
ConcatUnfoldInterleaveOuter s
ost [])
  where
    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> ConcatUnfoldInterleaveState s s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
step State StreamK m a
gst (ConcatUnfoldInterleaveOuter s
o [s]
ls) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
ostep (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
o
        case Step s a
r of
            Yield a
a s
o' -> do
                s
i <- a -> m s
inject a
a
                s
i s
-> m (Step (ConcatUnfoldInterleaveState s s) b)
-> m (Step (ConcatUnfoldInterleaveState s s) b)
`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 StreamK 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 StreamK m a
_ (ConcatUnfoldInterleaveInner s
o (s
st:[s]
ls)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (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 StreamK 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 StreamK 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 StreamK m a
_ (ConcatUnfoldInterleaveInnerL (s
st:[s]
ls) [s]
rs) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (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 StreamK 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 StreamK 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 StreamK m a
_ (ConcatUnfoldInterleaveInnerR [s]
ls (s
st:[s]
rs)) = do
        Step s b
r <- s -> m (Step s b)
istep s
st
        Step (ConcatUnfoldInterleaveState s s) b
-> m (Step (ConcatUnfoldInterleaveState s s) b)
forall (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 interposeSuffixM #-}
interposeSuffixM
    :: Monad m
    => m c -> Unfold m b c -> Stream m b -> Stream m c
interposeSuffixM :: m c -> Unfold m b c -> Stream m b -> Stream m c
interposeSuffixM
    m c
action
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State StreamK m b -> s -> m (Step s b)
step1 s
state1) =
    (State StreamK m c
 -> InterposeSuffixState s s
 -> m (Step (InterposeSuffixState s s) c))
-> InterposeSuffixState s s -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
forall (m :: * -> *) a.
State StreamK m a
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
step (s -> InterposeSuffixState s s
forall s1 i1. s1 -> InterposeSuffixState s1 i1
InterposeSuffixFirst s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterposeSuffixState s s
-> m (Step (InterposeSuffixState s s) c)
step State StreamK m a
gst (InterposeSuffixFirst s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                s
i s
-> m (Step (InterposeSuffixState s s) c)
-> m (Step (InterposeSuffixState s s) c)
`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 StreamK m a
_ (InterposeSuffixFirstInner s
s1 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeSuffixState s s) c
 -> m (Step (InterposeSuffixState s s) c))
-> Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> InterposeSuffixState s s
forall s1 i1. s1 -> i1 -> InterposeSuffixState s1 i1
InterposeSuffixFirstInner s
s1 s
i')
            Skip s
i'    -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeSuffixState s s
forall s1 i1. s1 -> i1 -> InterposeSuffixState s1 i1
InterposeSuffixFirstInner s
s1 s
i')
            Step s c
Stop       -> InterposeSuffixState s s -> Step (InterposeSuffixState s s) c
forall s a. s -> Step s a
Skip (s -> InterposeSuffixState s s
forall s1 i1. s1 -> InterposeSuffixState s1 i1
InterposeSuffixSecond s
s1)

    step State StreamK m a
_ (InterposeSuffixSecond s
s1) = do
        c
r <- m c
action
        Step (InterposeSuffixState s s) c
-> m (Step (InterposeSuffixState s s) c)
forall (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)

-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)

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

{-# 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 interposeM #-}
interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c
interposeM :: m c -> Unfold m b c -> Stream m b -> Stream m c
interposeM
    m c
action
    (Unfold s -> m (Step s c)
istep1 b -> m s
inject1) (Stream State StreamK m b -> s -> m (Step s b)
step1 s
state1) =
    (State StreamK m c
 -> InterposeState s s Any -> m (Step (InterposeState s s Any) c))
-> InterposeState s s Any -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> InterposeState s s Any -> m (Step (InterposeState s s Any) c)
forall (m :: * -> *) a a a.
State StreamK m a
-> InterposeState s s a -> m (Step (InterposeState s s a) c)
step (s -> InterposeState s s Any
forall s1 i1 a. s1 -> InterposeState s1 i1 a
InterposeFirst s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> InterposeState s s a -> m (Step (InterposeState s s a) c)
step State StreamK m a
gst (InterposeFirst s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                s
i s
-> m (Step (InterposeState s s a) c)
-> m (Step (InterposeState s s a) c)
`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 StreamK m a
_ (InterposeFirstInner s
s1 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (InterposeState s s a) c
 -> m (Step (InterposeState s s a) c))
-> Step (InterposeState s s a) c
-> m (Step (InterposeState s s a) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeFirstInner s
s1 s
i')
            Skip s
i'    -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> s -> InterposeState s s a
forall s1 i1 a. s1 -> i1 -> InterposeState s1 i1 a
InterposeFirstInner s
s1 s
i')
            Step s c
Stop       -> InterposeState s s a -> Step (InterposeState s s a) c
forall s a. s -> Step s a
Skip (s -> InterposeState s s a
forall s1 i1 a. s1 -> InterposeState s1 i1 a
InterposeFirstInject s
s1)

    step State StreamK m a
gst (InterposeFirstInject s
s1) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step1 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject1 b
a
                -- i `seq` return (Skip (InterposeFirstBuf s i))
                s
i s
-> m (Step (InterposeState s s a) c)
-> m (Step (InterposeState s s a) c)
`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 StreamK m a
_ (InterposeSecondYield s
s1 s
i1) = do
        c
r <- m c
action
        Step (InterposeState s s a) c -> m (Step (InterposeState s s a) c)
forall (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)
    -}

-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)

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

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

-- | 'interleaveFstSuffix' followed by unfold and concat.
--
-- /Pre-release/
{-# 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 StreamK m a -> s -> m (Step s a)
step1 s
state1)
    (Unfold s -> m (Step s c)
istep2 b -> m s
inject2) (Stream State StreamK m b -> s -> m (Step s b)
step2 s
state2) =
    (State StreamK m c
 -> ICUState s s s s -> m (Step (ICUState s s s s) c))
-> ICUState s s s s -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
forall (m :: * -> *) a.
State StreamK m a
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
step (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUFirst s
state1 s
state2)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m a
-> ICUState s s s s -> m (Step (ICUState s s s s) c)
step State StreamK m a
gst (ICUFirst s
s1 s
s2) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s a
r of
            Yield a
a s
s -> do
                s
i <- a -> m s
inject1 a
a
                s
i s -> m (Step (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 StreamK m a
gst (ICUFirstOnly s
s1) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step1 (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s1
        case Step s a
r of
            Yield a
a s
s -> do
                s
i <- a -> m s
inject1 a
a
                s
i s -> m (Step (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 StreamK m a
_ (ICUFirstInner s
s1 s
s2 s
i1) = do
        Step s c
r <- s -> m (Step s c)
istep1 s
i1
        Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstInner s
s1 s
s2 s
i')
            Skip s
i'    -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i1 -> ICUState s1 s2 i1 i2
ICUFirstInner s
s1 s
s2 s
i')
            Step s c
Stop       -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUSecond s
s1 s
s2)

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

    step State StreamK m a
gst (ICUSecond s
s1 s
s2) = do
        Step s b
r <- State StreamK m b -> s -> m (Step s b)
step2 (State StreamK m a -> State StreamK m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
s2
        case Step s b
r of
            Yield b
a s
s -> do
                s
i <- b -> m s
inject2 b
a
                s
i s -> m (Step (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 StreamK m a
_ (ICUSecondInner s
s1 s
s2 s
i2) = do
        Step s c
r <- s -> m (Step s c)
istep2 s
i2
        Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c))
-> Step (ICUState s s s s) c -> m (Step (ICUState s s s s) c)
forall a b. (a -> b) -> a -> b
$ case Step s c
r of
            Yield c
x s
i' -> c -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. a -> s -> Step s a
Yield c
x (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i2 -> ICUState s1 s2 i1 i2
ICUSecondInner s
s1 s
s2 s
i')
            Skip s
i'    -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> i2 -> ICUState s1 s2 i1 i2
ICUSecondInner s
s1 s
s2 s
i')
            Step s c
Stop       -> ICUState s s s s -> Step (ICUState s s s s) c
forall s a. s -> Step s a
Skip (s -> s -> ICUState s s s s
forall s1 s2 i1 i2. s1 -> s2 -> ICUState s1 s2 i1 i2
ICUFirst s
s1 s
s2)

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

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

-- XXX we can swap the order of arguments to gintercalate so that the
-- definition of unfoldMany becomes simpler? The first stream should be
-- infixed inside the second one. However, if we change the order in
-- "interleave" as well similarly, then that will make it a bit unintuitive.
--
-- > unfoldMany unf str =
-- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())

-- | 'interleaveFst' followed by unfold and concat.
--
-- /Pre-release/
{-# 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 StreamK m a -> s -> m (Step s a)
step1 s
state1)
    (Unfold s -> m (Step s c)
istep2 b -> m s
inject2) (Stream State StreamK m b -> s -> m (Step s b)
step2 s
state2) =
    (State StreamK m c
 -> ICALState s s s s Any -> m (Step (ICALState s s s s Any) c))
-> ICALState s s s s Any -> Stream m c
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m c
-> ICALState s s s s Any -> m (Step (ICALState s s s s Any) c)
forall (m :: * -> *) a a a.
State StreamK m a
-> ICALState s s s s a -> m (Step (ICALState s s s s a) c)
step (s -> s -> ICALState s s s s Any
forall s1 s2 i1 i2 a. s1 -> s2 -> ICALState s1 s2 i1 i2 a
ICALFirst s
state1 s
state2)

    where

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

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

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

-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)

-- | 'intersperseMSuffix' followed by unfold and concat.
--
-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a
-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity
-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"
--
-- >>> input = Stream.fromList ["abc", "def", "ghi"]
-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input
-- "abc\ndef\nghi\n"
--
{-# INLINE intercalateSuffix #-}
intercalateSuffix :: Monad m
    => Unfold m b c -> b -> Stream m b -> Stream m c
intercalateSuffix :: Unfold m b c -> b -> Stream m b -> Stream m c
intercalateSuffix Unfold m b c
unf b
seed = Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldMany Unfold m b c
unf (Stream m b -> Stream m c)
-> (Stream m b -> Stream m b) -> Stream m b -> Stream m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m b -> Stream m b -> Stream m b
forall (m :: * -> *) a. Monad m => m a -> Stream m a -> Stream m a
intersperseMSuffix (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
seed)

-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)

-- | 'intersperse' followed by unfold and concat.
--
-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a
-- >>> intersperse = Stream.intercalate Unfold.identity
-- >>> unwords = Stream.intercalate Unfold.fromList " "
--
-- >>> input = Stream.fromList ["abc", "def", "ghi"]
-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input
-- "abc def ghi"
--
{-# INLINE intercalate #-}
intercalate :: Monad m
    => Unfold m b c -> b -> Stream m b -> Stream m c
intercalate :: Unfold m b c -> b -> Stream m b -> Stream m c
intercalate Unfold m b c
unf b
seed Stream m b
str = Unfold m b c -> Stream m b -> Stream m c
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
unfoldMany Unfold m b c
unf (Stream m b -> Stream m c) -> Stream m b -> Stream m c
forall a b. (a -> b) -> a -> b
$ b -> Stream m b -> Stream m b
forall (m :: * -> *) a. Monad m => a -> Stream m a -> Stream m a
intersperse b
seed Stream m b
str

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

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

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

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

    where

    {-# INLINE iterStep #-}
    iterStep :: m (Step fs b)
-> s
-> (fs -> a -> m (Step fs b))
-> (fs -> m b)
-> m (Step (FIterState s (m 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 (m b) m a b) a
-> m (Step (FIterState s (m b) m a b) a)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (FIterState s (m b) m a b) a
 -> m (Step (FIterState s (m b) m a b) a))
-> Step (FIterState s (m b) m a b) a
-> m (Step (FIterState s (m b) m a b) a)
forall a b. (a -> b) -> a -> b
$ FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) a
forall s a. s -> Step s a
Skip
            (FIterState s (m b) m a b -> Step (FIterState s (m b) m a b) a)
-> FIterState s (m b) m a b -> Step (FIterState s (m 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 (m 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 (m b) m a b -> FIterState s (m b) m a b
forall s f (m :: * -> *) a b.
b -> FIterState s f m a b -> FIterState s f m a b
FIterYield b
fb (FIterState s (m b) m a b -> FIterState s (m b) m a b)
-> FIterState s (m b) m a b -> FIterState s (m b) m a b
forall a b. (a -> b) -> a -> b
$ s -> m b -> FIterState s (m b) m a b
forall s f (m :: * -> *) a b. s -> f -> FIterState s f m a b
FIterInit s
st (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
fb)

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

{-# ANN type CIterState Fuse #-}
data CIterState s f fs b
    = CIterInit s f
    | CIterConsume s fs
    | CIterYield b (CIterState s f fs b)
    | CIterStop

-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be
-- much more efficient due to stream fusion.
--
-- /Internal/
{-# INLINE_NORMAL refoldIterateM #-}
refoldIterateM ::
       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b
refoldIterateM :: Refold m b a b -> m b -> Stream m a -> Stream m b
refoldIterateM (Refold s -> a -> m (Step s b)
fstep b -> m (Step s b)
finject s -> m b
fextract) m b
initial (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> CIterState s (m b) s b -> m (Step (CIterState s (m b) s b) b))
-> CIterState s (m b) s b -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> CIterState s (m b) s b -> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) a.
State StreamK m a
-> CIterState s (m b) s b -> m (Step (CIterState s (m b) s b) b)
stepOuter (s -> m b -> CIterState s (m b) s b
forall s f fs b. s -> f -> CIterState s f fs b
CIterInit s
state m b
initial)

    where

    {-# INLINE iterStep #-}
    iterStep :: s -> m (Step fs b) -> m (Step (CIterState s (m b) fs b) a)
iterStep s
st m (Step fs b)
action = do
        Step fs b
res <- m (Step fs b)
action
        Step (CIterState s (m b) fs b) a
-> m (Step (CIterState s (m b) fs b) a)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (CIterState s (m b) fs b) a
 -> m (Step (CIterState s (m b) fs b) a))
-> Step (CIterState s (m b) fs b) a
-> m (Step (CIterState s (m b) fs b) a)
forall a b. (a -> b) -> a -> b
$ CIterState s (m b) fs b -> Step (CIterState s (m b) fs b) a
forall s a. s -> Step s a
Skip
            (CIterState s (m b) fs b -> Step (CIterState s (m b) fs b) a)
-> CIterState s (m b) fs b -> Step (CIterState s (m b) fs b) a
forall a b. (a -> b) -> a -> b
$ case Step fs b
res of
                  FL.Partial fs
fs -> s -> fs -> CIterState s (m b) fs b
forall s f fs b. s -> fs -> CIterState s f fs b
CIterConsume s
st fs
fs
                  FL.Done b
fb -> b -> CIterState s (m b) fs b -> CIterState s (m b) fs b
forall s f fs b. b -> CIterState s f fs b -> CIterState s f fs b
CIterYield b
fb (CIterState s (m b) fs b -> CIterState s (m b) fs b)
-> CIterState s (m b) fs b -> CIterState s (m b) fs b
forall a b. (a -> b) -> a -> b
$ s -> m b -> CIterState s (m b) fs b
forall s f fs b. s -> f -> CIterState s f fs b
CIterInit s
st (b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
fb)

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> CIterState s (m b) s b -> m (Step (CIterState s (m b) s b) b)
stepOuter State StreamK m a
_ (CIterInit s
st m b
action) = do
        s -> m (Step s b) -> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) (m :: * -> *) s fs b a.
(Monad m, Monad m) =>
s -> m (Step fs b) -> m (Step (CIterState s (m b) fs b) a)
iterStep s
st (m b
action m b -> (b -> m (Step s b)) -> m (Step s b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= b -> m (Step s b)
finject)
    stepOuter State StreamK m a
gst (CIterConsume s
st s
fs) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> s -> m (Step s b) -> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) (m :: * -> *) s fs b a.
(Monad m, Monad m) =>
s -> m (Step fs b) -> m (Step (CIterState s (m b) fs b) a)
iterStep s
s (s -> a -> m (Step s b)
fstep s
fs a
x)
            Skip s
s -> Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (CIterState s (m b) s b) b
 -> m (Step (CIterState s (m b) s b) b))
-> Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall a b. (a -> b) -> a -> b
$ CIterState s (m b) s b -> Step (CIterState s (m b) s b) b
forall s a. s -> Step s a
Skip (CIterState s (m b) s b -> Step (CIterState s (m b) s b) b)
-> CIterState s (m b) s b -> Step (CIterState s (m b) s b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> CIterState s (m b) s b
forall s f fs b. s -> fs -> CIterState s f fs b
CIterConsume s
s s
fs
            Step s a
Stop -> do
                b
b <- s -> m b
fextract s
fs
                Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (CIterState s (m b) s b) b
 -> m (Step (CIterState s (m b) s b) b))
-> Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall a b. (a -> b) -> a -> b
$ CIterState s (m b) s b -> Step (CIterState s (m b) s b) b
forall s a. s -> Step s a
Skip (CIterState s (m b) s b -> Step (CIterState s (m b) s b) b)
-> CIterState s (m b) s b -> Step (CIterState s (m b) s b) b
forall a b. (a -> b) -> a -> b
$ b -> CIterState s (m b) s b -> CIterState s (m b) s b
forall s f fs b. b -> CIterState s f fs b -> CIterState s f fs b
CIterYield b
b CIterState s (m b) s b
forall s f fs b. CIterState s f fs b
CIterStop
    stepOuter State StreamK m a
_ (CIterYield b
a CIterState s (m b) s b
next) = Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (CIterState s (m b) s b) b
 -> m (Step (CIterState s (m b) s b) b))
-> Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall a b. (a -> b) -> a -> b
$ b -> CIterState s (m b) s b -> Step (CIterState s (m b) s b) b
forall s a. a -> s -> Step s a
Yield b
a CIterState s (m b) s b
next
    stepOuter State StreamK m a
_ CIterState s (m b) s b
CIterStop = Step (CIterState s (m b) s b) b
-> m (Step (CIterState s (m b) s b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return Step (CIterState s (m b) s b) b
forall s a. Step s a
Stop

-- "n" elements at the end are dropped by the fold.
{-# INLINE sliceBy #-}
sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
sliceBy :: Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
sliceBy (Fold s -> a -> m (Step s Int)
step1 m (Step s Int)
initial1 s -> m Int
extract1) Int
n = (Tuple' Int s -> a -> m (Step (Tuple' Int s) (Int, Int)))
-> ((Int, Int) -> m (Step (Tuple' Int s) (Int, Int)))
-> (Tuple' Int s -> m (Int, Int))
-> Refold m (Int, Int) a (Int, Int)
forall (m :: * -> *) c a b s.
(s -> a -> m (Step s b))
-> (c -> m (Step s b)) -> (s -> m b) -> Refold m c a b
Refold Tuple' Int s -> a -> m (Step (Tuple' Int s) (Int, Int))
forall a. Tuple' a s -> a -> m (Step (Tuple' a s) (a, Int))
step (Int, Int) -> m (Step (Tuple' Int s) (Int, Int))
inject Tuple' Int s -> m (Int, Int)
forall t. Tuple' t s -> m (t, Int)
extract

    where

    inject :: (Int, Int) -> m (Step (Tuple' Int s) (Int, Int))
inject (Int
i, Int
len) = do
        Step s Int
r <- m (Step s Int)
initial1
        Step (Tuple' Int s) (Int, Int)
-> m (Step (Tuple' Int s) (Int, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' Int s) (Int, Int)
 -> m (Step (Tuple' Int s) (Int, Int)))
-> Step (Tuple' Int s) (Int, Int)
-> m (Step (Tuple' Int s) (Int, Int))
forall a b. (a -> b) -> a -> b
$ case Step s Int
r of
            Partial s
s -> Tuple' Int s -> Step (Tuple' Int s) (Int, Int)
forall s b. s -> Step s b
Partial (Tuple' Int s -> Step (Tuple' Int s) (Int, Int))
-> Tuple' Int s -> Step (Tuple' Int s) (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int -> s -> Tuple' Int s
forall a b. a -> b -> Tuple' a b
Tuple' (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n) s
s
            Done Int
l -> (Int, Int) -> Step (Tuple' Int s) (Int, Int)
forall s b. b -> Step s b
Done (Int
i, Int
l)

    step :: Tuple' a s -> a -> m (Step (Tuple' a s) (a, Int))
step (Tuple' a
i s
s) a
x = do
        Step s Int
r <- s -> a -> m (Step s Int)
step1 s
s a
x
        Step (Tuple' a s) (a, Int) -> m (Step (Tuple' a s) (a, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (Tuple' a s) (a, Int) -> m (Step (Tuple' a s) (a, Int)))
-> Step (Tuple' a s) (a, Int) -> m (Step (Tuple' a s) (a, Int))
forall a b. (a -> b) -> a -> b
$ case Step s Int
r of
            Partial s
s1 -> Tuple' a s -> Step (Tuple' a s) (a, Int)
forall s b. s -> Step s b
Partial (Tuple' a s -> Step (Tuple' a s) (a, Int))
-> Tuple' a s -> Step (Tuple' a s) (a, Int)
forall a b. (a -> b) -> a -> b
$ a -> s -> Tuple' a s
forall a b. a -> b -> Tuple' a b
Tuple' a
i s
s1
            Done Int
len -> (a, Int) -> Step (Tuple' a s) (a, Int)
forall s b. b -> Step s b
Done (a
i, Int
len)

    extract :: Tuple' t s -> m (t, Int)
extract (Tuple' t
i s
s) = (t
i,) (Int -> (t, Int)) -> m Int -> m (t, Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m Int
extract1 s
s

{-# INLINE sliceOnSuffix #-}
sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)
sliceOnSuffix :: (a -> Bool) -> Stream m a -> Stream m (Int, Int)
sliceOnSuffix a -> Bool
predicate =
    -- Scan the stream with the given refold
    Refold m (Int, Int) a (Int, Int)
-> m (Int, Int) -> Stream m a -> Stream m (Int, Int)
forall (m :: * -> *) b a.
Monad m =>
Refold m b a b -> m b -> Stream m a -> Stream m b
refoldIterateM
        (Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
forall (m :: * -> *) a.
Monad m =>
Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)
sliceBy ((a -> Bool) -> Fold m a Int -> Fold m a Int
forall (m :: * -> *) a b.
Monad m =>
(a -> Bool) -> Fold m a b -> Fold m a b
FL.takeEndBy_ a -> Bool
predicate Fold m a Int
forall (m :: * -> *) a. Monad m => Fold m a Int
FL.length) Int
1)
        ((Int, Int) -> m (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1, Int
0))

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

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

-- XXX return the remaining stream as part of the error.
-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as
-- well?
{-# INLINE_NORMAL parseManyD #-}
parseManyD
    :: Monad m
    => PRD.Parser a m b
    -> Stream m a
    -> Stream m (Either ParseError b)
parseManyD :: Parser a m b -> Stream m a -> Stream m (Either ParseError b)
parseManyD (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Step s b)
extract) (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m (Either ParseError b)
 -> ParseChunksState (Either ParseError b) [a] s s
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> ParseChunksState (Either ParseError b) [a] s s
-> Stream m (Either ParseError b)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (Either ParseError b)
-> ParseChunksState (Either ParseError b) [a] s s
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a.
State StreamK m a
-> ParseChunksState (Either ParseError b) [a] s s
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
stepOuter ([a] -> s -> ParseChunksState (Either ParseError 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 StreamK m a
-> ParseChunksState (Either ParseError b) [a] s s
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
stepOuter State StreamK m a
gst (ParseChunksInit [] s
st) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                Initial s b
res <- m (Initial s b)
initial
                case Initial s b
res of
                    PRD.IPartial s
ps ->
                        Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
pb) ParseChunksState (Either ParseError b) [a] s s
forall x pst. ParseChunksState x [a] s pst
next
                    PRD.IError String
err ->
                        Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                            (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                                (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                                ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])
            Skip s
s -> Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
forall s a. Step s a
Stop

    -- Buffer is not empty, go to buffered processing loop
    stepOuter State StreamK 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
pb) ParseChunksState (Either ParseError b) [a] s s
forall x pst. ParseChunksState x [a] s pst
next
            PRD.IError String
err ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])

    -- This is simplified ParseChunksInit
    stepOuter State StreamK m a
_ (ParseChunksInitBuf [a]
src) = do
        Initial s b
res <- m (Initial s b)
initial
        case Initial s b
res of
            PRD.IPartial s
ps ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksExtract [a]
src [] s
ps
            PRD.IDone b
pb ->
                let next :: ParseChunksState x [a] st pst
next = [a] -> ParseChunksState x [a] st pst
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitBuf [a]
src
                 in Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
pb) ParseChunksState (Either ParseError b) [a] s s
forall x st pst. ParseChunksState x [a] st pst
next
            PRD.IError String
err ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])

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

    -- Buffer is empty, process elements from the stream
    stepOuter State StreamK m a
gst (ParseChunksStream s
st [a]
buf s
pst) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                            Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                            Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> s -> ParseChunksState (Either ParseError 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 ->
                        Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                            (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                                (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                                ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])
            Skip s
s -> Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState (Either ParseError 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 -> Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStop [a]
buf s
pst

    -- go back to stream processing mode
    stepOuter State StreamK m a
_ (ParseChunksBuf [] s
s [a]
buf s
pst) =
        Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s -> [a] -> s -> ParseChunksState (Either ParseError 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 StreamK 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s -> [a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> s -> ParseChunksState (Either ParseError 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> s -> ParseChunksState (Either ParseError 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 ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])

    -- This is simplified ParseChunksBuf
    stepOuter State StreamK m a
_ (ParseChunksExtract [] [a]
buf s
pst) =
        Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStop [a]
buf s
pst

    stepOuter State StreamK m a
_ (ParseChunksExtract (a
x:[a]
xs) [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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksExtract [a]
xs [] 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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksExtract [a]
src [] s
pst1
            PR.Continue Int
0 s
pst1 ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksExtract [a]
xs (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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksExtract [a]
src [a]
buf1 s
pst1
            PR.Done Int
0 b
b ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitBuf [a]
xs)
            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 (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitBuf [a]
src)
            PR.Error String
err ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])

    -- This is simplified ParseChunksExtract
    stepOuter State StreamK m a
_ (ParseChunksStop [a]
buf s
pst) = do
        Step s b
pRes <- s -> m (Step s b)
extract s
pst
        case Step s b
pRes of
            PR.Partial Int
_ s
_ -> String
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a. HasCallStack => String -> a
error String
"Bug: parseMany: Partial in extract"
            PR.Continue Int
0 s
pst1 ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStop [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]
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]
buf
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> s -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
inpBuf -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksExtract [a]
src [a]
buf1 s
pst1
            PR.Done Int
0 b
b -> do
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                    Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])
            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]
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]
buf)
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                    Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitBuf [a]
src)
            PR.Error String
err ->
                Step
  (ParseChunksState (Either ParseError b) [a] s s)
  (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ParseChunksState (Either ParseError b) [a] s s)
   (Either ParseError b)
 -> m (Step
         (ParseChunksState (Either ParseError b) [a] s s)
         (Either ParseError b)))
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
-> m (Step
        (ParseChunksState (Either ParseError b) [a] s s)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ParseChunksState (Either ParseError b) [a] s s
 -> Step
      (ParseChunksState (Either ParseError b) [a] s s)
      (Either ParseError b))
-> ParseChunksState (Either ParseError b) [a] s s
-> Step
     (ParseChunksState (Either ParseError b) [a] s s)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ParseChunksState (Either ParseError b) [a] s s
-> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a] -> ParseChunksState (Either ParseError b) [a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [])

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

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

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

-- XXX Change the parser arguments' order

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

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

-- XXX Review the changes
{-# INLINE_NORMAL parseIterateD #-}
parseIterateD
    :: Monad m
    => (b -> PRD.Parser a m b)
    -> b
    -> Stream m a
    -> Stream m (Either ParseError b)
parseIterateD :: (b -> Parser a m b)
-> b -> Stream m a -> Stream m (Either ParseError b)
parseIterateD b -> Parser a m b
func b
seed (Stream State StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m (Either ParseError b)
 -> ConcatParseState
      (Either ParseError b) b [a] s (Parser a m b) m a
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Stream m (Either ParseError b)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (Either ParseError b)
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a.
State StreamK m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
stepOuter ([a]
-> s
-> Parser a m b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInit [] s
state (b -> Parser a m b
func b
seed))

    where

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

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

    -- This is simplified ConcatParseInit
    stepOuter State StreamK m a
_ (ConcatParseInitBuf [a]
src
                    (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m (Step s b)
extract)) = do
        Initial s b
res <- m (Initial s b)
initial
        case Initial s b
res of
            PRD.IPartial s
ps ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseExtract [a]
src [] s -> a -> m (Step s b)
pstep s
ps s -> m (Step s b)
extract
            PRD.IDone b
pb ->
                let next :: ConcatParseState c b [a] st (Parser a m b) m a
next = [a]
-> Parser a m b -> ConcatParseState c b [a] st (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInitBuf [a]
src (b -> Parser a m b
func b
pb)
                 in Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
pb) ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
forall c b st (m :: * -> *) a.
ConcatParseState c b [a] st (Parser a m b) m a
next
            PRD.IError String
err ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a]
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState c b inpBuf st p m a
ConcatParseInitLeftOver [])

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

    -- Buffer is empty process elements from the stream
    stepOuter State StreamK m a
gst (ConcatParseStream s
st [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s b)
extract) = do
        Step s a
r <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
r of
            Yield a
x s
s -> do
                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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseStream s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseBuf [a]
src s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseBuf [a]
src s
s [a]
buf1 s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                            Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a]
-> s
-> Parser a m b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInit [a]
src s
s (b -> Parser a m b
func b
b))
                    PR.Error String
err ->
                        Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                            (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                            (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield
                                (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                                ([a]
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState c b inpBuf st p m a
ConcatParseInitLeftOver [])
            Skip s
s -> Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseStream s
s [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s b)
extract
            Step s a
Stop -> Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseStop [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s b)
extract

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

    -- buffered processing loop
    stepOuter State StreamK m a
_ (ConcatParseBuf (a
x:[a]
xs) s
s [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseBuf [a]
xs s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseBuf [a]
src s
s [] s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> s
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> st
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseBuf [a]
src s
s [a]
buf1 s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b)
                                    ([a]
-> s
-> Parser a m b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> st -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInit [a]
src s
s (b -> Parser a m b
func b
b))
            PR.Error String
err ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a]
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState c b inpBuf st p m a
ConcatParseInitLeftOver [])

    -- This is simplified ConcatParseBuf
    stepOuter State StreamK m a
_ (ConcatParseExtract [] [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s b)
extract) =
        Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseStop [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s b)
extract

    stepOuter State StreamK m a
_ (ConcatParseExtract (a
x:[a]
xs) [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseExtract [a]
xs [] s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s 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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseExtract [a]
src [] s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s b)
extract
            PR.Continue Int
0 s
pst1 ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseExtract [a]
xs (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
buf) s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s b)
extract
            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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseExtract [a]
src [a]
buf1 s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s b)
extract
            PR.Done Int
0 b
b ->
                 Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a]
-> Parser a m b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInitBuf [a]
xs (b -> Parser a m b
func b
b))
            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 (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a]
-> Parser a m b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInitBuf [a]
src (b -> Parser a m b
func b
b))
            PR.Error String
err ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a]
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState c b inpBuf st p m a
ConcatParseInitLeftOver [])

    -- This is simplified ConcatParseExtract
    stepOuter State StreamK m a
_ (ConcatParseStop [a]
buf s -> a -> m (Step s b)
pstep s
pst s -> m (Step s b)
extract) = do
        Step s b
pRes <- s -> m (Step s b)
extract s
pst
        case Step s b
pRes of
            PR.Partial Int
_ s
_ -> String
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a. HasCallStack => String -> a
error String
"Bug: parseIterate: Partial in extract"
            PR.Continue Int
0 s
pst1 ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseStop [a]
buf s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s b)
extract
            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]
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]
buf
                    src :: [a]
src  = [a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ [a]
-> [a]
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a s.
inpBuf
-> inpBuf
-> (s -> a -> m (Step s b))
-> s
-> (s -> m (Step s b))
-> ConcatParseState c b inpBuf st p m a
ConcatParseExtract [a]
src [a]
buf1 s -> a -> m (Step s b)
pstep s
pst1 s -> m (Step s b)
extract
            PR.Done Int
0 b
b -> do
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                    Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a]
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState c b inpBuf st p m a
ConcatParseInitLeftOver [])
            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]
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]
buf)
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$
                    Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield (b -> Either ParseError b
forall a b. b -> Either a b
Right b
b) ([a]
-> Parser a m b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> p -> ConcatParseState c b inpBuf st p m a
ConcatParseInitBuf [a]
src (b -> Parser a m b
func b
b))
            PR.Error String
err ->
                Step
  (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
  (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall (m :: * -> *) a. Monad m => a -> m a
return
                    (Step
   (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
   (Either ParseError b)
 -> m (Step
         (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
         (Either ParseError b)))
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
-> m (Step
        (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
        (Either ParseError b))
forall a b. (a -> b) -> a -> b
$ ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall s a. s -> Step s a
Skip
                    (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a
 -> Step
      (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
      (Either ParseError b))
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> Step
     (ConcatParseState (Either ParseError b) b [a] s (Parser a m b) m a)
     (Either ParseError b)
forall a b. (a -> b) -> a -> b
$ Either ParseError b
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
c
-> ConcatParseState c b inpBuf st p m a
-> ConcatParseState c b inpBuf st p m a
ConcatParseYield
                        (ParseError -> Either ParseError b
forall a b. a -> Either a b
Left (String -> ParseError
ParseError String
err))
                        ([a]
-> ConcatParseState
     (Either ParseError b) b [a] s (Parser a m b) m a
forall c b inpBuf st p (m :: * -> *) a.
inpBuf -> ConcatParseState c b inpBuf st p m a
ConcatParseInitLeftOver [])

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

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

------------------------------------------------------------------------------
-- 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 StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> GroupByState s s a Any -> m (Step (GroupByState s s a Any) b))
-> GroupByState s s a Any -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> GroupByState s s a Any -> m (Step (GroupByState s s a Any) b)
forall (m :: * -> *) a b b.
State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter (s -> GroupByState s s a Any
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
state)

    where

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

        where

        -- XXX code duplicated from the previous equation
        go :: SPEC -> s -> s -> m (Step (GroupByState s fs a b) b)
go !SPEC
_ s
stt !s
acc = do
            Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
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 StreamK 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 StreamK m a
_ GroupByState s s a b
GroupingDone = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (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 StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> GroupByState s s a b -> m (Step (GroupByState s s a b) b))
-> GroupByState s s a b -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a.
State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter (s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
state)

    where

    {-# INLINE_LATE stepOuter #-}
    stepOuter :: State StreamK m a
-> GroupByState s s a b -> m (Step (GroupByState s s a b) b)
stepOuter State StreamK m a
_ (GroupingInit s
st) = do
        -- XXX Note that if the stream stops without yielding a single element
        -- in the group we discard the "initial" effect.
        Step s b
res <- m (Step s b)
initial
        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
fs -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> GroupByState s s a b
forall st fs a b. st -> fs -> GroupByState st fs a b
GroupingDo s
st s
fs
                  FL.Done b
fb -> b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
fb (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> GroupByState s s a b
forall st fs a b. st -> GroupByState st fs a b
GroupingInit s
st
    stepOuter State StreamK m a
gst (GroupingDo s
st s
fs) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                Step s b
r <- s -> a -> m (Step s b)
fstep s
fs a
x
                case Step s b
r of
                    FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
forall fs b.
SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
x s
s s
fs1
                    FL.Done b
fb -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
prev a
x
                    then do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s fs a b) b)
go SPEC
SPEC a
x s
s s
fs1
                            FL.Done b
b -> Step (GroupByState s fs a b) b
-> m (Step (GroupByState s fs a b) b)
forall (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 StreamK m a
_ (GroupingInitWith s
st a
x) = do
        Step s b
res <- m (Step s b)
initial
        Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return
            (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ case Step s b
res of
                  FL.Partial s
s -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. s -> Step s a
Skip (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> s -> a -> GroupByState s s a b
forall st fs a b. st -> fs -> a -> GroupByState st fs a b
GroupingDoWith s
st s
s a
x
                  FL.Done b
b -> b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
b (GroupByState s s a b -> Step (GroupByState s s a b) b)
-> GroupByState s s a b -> Step (GroupByState s s a b) b
forall a b. (a -> b) -> a -> b
$ s -> a -> GroupByState s s a b
forall st fs a b. st -> a -> GroupByState st fs a b
GroupingInitWith s
st a
x
    stepOuter State StreamK m a
gst (GroupingDoWith s
st s
fs a
previous) = do
        Step s b
res <- s -> a -> m (Step s b)
fstep s
fs a
previous
        case Step s b
res of
            FL.Partial s
s -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
go SPEC
SPEC a
previous s
st s
s
            FL.Done b
b -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> a -> Bool
cmp a
prev a
x
                    then do
                        Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                        case Step s b
r of
                            FL.Partial s
fs1 -> SPEC -> a -> s -> s -> m (Step (GroupByState s s a b) b)
go SPEC
SPEC a
x s
s s
fs1
                            FL.Done b
b -> Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (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 StreamK m a
_ (GroupingYield b
r GroupByState s s a b
next) = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (GroupByState s s a b) b
 -> m (Step (GroupByState s s a b) b))
-> Step (GroupByState s s a b) b
-> m (Step (GroupByState s s a b) b)
forall a b. (a -> b) -> a -> b
$ b -> GroupByState s s a b -> Step (GroupByState s s a b) b
forall s a. a -> s -> Step s a
Yield b
r GroupByState s s a b
next
    stepOuter State StreamK m a
_ GroupByState s s a b
GroupingDone = Step (GroupByState s s a b) b -> m (Step (GroupByState s s a b) b)
forall (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 StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK m b
 -> WordsByState s s b -> m (Step (WordsByState s s b) b))
-> WordsByState s s b -> Stream m b
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m b
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
forall (m :: * -> *) a.
State StreamK m a
-> WordsByState s s b -> m (Step (WordsByState s s b) b)
stepOuter (s -> WordsByState s s b
forall st fs b. st -> WordsByState st fs b
WordsByInit s
state)

    where

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

    stepOuter State StreamK m a
gst (WordsByDo s
st s
fs) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                if a -> Bool
predicate a
x
                then do
                    Step s b
resi <- m (Step s b)
initial
                    Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall (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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
stt
            case Step s a
res of
                Yield a
x s
s -> do
                    if a -> Bool
predicate a
x
                    then do
                        {-
                        r <- 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 StreamK 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 StreamK m a
_ (WordsByYield b
b WordsByState s s b
next) = Step (WordsByState s s b) b -> m (Step (WordsByState s s b) b)
forall (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, Unbox 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 StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK 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 StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK 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 StreamK 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. Unbox 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 = SIZE_OF(a) * 8

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

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

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

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

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

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

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

    -- XXX shall we use a random starting hash or 1 instead of 0?
    patHash :: Word32
patHash = (Word32 -> a -> Word32) -> Word32 -> Array a -> Word32
forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall a. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    skip :: 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 StreamK 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 StreamK 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
$ Int -> Array a -> IO a
forall a. Unbox a => Int -> Array a -> IO a
A.unsafeIndexIO Int
0 Array a
patArr
                         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 SIZE_OF(a) * patLen
                               Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Proxy Word -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy Word
forall k (t :: k). Proxy t
Proxy :: Proxy 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 StreamK 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 StreamK 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 StreamK m a
gst (SplitOnSeqEmpty s
acc s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                Step s b
r <- s -> a -> m (Step s b)
fstep s
acc a
x
                b
b1 <-
                    case Step s b
r of
                        FL.Partial s
acc1 -> s -> m b
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 StreamK 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 StreamK m a
gst (SplitOnSeqSingle s
fs s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                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 StreamK 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 StreamK m a
_ (SplitOnSeqWordDone Int
n s
fs Word
wrd) = do
        let old :: Word
old = Word
elemMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
wrd Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` (Int
elemBits Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
        Step s b
r <- s -> a -> m (Step s b)
fstep s
fs (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
old)
        case Step s b
r of
            FL.Partial s
fs1 -> SplitOnSeqState (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 StreamK 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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let wrd1 :: Word
wrd1 = Word -> a -> Word
forall a a. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
wrd a
x
                    if Int
idx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
maxIndex
                    then do
                        if Word
wrd1 Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. Word
wordMask Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
wordPat
                        then do
                            let jump :: fs -> SplitOnSeqState 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 StreamK 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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSeqState 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 StreamK m a
gst (SplitOnSeqKRInit Int
idx s
fs s
st Ring a
rb Ptr a
rh) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                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 StreamK 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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    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 StreamK 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 StreamK 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 StreamK 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, Unbox 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 StreamK m a -> s -> m (Step s a)
step s
state) =
    (State StreamK 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 StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK 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 StreamK 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. Unbox 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 = SIZE_OF(a) * 8

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

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

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

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

    nextAfterInit :: (fs -> SplitOnSuffixSeqState 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. Unbox a => (b -> a -> b) -> b -> Array a -> b
A.foldl' Word32 -> a -> Word32
forall a. Enum a => Word32 -> a -> Word32
addCksum Word32
0 Array a
patArr

    skip :: 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 StreamK 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 StreamK 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
$ Int -> Array a -> IO a
forall a. Unbox a => Int -> Array a -> IO a
A.unsafeIndexIO Int
0 Array a
patArr
                         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 SIZE_OF(a) * patLen
                               Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Proxy Word -> Int
forall a. Unbox a => Proxy a -> Int
sizeOf (Proxy Word
forall k (t :: k). Proxy t
Proxy :: Proxy 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 StreamK 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 StreamK 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 StreamK m a
gst (SplitOnSuffixSeqEmpty s
acc s
st) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> do
                let jump :: fs -> SplitOnSuffixSeqState 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 StreamK 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 StreamK m a
gst (SplitOnSuffixSeqSingleInit s
fs s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> a
-> a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (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 StreamK m a
gst (SplitOnSuffixSeqSingle s
fs s
st a
pat) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
        case Step s a
res of
            Yield a
x s
s -> a
-> a
-> s
-> s
-> m (Step
        (SplitOnSuffixSeqState (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 StreamK 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 StreamK m a
_ (SplitOnSuffixSeqWordDone Int
n s
fs Word
wrd) = do
        let old :: Word
old = Word
elemMask Word -> Word -> Word
forall a. Bits a => a -> a -> a
.&. (Word
wrd Word -> Int -> Word
forall a. Bits a => a -> Int -> a
`shiftR` (Int
elemBits Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)))
        Step s b
r <- s -> a -> m (Step s b)
fstep s
fs (Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
old)
        case Step s b
r of
            FL.Partial s
fs1 -> SplitOnSuffixSeqState (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 StreamK m a
gst (SplitOnSuffixSeqWordInit s
fs0 s
st0) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st0
        case Step s a
res of
            Yield a
x s
s -> do
                let wrd :: Word
wrd = Word -> a -> Word
forall a a. (Bits a, Num a, Enum a) => a -> a -> a
addToWord Word
0 a
x
                Step s b
r <- if Bool
withSep then s -> a -> m (Step s b)
fstep s
fs0 a
x else Step s b -> m (Step s b)
forall (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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSuffixSeqState 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 StreamK 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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    let jump :: fs -> SplitOnSuffixSeqState 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 StreamK m a
gst (SplitOnSuffixSeqKRInit Int
idx0 s
fs s
st0 Ring a
rb Ptr a
rh0) = do
        Step s a
res <- State StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st0
        case Step s a
res of
            Yield a
x s
s -> do
                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 StreamK 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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    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 StreamK 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 StreamK m a -> s -> m (Step s a)
step (State StreamK m a -> State StreamK m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State StreamK m a
gst) s
st
            case Step s a
res of
                Yield a
x s
s -> do
                    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 StreamK 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 StreamK 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 StreamK 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

-- Implement this as a fold or a parser instead.
-- This can be implemented easily using Rabin Karp
-- | Split post any one of the given patterns.
--
-- /Unimplemented/
{-# INLINE splitOnSuffixSeqAny #-}
splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>
    [Array a] -> Fold m a b -> Stream m a -> Stream m b
splitOnSuffixSeqAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b
splitOnSuffixSeqAny [Array a]
_subseq Fold m a b
_f Stream m a
_m = Stream m b
forall a. HasCallStack => a
undefined
    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)

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

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

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

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

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

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

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step State StreamK m (f a)
gst (SplitInitial s
st) = do
        Step s (f a)
r <- State StreamK m (f a) -> s -> m (Step s (f a))
step1 State StreamK m (f a)
gst s
st
        case Step s (f a)
r of
            Yield f a
x s
s -> do
                (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
x
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall (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)
forall s a. Step s a
Stop

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

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

-- | Performs infix separator style splitting.
{-# INLINE_NORMAL splitInnerBySuffix #-}
splitInnerBySuffix
    :: (Monad m, 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 StreamK m (f a) -> s -> m (Step s (f a))
step1 s
state1) =
    (State StreamK m (f a)
 -> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a)))
-> SplitState s (f a) -> Stream m (f a)
forall (m :: * -> *) a s.
(State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a
Stream State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step (s -> SplitState s (f a)
forall s arr. s -> SplitState s arr
SplitInitial s
state1)

    where

    {-# INLINE_LATE step #-}
    step :: State StreamK m (f a)
-> SplitState s (f a) -> m (Step (SplitState s (f a)) (f a))
step State StreamK m (f a)
gst (SplitInitial s
st) = do
        Step s (f a)
r <- State StreamK m (f a) -> s -> m (Step s (f a))
step1 State StreamK m (f a)
gst s
st
        case Step s (f a)
r of
            Yield f a
x s
s -> do
                (f a
x1, Maybe (f a)
mx2) <- f a -> m (f a, Maybe (f a))
splitter f a
x
                Step (SplitState s (f a)) (f a)
-> m (Step (SplitState s (f a)) (f a))
forall (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)
forall s a. Step s a
Stop

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

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

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

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

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

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