-- |
-- Module      : Streamly.Internal.Data.Array.Stream.Foreign
-- Copyright   : (c) 2019 Composewell Technologies
-- License     : BSD3-3-Clause
-- Maintainer  : streamly@composewell.com
-- Stability   : pre-release
-- Portability : GHC
--
-- Combinators to efficiently manipulate streams of immutable arrays.
--
module Streamly.Internal.Data.Array.Stream.Foreign
    (
    -- * Creation
      arraysOf

    -- * Flattening to elements
    , concat
    , concatRev
    , interpose
    , interposeSuffix
    , intercalateSuffix
    , unlines

    -- * Elimination
    -- ** Element Folds
    , fold
    , parse
    , parseD

    -- ** Array Folds
    , foldArr
    , foldArr_
    -- , parseArr
    , parseArrD
    , foldArrMany

    , toArray

    -- * Compaction
    , lpackArraysChunksOf
    , compact

    -- * Splitting
    , splitOn
    , splitOnSuffix
    )
where

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

import Data.Bifunctor (second)
import Control.Exception (assert)
import Control.Monad.Catch (MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO(..))
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup (Semigroup(..))
#endif
import Data.Word (Word8)
import Foreign.ForeignPtr (touchForeignPtr)
import Foreign.Ptr (minusPtr, plusPtr, castPtr)
import Foreign.Storable (Storable(..))
import Fusion.Plugin.Types (Fuse(..))
import GHC.Exts (SpecConstrAnnotation(..))
import GHC.ForeignPtr (ForeignPtr(..))
import GHC.Ptr (Ptr(..))
import GHC.Types (SPEC(..))
import Prelude hiding (null, last, (!!), read, concat, unlines)

import Streamly.Internal.Data.Array.Foreign.Mut.Type
    (arrayToFptrContents, fptrToArrayContents, touch)
import Streamly.Internal.Data.Array.Foreign.Type (Array(..))
import Streamly.Internal.Data.Fold.Type (Fold(..))
import Streamly.Internal.Data.Parser (ParseError(..))
import Streamly.Internal.Data.Stream.Serial (SerialT)
import Streamly.Internal.Data.Stream.IsStream.Type
    (IsStream, fromStreamD, toStreamD)
import Streamly.Internal.Data.SVar (adaptState, defState)
import Streamly.Internal.Data.Array.Foreign.Mut.Type
    (memcpy, allocBytesToElemCount)

import qualified Streamly.Internal.Data.Array.Foreign as A
import qualified Streamly.Internal.Data.Array.Foreign as Array
import qualified Streamly.Internal.Data.Array.Foreign.Type as A
import qualified Streamly.Internal.Data.Array.Foreign.Mut.Type as MA
import qualified Streamly.Internal.Data.Array.Stream.Mut.Foreign as AS
import qualified Streamly.Internal.Data.Array.Stream.Fold.Foreign as ASF
import qualified Streamly.Internal.Data.Fold.Type as FL
import qualified Streamly.Internal.Data.Parser as PR
import qualified Streamly.Internal.Data.Parser.ParserD as PRD
import qualified Streamly.Internal.Data.Stream.IsStream as S
import qualified Streamly.Internal.Data.Stream.StreamD as D

-- XXX Since these are immutable arrays MonadIO constraint can be removed from
-- most places.

-------------------------------------------------------------------------------
-- Generation
-------------------------------------------------------------------------------

-- | @arraysOf n stream@ groups the elements in the input stream into arrays of
-- @n@ elements each.
--
-- > arraysOf n = Stream.chunksOf n (Array.writeN n)
--
-- /Pre-release/
{-# INLINE arraysOf #-}
arraysOf :: (IsStream t, MonadIO m, Storable a)
    => Int -> t m a -> t m (Array a)
arraysOf :: Int -> t m a -> t m (Array a)
arraysOf Int
n t m a
str = Stream m (Array a) -> t m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m (Array a) -> t m (Array a))
-> Stream m (Array a) -> t m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Stream m a -> Stream m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m a -> Stream m (Array a)
A.arraysOf Int
n (t m a -> Stream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD t m a
str)

-------------------------------------------------------------------------------
-- Append
-------------------------------------------------------------------------------

-- XXX efficiently compare two streams of arrays. Two streams can have chunks
-- of different sizes, we can handle that in the stream comparison abstraction.
-- This could be useful e.g. to fast compare whether two files differ.

-- | Convert a stream of arrays into a stream of their elements.
--
-- Same as the following:
--
-- > concat = Stream.unfoldMany Array.read
--
-- @since 0.7.0
{-# INLINE concat #-}
concat :: (IsStream t, Monad m, Storable a) => t m (Array a) -> t m a
-- concat m = fromStreamD $ A.flattenArrays (toStreamD m)
-- concat m = fromStreamD $ D.concatMap A.toStreamD (toStreamD m)
concat :: t m (Array a) -> t m a
concat t m (Array a)
m = Stream m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m a -> t m a) -> Stream m a -> t m a
forall a b. (a -> b) -> a -> b
$ Unfold m (Array a) a -> Stream m (Array a) -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldMany Unfold m (Array a) a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Unfold m (Array a) a
A.read (t m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD t m (Array a)
m)

-- | Convert a stream of arrays into a stream of their elements reversing the
-- contents of each array before flattening.
--
-- > concatRev = Stream.unfoldMany Array.readRev
--
-- @since 0.7.0
{-# INLINE concatRev #-}
concatRev :: (IsStream t, Monad m, Storable a) => t m (Array a) -> t m a
-- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m)
concatRev :: t m (Array a) -> t m a
concatRev t m (Array a)
m = Stream m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m a -> t m a) -> Stream m a -> t m a
forall a b. (a -> b) -> a -> b
$ Unfold m (Array a) a -> Stream m (Array a) -> Stream m a
forall (m :: * -> *) a b.
Monad m =>
Unfold m a b -> Stream m a -> Stream m b
D.unfoldMany Unfold m (Array a) a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Unfold m (Array a) a
A.readRev (t m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD t m (Array a)
m)

-------------------------------------------------------------------------------
-- Intersperse and append
-------------------------------------------------------------------------------

-- | Flatten a stream of arrays after inserting the given element between
-- arrays.
--
-- /Pre-release/
{-# INLINE interpose #-}
interpose :: (Monad m, IsStream t, Storable a) => a -> t m (Array a) -> t m a
interpose :: a -> t m (Array a) -> t m a
interpose a
x = a -> Unfold m (Array a) a -> t m (Array a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) c b.
(IsStream t, Monad m) =>
c -> Unfold m b c -> t m b -> t m c
S.interpose a
x Unfold m (Array a) a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Unfold m (Array a) a
A.read

{-# INLINE intercalateSuffix #-}
intercalateSuffix :: (Monad m, IsStream t, Storable a)
    => Array a -> t m (Array a) -> t m a
intercalateSuffix :: Array a -> t m (Array a) -> t m a
intercalateSuffix = Unfold m (Array a) a -> Array a -> t m (Array a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) b c.
(IsStream t, Monad m) =>
Unfold m b c -> b -> t m b -> t m c
S.intercalateSuffix Unfold m (Array a) a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Unfold m (Array a) a
A.read

-- | Flatten a stream of arrays appending the given element after each
-- array.
--
-- @since 0.7.0
{-# INLINE interposeSuffix #-}
interposeSuffix :: (Monad m, IsStream t, Storable a)
    => a -> t m (Array a) -> t m a
-- interposeSuffix x = fromStreamD . A.unlines x . toStreamD
interposeSuffix :: a -> t m (Array a) -> t m a
interposeSuffix a
x = a -> Unfold m (Array a) a -> t m (Array a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) c b.
(IsStream t, Monad m) =>
c -> Unfold m b c -> t m b -> t m c
S.interposeSuffix a
x Unfold m (Array a) a
forall (m :: * -> *) a.
(Monad m, Storable a) =>
Unfold m (Array a) a
A.read

data FlattenState s a =
      OuterLoop s
    | InnerLoop s !MA.ArrayContents !(Ptr a) !(Ptr a)

-- XXX Remove monadIO constraint
{-# INLINE_NORMAL unlines #-}
unlines :: forall m a. (MonadIO m, Storable a)
    => a -> D.Stream m (Array a) -> D.Stream m a
unlines :: a -> Stream m (Array a) -> Stream m a
unlines a
sep (D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = (State Stream m a
 -> FlattenState s a -> m (Step (FlattenState s a) a))
-> FlattenState s a -> Stream m a
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a.
State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' (s -> FlattenState s a
forall s a. s -> FlattenState s a
OuterLoop s
state)
    where
    {-# INLINE_LATE step' #-}
    step' :: State Stream m a
-> FlattenState s a -> m (Step (FlattenState s a) a)
step' State Stream m a
gst (OuterLoop s
st) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (State Stream m a -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ case Step s (Array a)
r of
            D.Yield Array{Ptr a
ArrayContents
aEnd :: forall a. Array a -> Ptr a
arrStart :: forall a. Array a -> Ptr a
arrContents :: forall a. Array a -> ArrayContents
aEnd :: Ptr a
arrStart :: Ptr a
arrContents :: ArrayContents
..} s
s ->
                FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> ArrayContents -> Ptr a -> Ptr a -> FlattenState s a
forall s a.
s -> ArrayContents -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
s ArrayContents
arrContents Ptr a
arrStart Ptr a
aEnd)
            D.Skip s
s -> FlattenState s a -> Step (FlattenState s a) a
forall s a. s -> Step s a
D.Skip (s -> FlattenState s a
forall s a. s -> FlattenState s a
OuterLoop s
s)
            Step s (Array a)
D.Stop -> Step (FlattenState s a) a
forall s a. Step s a
D.Stop

    step' State Stream m a
_ (InnerLoop s
st ArrayContents
_ Ptr a
p Ptr a
end) | Ptr a
p Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
end =
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ a -> FlattenState s a -> Step (FlattenState s a) a
forall s a. a -> s -> Step s a
D.Yield a
sep (FlattenState s a -> Step (FlattenState s a) a)
-> FlattenState s a -> Step (FlattenState s a) a
forall a b. (a -> b) -> a -> b
$ s -> FlattenState s a
forall s a. s -> FlattenState s a
OuterLoop s
st

    step' State Stream m a
_ (InnerLoop s
st ArrayContents
contents Ptr a
p Ptr a
end) = do
        a
x <- 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
$ do
                    a
r <- Ptr a -> IO a
forall a. Storable a => Ptr a -> IO a
peek Ptr a
p
                    ArrayContents -> IO ()
touch ArrayContents
contents
                    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
        Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (FlattenState s a) a -> m (Step (FlattenState s a) a))
-> Step (FlattenState s a) a -> m (Step (FlattenState s a) a)
forall a b. (a -> b) -> a -> b
$ a -> FlattenState s a -> Step (FlattenState s a) a
forall s a. a -> s -> Step s a
D.Yield a
x (s -> ArrayContents -> Ptr a -> Ptr a -> FlattenState s a
forall s a.
s -> ArrayContents -> Ptr a -> Ptr a -> FlattenState s a
InnerLoop s
st ArrayContents
contents (PTR_NEXT(p,a)) end)

-------------------------------------------------------------------------------
-- Compact
-------------------------------------------------------------------------------

-- XXX These would not be needed once we implement compactLEFold, see
-- module Streamly.Internal.Data.Array.Stream.Mut.Foreign
--
{-# INLINE_NORMAL packArraysChunksOf #-}
packArraysChunksOf :: (MonadIO m, Storable a)
    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)
packArraysChunksOf :: Int -> Stream m (Array a) -> Stream m (Array a)
packArraysChunksOf Int
n Stream m (Array a)
str =
    (Array a -> Array a) -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
D.map Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze (Stream m (Array a) -> Stream m (Array a))
-> Stream m (Array a) -> Stream m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m (Array a) -> Stream m (Array a)
AS.packArraysChunksOf Int
n (Stream m (Array a) -> Stream m (Array a))
-> Stream m (Array a) -> Stream m (Array a)
forall a b. (a -> b) -> a -> b
$ (Array a -> Array a) -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Stream m a -> Stream m b
D.map Array a -> Array a
forall a. Array a -> Array a
A.unsafeThaw Stream m (Array a)
str

-- XXX instead of writing two different versions of this operation, we should
-- write it as a pipe.
{-# INLINE_NORMAL lpackArraysChunksOf #-}
lpackArraysChunksOf :: (MonadIO m, Storable a)
    => Int -> Fold m (Array a) () -> Fold m (Array a) ()
lpackArraysChunksOf :: Int -> Fold m (Array a) () -> Fold m (Array a) ()
lpackArraysChunksOf Int
n Fold m (Array a) ()
fld =
    (Array a -> Array a) -> Fold m (Array a) () -> Fold m (Array a) ()
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
FL.lmap Array a -> Array a
forall a. Array a -> Array a
A.unsafeThaw (Fold m (Array a) () -> Fold m (Array a) ())
-> Fold m (Array a) () -> Fold m (Array a) ()
forall a b. (a -> b) -> a -> b
$ Int -> Fold m (Array a) () -> Fold m (Array a) ()
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Fold m (Array a) () -> Fold m (Array a) ()
AS.lpackArraysChunksOf Int
n ((Array a -> Array a) -> Fold m (Array a) () -> Fold m (Array a) ()
forall a b (m :: * -> *) r. (a -> b) -> Fold m b r -> Fold m a r
FL.lmap Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze Fold m (Array a) ()
fld)

-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a
-- maximum specified size in bytes.
--
-- @since 0.7.0
{-# INLINE compact #-}
compact :: (MonadIO m, Storable a)
    => Int -> SerialT m (Array a) -> SerialT m (Array a)
compact :: Int -> SerialT m (Array a) -> SerialT m (Array a)
compact Int
n SerialT m (Array a)
xs = Stream m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m (Array a) -> SerialT m (Array a))
-> Stream m (Array a) -> SerialT m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> Stream m (Array a) -> Stream m (Array a)
packArraysChunksOf Int
n (SerialT m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD SerialT m (Array a)
xs)

-------------------------------------------------------------------------------
-- Split
-------------------------------------------------------------------------------

data SplitState s arr
    = Initial s
    | Buffering s arr
    | Splitting s arr
    | Yielding arr (SplitState s arr)
    | Finishing

-- | Split a stream of arrays on a given separator byte, dropping the separator
-- and coalescing all the arrays between two separators into a single array.
--
-- @since 0.7.0
{-# INLINE_NORMAL _splitOn #-}
_splitOn
    :: MonadIO m
    => Word8
    -> D.Stream m (Array Word8)
    -> D.Stream m (Array Word8)
_splitOn :: Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)
_splitOn Word8
byte (D.Stream State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step s
state) = (State Stream m (Array Word8)
 -> SplitState s (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> SplitState s (Array Word8) -> Stream m (Array Word8)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array Word8)
-> SplitState s (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
step' (s -> SplitState s (Array Word8)
forall s arr. s -> SplitState s arr
Initial s
state)

    where

    {-# INLINE_LATE step' #-}
    step' :: State Stream m (Array Word8)
-> SplitState s (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
step' State Stream m (Array Word8)
gst (Initial s
st) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            D.Yield Array Word8
arr s
s -> do
                (Array Word8
arr1, Maybe (Array Word8)
marr2) <- Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
A.breakOn Word8
byte Array Word8
arr
                Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                    Maybe (Array Word8)
Nothing   -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
arr1)
                    Just Array Word8
arr2 -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
arr1 (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Splitting s
s Array Word8
arr2))
            D.Skip s
s -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> SplitState s (Array Word8)
forall s arr. s -> SplitState s arr
Initial s
s)
            Step s (Array Word8)
D.Stop -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (Array Word8)) (Array Word8)
forall s a. Step s a
D.Stop

    step' State Stream m (Array Word8)
gst (Buffering s
st Array Word8
buf) = do
        Step s (Array Word8)
r <- State Stream m (Array Word8) -> s -> m (Step s (Array Word8))
step State Stream m (Array Word8)
gst s
st
        case Step s (Array Word8)
r of
            D.Yield Array Word8
arr s
s -> do
                (Array Word8
arr1, Maybe (Array Word8)
marr2) <- Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
A.breakOn Word8
byte Array Word8
arr
                Array Word8
buf' <- Array Word8 -> Array Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
A.splice Array Word8
buf Array Word8
arr1
                Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                    Maybe (Array Word8)
Nothing -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
buf')
                    Just Array Word8
x -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
buf' (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Splitting s
s Array Word8
x))
            D.Skip s
s -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
s Array Word8
buf)
            Step s (Array Word8)
D.Stop -> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$
                if Array Word8 -> Int
forall a. Array a -> Int
A.byteLength Array Word8
buf Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                then Step (SplitState s (Array Word8)) (Array Word8)
forall s a. Step s a
D.Stop
                else SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
buf SplitState s (Array Word8)
forall s arr. SplitState s arr
Finishing)

    step' State Stream m (Array Word8)
_ (Splitting s
st Array Word8
buf) = do
        (Array Word8
arr1, Maybe (Array Word8)
marr2) <- Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
A.breakOn Word8
byte Array Word8
buf
        Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ case Maybe (Array Word8)
marr2 of
                Maybe (Array Word8)
Nothing -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (SplitState s (Array Word8)
 -> Step (SplitState s (Array Word8)) (Array Word8))
-> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Buffering s
st Array Word8
arr1
                Just Array Word8
arr2 -> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. s -> Step s a
D.Skip (SplitState s (Array Word8)
 -> Step (SplitState s (Array Word8)) (Array Word8))
-> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall a b. (a -> b) -> a -> b
$ Array Word8
-> SplitState s (Array Word8) -> SplitState s (Array Word8)
forall s arr. arr -> SplitState s arr -> SplitState s arr
Yielding Array Word8
arr1 (s -> Array Word8 -> SplitState s (Array Word8)
forall s arr. s -> arr -> SplitState s arr
Splitting s
st Array Word8
arr2)

    step' State Stream m (Array Word8)
_ (Yielding Array Word8
arr SplitState s (Array Word8)
next) = Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (SplitState s (Array Word8)) (Array Word8)
 -> m (Step (SplitState s (Array Word8)) (Array Word8)))
-> Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall a b. (a -> b) -> a -> b
$ Array Word8
-> SplitState s (Array Word8)
-> Step (SplitState s (Array Word8)) (Array Word8)
forall s a. a -> s -> Step s a
D.Yield Array Word8
arr SplitState s (Array Word8)
next
    step' State Stream m (Array Word8)
_ SplitState s (Array Word8)
Finishing = Step (SplitState s (Array Word8)) (Array Word8)
-> m (Step (SplitState s (Array Word8)) (Array Word8))
forall (m :: * -> *) a. Monad m => a -> m a
return Step (SplitState s (Array Word8)) (Array Word8)
forall s a. Step s a
D.Stop

-- XXX Remove MonadIO constraint.
-- | Split a stream of arrays on a given separator byte, dropping the separator
-- and coalescing all the arrays between two separators into a single array.
--
-- @since 0.7.0
{-# INLINE splitOn #-}
splitOn
    :: (IsStream t, MonadIO m)
    => Word8
    -> t m (Array Word8)
    -> t m (Array Word8)
splitOn :: Word8 -> t m (Array Word8) -> t m (Array Word8)
splitOn Word8
byte t m (Array Word8)
s =
    Stream m (Array Word8) -> t m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m (Array Word8) -> t m (Array Word8))
-> Stream m (Array Word8) -> t m (Array Word8)
forall a b. (a -> b) -> a -> b
$ (Array Word8 -> m (Array Word8, Maybe (Array Word8)))
-> (Array Word8 -> Array Word8 -> m (Array Word8))
-> Stream m (Array Word8)
-> Stream m (Array Word8)
forall (m :: * -> *) (f :: * -> *) a.
Monad m =>
(f a -> m (f a, Maybe (f a)))
-> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)
D.splitInnerBy (Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
A.breakOn Word8
byte) Array Word8 -> Array Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
A.splice (Stream m (Array Word8) -> Stream m (Array Word8))
-> Stream m (Array Word8) -> Stream m (Array Word8)
forall a b. (a -> b) -> a -> b
$ t m (Array Word8) -> Stream m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD t m (Array Word8)
s

{-# INLINE splitOnSuffix #-}
splitOnSuffix
    :: (IsStream t, MonadIO m)
    => Word8
    -> t m (Array Word8)
    -> t m (Array Word8)
-- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s
splitOnSuffix :: Word8 -> t m (Array Word8) -> t m (Array Word8)
splitOnSuffix Word8
byte t m (Array Word8)
s =
    Stream m (Array Word8) -> t m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m (Array Word8) -> t m (Array Word8))
-> Stream m (Array Word8) -> t m (Array Word8)
forall a b. (a -> b) -> a -> b
$ (Array Word8 -> m (Array Word8, Maybe (Array Word8)))
-> (Array Word8 -> Array Word8 -> m (Array Word8))
-> Stream m (Array Word8)
-> Stream m (Array Word8)
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Eq (f a), Monoid (f a)) =>
(f a -> m (f a, Maybe (f a)))
-> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)
D.splitInnerBySuffix (Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
forall (m :: * -> *).
MonadIO m =>
Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
A.breakOn Word8
byte) Array Word8 -> Array Word8 -> m (Array Word8)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
A.splice (Stream m (Array Word8) -> Stream m (Array Word8))
-> Stream m (Array Word8) -> Stream m (Array Word8)
forall a b. (a -> b) -> a -> b
$ t m (Array Word8) -> Stream m (Array Word8)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD t m (Array Word8)
s

-------------------------------------------------------------------------------
-- Elimination - Running folds
-------------------------------------------------------------------------------

-- XXX This should be written using CPS (as foldK) if we want it to scale wrt
-- to the number of times it can be called on the same stream.
--
{-# INLINE_NORMAL foldD #-}
foldD :: forall m a b. (MonadIO m, Storable a) =>
    Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))
foldD :: Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
foldD (Fold s -> a -> m (Step s b)
fstep m (Step s b)
initial s -> m b
extract) stream :: Stream m (Array a)
stream@(D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = do
    Step s b
res <- m (Step s b)
initial
    case Step s b
res of
        FL.Partial s
fs -> SPEC -> s -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
state s
fs
        FL.Done b
fb -> (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, Stream m (Array a)) -> m (b, Stream m (Array a)))
-> (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall a b. (a -> b) -> a -> b
$! (b
fb, Stream m (Array a)
stream)

    where

    {-# INLINE go #-}
    go :: SPEC -> s -> s -> m (b, Stream m (Array a))
go !SPEC
_ s
st !s
fs = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s (Array a)
r of
            D.Yield (Array ArrayContents
contents Ptr a
start (Ptr Addr#
end)) s
s ->
                let fp :: ForeignPtr a
fp = Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
end (ArrayContents -> ForeignPtrContents
arrayToFptrContents ArrayContents
contents)
                 in SPEC
-> s -> ForeignPtr a -> Ptr a -> s -> m (b, Stream m (Array a))
goArray SPEC
SPEC s
s ForeignPtr a
forall a. ForeignPtr a
fp Ptr a
start s
fs
            D.Skip s
s -> SPEC -> s -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
s s
fs
            Step s (Array a)
D.Stop -> do
                b
b <- s -> m b
extract s
fs
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a)
forall (m :: * -> *) a. Monad m => Stream m a
D.nil)

    goArray :: SPEC
-> s -> ForeignPtr a -> Ptr a -> s -> m (b, Stream m (Array a))
goArray !SPEC
_ s
s fp :: ForeignPtr a
fp@(ForeignPtr Addr#
end ForeignPtrContents
_) !Ptr a
cur !s
fs
        | Ptr a
cur Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end = do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp
            SPEC -> s -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
s s
fs
    goArray !SPEC
_ s
st fp :: ForeignPtr a
fp@(ForeignPtr Addr#
end ForeignPtrContents
contents) !Ptr a
cur !s
fs = do
        a
x <- 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
cur
        Step s b
res <- s -> a -> m (Step s b)
fstep s
fs a
x
        let next :: Ptr b
next = PTR_NEXT(cur,a)
        case Step s b
res of
            FL.Done b
b -> do
                let arr :: Array a
arr = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array (ForeignPtrContents -> ArrayContents
fptrToArrayContents ForeignPtrContents
contents) Ptr a
forall b. Ptr b
next (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end)
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return ((b, Stream m (Array a)) -> m (b, Stream m (Array a)))
-> (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall a b. (a -> b) -> a -> b
$! (b
b, Array a -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a. Monad m => a -> Stream m a -> Stream m a
D.cons Array a
forall a. Array a
arr ((State Stream m (Array a) -> s -> m (Step s (Array a)))
-> s -> Stream m (Array a)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
st))
            FL.Partial s
fs1 -> SPEC
-> s -> ForeignPtr a -> Ptr a -> s -> m (b, Stream m (Array a))
goArray SPEC
SPEC s
st ForeignPtr a
fp Ptr a
forall b. Ptr b
next s
fs1

-- | Fold an array stream using the supplied 'Fold'. Returns the fold result
-- and the unconsumed stream.
--
-- /Internal/
--
{-# INLINE_NORMAL fold #-}
fold ::
       (MonadIO m, Storable a)
    => FL.Fold m a b
    -> SerialT m (A.Array a)
    -> m (b, SerialT m (A.Array a))
fold :: Fold m a b -> SerialT m (Array a) -> m (b, SerialT m (Array a))
fold Fold m a b
f SerialT m (Array a)
s = (Stream m (Array a) -> SerialT m (Array a))
-> (b, Stream m (Array a)) -> (b, SerialT m (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD ((b, Stream m (Array a)) -> (b, SerialT m (Array a)))
-> m (b, Stream m (Array a)) -> m (b, SerialT m (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
forall (m :: * -> *) a b.
(MonadIO m, Storable a) =>
Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
foldD Fold m a b
f (SerialT m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD SerialT m (Array a)
s)

-------------------------------------------------------------------------------
-- Fold to a single Array
-------------------------------------------------------------------------------

-- When we have to take an array partially, take the last part of the array.
{-# INLINE takeArrayListRev #-}
takeArrayListRev :: forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev :: Int -> [Array a] -> [Array a]
takeArrayListRev = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
go

    where

    go :: Int -> [Array a] -> [Array a]
go Int
_ [] = []
    go Int
n [Array a]
_ | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = []
    go Int
n (Array a
x:[Array a]
xs) =
        let len :: Int
len = Array a -> Int
forall a. Storable a => Array a -> Int
Array.length Array a
x
        in if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
           then Array a
x Array a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
: Int -> [Array a] -> [Array a]
go (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) [Array a]
xs
           else if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
           then [Array a
x]
           else let !(Array ArrayContents
contents Ptr a
_ Ptr a
end) = Array a
x
                    !start :: Ptr b
start = Ptr a
end Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
                 in [ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array ArrayContents
contents Ptr a
forall b. Ptr b
start Ptr a
end]

-- When we have to take an array partially, take the last part of the array in
-- the first split.
{-# INLINE splitAtArrayListRev #-}
splitAtArrayListRev :: forall a. Storable a =>
    Int -> [Array a] -> ([Array a],[Array a])
splitAtArrayListRev :: Int -> [Array a] -> ([Array a], [Array a])
splitAtArrayListRev Int
n [Array a]
ls
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], [Array a]
ls)
  | Bool
otherwise = Int -> [Array a] -> ([Array a], [Array a])
go Int
n [Array a]
ls
    where
        go :: Int -> [Array a] -> ([Array a], [Array a])
        go :: Int -> [Array a] -> ([Array a], [Array a])
go Int
_  []     = ([], [])
        go Int
m (Array a
x:[Array a]
xs) =
            let len :: Int
len = Array a -> Int
forall a. Storable a => Array a -> Int
Array.length Array a
x
                ([Array a]
xs', [Array a]
xs'') = Int -> [Array a] -> ([Array a], [Array a])
go (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) [Array a]
xs
             in if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len
                then (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
xs', [Array a]
xs'')
                else if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
len
                then ([Array a
x],[Array a]
xs)
                else let !(Array ArrayContents
contents Ptr a
start Ptr a
end) = Array a
x
                         end1 :: Ptr b
end1 = Ptr a
end Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int -> Int
forall a. Num a => a -> a
negate (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* SIZE_OF(a))
                         arr2 :: Array a
arr2 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array ArrayContents
contents Ptr a
start Ptr a
forall b. Ptr b
end1
                         arr1 :: Array a
arr1 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array ArrayContents
contents Ptr a
forall b. Ptr b
end1 Ptr a
end
                      in ([Array a
arr1], Array a
arr2Array a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
xs)

-------------------------------------------------------------------------------
-- Fold to a single Array
-------------------------------------------------------------------------------

-- XXX Both of these implementations of splicing seem to perform equally well.
-- We need to perform benchmarks over a range of sizes though.

-- CAUTION! length must more than equal to lengths of all the arrays in the
-- stream.
{-# INLINE spliceArraysLenUnsafe #-}
spliceArraysLenUnsafe :: (MonadIO m, Storable a)
    => Int -> SerialT m (MA.Array a) -> m (MA.Array a)
spliceArraysLenUnsafe :: Int -> SerialT m (Array a) -> m (Array a)
spliceArraysLenUnsafe Int
len SerialT m (Array a)
buffered = do
    Array a
arr <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> m (Array a)
MA.newArray Int
len
    Ptr a
end <- (Ptr a -> Array a -> m (Ptr a))
-> m (Ptr a) -> SerialT m (Array a) -> m (Ptr a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> SerialT m a -> m b
S.foldlM' Ptr a -> Array a -> m (Ptr a)
forall (m :: * -> *) a a b.
MonadIO m =>
Ptr a -> Array a -> m (Ptr b)
writeArr (Ptr a -> m (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> m (Ptr a)) -> Ptr a -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Array a -> Ptr a
forall a. Array a -> Ptr a
MA.aEnd Array a
arr) SerialT m (Array a)
buffered
    Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Array a
arr {aEnd :: Ptr a
MA.aEnd = Ptr a
end}

    where

    writeArr :: Ptr a -> Array a -> m (Ptr b)
writeArr Ptr a
dst (MA.Array ArrayContents
ac Ptr a
src Ptr a
ae Ptr a
_) =
        IO (Ptr b) -> m (Ptr b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr b) -> m (Ptr b)) -> IO (Ptr b) -> m (Ptr b)
forall a b. (a -> b) -> a -> b
$ do
            let count :: Int
count = Ptr a
ae Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
src
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
dst) (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
src) Int
count
            ArrayContents -> IO ()
touch ArrayContents
ac
            Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b -> IO (Ptr b)) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ Ptr a
dst Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
count

{-# INLINE _spliceArrays #-}
_spliceArrays :: (MonadIO m, Storable a)
    => SerialT m (Array a) -> m (Array a)
_spliceArrays :: SerialT m (Array a) -> m (Array a)
_spliceArrays SerialT m (Array a)
s = do
    SerialT m (Array a)
buffered <- (Array a -> SerialT m (Array a) -> SerialT m (Array a))
-> SerialT m (Array a)
-> SerialT m (Array a)
-> m (SerialT m (Array a))
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> SerialT m a -> m b
S.foldr Array a -> SerialT m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
S.cons SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
S.nil SerialT m (Array a)
s
    Int
len <- SerialT m Int -> m Int
forall (m :: * -> *) a. (Monad m, Num a) => SerialT m a -> m a
S.sum ((Array a -> Int) -> SerialT m (Array a) -> SerialT m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
S.map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length SerialT m (Array a)
buffered)
    Array a
arr <- IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> m (Array a)
MA.newArray Int
len
    Ptr a
end <- (Ptr a -> Array a -> m (Ptr a))
-> m (Ptr a) -> SerialT m (Array a) -> m (Ptr a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> SerialT m a -> m b
S.foldlM' Ptr a -> Array a -> m (Ptr a)
forall (m :: * -> *) a a b.
MonadIO m =>
Ptr a -> Array a -> m (Ptr b)
writeArr (Ptr a -> m (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr a -> m (Ptr a)) -> Ptr a -> m (Ptr a)
forall a b. (a -> b) -> a -> b
$ Array a -> Ptr a
forall a. Array a -> Ptr a
MA.aEnd Array a
arr) SerialT m (Array a)
s
    Array a -> m (Array a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Array a -> m (Array a)) -> Array a -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze (Array a -> Array a) -> Array a -> Array a
forall a b. (a -> b) -> a -> b
$ Array a
arr {aEnd :: Ptr a
MA.aEnd = Ptr a
end}

    where

    writeArr :: Ptr a -> Array a -> m (Ptr b)
writeArr Ptr a
dst (Array ArrayContents
ac Ptr a
src Ptr a
ae) =
        IO (Ptr b) -> m (Ptr b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ptr b) -> m (Ptr b)) -> IO (Ptr b) -> m (Ptr b)
forall a b. (a -> b) -> a -> b
$ do
            let count :: Int
count = Ptr a
ae Ptr a -> Ptr a -> Int
forall a b. Ptr a -> Ptr b -> Int
`minusPtr` Ptr a
src
            Ptr Word8 -> Ptr Word8 -> Int -> IO ()
memcpy (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
dst) (Ptr a -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr Ptr a
src) Int
count
            ArrayContents -> IO ()
touch ArrayContents
ac
            Ptr b -> IO (Ptr b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr b -> IO (Ptr b)) -> Ptr b -> IO (Ptr b)
forall a b. (a -> b) -> a -> b
$ Ptr a
dst Ptr a -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
count

{-# INLINE _spliceArraysBuffered #-}
_spliceArraysBuffered :: (MonadIO m, Storable a)
    => SerialT m (Array a) -> m (Array a)
_spliceArraysBuffered :: SerialT m (Array a) -> m (Array a)
_spliceArraysBuffered SerialT m (Array a)
s = do
    SerialT m (Array a)
buffered <- (Array a -> SerialT m (Array a) -> SerialT m (Array a))
-> SerialT m (Array a)
-> SerialT m (Array a)
-> m (SerialT m (Array a))
forall (m :: * -> *) a b.
Monad m =>
(a -> b -> b) -> b -> SerialT m a -> m b
S.foldr Array a -> SerialT m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) a (m :: * -> *).
IsStream t =>
a -> t m a -> t m a
S.cons SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
IsStream t =>
t m a
S.nil SerialT m (Array a)
s
    Int
len <- SerialT m Int -> m Int
forall (m :: * -> *) a. (Monad m, Num a) => SerialT m a -> m a
S.sum ((Array a -> Int) -> SerialT m (Array a) -> SerialT m Int
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
S.map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length SerialT m (Array a)
buffered)
    Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze (Array a -> Array a) -> m (Array a) -> m (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> SerialT m (Array a) -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> SerialT m (Array a) -> m (Array a)
spliceArraysLenUnsafe Int
len ((Array a -> Array a) -> SerialT m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
S.map Array a -> Array a
forall a. Array a -> Array a
A.unsafeThaw SerialT m (Array a)
s)

{-# INLINE spliceArraysRealloced #-}
spliceArraysRealloced :: forall m a. (MonadIO m, Storable a)
    => SerialT m (Array a) -> m (Array a)
spliceArraysRealloced :: SerialT m (Array a) -> m (Array a)
spliceArraysRealloced SerialT m (Array a)
s = do
    let n :: Int
n = a -> Int -> Int
forall a. Storable a => a -> Int -> Int
allocBytesToElemCount (a
forall a. HasCallStack => a
undefined :: a) (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024)
        idst :: m (Array a)
idst = IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Int -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Int -> m (Array a)
MA.newArray Int
n

    Array a
arr <- (Array a -> Array a -> m (Array a))
-> m (Array a) -> SerialT m (Array a) -> m (Array a)
forall (m :: * -> *) b a.
Monad m =>
(b -> a -> m b) -> m b -> SerialT m a -> m b
S.foldlM' Array a -> Array a -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> Array a -> m (Array a)
MA.spliceExp m (Array a)
idst ((Array a -> Array a) -> SerialT m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a b.
(IsStream t, Monad m) =>
(a -> b) -> t m a -> t m b
S.map Array a -> Array a
forall a. Array a -> Array a
A.unsafeThaw SerialT m (Array a)
s)
    IO (Array a) -> m (Array a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Array a) -> m (Array a)) -> IO (Array a) -> m (Array a)
forall a b. (a -> b) -> a -> b
$ Array a -> Array a
forall a. Array a -> Array a
A.unsafeFreeze (Array a -> Array a) -> IO (Array a) -> IO (Array a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array a -> IO (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
Array a -> m (Array a)
MA.rightSize Array a
arr

-- XXX This should just be "fold A.write"
--
-- | Given a stream of arrays, splice them all together to generate a single
-- array. The stream must be /finite/.
--
-- @since 0.7.0
{-# INLINE toArray #-}
toArray :: (MonadIO m, Storable a) => SerialT m (Array a) -> m (Array a)
toArray :: SerialT m (Array a) -> m (Array a)
toArray = SerialT m (Array a) -> m (Array a)
forall (m :: * -> *) a.
(MonadIO m, Storable a) =>
SerialT m (Array a) -> m (Array a)
spliceArraysRealloced
-- spliceArrays = _spliceArraysBuffered

-- exponentially increasing sizes of the chunks upto the max limit.
-- XXX this will be easier to implement with parsers/terminating folds
-- With this we should be able to reduce the number of chunks/allocations.
-- The reallocation/copy based toArray can also be implemented using this.
--
{-
{-# INLINE toArraysInRange #-}
toArraysInRange :: (IsStream t, MonadIO m, Storable a)
    => Int -> Int -> Fold m (Array a) b -> Fold m a b
toArraysInRange low high (Fold step initial extract) =
-}

{-
-- | Fold the input to a pure buffered stream (List) of arrays.
{-# INLINE _toArraysOf #-}
_toArraysOf :: (MonadIO m, Storable a)
    => Int -> Fold m a (SerialT Identity (Array a))
_toArraysOf n = FL.chunksOf n (A.writeNF n) FL.toStream
-}

-------------------------------------------------------------------------------
-- Elimination - running element parsers
-------------------------------------------------------------------------------

-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need
-- to make a newtype.
{-# ANN type List NoSpecConstr #-}
newtype List a = List {List a -> [a]
getList :: [a]}

-- This can be generalized to any type provided it can be unfolded to a stream
-- and it can be combined using a semigroup operation.
--
-- XXX This should be written using CPS (as parseK) if we want it to scale wrt
-- to the number of times it can be called on the same stream.
{-# INLINE_NORMAL parseD #-}
parseD ::
       forall m a b. (MonadIO m, MonadThrow m, Storable a)
    => PRD.Parser m a b
    -> D.Stream m (Array.Array a)
    -> m (b, D.Stream m (Array.Array a))
parseD :: Parser m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
parseD (PRD.Parser s -> a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract) stream :: Stream m (Array a)
stream@(D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        PRD.IPartial s
s -> SPEC -> s -> List a -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
state ([a] -> List a
forall a. [a] -> List a
List []) s
s
        PRD.IDone b
b -> (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a)
stream)
        PRD.IError String
err -> ParseError -> m (b, Stream m (Array a))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m (Array a)))
-> ParseError -> m (b, Stream m (Array a))
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    where

    -- "backBuf" contains last few items in the stream that we may have to
    -- backtrack to.
    --
    -- XXX currently we are using a dumb list based approach for backtracking
    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
    -- That will allow us more efficient random back and forth movement.
    go :: SPEC -> s -> List a -> s -> m (b, Stream m (Array a))
go !SPEC
_ s
st List a
backBuf !s
pst = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s (Array a)
r of
            D.Yield (Array ArrayContents
contents Ptr a
start (Ptr Addr#
end)) s
s ->
                SPEC
-> s
-> List a
-> ForeignPtr a
-> Ptr a
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC s
s List a
backBuf
                    (Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
end (ArrayContents -> ForeignPtrContents
arrayToFptrContents ArrayContents
contents)) Ptr a
start s
pst
            D.Skip s
s -> SPEC -> s -> List a -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
s List a
backBuf s
pst
            Step s (Array a)
D.Stop -> do
                b
b <- s -> m b
extract s
pst
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a)
forall (m :: * -> *) a. Monad m => Stream m a
D.nil)

    -- Use strictness on "cur" to keep it unboxed
    gobuf :: SPEC
-> s
-> List a
-> ForeignPtr a
-> Ptr a
-> s
-> m (b, Stream m (Array a))
gobuf !SPEC
_ s
s List a
backBuf fp :: ForeignPtr a
fp@(ForeignPtr Addr#
end ForeignPtrContents
_) !Ptr a
cur !s
pst
        | Ptr a
cur Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end = do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr ForeignPtr a
fp
            SPEC -> s -> List a -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
s List a
backBuf s
pst
    gobuf !SPEC
_ s
s List a
backBuf fp :: ForeignPtr a
fp@(ForeignPtr Addr#
end ForeignPtrContents
contents) !Ptr a
cur !s
pst = do
        a
x <- 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
cur
        Step s b
pRes <- s -> a -> m (Step s b)
pstep s
pst a
x
        let next :: Ptr b
next = PTR_NEXT(cur,a)
        case Step s b
pRes of
            PR.Partial Int
0 s
pst1 ->
                 SPEC
-> s
-> List a
-> ForeignPtr a
-> Ptr a
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ForeignPtr a
fp Ptr a
forall b. Ptr b
next 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
Prelude.length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)) (() -> 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]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)
                    arr0 :: Array a
arr0 = Int -> [a] -> Array a
forall a. Storable a => Int -> [a] -> Array a
A.fromListN Int
n ([a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0)
                    arr1 :: Array a
arr1 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array (ForeignPtrContents -> ArrayContents
fptrToArrayContents ForeignPtrContents
contents) Ptr a
forall b. Ptr b
next (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end)
                    src :: Array a
src = Array a
arr0 Array a -> Array a -> Array a
forall a. Semigroup a => a -> a -> a
<> Array a
forall a. Array a
arr1
                let !(Array ArrayContents
cont1 Ptr a
start (Ptr Addr#
end1)) = Array a
src
                    fp1 :: ForeignPtr a
fp1 = Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
end1 (ArrayContents -> ForeignPtrContents
arrayToFptrContents ArrayContents
cont1)
                SPEC
-> s
-> List a
-> ForeignPtr a
-> Ptr a
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List []) ForeignPtr a
forall a. ForeignPtr a
fp1 Ptr a
start s
pst1
            PR.Continue Int
0 s
pst1 ->
                SPEC
-> s
-> List a
-> ForeignPtr a
-> Ptr a
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)) ForeignPtr a
fp Ptr a
forall b. Ptr b
next 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
Prelude.length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)) (() -> 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]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)
                    arr0 :: Array a
arr0 = Int -> [a] -> Array a
forall a. Storable a => Int -> [a] -> Array a
A.fromListN Int
n ([a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0)
                    arr1 :: Array a
arr1 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array (ForeignPtrContents -> ArrayContents
fptrToArrayContents ForeignPtrContents
contents) Ptr a
forall b. Ptr b
next (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end)
                    src :: Array a
src = Array a
arr0 Array a -> Array a -> Array a
forall a. Semigroup a => a -> a -> a
<> Array a
forall a. Array a
arr1
                let !(Array ArrayContents
cont1 Ptr a
start (Ptr Addr#
end1)) = Array a
src
                    fp1 :: ForeignPtr a
fp1 = Addr# -> ForeignPtrContents -> ForeignPtr a
forall a. Addr# -> ForeignPtrContents -> ForeignPtr a
ForeignPtr Addr#
end1 (ArrayContents -> ForeignPtrContents
arrayToFptrContents ArrayContents
cont1)
                SPEC
-> s
-> List a
-> ForeignPtr a
-> Ptr a
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC s
s ([a] -> List a
forall a. [a] -> List a
List [a]
buf1) ForeignPtr a
forall a. ForeignPtr a
fp1 Ptr a
start s
pst1
            PR.Done Int
0 b
b -> do
                let arr :: Array a
arr = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array (ForeignPtrContents -> ArrayContents
fptrToArrayContents ForeignPtrContents
contents) Ptr a
forall b. Ptr b
next (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end)
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Array a -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a. Monad m => a -> Stream m a -> Stream m a
D.cons Array a
forall a. Array a
arr ((State Stream m (Array a) -> s -> m (Step s (Array a)))
-> s -> Stream m (Array a)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step 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
Prelude.length (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)) (() -> 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]
:List a -> [a]
forall a. List a -> [a]
getList List a
backBuf)
                    -- XXX create the array in reverse instead
                    arr0 :: Array a
arr0 = Int -> [a] -> Array a
forall a. Storable a => Int -> [a] -> Array a
A.fromListN Int
n ([a] -> [a]
forall a. [a] -> [a]
Prelude.reverse [a]
src0)
                    arr1 :: Array a
arr1 = ArrayContents -> Ptr a -> Ptr a -> Array a
forall a. ArrayContents -> Ptr a -> Ptr a -> Array a
Array (ForeignPtrContents -> ArrayContents
fptrToArrayContents ForeignPtrContents
contents) Ptr a
forall b. Ptr b
next (Addr# -> Ptr a
forall a. Addr# -> Ptr a
Ptr Addr#
end)
                    -- XXX Use StreamK to avoid adding arbitrary layers of
                    -- constructors every time.
                    str :: Stream m (Array a)
str = Array a -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a. Monad m => a -> Stream m a -> Stream m a
D.cons Array a
arr0 (Array a -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a. Monad m => a -> Stream m a -> Stream m a
D.cons Array a
forall a. Array a
arr1 ((State Stream m (Array a) -> s -> m (Step s (Array a)))
-> s -> Stream m (Array a)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
s))
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a)
str)
            PR.Error String
err -> ParseError -> m (b, Stream m (Array a))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m (Array a)))
-> ParseError -> m (b, Stream m (Array a))
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

-- | Parse an array stream using the supplied 'Parser'.  Returns the parse
-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
--
-- /Internal/
--
{-# INLINE_NORMAL parse #-}
parse ::
       (MonadIO m, MonadThrow m, Storable a)
    => PRD.Parser m a b
    -> SerialT m (A.Array a)
    -> m (b, SerialT m (A.Array a))
parse :: Parser m a b -> SerialT m (Array a) -> m (b, SerialT m (Array a))
parse Parser m a b
p SerialT m (Array a)
s = (Stream m (Array a) -> SerialT m (Array a))
-> (b, Stream m (Array a)) -> (b, SerialT m (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Stream m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD ((b, Stream m (Array a)) -> (b, SerialT m (Array a)))
-> m (b, Stream m (Array a)) -> m (b, SerialT m (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
forall (m :: * -> *) a b.
(MonadIO m, MonadThrow m, Storable a) =>
Parser m a b -> Stream m (Array a) -> m (b, Stream m (Array a))
parseD Parser m a b
p (SerialT m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD SerialT m (Array a)
s)

-------------------------------------------------------------------------------
-- Elimination - Running Array Folds and parsers
-------------------------------------------------------------------------------

{-# INLINE_NORMAL parseArrD #-}
parseArrD ::
       forall m a b. (MonadIO m, MonadThrow m, Storable a)
    => PRD.Parser m (Array a) b
    -> D.Stream m (Array.Array a)
    -> m (b, D.Stream m (Array.Array a))
parseArrD :: Parser m (Array a) b
-> Stream m (Array a) -> m (b, Stream m (Array a))
parseArrD (PRD.Parser s -> Array a -> m (Step s b)
pstep m (Initial s b)
initial s -> m b
extract) stream :: Stream m (Array a)
stream@(D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
state) = do
    Initial s b
res <- m (Initial s b)
initial
    case Initial s b
res of
        PRD.IPartial s
s -> SPEC -> s -> List (Array a) -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
state ([Array a] -> List (Array a)
forall a. [a] -> List a
List []) s
s
        PRD.IDone b
b -> (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a)
stream)
        PRD.IError String
err -> ParseError -> m (b, Stream m (Array a))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m (Array a)))
-> ParseError -> m (b, Stream m (Array a))
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

    where

    -- "backBuf" contains last few items in the stream that we may have to
    -- backtrack to.
    --
    -- XXX currently we are using a dumb list based approach for backtracking
    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.
    -- That will allow us more efficient random back and forth movement.
    go :: SPEC -> s -> List (Array a) -> s -> m (b, Stream m (Array a))
go !SPEC
_ s
st List (Array a)
backBuf !s
pst = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. State t m a
defState s
st
        case Step s (Array a)
r of
            D.Yield Array a
x s
s -> SPEC
-> [Array a]
-> s
-> List (Array a)
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC [Array a
x] s
s List (Array a)
backBuf s
pst
            D.Skip s
s -> SPEC -> s -> List (Array a) -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
s List (Array a)
backBuf s
pst
            Step s (Array a)
D.Stop -> do
                b
b <- s -> m b
extract s
pst
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a)
forall (m :: * -> *) a. Monad m => Stream m a
D.nil)

    gobuf :: SPEC
-> [Array a]
-> s
-> List (Array a)
-> s
-> m (b, Stream m (Array a))
gobuf !SPEC
_ [] s
s List (Array a)
backBuf !s
pst = SPEC -> s -> List (Array a) -> s -> m (b, Stream m (Array a))
go SPEC
SPEC s
s List (Array a)
backBuf s
pst
    gobuf !SPEC
_ (Array a
x:[Array a]
xs) s
s List (Array a)
backBuf !s
pst = do
        Step s b
pRes <- s -> Array a -> m (Step s b)
pstep s
pst Array a
x
        case Step s b
pRes of
            PR.Partial Int
0 s
pst1 ->
                 SPEC
-> [Array a]
-> s
-> List (Array a)
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC [Array a]
xs s
s ([Array a] -> List (Array a)
forall a. [a] -> List a
List []) 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)))
                    (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [Array a]
src0 = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)
                    src :: [Array a]
src  = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0 [Array a] -> [Array a] -> [Array a]
forall a. [a] -> [a] -> [a]
++ [Array a]
xs
                SPEC
-> [Array a]
-> s
-> List (Array a)
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC [Array a]
src s
s ([Array a] -> List (Array a)
forall a. [a] -> List a
List []) s
pst1
            PR.Continue Int
0 s
pst1 ->
                SPEC
-> [Array a]
-> s
-> List (Array a)
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC [Array a]
xs s
s ([Array a] -> List (Array a)
forall a. [a] -> List a
List (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)) 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)))
                    (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([Array a]
src0, [Array a]
buf1) = Int -> [Array a] -> ([Array a], [Array a])
forall a. Storable a => Int -> [Array a] -> ([Array a], [Array a])
splitAtArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)
                    src :: [Array a]
src  = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0 [Array a] -> [Array a] -> [Array a]
forall a. [a] -> [a] -> [a]
++ [Array a]
xs
                SPEC
-> [Array a]
-> s
-> List (Array a)
-> s
-> m (b, Stream m (Array a))
gobuf SPEC
SPEC [Array a]
src s
s ([Array a] -> List (Array a)
forall a. [a] -> List a
List [Array a]
buf1) s
pst1
            PR.Done Int
0 b
b ->
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, (State Stream m (Array a) -> s -> m (Step s (Array a)))
-> s -> Stream m (Array a)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)))
                    (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [Array a]
src0 = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:List (Array a) -> [Array a]
forall a. List a -> [a]
getList List (Array a)
backBuf)
                    src :: [Array a]
src = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0 [Array a] -> [Array a] -> [Array a]
forall a. [a] -> [a] -> [a]
++ [Array a]
xs
                (b, Stream m (Array a)) -> m (b, Stream m (Array a))
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, Stream m (Array a) -> Stream m (Array a) -> Stream m (Array a)
forall (m :: * -> *) a.
Monad m =>
Stream m a -> Stream m a -> Stream m a
D.append ([Array a] -> Stream m (Array a)
forall (m :: * -> *) a. Applicative m => [a] -> Stream m a
D.fromList [Array a]
src) ((State Stream m (Array a) -> s -> m (Step s (Array a)))
-> s -> Stream m (Array a)
forall (m :: * -> *) a s.
(State Stream m a -> s -> m (Step s a)) -> s -> Stream m a
D.Stream State Stream m (Array a) -> s -> m (Step s (Array a))
step s
s))
            PR.Error String
err -> ParseError -> m (b, Stream m (Array a))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (b, Stream m (Array a)))
-> ParseError -> m (b, Stream m (Array a))
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

{-
-- | Parse an array stream using the supplied 'Parser'.  Returns the parse
-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.
--
-- /Internal/
--
{-# INLINE parseArr #-}
parseArr ::
       (MonadIO m, MonadThrow m, Storable a)
    => ASF.Parser m a b
    -> SerialT m (A.Array a)
    -> m (b, SerialT m (A.Array a))
parseArr p s = fmap fromStreamD <$> parseD p (toStreamD s)
-}

-- | Fold an array stream using the supplied array stream 'Fold'.
--
-- /Pre-release/
--
{-# INLINE foldArr #-}
foldArr :: (MonadIO m, MonadThrow m, Storable a) =>
    ASF.Fold m a b -> SerialT m (A.Array a) -> m b
foldArr :: Fold m a b -> SerialT m (Array a) -> m b
foldArr (ASF.Fold Parser m (Array a) b
p) SerialT m (Array a)
s = (b, Stream m (Array a)) -> b
forall a b. (a, b) -> a
fst ((b, Stream m (Array a)) -> b) -> m (b, Stream m (Array a)) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m (Array a) b
-> Stream m (Array a) -> m (b, Stream m (Array a))
forall (m :: * -> *) a b.
(MonadIO m, MonadThrow m, Storable a) =>
Parser m (Array a) b
-> Stream m (Array a) -> m (b, Stream m (Array a))
parseArrD Parser m (Array a) b
p (SerialT m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD SerialT m (Array a)
s)

-- | Like 'fold' but also returns the remaining stream.
--
-- /Pre-release/
--
{-# INLINE foldArr_ #-}
foldArr_ :: (MonadIO m, MonadThrow m, Storable a) =>
    ASF.Fold m a b -> SerialT m (A.Array a) -> m (b, SerialT m (A.Array a))
foldArr_ :: Fold m a b -> SerialT m (Array a) -> m (b, SerialT m (Array a))
foldArr_ (ASF.Fold Parser m (Array a) b
p) SerialT m (Array a)
s = (Stream m (Array a) -> SerialT m (Array a))
-> (b, Stream m (Array a)) -> (b, SerialT m (Array a))
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second Stream m (Array a) -> SerialT m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD ((b, Stream m (Array a)) -> (b, SerialT m (Array a)))
-> m (b, Stream m (Array a)) -> m (b, SerialT m (Array a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser m (Array a) b
-> Stream m (Array a) -> m (b, Stream m (Array a))
forall (m :: * -> *) a b.
(MonadIO m, MonadThrow m, Storable a) =>
Parser m (Array a) b
-> Stream m (Array a) -> m (b, Stream m (Array a))
parseArrD Parser m (Array a) b
p (SerialT m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD SerialT m (Array a)
s)

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

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

    where

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

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

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

    -- Buffer is empty, process elements from the stream
    stepOuter State Stream m a
gst (ParseChunksStream s
st [Array a]
backBuf s
pst) = do
        Step s (Array a)
r <- State Stream m (Array a) -> s -> m (Step s (Array a))
step (State Stream m a -> State Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a (n :: * -> *) b.
State t m a -> State t n b
adaptState State Stream m a
gst) s
st
        case Step s (Array a)
r of
            D.Yield Array a
x s
s -> do
                Step s b
pRes <- s -> Array a -> m (Step s b)
pstep s
pst Array a
x
                case Step s b
pRes of
                    PR.Partial Int
0 s
pst1 ->
                        Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [Array a] -> s -> ParseChunksState b [Array 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)))
                            (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [Array a]
src0 = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)
                            src :: [Array a]
src  = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0
                        Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ [Array a]
-> s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [Array a]
src s
s [] s
pst1
                    PR.Continue Int
0 s
pst1 ->
                        Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStream s
s (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf) 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)))
                            (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let ([Array a]
src0, [Array a]
buf1) = Int -> [Array a] -> ([Array a], [Array a])
forall a. Storable a => Int -> [Array a] -> ([Array a], [Array a])
splitAtArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)
                            src :: [Array a]
src  = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0
                        Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ [Array a]
-> s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [Array a]
src s
s [Array a]
buf1 s
pst1
                    PR.Done Int
0 b
b -> do
                        Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$
                            b
-> ParseChunksState b [Array a] s s
-> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([Array a] -> s -> ParseChunksState b [Array 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)))
                            (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                        let src0 :: [Array a]
src0 = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)
                        let src :: [Array a]
src = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0
                        Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$
                            b
-> ParseChunksState b [Array a] s s
-> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [Array a]
src s
s)
                    PR.Error String
err -> ParseError -> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Step (ParseChunksState b [Array a] s s) b))
-> ParseError -> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err
            D.Skip s
s -> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksStream s
s [Array a]
backBuf s
pst
            Step s (Array a)
D.Stop   -> do
                b
b <- s -> m b
extract s
pst
                let src :: [Array a]
src = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
backBuf
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$
                    b
-> ParseChunksState b [Array a] s s
-> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([Array a] -> ParseChunksState b [Array a] s s
forall x inpBuf st pst. inpBuf -> ParseChunksState x inpBuf st pst
ParseChunksInitLeftOver [Array a]
src)

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

    -- buffered processing loop
    stepOuter State Stream m a
_ (ParseChunksBuf (Array a
x:[Array a]
xs) s
s [Array a]
backBuf s
pst) = do
        Step s b
pRes <- s -> Array a -> m (Step s b)
pstep s
pst Array a
x
        case Step s b
pRes of
            PR.Partial Int
0 s
pst1 ->
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ [Array a]
-> s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [Array 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf))) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [Array a]
src0 = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)
                    src :: [Array a]
src  = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0 [Array a] -> [Array a] -> [Array a]
forall a. [a] -> [a] -> [a]
++ [Array a]
xs
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ [Array a]
-> s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [Array a]
src s
s [] s
pst1
            PR.Continue Int
0 s
pst1 ->
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ [Array a]
-> s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [Array a]
xs s
s (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf) 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf))) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let ([Array a]
src0, [Array a]
buf1) = Int -> [Array a] -> ([Array a], [Array a])
forall a. Storable a => Int -> [Array a] -> ([Array a], [Array a])
splitAtArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)
                    src :: [Array a]
src  = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0 [Array a] -> [Array a] -> [Array a]
forall a. [a] -> [a] -> [a]
++ [Array a]
xs
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ [Array a]
-> s -> [Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> inpBuf -> pst -> ParseChunksState x inpBuf st pst
ParseChunksBuf [Array a]
src s
s [Array a]
buf1 s
pst1
            PR.Done Int
0 b
b ->
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ b
-> ParseChunksState b [Array a] s s
-> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [Array 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
<= [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((Array a -> Int) -> [Array a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Array a -> Int
forall a. Storable a => Array a -> Int
Array.length (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf))) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
                let src0 :: [Array a]
src0 = Int -> [Array a] -> [Array a]
forall a. Storable a => Int -> [Array a] -> [Array a]
takeArrayListRev Int
n (Array a
xArray a -> [Array a] -> [Array a]
forall a. a -> [a] -> [a]
:[Array a]
backBuf)
                    src :: [Array a]
src = [Array a] -> [Array a]
forall a. [a] -> [a]
Prelude.reverse [Array a]
src0 [Array a] -> [Array a] -> [Array a]
forall a. [a] -> [a] -> [a]
++ [Array a]
xs
                Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Step (ParseChunksState b [Array a] s s) b
 -> m (Step (ParseChunksState b [Array a] s s) b))
-> Step (ParseChunksState b [Array a] s s) b
-> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall s a. s -> Step s a
D.Skip (ParseChunksState b [Array a] s s
 -> Step (ParseChunksState b [Array a] s s) b)
-> ParseChunksState b [Array a] s s
-> Step (ParseChunksState b [Array a] s s) b
forall a b. (a -> b) -> a -> b
$ b
-> ParseChunksState b [Array a] s s
-> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
x
-> ParseChunksState x inpBuf st pst
-> ParseChunksState x inpBuf st pst
ParseChunksYield b
b ([Array a] -> s -> ParseChunksState b [Array a] s s
forall x inpBuf st pst.
inpBuf -> st -> ParseChunksState x inpBuf st pst
ParseChunksInit [Array a]
src s
s)
            PR.Error String
err -> ParseError -> m (Step (ParseChunksState b [Array a] s s) b)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Step (ParseChunksState b [Array a] s s) b))
-> ParseError -> m (Step (ParseChunksState b [Array a] s s) b)
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
err

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

-- | Apply an array stream 'Fold' repeatedly on an array stream and emit the
-- fold outputs in the output stream.
--
-- See "Streamly.Prelude.foldMany" for more details.
--
-- /Pre-release/
{-# INLINE foldArrMany #-}
foldArrMany
    :: (IsStream t, MonadThrow m, Storable a)
    => ASF.Fold m a b
    -> t m (Array a)
    -> t m b
foldArrMany :: Fold m a b -> t m (Array a) -> t m b
foldArrMany Fold m a b
p t m (Array a)
m = Stream m b -> t m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
Stream m a -> t m a
fromStreamD (Stream m b -> t m b) -> Stream m b -> t m b
forall a b. (a -> b) -> a -> b
$ Fold m a b -> Stream m (Array a) -> Stream m b
forall (m :: * -> *) a b.
(MonadThrow m, Storable a) =>
Fold m a b -> Stream m (Array a) -> Stream m b
foldArrManyD Fold m a b
p (t m (Array a) -> Stream m (Array a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(IsStream t, Monad m) =>
t m a -> Stream m a
toStreamD t m (Array a)
m)