packages feed

streamly-core 0.1.0 → 0.2.0

raw patch · 145 files changed

+37902/−37143 lines, 145 filesdep +Win32dep +ghc-bignumdep +integer-gmpdep ~basedep ~containersdep ~filepathnew-uploader

Dependencies added: Win32, ghc-bignum, integer-gmp, unix

Dependency ranges changed: base, containers, filepath, ghc-prim, template-haskell

Files

Changelog.md view
@@ -1,8 +1,59 @@ # Changelog +## 0.2.0 (Nov 2023)++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of API changes in this release. Only a few significant+changes are mentioned here.++### Breaking Changes++* `ParserK` in `Streamly.Data.ParserK` is not implicitly specialized+  to arrays anymore. To adapt to the new code, change `ParserK a m+  b` to `ParserK (Array a) m b` where the `Array` type comes from+  `Streamly.Data.Array`. This change also affected the signatures of+  `parseChunks` and `parseBreakChunks`.+* Changed the signature of 'Streamly.Data.Stream.handle' to make the+  exception handler monadic.+* Behavior change: Exceptions are now rethrown promptly in `bracketIO`.++### Enhancements++* __Serialization__: Added a `Streamly.Data.MutByteArray` module with a+  `Serialize` type class for fast binary serialization. The Data.Array+  module supplies the `serialize` and `deserialize` operations for arrays.+* __Unpinned Arrays__: Unboxed arrays are now created unpinned by default,+  they were created pinned earlier. During IO operations, unpinned arrays+  are automatically copied to pinned memory. When arrays are directly+  passed to IO operations programmers can choose to create them pinned to+  avoid a copy.  To create pinned arrays, use the internal APIs with the+  `pinned*` prefix.+* StreamK now supports native exception handling routines (handle, bracketIO).+  Earlier we had to convert it to the `Stream` type for exception handling.++### Deprecations++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of deprecations.++### Internal API Changes++* Fold constructor has changed, added a `final` field to support+  finalization and cleanup of a chain of folds. The `extract` field is+  now used only for mapping the fold internal state to fold result for+  scanning purposes.+* Many low level internal modules have been removed, they are entirely+  exported from higher level internal modules. If you were importing any+  of the missing low level modules then import the higher level modules instead.+* Internal module changes:+  * Streamly.Internal.Serialize.FromBytes -> Streamly.Internal.Data.Binary.Parser+  * Streamly.Internal.Serialize.ToBytes ->   Streamly.Internal.Data.Binary.Stream+  * Streamly.Internal.Data.Unbox is now exported via Streamly.Internal.Data.Serialize+  * Streamly.Internal.Data.IORef.Unboxed is now exported via Streamly.Internal.Data.Serialize+ ## 0.1.0 (March 2023) -Also see [streamly-core-0.1.0 API Changelog](/core/docs/ApiChangelogs/0.1.0.txt) or+Also see [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt  `streamly` package is split into two packages, (1) `streamly-core` that
LICENSE view
@@ -279,3 +279,44 @@ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-------------------------------------------------------------------------------+th-utilities-0.2.5.0 (https://hackage.haskell.org/package/th-utilities)+-------------------------------------------------------------------------------+Copyright (c) 2016 FP Complete Corporation.++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++-------------------------------------------------------------------------------+th-abstraction-0.5.0.0 (https://hackage.haskell.org/package/th-abstraction)+-------------------------------------------------------------------------------+Copyright (c) 2017-2020 Eric Mertens++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.
configure view
@@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for streamly-core 0.1.0.+# Generated by GNU Autoconf 2.71 for streamly-core 0.2.0. # # Report bugs to <streamly@composewell.com>. #@@ -610,8 +610,8 @@ # Identity of this package. PACKAGE_NAME='streamly-core' PACKAGE_TARNAME='streamly-core'-PACKAGE_VERSION='0.1.0'-PACKAGE_STRING='streamly-core 0.1.0'+PACKAGE_VERSION='0.2.0'+PACKAGE_STRING='streamly-core 0.2.0' PACKAGE_BUGREPORT='streamly@composewell.com' PACKAGE_URL='https://streamly.composewell.com' @@ -1256,7 +1256,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures streamly-core 0.1.0 to adapt to many kinds of systems.+\`configure' configures streamly-core 0.2.0 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1318,7 +1318,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of streamly-core 0.1.0:";;+     short | recursive ) echo "Configuration of streamly-core 0.2.0:";;    esac   cat <<\_ACEOF @@ -1404,7 +1404,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-streamly-core configure 0.1.0+streamly-core configure 0.2.0 generated by GNU Autoconf 2.71  Copyright (C) 2021 Free Software Foundation, Inc.@@ -1622,7 +1622,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by streamly-core $as_me 0.1.0, which was+It was created by streamly-core $as_me 0.2.0, which was generated by GNU Autoconf 2.71.  Invocation command line was    $ $0$ac_configure_args_raw@@ -3832,7 +3832,7 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by streamly-core $as_me 0.1.0, which was+This file was extended by streamly-core $as_me 0.2.0, which was generated by GNU Autoconf 2.71.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES@@ -3888,7 +3888,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-streamly-core config.status 0.1.0+streamly-core config.status 0.2.0 configured by $0, generated by GNU Autoconf 2.71,   with options \\"\$ac_cs_config\\"
configure.ac view
@@ -3,7 +3,7 @@ # See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on # the macros used in this file. -AC_INIT([streamly-core], [0.1.0], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])+AC_INIT([streamly-core], [0.2.0], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])  # To suppress "WARNING: unrecognized options: --with-compiler" AC_ARG_WITH([compiler], [GHC])
+ docs/ApiChangelogs/0.1.0-0.2.0.txt view
@@ -0,0 +1,1471 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Unicode.Parser+    [A] double :: Monad m => Parser Char m Double+[C] Streamly.FileSystem.Handle+    [A] readWith :: MonadIO m => Int -> Handle -> Stream m Word8+    [A] readChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8)+[C] Streamly.FileSystem.Dir+    [C] readEither+        [O] readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+        [N] readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)+    [C] read+        [O] read :: MonadIO m => FilePath -> Stream m FilePath+        [N] read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+[C] Streamly.Data.Unfold+    [A] class Enum a => Enumerable a+    [A] second :: b -> Unfold m (a, b) c -> Unfold m a c+    [A] first :: a -> Unfold m (a, b) c -> Unfold m b c+    [A] enumerateFromTo :: (Enumerable a, Monad m) => Unfold m (a, a) a+    [A] enumerateFromThenTo :: (Enumerable a, Monad m) => Unfold m (a, a, a) a+    [A] enumerateFromThen :: (Enumerable a, Monad m) => Unfold m (a, a) a+    [A] enumerateFrom :: (Enumerable a, Monad m) => Unfold m a a+[C] Streamly.Data.StreamK+    [C] parseChunks+        [O] parseChunks :: (Monad m, Unbox a) => ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b)+        [N] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [C] parseBreakChunks+        [O] parseBreakChunks :: (Monad m, Unbox a) => ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+        [N] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: forall m a b. Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+    [A] parse :: Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b)+    [A] handle :: (MonadCatch m, Exception e) => (e -> m (StreamK m a)) -> StreamK m a -> StreamK m a+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> StreamK m a) -> StreamK m a+[C] Streamly.Data.Stream+    [A] wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [C] handle+        [O] handle :: (MonadCatch m, Exception e) => (e -> Stream m a) -> Stream m a -> Stream m a+        [N] handle :: (MonadCatch m, Exception e) => (e -> m (Stream m a)) -> Stream m a -> Stream m a+    [A] groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b+[C] Streamly.Data.ParserK+    [D] fromParser :: (MonadIO m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [D] fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK (Array a) m b+    [A] adaptCG :: Monad m => Parser a m b -> ParserK (Array a) m b+    [A] adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [A] adapt :: Monad m => Parser a m b -> ParserK a m b+[C] Streamly.Data.Parser+    [A] groupByRollingEither :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)+    [A] groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+[A] Streamly.Data.MutByteArray+    [A] class Unbox a+    [A] class Serialize a+    [A] SerializeConfig+    [A] MutByteArray+    [A] unpin :: MutByteArray -> IO MutByteArray+    [A] sizeOf :: (Unbox a, SizeOfRep (Rep a)) => Proxy a -> Int+    [A] serializeAt :: Serialize a => Int -> MutByteArray -> a -> IO Int+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pinnedNew :: Int -> IO MutByteArray+    [A] pin :: MutByteArray -> IO MutByteArray+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [A] new :: Int -> IO MutByteArray+    [A] isPinned :: MutByteArray -> Bool+    [A] inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] deserializeAt :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+    [A] deriveUnbox :: Q [Dec] -> Q [Dec]+    [A] deriveSerializeWith :: (SerializeConfig -> SerializeConfig) -> Q [Dec] -> Q [Dec]+    [A] deriveSerialize :: Q [Dec] -> Q [Dec]+    [A] addSizeTo :: Serialize a => Int -> a -> Int+[C] Streamly.Data.MutArray.Generic+    [A] write :: MonadIO m => Fold m a (MutArray a)+    [A] readRev :: MonadIO m => MutArray a -> Stream m a+    [A] read :: MonadIO m => MutArray a -> Stream m a+    [A] putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [A] modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] length :: MutArray a -> Int+    [A] getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+    [C] getIndex+        [O] getIndex :: MonadIO m => Int -> MutArray a -> m a+        [N] getIndex :: MonadIO m => Int -> MutArray a -> m (Maybe a)+    [A] fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)+    [A] fromList :: MonadIO m => [a] -> m (MutArray a)+[C] Streamly.Data.MutArray+    [A] unpin :: MutArray a -> IO (MutArray a)+    [A] readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] putIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [D] pokeByteIndex :: Unbox a => Int -> MutByteArray -> a -> IO ()+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] pin :: MutArray a -> IO (MutArray a)+    [D] peekByteIndex :: Unbox a => Int -> MutByteArray -> IO a+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [D] newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modify :: forall m a. (MonadIO m, Unbox a) => MutArray a -> (a -> a) -> m ()+    [A] isPinned :: MutArray a -> Bool+    [A] getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [C] getIndex+        [O] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+        [N] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)+[C] Streamly.Data.Array.Generic+    [A] toList :: Array a -> [a]+    [A] getIndex :: Int -> Array a -> Maybe a+[C] Streamly.Data.Array+    [A] unpin :: Array a -> IO (Array a)+    [D] pokeByteIndex :: Unbox a => Int -> MutByteArray -> a -> IO ()+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pin :: Array a -> IO (Array a)+    [D] peekByteIndex :: Unbox a => Int -> MutByteArray -> IO a+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [A] isPinned :: Array a -> Bool+[C] Streamly.Console.Stdio++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Unicode.Stream+    [C] writeCharUtf8'+        [O] writeCharUtf8' :: Monad m => Fold m Word8 Char+        [N] writeCharUtf8' :: Monad m => Parser Word8 m Char+[C] Streamly.Internal.Unicode.Parser+    [A] number :: Monad m => Parser Char m (Integer, Int)+    [A] mkDouble :: Integer -> Int -> Double+    [A] doubleParser :: Monad m => Parser Char m (Int, Int)+    [C] double+        [O] double :: Parser Char m Double+        [N] double :: Monad m => Parser Char m Double+[R] Streamly.Internal.Serialize.ToBytes+[R] Streamly.Internal.Serialize.FromBytes+[C] Streamly.Internal.FileSystem.File+    [A] writeAppendWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m Word8 -> m ()+    [A] writeAppendChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+    [A] writeAppendArray :: FilePath -> Array a -> IO ()+    [A] writeAppend :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+    [R] appendWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m Word8 -> m ()+    [R] appendChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+    [R] appendArray :: FilePath -> Array a -> IO ()+    [R] append :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+[C] Streamly.Internal.FileSystem.Dir+    [C] reader+        [O] reader :: MonadIO m => Unfold m FilePath FilePath+        [N] reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+    [C] readFiles+        [O] readFiles :: MonadIO m => FilePath -> Stream m FilePath+        [N] readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+    [C] readEitherPaths+        [O] readEitherPaths :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+        [N] readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)+    [C] readEither+        [O] readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+        [N] readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)+    [C] readDirs+        [O] readDirs :: MonadIO m => FilePath -> Stream m FilePath+        [N] readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+    [C] read+        [O] read :: MonadIO m => FilePath -> Stream m FilePath+        [N] read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+    [C] fileReader+        [O] fileReader :: MonadIO m => Unfold m FilePath FilePath+        [N] fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+    [C] eitherReaderPaths+        [O] eitherReaderPaths :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+        [N] eitherReaderPaths :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)+    [C] eitherReader+        [O] eitherReader :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+        [N] eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)+    [C] dirReader+        [O] dirReader :: MonadIO m => Unfold m FilePath FilePath+        [N] dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+[R] Streamly.Internal.Data.Unfold.Type+[R] Streamly.Internal.Data.Unfold.Enumeration+[C] Streamly.Internal.Data.Unfold+    [C] Unfold+        [A] Unfold :: (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b+    [A] takeWhileMWithInput :: Monad m => (a -> b -> m Bool) -> Unfold m a b -> Unfold m a b+    [A] manyInterleave :: Monad m => Unfold m a b -> Unfold m c a -> Unfold m c b+    [A] enumerateFromStepIntegral :: (Monad m, Integral a) => Unfold m (a, a) a+    [A] crossApplySnd :: Unfold m a b -> Unfold m a c -> Unfold m a c+    [A] crossApplyFst :: Unfold m a b -> Unfold m a c -> Unfold m a b+    [A] concatMap :: Monad m => (b -> Unfold m a c) -> Unfold m a b -> Unfold m a c+[R] Streamly.Internal.Data.Unboxed+[C] Streamly.Internal.Data.Time.Units+    [R] Streamly.Internal.Data.Unboxed.Unbox+    [A] Streamly.Internal.Data.Unbox.Unbox+        [A] instance Streamly.Internal.Data.Unbox.Unbox Streamly.Internal.Data.Time.Units.NanoSecond64+        [A] instance Streamly.Internal.Data.Unbox.Unbox Streamly.Internal.Data.Time.Units.MilliSecond64+        [A] instance Streamly.Internal.Data.Unbox.Unbox Streamly.Internal.Data.Time.Units.MicroSecond64+[R] Streamly.Internal.Data.Time.Clock.Type+[A] Streamly.Internal.Data.StreamK+    [A] CrossStreamK+    [A] (FixityR,6)+    [A] (FixityR,6)+    [A] (FixityR,6)+    [A] (FixityR,5)+    [A] (FixityR,5)+    [A] (FixityR,6)+    [A] (FixityR,5)+    [A] StreamK+        [A] MkStream :: (forall r. State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r) -> StreamK m a+    [A] zipWithM :: Monad m => (a -> b -> m c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] zipWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] unfoldrMWith :: Monad m => (m a -> StreamK m a -> StreamK m a) -> (b -> m (Maybe (a, b))) -> b -> StreamK m a+    [A] unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> StreamK m a+    [A] unfoldr :: (b -> Maybe (a, b)) -> b -> StreamK m a+    [A] uncons :: Applicative m => StreamK m a -> m (Maybe (a, StreamK m a))+    [A] unShare :: StreamK m a -> StreamK m a+    [A] unCross :: CrossStreamK m a -> StreamK m a+    [A] toStream :: Applicative m => StreamK m a -> Stream m a+    [A] toList :: Monad m => StreamK m a -> m [a]+    [A] the :: (Eq a, Monad m) => StreamK m a -> m (Maybe a)+    [A] takeWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] take :: Int -> StreamK m a -> StreamK m a+    [A] tail :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))+    [A] sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a+    [A] sequence :: Monad m => StreamK m (m a) -> StreamK m a+    [A] scanlx' :: (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> StreamK m b+    [A] scanl' :: (b -> a -> b) -> b -> StreamK m a -> StreamK m b+    [A] reverse :: StreamK m a -> StreamK m a+    [A] replicateMWith :: (m a -> StreamK m a -> StreamK m a) -> Int -> m a -> StreamK m a+    [A] replicateM :: Monad m => Int -> m a -> StreamK m a+    [A] replicate :: Int -> a -> StreamK m a+    [A] repeatMWith :: (m a -> t m a -> t m a) -> m a -> t m a+    [A] repeatM :: Monad m => m a -> StreamK m a+    [A] repeat :: a -> StreamK m a+    [A] parseDBreak :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+    [A] parseD :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseError b)+    [A] parseChunksGeneric :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakChunksGeneric :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: forall m a b. Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+    [A] parse :: Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b)+    [A] null :: Monad m => StreamK m a -> m Bool+    [A] notElem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+    [A] nilM :: Applicative m => m b -> StreamK m a+    [A] nil :: StreamK m a+    [A] mkStream :: (forall r. State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r) -> StreamK m a+    [A] mkCross :: StreamK m a -> CrossStreamK m a+    [A] minimumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+    [A] minimum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+    [A] mfix :: Monad m => (m a -> StreamK m a) -> StreamK m a+    [A] mergeMapWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] mergeIterateWith :: (StreamK m a -> StreamK m a -> StreamK m a) -> (a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] mergeByM :: Monad m => (a -> a -> m Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+    [A] mergeBy :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+    [A] maximumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+    [A] maximum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+    [A] mapMaybe :: (a -> Maybe b) -> StreamK m a -> StreamK m b+    [A] mapM_ :: Monad m => (a -> m b) -> StreamK m a -> m ()+    [A] mapMWith :: (m b -> StreamK m b -> StreamK m b) -> (a -> m b) -> StreamK m a -> StreamK m b+    [A] mapMSerial :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+    [A] mapM :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+    [A] map :: (a -> b) -> StreamK m a -> StreamK m b+    [A] lookup :: (Monad m, Eq a) => a -> StreamK m (a, b) -> m (Maybe b)+    [A] liftInner :: (Monad m, MonadTrans t, Monad (t m)) => StreamK m a -> StreamK (t m) a+    [A] last :: Monad m => StreamK m a -> m (Maybe a)+    [A] iterateMWith :: Monad m => (m a -> StreamK m a -> StreamK m a) -> (a -> m a) -> m a -> StreamK m a+    [A] iterateM :: Monad m => (a -> m a) -> m a -> StreamK m a+    [A] iterate :: (a -> a) -> a -> StreamK m a+    [A] intersperseM :: Monad m => m a -> StreamK m a -> StreamK m a+    [A] intersperse :: Monad m => a -> StreamK m a -> StreamK m a+    [A] interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a+    [A] interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a+    [A] interleave :: StreamK m a -> StreamK m a -> StreamK m a+    [A] insertBy :: (a -> a -> Ordering) -> a -> StreamK m a -> StreamK m a+    [A] init :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))+    [A] hoist :: (Monad m, Monad n) => (forall x. m x -> n x) -> StreamK m a -> StreamK n a+    [A] head :: Monad m => StreamK m a -> m (Maybe a)+    [A] handle :: (MonadCatch m, Exception e) => (e -> m (StreamK m a)) -> StreamK m a -> StreamK m a+    [A] fromYieldK :: YieldK m a -> StreamK m a+    [A] fromStream :: Monad m => Stream m a -> StreamK m a+    [A] fromStopK :: StopK m -> StreamK m a+    [A] fromPure :: a -> StreamK m a+    [A] fromList :: [a] -> StreamK m a+    [A] fromIndicesMWith :: (m a -> StreamK m a -> StreamK m a) -> (Int -> m a) -> StreamK m a+    [A] fromIndicesM :: Monad m => (Int -> m a) -> StreamK m a+    [A] fromIndices :: (Int -> a) -> StreamK m a+    [A] fromFoldableM :: (Foldable f, Monad m) => f (m a) -> StreamK m a+    [A] fromFoldable :: Foldable f => f a -> StreamK m a+    [A] fromEffect :: Monad m => m a -> StreamK m a+    [A] foldrT :: (Monad m, Monad (s m), MonadTrans s) => (a -> s m b -> s m b) -> s m b -> StreamK m a -> s m b+    [A] foldrSShared :: (a -> StreamK m b -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldrSM :: Monad m => (m a -> StreamK m b -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldrS :: (a -> StreamK m b -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldrM :: (a -> m b -> m b) -> m b -> StreamK m a -> m b+    [A] foldr1 :: Monad m => (a -> a -> a) -> StreamK m a -> m (Maybe a)+    [A] foldr :: Monad m => (a -> b -> b) -> b -> StreamK m a -> m b+    [A] foldlx' :: forall m a b x. Monad m => (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> m b+    [A] foldlT :: (Monad m, Monad (s m), MonadTrans s) => (s m b -> a -> s m b) -> s m b -> StreamK m a -> s m b+    [A] foldlS :: (StreamK m b -> a -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b+    [A] foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b+    [A] foldl' :: Monad m => (b -> a -> b) -> b -> StreamK m a -> m b+    [A] foldStreamShared :: State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> StreamK m a -> m r+    [A] foldStream :: State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> StreamK m a -> m r+    [A] foldEither :: Monad m => Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))+    [A] foldConcat :: Monad m => Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)+    [A] foldBreak :: Monad m => Fold m a b -> StreamK m a -> m (b, StreamK m a)+    [A] fold :: Monad m => Fold m a b -> StreamK m a -> m b+    [A] findM :: Monad m => (a -> m Bool) -> StreamK m a -> m (Maybe a)+    [A] findIndices :: (a -> Bool) -> StreamK m a -> StreamK m Int+    [A] find :: Monad m => (a -> Bool) -> StreamK m a -> m (Maybe a)+    [A] filter :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] evalStateT :: Monad m => m s -> StreamK (StateT s m) a -> StreamK m a+    [A] elem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+    [A] dropWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] drop :: Int -> StreamK m a -> StreamK m a+    [A] drain :: Monad m => StreamK m a -> m ()+    [A] deleteBy :: (a -> a -> Bool) -> a -> StreamK m a -> StreamK m a+    [A] crossWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] crossApplyWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m (a -> b) -> StreamK m a -> StreamK m b+    [A] crossApplySnd :: StreamK m a -> StreamK m b -> StreamK m b+    [A] crossApplyFst :: StreamK m a -> StreamK m b -> StreamK m a+    [A] crossApply :: StreamK m (a -> b) -> StreamK m a -> StreamK m b+    [A] cross :: Monad m => StreamK m a -> StreamK m b -> StreamK m (a, b)+    [A] consMBy :: Monad m => (StreamK m a -> StreamK m a -> StreamK m a) -> m a -> StreamK m a -> StreamK m a+    [A] consM :: Monad m => m a -> StreamK m a -> StreamK m a+    [A] consK :: YieldK m a -> StreamK m a -> StreamK m a+    [A] cons :: a -> StreamK m a -> StreamK m a+    [A] conjoin :: Monad m => StreamK m a -> StreamK m a -> StreamK m a+    [A] concatMapWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] concatMapEffect :: Monad m => (b -> StreamK m a) -> m b -> StreamK m a+    [A] concatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] concatIterateWith :: (StreamK m a -> StreamK m a -> StreamK m a) -> (a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] concatIterateScanWith :: Monad m => (StreamK m a -> StreamK m a -> StreamK m a) -> (b -> a -> m (b, StreamK m a)) -> m b -> StreamK m a -> StreamK m a+    [A] concatIterateLeftsWith :: b ~ Either a c => (StreamK m b -> StreamK m b -> StreamK m b) -> (a -> StreamK m b) -> StreamK m b -> StreamK m b+    [A] concatEffect :: Monad m => m (StreamK m a) -> StreamK m a+    [A] buildSM :: Monad m => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a+    [A] buildS :: ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a+    [A] buildM :: Monad m => (forall r. (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r) -> StreamK m a+    [A] build :: forall m a. (forall b. (a -> b -> b) -> b -> b) -> StreamK m a+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> StreamK m a) -> StreamK m a+    [A] bindWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] before :: Monad m => m b -> StreamK m a -> StreamK m a+    [A] augmentSM :: Monad m => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] augmentS :: ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] append :: StreamK m a -> StreamK m a -> StreamK m a+    [A] any :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+    [A] all :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+    [A] (.:) :: a -> StreamK m a -> StreamK m a+    [A] (!!) :: Monad m => StreamK m a -> Int -> m (Maybe a)+[R] Streamly.Internal.Data.Stream.StreamK.Type+[R] Streamly.Internal.Data.Stream.StreamK.Transformer+[R] Streamly.Internal.Data.Stream.StreamK+[R] Streamly.Internal.Data.Stream.StreamD.Type+[R] Streamly.Internal.Data.Stream.StreamD.Transformer+[R] Streamly.Internal.Data.Stream.StreamD.Transform+[R] Streamly.Internal.Data.Stream.StreamD.Top+[R] Streamly.Internal.Data.Stream.StreamD.Step+[R] Streamly.Internal.Data.Stream.StreamD.Nesting+[R] Streamly.Internal.Data.Stream.StreamD.Lift+[R] Streamly.Internal.Data.Stream.StreamD.Generate+[R] Streamly.Internal.Data.Stream.StreamD.Exception+[R] Streamly.Internal.Data.Stream.StreamD.Eliminate+[R] Streamly.Internal.Data.Stream.StreamD.Container+[D] Streamly.Internal.Data.Stream.StreamD+[R] Streamly.Internal.Data.Stream.Common+[R] Streamly.Internal.Data.Stream.Chunked+[C] Streamly.Internal.Data.Stream+    [A] class Enum a => Enumerable a+    [A] Stream+        [A] UnStream :: (State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a+    [A] Step+        [A] Yield :: a -> s -> Step s a+        [A] Stop :: Step s a+        [A] Skip :: s -> Step s a+    [A] InterleaveState+        [A] InterleaveSecondOnly :: s2 -> InterleaveState s1 s2+        [A] InterleaveSecond :: s1 -> s2 -> InterleaveState s1 s2+        [A] InterleaveFirstOnly :: s1 -> InterleaveState s1 s2+        [A] InterleaveFirst :: s1 -> s2 -> InterleaveState s1 s2+    [A] FoldManyPost+        [A] FoldManyPostYield :: b -> FoldManyPost s fs b a -> FoldManyPost s fs b a+        [A] FoldManyPostStart :: s -> FoldManyPost s fs b a+        [A] FoldManyPostLoop :: s -> fs -> FoldManyPost s fs b a+        [A] FoldManyPostDone :: FoldManyPost s fs b a+    [A] FoldMany+        [A] FoldManyYield :: b -> FoldMany s fs b a -> FoldMany s fs b a+        [A] FoldManyStart :: s -> FoldMany s fs b a+        [A] FoldManyLoop :: s -> fs -> FoldMany s fs b a+        [A] FoldManyFirst :: fs -> s -> FoldMany s fs b a+        [A] FoldManyDone :: FoldMany s fs b a+    [A] CrossStream+    [A] ConcatUnfoldInterleaveState+        [A] ConcatUnfoldInterleaveOuter :: o -> [i] -> ConcatUnfoldInterleaveState o i+        [A] ConcatUnfoldInterleaveInnerR :: [i] -> [i] -> ConcatUnfoldInterleaveState o i+        [A] ConcatUnfoldInterleaveInnerL :: [i] -> [i] -> ConcatUnfoldInterleaveState o i+        [A] ConcatUnfoldInterleaveInner :: o -> [i] -> ConcatUnfoldInterleaveState o i+    [A] ConcatMapUState+        [A] ConcatMapUOuter :: o -> ConcatMapUState o i+        [A] ConcatMapUInner :: o -> i -> ConcatMapUState o i+    [A] AppendState+        [A] AppendSecond :: s2 -> AppendState s1 s2+        [A] AppendFirst :: s1 -> AppendState s1 s2+    [A] pattern Stream :: (State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a+    [A] zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+    [A] zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] with :: Monad m => (Stream m a -> Stream m (s, a)) -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a)) -> ((s, a) -> b) -> Stream m a -> Stream m a+    [A] usingStateT :: Monad m => m s -> (Stream (StateT s m) a -> Stream (StateT s m) a) -> Stream m a -> Stream m a+    [A] usingReaderT :: Monad m => m r -> (Stream (ReaderT r m) a -> Stream (ReaderT r m) a) -> Stream m a -> Stream m a+    [A] uniqBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a+    [A] uniq :: (Eq a, Monad m) => Stream m a -> Stream m a+    [A] unionWithStreamGenericBy :: MonadIO m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] unionWithStreamAscBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+    [A] unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a+    [A] unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldIterateDfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldIterateBfsRev :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldIterateBfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfold :: Applicative m => Unfold m a b -> a -> Stream m b+    [A] uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+    [A] unCross :: CrossStream m a -> Stream m a+    [A] transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b+    [A] trace_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a+    [A] toStreamK :: Monad m => Stream m a -> StreamK m a+    [A] toListRev :: Monad m => Stream m a -> m [a]+    [A] toList :: Monad m => Stream m a -> m [a]+    [A] timestamped :: MonadIO m => Stream m a -> Stream m (AbsTime, a)+    [A] timestampWith :: MonadIO m => Double -> Stream m a -> Stream m (AbsTime, a)+    [A] timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)+    [A] times :: MonadIO m => Stream m (AbsTime, RelTime64)+    [A] timeout :: AbsTime -> t m ()+    [A] timeIndexed :: MonadIO m => Stream m a -> Stream m (RelTime64, a)+    [A] timeIndexWith :: MonadIO m => Double -> Stream m a -> Stream m (RelTime64, a)+    [A] the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)+    [A] tapOffsetEvery :: Monad m => Int -> Int -> Fold m a b -> Stream m a -> Stream m a+    [A] tap :: Monad m => Fold m a b -> Stream m a -> Stream m a+    [A] takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] takeWhileLast :: (a -> Bool) -> Stream m a -> Stream m a+    [A] takeWhileAround :: (a -> Bool) -> Stream m a -> Stream m a+    [A] takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] takeEndByM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] take :: Applicative m => Int -> Stream m a -> Stream m a+    [A] tail :: Monad m => Stream m a -> m (Maybe (Stream m a))+    [A] stripSuffixUnbox :: (MonadIO m, Eq a, Unbox a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] stripSuffix :: (Monad m, Eq a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] stripPrefix :: (Monad m, Eq a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] strideFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a+    [A] splitOnSuffixSeqAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnSuffixSeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) => Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnSeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnPrefix :: (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitInnerBySuffix :: (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)+    [A] splitInnerBy :: 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)+    [A] slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] sequence :: Monad m => Stream m (m a) -> Stream m a+    [A] scanlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+    [A] scanlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+    [A] scanlMAfter' :: Monad m => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+    [A] scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+    [A] scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+    [A] scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+    [A] scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+    [A] scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [A] scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [A] scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b+    [A] scanMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] scan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)+    [A] runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a+    [A] runInnerWithState :: Monad m => (forall b. s -> t m b -> m (b, s)) -> m s -> Stream (t m) a -> Stream m (s, a)+    [A] runInnerWith :: Monad m => (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a+    [A] roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b+    [A] rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b+    [A] rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b+    [A] reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a+    [A] reverse :: Monad m => Stream m a -> Stream m a+    [A] replicateM :: Monad m => Int -> m a -> Stream m a+    [A] replicate :: Monad m => Int -> a -> Stream m a+    [A] repeated :: Stream m a -> Stream m a+    [A] repeatM :: Monad m => m a -> Stream m a+    [A] repeat :: Monad m => a -> Stream m a+    [A] relTimesWith :: MonadIO m => Double -> Stream m RelTime64+    [A] relTimes :: MonadIO m => Stream m RelTime64+    [A] refoldMany :: Monad m => Refold m x a b -> m x -> Stream m a -> Stream m b+    [A] refoldIterateM :: Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b+    [A] reduceIterateBfs :: Monad m => (a -> a -> m a) -> Stream m a -> m (Maybe a)+    [A] reassembleBy :: Fold m a b -> (a -> a -> Int) -> Stream m a -> Stream m b+    [A] prune :: (a -> Bool) -> Stream m a -> Stream m a+    [A] prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [A] postscanlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+    [A] postscanlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+    [A] postscanlMAfter' :: Monad m => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+    [A] postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+    [A] postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+    [A] postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] parseSequence :: Stream m (Parser a m b) -> Stream m a -> Stream m b+    [A] parseManyTill :: Parser a m b -> Parser a m x -> Stream m a -> Stream m b+    [A] parseManyD :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseMany :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseIterateD :: Monad m => (b -> Parser a m b) -> b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseIterate :: Monad m => (b -> Parser a m b) -> b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseD :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)+    [A] parseBreakD :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+    [A] parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+    [A] parse :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)+    [A] onException :: MonadCatch m => m b -> Stream m a -> Stream m a+    [A] null :: Monad m => Stream m a -> m Bool+    [A] nub :: (Monad m, Ord a) => Stream m a -> Stream m a+    [A] notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+    [A] nilM :: Applicative m => m b -> Stream m a+    [A] nil :: Applicative m => Stream m a+    [A] morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a+    [A] mkCross :: Stream m a -> CrossStream m a+    [A] minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+    [A] minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+    [A] mergeMinBy :: (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] mergeFstBy :: (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] mergeByM :: Monad m => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] mergeBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+    [A] maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+    [A] mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b+    [A] mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b+    [A] mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()+    [A] mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+    [A] map :: Monad m => (a -> b) -> Stream m a -> Stream m b+    [A] lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)+    [A] liftInnerWith :: Monad (t m) => (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a+    [A] liftInner :: (Monad m, MonadTrans t, Monad (t m)) => Stream m a -> Stream (t m) a+    [A] last :: Monad m => Stream m a -> m (Maybe a)+    [A] joinOuterGeneric :: MonadIO m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [A] joinOuterAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [A] joinOuter :: (Ord k, MonadIO m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)+    [A] joinLeftGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [A] joinLeftAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [A] joinLeft :: (Ord k, Monad m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)+    [A] joinInnerGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)+    [A] joinInnerAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)+    [A] joinInner :: (Monad m, Ord k) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)+    [A] iterateM :: Monad m => (a -> m a) -> m a -> Stream m a+    [A] iterate :: Monad m => (a -> a) -> a -> Stream m a+    [A] isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) => Stream m a -> Stream m a -> m Bool+    [A] isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+    [A] isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+    [A] isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+    [A] isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a) => Stream m a -> Stream m a -> m Bool+    [A] intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseMWith :: Int -> m a -> Stream m a -> Stream m a+    [A] intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseMSuffixWith :: forall m a. Monad m => Int -> m a -> Stream m a -> Stream m a+    [A] intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a+    [A] intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseM :: Monad m => m a -> Stream m a -> Stream m a+    [A] intersperse :: Monad m => a -> Stream m a -> Stream m a+    [A] intersectBySorted :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] interposeSuffixM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interposeSuffix :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interpose :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleave :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] intercalateSuffix :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] intercalate :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a+    [A] indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)+    [A] indexed :: Monad m => Stream m a -> Stream m (Int, a)+    [A] headElse :: Monad m => a -> Stream m a -> m a+    [A] head :: Monad m => Stream m a -> m (Maybe a)+    [A] handle :: (MonadCatch m, Exception e) => (e -> m (Stream m a)) -> Stream m a -> Stream m a+    [A] groupsWhile :: Monad m => (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] groupsRollingBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b+    [A] gintercalateSuffix :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [A] gintercalate :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [A] ghandle :: (MonadCatch m, Exception e) => (e -> Stream m a -> m (Stream m a)) -> Stream m a -> Stream m a+    [A] generateM :: Monad m => Int -> (Int -> m a) -> Stream m a+    [A] generate :: Monad m => Int -> (Int -> a) -> Stream m a+    [A] generalizeInner :: Monad m => Stream Identity a -> Stream m a+    [A] gbracket_ :: Monad m => m c -> (c -> m d) -> (c -> e -> Stream m b -> m (Stream m b)) -> (forall s. m s -> m (Either e s)) -> (c -> Stream m b) -> Stream m b+    [A] gbracket :: MonadIO m => IO c -> (c -> IO d1) -> (c -> e -> Stream m b -> IO (Stream m b)) -> (c -> IO d2) -> (forall s. m s -> m (Either e s)) -> (c -> Stream m b) -> Stream m b+    [A] fromStreamK :: Applicative m => StreamK m a -> Stream m a+    [A] fromPure :: Applicative m => a -> Stream m a+    [A] fromPtrN :: (Monad m, Storable a) => Int -> Ptr a -> Stream m a+    [A] fromPtr :: forall m a. (Monad m, Storable a) => Ptr a -> Stream m a+    [A] fromListM :: Monad m => [m a] -> Stream m a+    [A] fromList :: Applicative m => [a] -> Stream m a+    [A] fromIndicesM :: Monad m => (Int -> m a) -> Stream m a+    [A] fromIndices :: Monad m => (Int -> a) -> Stream m a+    [A] fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a+    [A] fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a+    [A] fromEffect :: Applicative m => m a -> Stream m a+    [A] fromByteStr# :: Monad m => Addr# -> Stream m Word8+    [A] foldrT :: (Monad m, Monad (t m), MonadTrans t) => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b+    [A] foldrS :: Monad m => (a -> Stream m b -> Stream m b) -> Stream m b -> Stream m a -> Stream m b+    [A] foldrMx :: Monad m => (a -> m x -> m x) -> m x -> (m x -> m b) -> Stream m a -> m b+    [A] foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+    [A] foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)+    [A] foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+    [A] foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b+    [A] foldlT :: (Monad m, Monad (s m), MonadTrans s) => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b+    [A] foldlS :: Monad m => (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b+    [A] foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b+    [A] foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b+    [A] foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+    [A] foldSequence :: Stream m (Fold m a b) -> Stream m a -> Stream m b+    [A] foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] foldIterateM :: Monad m => (b -> m (Fold m a b)) -> m b -> Stream m a -> Stream m b+    [A] foldIterateBfs :: Fold m a (Either a a) -> Stream m a -> m (Maybe a)+    [A] foldEither :: Monad m => Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))+    [A] foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)+    [A] foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b+    [A] foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)+    [A] fold :: Monad m => Fold m a b -> Stream m a -> m b+    [A] findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)+    [A] findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int+    [A] find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+    [A] finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a+    [A] finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a+    [A] filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] filterInStreamGenericBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] filterInStreamAscBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a+    [A] eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool+    [A] enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a+    [A] enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a+    [A] enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a+    [A] enumerateFromToFractional :: (Monad m, Fractional a, Ord a) => a -> a -> Stream m a+    [A] enumerateFromTo :: (Enumerable a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromThenToSmall :: (Monad m, Enum a) => a -> a -> a -> Stream m a+    [A] enumerateFromThenToIntegral :: (Monad m, Integral a) => a -> a -> a -> Stream m a+    [A] enumerateFromThenToFractional :: (Monad m, Fractional a, Ord a) => a -> a -> a -> Stream m a+    [A] enumerateFromThenTo :: (Enumerable a, Monad m) => a -> a -> a -> Stream m a+    [A] enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a) => a -> a -> Stream m a+    [A] enumerateFromThenNum :: (Monad m, Num a) => a -> a -> Stream m a+    [A] enumerateFromThenIntegral :: (Monad m, Integral a, Bounded a) => a -> a -> Stream m a+    [A] enumerateFromThenFractional :: (Monad m, Fractional a) => a -> a -> Stream m a+    [A] enumerateFromThen :: (Enumerable a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a+    [A] enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromNum :: (Monad m, Num a) => a -> Stream m a+    [A] enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a+    [A] enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a+    [A] enumerateFromBounded :: (Monad m, Enumerable a, Bounded a) => a -> Stream m a+    [A] enumerateFrom :: (Enumerable a, Monad m) => a -> Stream m a+    [A] enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a+    [A] elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int+    [A] elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+    [A] durations :: Double -> t m RelTime64+    [A] dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] dropWhileLast :: (a -> Bool) -> Stream m a -> Stream m a+    [A] dropWhileAround :: (a -> Bool) -> Stream m a -> Stream m a+    [A] dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] dropSuffix :: Stream m a -> Stream m a -> Stream m a+    [A] dropPrefix :: Stream m a -> Stream m a -> Stream m a+    [A] dropLast :: Int -> Stream m a -> Stream m a+    [A] dropInfix :: Stream m a -> Stream m a -> Stream m a+    [A] drop :: Monad m => Int -> Stream m a -> Stream m a+    [A] drain :: Monad m => Stream m a -> m ()+    [A] deleteInStreamGenericBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] deleteInStreamAscBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a+    [A] delayPre :: MonadIO m => Double -> Stream m a -> Stream m a+    [A] delayPost :: MonadIO m => Double -> Stream m a -> Stream m a+    [A] delay :: MonadIO m => Double -> Stream m a -> Stream m a+    [A] crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] crossApplySnd :: Functor f => Stream f a -> Stream f b -> Stream f b+    [A] crossApplyFst :: Functor f => Stream f a -> Stream f b -> Stream f a+    [A] crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b+    [A] cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+    [A] consM :: Applicative m => m a -> Stream m a -> Stream m a+    [A] cons :: Applicative m => a -> Stream m a -> Stream m a+    [A] concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+    [A] concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+    [A] concatIterateScan :: Monad m => (b -> a -> m b) -> (b -> m (Maybe (b, Stream m a))) -> b -> Stream m a+    [A] concatIterateDfs :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatIterateBfsRev :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatIterateBfs :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatEffect :: Monad m => m (Stream m a) -> Stream m a+    [A] concat :: Monad m => Stream m (Stream m a) -> Stream m a+    [A] cmpBy :: Monad m => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering+    [A] catRights :: Monad m => Stream m (Either a b) -> Stream m b+    [A] catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a+    [A] catLefts :: Monad m => Stream m (Either a b) -> Stream m a+    [A] catEithers :: Monad m => Stream m (Either a a) -> Stream m a+    [A] bracketUnsafe :: MonadCatch m => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+    [A] bracketIO3 :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> IO d) -> (b -> IO e) -> (b -> Stream m a) -> Stream m a+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+    [A] before :: Monad m => m b -> Stream m a -> Stream m a+    [A] append :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] any :: Monad m => (a -> Bool) -> Stream m a -> m Bool+    [A] all :: Monad m => (a -> Bool) -> Stream m a -> m Bool+    [A] afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a+    [A] afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a+    [A] absTimesWith :: MonadIO m => Double -> Stream m AbsTime+    [A] absTimes :: MonadIO m => Stream m AbsTime+    [A] (!!) :: Monad m => Stream m a -> Int -> m (Maybe a)+[R] Streamly.Internal.Data.Ring.Unboxed+[A] Streamly.Internal.Data.Ring.Generic+    [A] Ring+        [A] [ringMax] :: Ring a -> !Int+        [A] [ringHead] :: Ring a -> !Int+        [A] [ringArr] :: Ring a -> MutArray a+        [A] Ring :: MutArray a -> !Int -> !Int -> Ring a+    [A] writeLastN :: MonadIO m => Int -> Fold m a (Ring a)+    [A] unsafeInsertRingWith :: Ring a -> a -> IO Int+    [A] toStreamWith :: Int -> Ring a -> Stream m a+    [A] toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+    [A] seek :: MonadIO m => Int -> Ring a -> m (Ring a)+    [A] createRing :: MonadIO m => Int -> m (Ring a)+    [A] copyToMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+[C] Streamly.Internal.Data.Ring+    [C] Ring+        [A] [ringStart] :: Ring a -> {-# UNPACK #-} !ForeignPtr a+        [R] [ringMax] :: Ring a -> !Int+        [R] [ringHead] :: Ring a -> !Int+        [A] [ringBound] :: Ring a -> {-# UNPACK #-} !Ptr a+        [R] [ringArr] :: Ring a -> MutArray a+        [C] Ring+            [O] Ring :: MutArray a -> !Int -> !Int -> Ring a+            [N] Ring :: {-# UNPACK #-} !ForeignPtr a -> {-# UNPACK #-} !Ptr a -> Ring a+    [A] GHC.Show.Show+        [A] instance (GHC.Show.Show a, GHC.Show.Show b, GHC.Show.Show c, GHC.Show.Show d) => GHC.Show.Show (Streamly.Internal.Data.Ring.Tuple4' a b c d)+    [A] writeN :: Int -> Fold m a (Ring a)+    [R] writeLastN :: MonadIO m => Int -> Fold m a (Ring a)+    [R] unsafeInsertRingWith :: Ring a -> a -> IO Int+    [A] unsafeInsert :: Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)+    [A] unsafeFoldRingNM :: forall m a b. (MonadIO m, Storable a) => Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+    [A] unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a) => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+    [A] unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a) => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+    [A] unsafeFoldRing :: forall a b. Storable a => Ptr a -> (b -> a -> b) -> b -> Ring a -> b+    [A] unsafeEqArrayN :: Ring a -> Ptr a -> Array a -> Int -> Bool+    [A] unsafeEqArray :: Ring a -> Ptr a -> Array a -> Bool+    [R] toStreamWith :: Int -> Ring a -> Stream m a+    [R] toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+    [A] startOf :: Ring a -> Ptr a+    [A] slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a) => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b+    [A] slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a) => Int -> Fold m (a, Maybe a) b -> Fold m a b+    [A] slide :: Ring a -> a -> m (Ring a)+    [R] seek :: MonadIO m => Int -> Ring a -> m (Ring a)+    [A] ringsOf :: Int -> Stream m a -> Stream m (MutArray a)+    [A] readRev :: Unfold m (MutArray a) a+    [A] read :: forall m a. (MonadIO m, Storable a) => Unfold m (Ring a, Ptr a, Int) a+    [A] putIndex :: Ring a -> Int -> a -> m ()+    [A] newRing :: Int -> m (Ring a)+    [A] new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)+    [A] moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a+    [A] modifyIndex :: Ring a -> Int -> (a -> (a, b)) -> m b+    [A] length :: Ring a -> Int+    [A] getIndexUnsafe :: Ring a -> Int -> m a+    [A] getIndexRev :: Ring a -> Int -> m a+    [A] getIndex :: Ring a -> Int -> m a+    [A] fromArray :: MutArray a -> Ring a+    [R] createRing :: MonadIO m => Int -> m (Ring a)+    [A] castUnsafe :: Ring a -> Ring b+    [A] cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)+    [A] bytesFree :: Ring a -> Int+    [A] byteLength :: Ring a -> Int+    [A] byteCapacity :: Ring a -> Int+    [A] asBytes :: Ring a -> Ring Word8+    [A] advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a+[R] Streamly.Internal.Data.Producer.Type+[R] Streamly.Internal.Data.Producer.Source+[C] Streamly.Internal.Data.Producer+    [A] Source+    [A] unread :: [b] -> Source a b -> Source a b+    [A] translate :: Functor m => (a -> c) -> (c -> a) -> Producer m c b -> Producer m a b+    [A] source :: Maybe a -> Source a b+    [A] producer :: Monad m => Producer m a b -> Producer m (Source a b) b+    [A] parseManyD :: Monad m => Parser a m b -> Producer m (Source x a) a -> Producer m (Source x a) (Either ParseError b)+    [A] parseMany :: Monad m => Parser a m b -> Producer m (Source x a) a -> Producer m (Source x a) (Either ParseError b)+    [A] parse :: Monad m => Parser a m b -> Producer m (Source s a) a -> Source s a -> m (Either ParseError b, Source s a)+    [A] lmap :: (a -> a) -> Producer m a b -> Producer m a b+    [A] isEmpty :: Source a b -> Bool+[R] Streamly.Internal.Data.Pipe.Type+[C] Streamly.Internal.Data.Pipe+    [A] Step+        [A] Yield :: a -> s -> Step s a+        [A] Continue :: s -> Step s a+    [A] PipeState+        [A] Produce :: s2 -> PipeState s1 s2+        [A] Consume :: s1 -> PipeState s1 s2+    [C] Pipe+        [A] Pipe :: (s1 -> a -> m (Step (PipeState s1 s2) b)) -> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b+[A] Streamly.Internal.Data.ParserK+    [A] Step+        [A] Partial :: !Int -> (Input a -> m (Step a m r)) -> Step a m r+        [A] Error :: !Int -> String -> Step a m r+        [A] Done :: !Int -> r -> Step a m r+        [A] Continue :: !Int -> (Input a -> m (Step a m r)) -> Step a m r+    [A] ParseResult+        [A] Success :: !Int -> !b -> ParseResult b+        [A] Failure :: !Int -> !String -> ParseResult b+    [A] Input+        [A] None :: Input a+        [A] Chunk :: a -> Input a+    [A] ParserK+        [A] [runParser] :: ParserK a m b -> forall r. (ParseResult b -> Int -> Input a -> m (Step a m r)) -> Int -> Int -> Input a -> m (Step a m r)+        [A] MkParser :: (forall r. (ParseResult b -> Int -> Input a -> m (Step a m r)) -> Int -> Int -> Input a -> m (Step a m r)) -> ParserK a m b+    [A] fromPure :: b -> ParserK a m b+    [A] fromEffect :: Monad m => m b -> ParserK a m b+    [A] die :: String -> ParserK a m b+    [A] adaptCG :: Monad m => Parser a m b -> ParserK (Array a) m b+    [A] adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [A] adapt :: Monad m => Parser a m b -> ParserK a m b+[R] Streamly.Internal.Data.Parser.ParserK.Type+[R] Streamly.Internal.Data.Parser.ParserD.Type+[R] Streamly.Internal.Data.Parser.ParserD.Tee+[R] Streamly.Internal.Data.Parser.ParserD+[C] Streamly.Internal.Data.Parser+    [A] Step+        [A] Partial :: !Int -> !s -> Step s b+        [A] Error :: !String -> Step s b+        [A] Done :: !Int -> !b -> Step s b+        [A] Continue :: !Int -> !s -> Step s b+    [A] Parser+        [A] Parser :: (s -> a -> m (Step s b)) -> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b+    [A] Initial+        [A] IPartial :: !s -> Initial s b+        [A] IError :: !String -> Initial s b+        [A] IDone :: !b -> Initial s b+    [A] GHC.Show.Show+        [A] instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Streamly.Internal.Data.Parser.Tuple'Fused a b)+    [A] ParseError+        [A] ParseError :: String -> ParseError+    [A] zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Fold m c x -> Parser b m x+    [A] zip :: Monad m => Stream m a -> Fold m (a, b) x -> Parser b m x+    [A] wordWithQuotes :: (Monad m, Eq a) => Bool -> (a -> a -> Maybe a) -> a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordProcessQuotes :: (Monad m, Eq a) => a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordKeepQuotes :: (Monad m, Eq a) => a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordFramedBy :: Monad m => (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] toFold :: Monad m => Parser a m b -> Fold m a b+    [A] takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeP :: Monad m => Int -> Parser a m b -> Parser a m b+    [A] takeGE :: Monad m => Int -> Fold m a b -> Parser a m b+    [A] takeFramedBy_ :: Monad m => (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeFramedByGeneric :: Monad m => Maybe (a -> Bool) -> Maybe (a -> Bool) -> Maybe (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeFramedByEsc_ :: Monad m => (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeEndByEsc :: Monad m => (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeEitherSepBy :: (a -> Bool) -> Fold m (Either a b) c -> Parser a m c+    [A] takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b+    [A] takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b+    [A] subsequenceBy :: (a -> a -> Bool) -> Stream m a -> Parser a m ()+    [A] streamEqBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Parser a m ()+    [A] split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+    [A] splitWith :: Monad m => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+    [A] splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] splitManyPost :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] spanByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+    [A] spanBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+    [A] span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+    [A] some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] sequence :: Monad m => Stream m (Parser a m b) -> Fold m b c -> Parser a m c+    [A] sepByAll :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] sepBy1 :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] sepBy :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] satisfy :: Monad m => (a -> Bool) -> Parser a m a+    [A] sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b+    [A] roundRobin :: t (Parser a m b) -> Fold m b c -> Parser a m c+    [A] rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c+    [A] retryMaxTotal :: Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] retryMaxSuccessive :: Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] retry :: Parser a m b -> Parser a m b+    [A] postscan :: Fold m a b -> Parser b m c -> Parser a m c+    [A] peek :: Monad m => Parser a m a+    [A] oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+    [A] oneNotEq :: (Monad m, Eq a) => a -> Parser a m a+    [A] oneEq :: (Monad m, Eq a) => a -> Parser a m a+    [A] one :: Monad m => Parser a m a+    [A] noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+    [A] noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+    [A] noErrorUnsafeSplitWith :: Monad m => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+    [A] noErrorUnsafeConcatMap :: Monad m => (b -> Parser a m c) -> Parser a m b -> Parser a m c+    [A] maybe :: Monad m => (a -> Maybe b) -> Parser a m b+    [A] manyTillP :: Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c+    [A] manyTill :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] manyThen :: Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] manyP :: Parser a m b -> Parser b m c -> Parser a m c+    [A] many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] makeIndexFilter :: (Fold m (s, a) b -> Parser a m b) -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b) -> ((s, a) -> Bool) -> Fold m a b -> Parser a m b+    [A] lookAhead :: Monad m => Parser a m b -> Parser a m b+    [A] lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r+    [A] lmap :: (a -> b) -> Parser b m r -> Parser a m r+    [A] listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]+    [A] listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]+    [A] indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b+    [A] groupByRollingEither :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)+    [A] groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+    [A] groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+    [A] fromPure :: Monad m => b -> Parser a m b+    [A] fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b+    [A] fromFold :: Monad m => Fold m a b -> Parser a m b+    [A] fromEffect :: Monad m => m b -> Parser a m b+    [A] filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)+    [A] eof :: Monad m => Parser a m ()+    [A] either :: Monad m => (a -> Either String b) -> Parser a m b+    [A] dropWhile :: Monad m => (a -> Bool) -> Parser a m ()+    [A] dieM :: Monad m => m String -> Parser a m b+    [A] die :: Monad m => String -> Parser a m b+    [A] deintercalateAll :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+    [A] deintercalate1 :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+    [A] deintercalate :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+    [A] countBetween :: Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] count :: Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] concatMap :: Monad m => (b -> Parser a m c) -> Parser a m b -> Parser a m c+    [A] blockWithQuotes :: (Monad m, Eq a) => (a -> Bool) -> (a -> Bool) -> a -> a -> Fold m a b -> Parser a m b+    [A] bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1+    [A] alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a+[A] Streamly.Internal.Data.MutByteArray+    [A] class Unbox a+    [A] class SizeOfRep (f :: Type -> Type)+    [A] class Serialize a+    [A] TypeOfType+        [A] UnitType :: Name -> TypeOfType+        [A] TheType :: SimpleDataCon -> TypeOfType+        [A] MultiType :: [SimpleDataCon] -> TypeOfType+    [A] SimpleDataCon+        [A] SimpleDataCon :: Name -> [Field] -> SimpleDataCon+    [A] SerializeConfig+        [A] [cfgRecordSyntaxWithHeader] :: SerializeConfig -> Bool+        [A] [cfgInlineSize] :: SerializeConfig -> Maybe Inline+        [A] [cfgInlineSerialize] :: SerializeConfig -> Maybe Inline+        [A] [cfgInlineDeserialize] :: SerializeConfig -> Maybe Inline+        [A] [cfgConstructorTagAsString] :: SerializeConfig -> Bool+        [A] SerializeConfig :: Maybe Inline -> Maybe Inline -> Maybe Inline -> Bool -> Bool -> SerializeConfig+    [A] PinnedState+        [A] Unpinned :: PinnedState+        [A] Pinned :: PinnedState+    [A] MutByteArray+        [A] MutByteArray :: MutableByteArray# RealWorld -> MutByteArray+    [A] DataType+        [A] [dtTvs] :: DataType -> [Name]+        [A] [dtName] :: DataType -> Name+        [A] [dtCxt] :: DataType -> Cxt+        [A] [dtCons] :: DataType -> [DataCon]+        [A] DataType :: Name -> [Name] -> Cxt -> [DataCon] -> DataType+    [A] DataCon+        [A] [dcTvs] :: DataCon -> [Name]+        [A] [dcName] :: DataCon -> Name+        [A] [dcFields] :: DataCon -> [(Maybe Name, Type)]+        [A] [dcCxt] :: DataCon -> Cxt+        [A] DataCon :: Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon+    [A] BoundedPtr+        [A] BoundedPtr :: MutByteArray -> Int -> Int -> BoundedPtr+    [A] Streamly.Internal.Data.Serialize.Type.Serialize+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize Streamly.Internal.Data.MutByteArray.LiftedInteger+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize GHC.Num.Integer.Integer+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize a => Streamly.Internal.Data.Serialize.Type.Serialize (GHC.Maybe.Maybe a)+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize (Data.Proxy.Proxy a)+        [A] instance (Streamly.Internal.Data.Serialize.Type.Serialize a, Streamly.Internal.Data.Serialize.Type.Serialize b) => Streamly.Internal.Data.Serialize.Type.Serialize (Data.Either.Either a b)+    [A] Peeker+        [A] Peeker :: Builder BoundedPtr IO a -> Peeker a+    [A] type Field = (Maybe Name, Type)+    [A] xorCmp :: [Word8] -> Name -> Name -> Q Exp+    [A] wListToString :: [Word8] -> String+    [A] w8_int :: Word8 -> Int+    [A] w32_int :: Word32 -> Int+    [A] unpin :: MutByteArray -> IO MutByteArray+    [A] typeOfType :: Type -> [DataCon] -> TypeOfType+    [A] skipByte :: Peeker ()+    [A] sizeOfRep :: SizeOfRep f => f x -> Int+    [A] sizeOfMutableByteArray :: MutByteArray -> IO Int+    [A] sizeOf :: (Unbox a, SizeOfRep (Rep a)) => Proxy a -> Int+    [A] simplifyDataCon :: DataCon -> SimpleDataCon+    [A] serializeW8List :: Name -> Name -> [Word8] -> Q Exp+    [A] serializeConfig :: SerializeConfig+    [A] serializeAt :: Serialize a => Int -> MutByteArray -> a -> IO Int+    [A] runPeeker :: Peeker a -> BoundedPtr -> IO a+    [A] reifyDataType :: Name -> Q DataType+    [A] readUnsafe :: Unbox a => Peeker a+    [A] read :: Unbox a => Peeker a+    [A] putSliceUnsafe :: MonadIO m => MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()+    [A] pokeRep :: PokeRep f => f a -> BoundedPtr -> IO BoundedPtr+    [A] pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+    [A] pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray+    [A] pinnedNew :: Int -> IO MutByteArray+    [A] pinnedCloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] pin :: MutByteArray -> IO MutByteArray+    [A] peekRep :: PeekRep f => Peeker (f x)+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [A] openConstructor :: Name -> Int -> Q Pat+    [A] nil :: MutByteArray+    [A] newBytesAs :: PinnedState -> Int -> IO MutByteArray+    [A] new :: Int -> IO MutByteArray+    [A] mkSerializeExprFields :: Name -> [Field] -> Q Exp+    [A] mkRecSizeOfExpr :: SimpleDataCon -> Q Exp+    [A] mkRecSerializeExpr :: Name -> SimpleDataCon -> Q Exp+    [A] mkRecDeserializeExpr :: Name -> Name -> Name -> SimpleDataCon -> Q Exp+    [A] mkFieldName :: Int -> Name+    [A] mkDeserializeKeysDec :: Name -> Name -> SimpleDataCon -> Q [Dec]+    [A] mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp+    [A] matchConstructor :: Name -> Int -> Q Exp -> Q Match+    [A] makeN :: Int -> Name+    [A] makeI :: Int -> Name+    [A] makeA :: Int -> Name+    [A] litProxy :: Unbox a => Proxy a -> Q Exp+    [A] litIntegral :: Integral a => a -> Q Exp+    [A] isUnitType :: [DataCon] -> Bool+    [A] isRecordSyntax :: SimpleDataCon -> Bool+    [A] isPinned :: MutByteArray -> Bool+    [A] int_w8 :: Int -> Word8+    [A] int_w32 :: Int -> Word32+    [A] inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld+    [A] genericSizeOf :: forall a. SizeOfRep (Rep a) => Proxy a -> Int+    [A] genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) => MutByteArray -> Int -> a -> IO ()+    [A] genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) => MutByteArray -> Int -> IO a+    [A] errorUnsupported :: String -> a+    [A] errorUnimplemented :: a+    [A] encodeRecordFields :: Bool -> SerializeConfig -> SerializeConfig+    [A] encodeConstrNames :: Bool -> SerializeConfig -> SerializeConfig+    [A] deserializeAt :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+    [A] deriveUnbox :: Q [Dec] -> Q [Dec]+    [A] deriveSerializeWith :: (SerializeConfig -> SerializeConfig) -> Q [Dec] -> Q [Dec]+    [A] deriveSerialize :: Q [Dec] -> Q [Dec]+    [A] conUpdateFuncDec :: Name -> [Field] -> Q [Dec]+    [A] cloneSliceUnsafeAs :: MonadIO m => PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray+    [A] cloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] c2w :: Char -> Word8+    [A] asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+    [A] addSizeTo :: Serialize a => Int -> a -> Int+    [A] _x :: Name+    [A] _val :: Name+    [A] _tag :: Name+    [A] _initialOffset :: Name+    [A] _endOffset :: Name+    [A] _arr :: Name+    [A] _acc :: Name+[A] Streamly.Internal.Data.MutArray.Stream+    [A] SpliceState+        [A] SpliceYielding :: arr -> SpliceState s arr -> SpliceState s arr+        [A] SpliceInitial :: s -> SpliceState s arr+        [A] SpliceFinish :: SpliceState s arr+        [A] SpliceBuffering :: s -> arr -> SpliceState s arr+    [A] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [A] splitOn :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [A] packArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] lpackArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (Either ParseError (MutArray a))+    [A] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactEQ :: Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compact :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+[A] Streamly.Internal.Data.MutArray.Generic+    [A] MutArray+        [A] [arrTrueLen] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrStart] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrLen] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrContents#] :: MutArray a -> MutableArray# RealWorld a+        [A] MutArray :: MutableArray# RealWorld a -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> MutArray a+    [A] writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] writeN :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] write :: MonadIO m => Fold m a (MutArray a)+    [A] uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)+    [A] toStreamK :: MonadIO m => MutArray a -> StreamK m a+    [A] toList :: MonadIO m => MutArray a -> m [a]+    [A] strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+    [A] snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)+    [A] reader :: MonadIO m => Unfold m (MutArray a) a+    [A] readRev :: MonadIO m => MutArray a -> Stream m a+    [A] read :: MonadIO m => MutArray a -> Stream m a+    [A] putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+    [A] putIndices :: MonadIO m => MutArray a -> Fold m (Int, a) ()+    [A] putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [A] putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()+    [A] producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a+    [A] producer :: MonadIO m => Producer m (MutArray a) a+    [A] nil :: MonadIO m => m (MutArray a)+    [A] new :: MonadIO m => Int -> m (MutArray a)+    [A] modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] length :: MutArray a -> Int+    [A] getSliceUnsafe :: Int -> Int -> MutArray a -> MutArray a+    [A] getSlice :: Int -> Int -> MutArray a -> MutArray a+    [A] getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+    [A] getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+    [A] getIndex :: MonadIO m => Int -> MutArray a -> m (Maybe a)+    [A] fromStreamN :: MonadIO m => Int -> Stream m a -> m (MutArray a)+    [A] fromStream :: MonadIO m => Stream m a -> m (MutArray a)+    [A] fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a)+    [A] fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)+    [A] fromList :: MonadIO m => [a] -> m (MutArray a)+    [A] eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool+    [A] cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering+    [A] clone :: MonadIO m => MutArray a -> m (MutArray a)+    [A] chunksOf :: forall m a. MonadIO m => Int -> Stream m a -> Stream m (MutArray a)+[A] Streamly.Internal.Data.MutArray+    [A] MutByteArray+    [A] MutArray+        [A] [arrStart] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrEnd] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrContents] :: MutArray a -> {-# UNPACK #-} !MutByteArray+        [A] [arrBound] :: MutArray a -> {-# UNPACK #-} !Int+        [A] MutArray :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> MutArray a+    [A] IORef+    [A] ArrayUnsafe+        [A] ArrayUnsafe :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> ArrayUnsafe a+    [A] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] writeNWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeIORef :: Unbox a => IORef a -> a -> IO ()+    [A] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [A] writeAppendWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+    [A] writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] writeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] writeAppend :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+    [A] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> MutArray a -> m ()+    [A] unpin :: MutArray a -> IO (MutArray a)+    [A] toStreamKWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+    [A] toStreamKRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+    [A] toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+    [A] toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+    [A] toStreamDWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] toStreamDRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]+    [A] swapIndices :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> MutArray a -> m ()+    [A] strip :: forall a m. (Unbox a, MonadIO m) => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] splitOn :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [A] splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+    [A] spliceWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)+    [A] spliceUnsafe :: MonadIO m => MutArray a -> MutArray a -> m (MutArray a)+    [A] spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+    [A] spliceCopy :: forall m a. MonadIO m => MutArray a -> MutArray a -> m (MutArray a)+    [A] splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+    [A] snocWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+    [A] snocUnsafe :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] snocMay :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (Maybe (MutArray a))+    [A] snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()+    [A] roundUpToPower2 :: Int -> Int+    [A] rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)+    [A] reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()+    [A] resizeExp :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] resize :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] readerRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Unfold m (MutArray a) a+    [A] readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+    [A] reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+    [A] readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] readIORef :: Unbox a => IORef a -> IO a+    [A] read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] putIndices :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Fold m (Int, a) ()+    [A] putIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] producerWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Producer m (MutArray a) a+    [A] producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a+    [A] pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> Stream m a+    [A] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (MutArray a)+    [A] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] pinnedNewBytes :: MonadIO m => Int -> m (MutArray a)+    [A] pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)+    [A] pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] pinnedClone :: MonadIO m => MutArray a -> m (MutArray a)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [A] pin :: MutArray a -> IO (MutArray a)+    [A] permute :: MutArray a -> m Bool+    [A] partitionBy :: forall m a. (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+    [A] nil :: MutArray a+    [A] newIORef :: forall a. Unbox a => a -> IO (IORef a)+    [A] newArrayWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)+    [A] new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] modifyIndices :: forall m a. (MonadIO m, Unbox a) => MutArray a -> (Int -> a -> a) -> Fold m Int ()+    [A] modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()+    [A] modify :: forall m a. (MonadIO m, Unbox a) => MutArray a -> (a -> a) -> m ()+    [A] mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()+    [A] memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+    [A] memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool+    [A] length :: forall a. Unbox a => MutArray a -> Int+    [A] isPinned :: MutArray a -> Bool+    [A] getSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [A] getSliceUnsafe :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [A] getSlice :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [A] getIndicesD :: (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a+    [A] getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+    [A] getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)+    [A] genSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (MutArray a)+    [A] fromStreamD :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+    [A] fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+    [A] fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)+    [A] fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [A] foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b+    [A] foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] divideBy :: Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()+    [A] cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+    [A] clone :: MonadIO m => MutArray a -> m (MutArray a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [A] castUnsafe :: MutArray a -> MutArray b+    [A] cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)+    [A] c_memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)+    [A] bytesFree :: MutArray a -> Int+    [A] byteLength :: MutArray a -> Int+    [A] byteCapacity :: MutArray a -> Int+    [A] bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()+    [A] breakOn :: MonadIO m => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+    [A] blockSize :: Int+    [A] asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] asBytes :: MutArray a -> MutArray Word8+    [A] arrayChunkBytes :: Int+    [A] allocBytesToElemCount :: Unbox a => a -> Int -> Int+[C] Streamly.Internal.Data.IsMap+    [A] mapTraverseWithKey :: (IsMap f, Applicative t) => (Key f -> a -> t b) -> f a -> t (f b)+[R] Streamly.Internal.Data.IORef.Unboxed+[R] Streamly.Internal.Data.Fold.Window+[R] Streamly.Internal.Data.Fold.Type+[R] Streamly.Internal.Data.Fold.Tee+[R] Streamly.Internal.Data.Fold.Step+[R] Streamly.Internal.Data.Fold.Container+[D] Streamly.Internal.Data.Fold.Chunked+[C] Streamly.Internal.Data.Fold+    [A] ManyState+    [C] Fold+        [C] Fold+            [O] Fold :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b+            [N] Fold :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b+    [A] windowSumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a+    [A] windowSum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a+    [A] windowRollingMapM :: Monad m => (Maybe a -> a -> m (Maybe b)) -> Fold m (a, Maybe a) (Maybe b)+    [A] windowRollingMap :: Monad m => (Maybe a -> a -> Maybe b) -> Fold m (a, Maybe a) (Maybe b)+    [A] windowRange :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))+    [A] windowPowerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a+    [A] windowPowerSum :: (Monad m, Num a) => Int -> Fold m (a, Maybe a) a+    [A] windowMinimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+    [A] windowMean :: forall m a. (Monad m, Fractional a) => Fold m (a, Maybe a) a+    [A] windowMaximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+    [A] windowLmap :: (c -> a) -> Fold m (a, Maybe a) b -> Fold m (c, Maybe c) b+    [A] windowLength :: (Monad m, Num b) => Fold m (a, Maybe a) b+    [A] toSet :: (Monad m, Ord a) => Fold m a (Set a)+    [A] toMapIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)+    [A] toMap :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)+    [A] toIntSet :: Monad m => Fold m Int IntSet+    [A] toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+    [A] toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+    [A] nubInt :: Monad m => Fold m Int (Maybe Int)+    [A] nub :: (Monad m, Ord a) => Fold m a (Maybe a)+    [A] mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)+    [A] kvToMap :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)+    [A] frequency :: (Monad m, Ord a) => Fold m a (Map a Int)+    [A] demuxToMapIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [A] demuxToMap :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [A] demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)+    [A] demuxToContainer :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)+    [A] demuxKvToMap :: (Monad m, Ord k) => (k -> m (Fold m a b)) -> Fold m (k, a) (Map k b)+    [A] demuxKvToContainer :: (Monad m, IsMap f, Traversable f) => (Key f -> m (Fold m a b)) -> Fold m (Key f, a) (f b)+    [A] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [A] demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))+    [A] demuxGeneric :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))+    [A] demux :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [A] cumulative :: Fold m (a, Maybe a) b -> Fold m a b+    [A] countDistinctInt :: Monad m => Fold m Int Int+    [A] countDistinct :: (Monad m, Ord a) => Fold m a Int+    [A] classifyIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [A] classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))+    [A] classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))+    [A] classify :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [A] chainStepM :: Applicative m => (s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)+[C] Streamly.Internal.Data.Builder+    [C] Builder+        [C] Builder+            [O] Builder :: (s -> m (s, a)) -> Builder s m a+            [N] Builder :: (s -> m (a, s)) -> Builder s m a+[A] Streamly.Internal.Data.Binary.Stream+    [A] class ToBytes a+    [A] word8 :: Applicative m => Word8 -> Stream m Word8+    [A] word64le :: Monad m => Word64 -> Stream m Word8+    [A] word64host :: Monad m => Word64 -> Stream m Word8+    [A] word64be :: Monad m => Word64 -> Stream m Word8+    [A] word32le :: Monad m => Word32 -> Stream m Word8+    [A] word32be :: Monad m => Word32 -> Stream m Word8+    [A] word16le :: Monad m => Word16 -> Stream m Word8+    [A] word16be :: Monad m => Word16 -> Stream m Word8+    [A] unit :: Applicative m => Stream m Word8+    [A] toBytes :: ToBytes a => a -> Stream m Word8+    [A] ordering :: Applicative m => Ordering -> Stream m Word8+    [A] int8 :: Applicative m => Int8 -> Stream m Word8+    [A] int64le :: Monad m => Int64 -> Stream m Word8+    [A] int64be :: Monad m => Int64 -> Stream m Word8+    [A] int32le :: Monad m => Int32 -> Stream m Word8+    [A] int32be :: Monad m => Int32 -> Stream m Word8+    [A] int16le :: Monad m => Int16 -> Stream m Word8+    [A] int16be :: Monad m => Int16 -> Stream m Word8+    [A] float32le :: Monad m => Float -> Stream m Word8+    [A] float32be :: Monad m => Float -> Stream m Word8+    [A] double64le :: Monad m => Double -> Stream m Word8+    [A] double64be :: Monad m => Double -> Stream m Word8+    [A] charUtf8 :: Monad m => Char -> Stream m Word8+    [A] charLatin1 :: Applicative m => Char -> Stream m Word8+    [A] bool :: Applicative m => Bool -> Stream m Word8+[A] Streamly.Internal.Data.Binary.Parser+    [A] class FromBytes a+    [A] word8 :: Monad m => Parser Word8 m Word8+    [A] word64le :: Monad m => Parser Word8 m Word64+    [A] word64host :: MonadIO m => Parser Word8 m Word64+    [A] word64be :: Monad m => Parser Word8 m Word64+    [A] word32le :: Monad m => Parser Word8 m Word32+    [A] word32be :: Monad m => Parser Word8 m Word32+    [A] word16le :: Monad m => Parser Word8 m Word16+    [A] word16be :: Monad m => Parser Word8 m Word16+    [A] unit :: Monad m => Parser Word8 m ()+    [A] ordering :: Monad m => Parser Word8 m Ordering+    [A] int8 :: Monad m => Parser Word8 m Int8+    [A] int64le :: Monad m => Parser Word8 m Int64+    [A] int64be :: Monad m => Parser Word8 m Int64+    [A] int32le :: Monad m => Parser Word8 m Int32+    [A] int32be :: Monad m => Parser Word8 m Int32+    [A] int16le :: Monad m => Parser Word8 m Int16+    [A] int16be :: Monad m => Parser Word8 m Int16+    [A] fromBytes :: FromBytes a => Parser Word8 m a+    [A] float32le :: MonadIO m => Parser Word8 m Float+    [A] float32be :: MonadIO m => Parser Word8 m Float+    [A] eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8+    [A] double64le :: MonadIO m => Parser Word8 m Double+    [A] double64be :: MonadIO m => Parser Word8 m Double+    [A] charLatin1 :: Monad m => Parser Word8 m Char+    [A] bool :: Monad m => Parser Word8 m Bool+[R] Streamly.Internal.Data.Array.Type+[A] Streamly.Internal.Data.Array.Stream+    [A] unlines :: forall m a. (MonadIO m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] toArray :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+    [A] splitOnSuffix :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] splitOn :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] runArrayParserDBreak :: forall m a b. (MonadIO m, Unbox a) => Parser (Array a) m b -> Stream m (Array a) -> m (Either ParseError b, Stream m (Array a))+    [A] runArrayFoldMany :: (Monad m, Unbox a) => ChunkFold m a b -> StreamK m (Array a) -> StreamK m (Either ParseError b)+    [A] runArrayFoldBreak :: (MonadIO m, Unbox a) => ChunkFold m a b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] runArrayFold :: (MonadIO m, Unbox a) => ChunkFold m a b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: (MonadIO m, Unbox a) => Parser a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] lpackArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [A] interposeSuffix :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] intercalateSuffix :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a+    [A] foldBreakD :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))+    [A] foldBreak :: (MonadIO m, Unbox a) => Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] compact :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+[R] Streamly.Internal.Data.Array.Mut.Type+[R] Streamly.Internal.Data.Array.Mut.Stream+[R] Streamly.Internal.Data.Array.Mut+[R] Streamly.Internal.Data.Array.Generic.Mut.Type+[C] Streamly.Internal.Data.Array.Generic+    [A] getIndex :: Int -> Array a -> Maybe a+    [A] fromPureStream :: Stream Identity a -> Array a+    [A] fromByteStr# :: Addr# -> Array Word8+    [A] chunksOf :: forall m a. MonadIO m => Int -> Stream m a -> Stream m (Array a)+[C] Streamly.Internal.Data.Array+    [A] ArrayUnsafe+        [A] ArrayUnsafe :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> ArrayUnsafe a+    [C] Array+        [A] [arrStart] :: Array a -> {-# UNPACK #-} !Int+        [A] [arrEnd] :: Array a -> {-# UNPACK #-} !Int+        [A] [arrContents] :: Array a -> {-# UNPACK #-} !MutByteArray+        [A] Array :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> Array a+    [A] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [R] writeNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (Array a)+    [A] unsafeMakePure :: Monad m => Fold IO a b -> Fold m a b+    [A] unsafeIndexIO :: forall a. Unbox a => Int -> Array a -> IO a+    [D] unsafeIndex :: forall a. Unbox a => Int -> Array a -> a+    [A] unsafeFreezeWithShrink :: Unbox a => MutArray a -> Array a+    [A] unpin :: Array a -> IO (Array a)+    [A] toStreamKRev :: forall m a. (Monad m, Unbox a) => Array a -> StreamK m a+    [A] toStreamK :: forall m a. (Monad m, Unbox a) => Array a -> StreamK m a+    [A] toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [A] toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [A] splitAt :: Unbox a => Int -> Array a -> (Array a, Array a)+    [A] splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)+    [A] serialize :: Serialize a => a -> Array Word8+    [A] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (Array a)+    [A] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] pinnedSerialize :: Serialize a => a -> Array Word8+    [A] pinnedFromListN :: Unbox a => Int -> [a] -> Array a+    [A] pinnedFromList :: Unbox a => [a] -> Array a+    [A] pinnedClone :: MonadIO m => Array a -> m (Array a)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] pin :: Array a -> IO (Array a)+    [A] nil :: Array a+    [A] isPinned :: Array a -> Bool+    [A] getIndexUnsafe :: forall a. Unbox a => Int -> Array a -> a+    [A] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)+    [A] fromStreamD :: forall m a. (MonadIO m, Unbox a) => Stream m a -> m (Array a)+    [A] fromPureStream :: Unbox a => Stream Identity a -> Array a+    [A] fromListRevN :: Unbox a => Int -> [a] -> Array a+    [A] fromListRev :: Unbox a => [a] -> Array a+    [A] fromByteStr# :: Addr# -> Array Word8+    [A] foldr :: Unbox a => (a -> b -> b) -> b -> Array a -> b+    [A] foldl' :: forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8+    [A] deserialize :: Serialize a => Array Word8 -> a+    [A] clone :: MonadIO m => Array a -> m (Array a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] byteLength :: Array a -> Int+    [A] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+    [A] breakOn :: MonadIO m => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
docs/Changelog.md view
@@ -1,8 +1,59 @@ # Changelog +## 0.2.0 (Nov 2023)++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of API changes in this release. Only a few significant+changes are mentioned here.++### Breaking Changes++* `ParserK` in `Streamly.Data.ParserK` is not implicitly specialized+  to arrays anymore. To adapt to the new code, change `ParserK a m+  b` to `ParserK (Array a) m b` where the `Array` type comes from+  `Streamly.Data.Array`. This change also affected the signatures of+  `parseChunks` and `parseBreakChunks`.+* Changed the signature of 'Streamly.Data.Stream.handle' to make the+  exception handler monadic.+* Behavior change: Exceptions are now rethrown promptly in `bracketIO`.++### Enhancements++* __Serialization__: Added a `Streamly.Data.MutByteArray` module with a+  `Serialize` type class for fast binary serialization. The Data.Array+  module supplies the `serialize` and `deserialize` operations for arrays.+* __Unpinned Arrays__: Unboxed arrays are now created unpinned by default,+  they were created pinned earlier. During IO operations, unpinned arrays+  are automatically copied to pinned memory. When arrays are directly+  passed to IO operations programmers can choose to create them pinned to+  avoid a copy.  To create pinned arrays, use the internal APIs with the+  `pinned*` prefix.+* StreamK now supports native exception handling routines (handle, bracketIO).+  Earlier we had to convert it to the `Stream` type for exception handling.++### Deprecations++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of deprecations.++### Internal API Changes++* Fold constructor has changed, added a `final` field to support+  finalization and cleanup of a chain of folds. The `extract` field is+  now used only for mapping the fold internal state to fold result for+  scanning purposes.+* Many low level internal modules have been removed, they are entirely+  exported from higher level internal modules. If you were importing any+  of the missing low level modules then import the higher level modules instead.+* Internal module changes:+  * Streamly.Internal.Serialize.FromBytes -> Streamly.Internal.Data.Binary.Parser+  * Streamly.Internal.Serialize.ToBytes ->   Streamly.Internal.Data.Binary.Stream+  * Streamly.Internal.Data.Unbox is now exported via Streamly.Internal.Data.Serialize+  * Streamly.Internal.Data.IORef.Unboxed is now exported via Streamly.Internal.Data.Serialize+ ## 0.1.0 (March 2023) -Also see [streamly-core-0.1.0 API Changelog](/core/docs/ApiChangelogs/0.1.0.txt) or+Also see [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt  `streamly` package is split into two packages, (1) `streamly-core` that
src/DocTestDataArray.hs view
@@ -1,6 +1,7 @@ {- $setup >>> :m >>> :set -XFlexibleContexts+>>> :set -XMagicHash >>> import Data.Function ((&)) >>> import Data.Functor.Identity (Identity(..)) >>> import System.IO.Unsafe (unsafePerformIO)@@ -11,4 +12,8 @@ >>> import qualified Streamly.Data.Array as Array >>> import qualified Streamly.Data.Fold as Fold >>> import qualified Streamly.Data.Stream as Stream++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Array as Array -}
src/DocTestDataFold.hs view
@@ -24,5 +24,4 @@ For APIs that have not been released yet.  >>> import qualified Streamly.Internal.Data.Fold as Fold->>> import qualified Streamly.Internal.Data.Fold.Window as FoldW -}
src/DocTestDataMutArray.hs view
@@ -6,5 +6,5 @@  For APIs that have not been released yet. ->>> import Streamly.Internal.Data.Array.Mut as MutArray+>>> import Streamly.Internal.Data.MutArray as MutArray -}
src/DocTestDataMutArrayGeneric.hs view
@@ -6,5 +6,5 @@  For APIs that have not been released yet. ->>> import Streamly.Internal.Data.Array.Generic.Mut.Type as MutArray+>>> import Streamly.Internal.Data.MutArray.Generic as MutArray -}
+ src/DocTestDataParserK.hs view
@@ -0,0 +1,15 @@+{- $setup+>>> :m+>>> import Control.Applicative ((<|>))+>>> import Data.Char (isDigit, isAlpha)++>>> import Streamly.Data.Parser (Parser)+>>> import Streamly.Data.ParserK (ParserK)++>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Data.ParserK as ParserK++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.ParserK as ParserK+-}
src/DocTestDataStream.hs view
@@ -22,6 +22,7 @@ >>> import qualified Streamly.Data.Array as Array >>> import qualified Streamly.Data.Fold as Fold >>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK >>> import qualified Streamly.Data.Unfold as Unfold >>> import qualified Streamly.Data.Parser as Parser >>> import qualified Streamly.FileSystem.Dir as Dir@@ -29,7 +30,6 @@ For APIs that have not been released yet.  >>> import qualified Streamly.Internal.Data.Fold as Fold->>> import qualified Streamly.Internal.Data.Fold.Window as Window >>> import qualified Streamly.Internal.Data.Parser as Parser >>> import qualified Streamly.Internal.Data.Stream as Stream >>> import qualified Streamly.Internal.Data.Unfold as Unfold
src/DocTestDataStreamK.hs view
@@ -1,6 +1,7 @@ {- $setup  >>> :m+>>> import Control.Concurrent (threadDelay) >>> import Data.Function (fix, (&)) >>> import Data.Semigroup (cycle1) @@ -15,6 +16,6 @@  For APIs that have not been released yet. ->>> import qualified Streamly.Internal.Data.Stream.StreamK as StreamK+>>> import qualified Streamly.Internal.Data.StreamK as StreamK >>> import qualified Streamly.Internal.FileSystem.Dir as Dir -}
+ src/DocTestFileSystemHandle.hs view
@@ -0,0 +1,15 @@+{- $setup+>>> :m+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.FileSystem.Handle as Handle hiding (readChunks)+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.Unfold as Unfold++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Array as Array (writeNUnsafe)+>>> import qualified Streamly.Internal.Data.Unfold as Unfold (first)+>>> import qualified Streamly.Internal.FileSystem.Handle as Handle+>>> import qualified Streamly.Internal.System.IO as IO (defaultChunkSize)+-}
+ src/DocTestUnicodeParser.hs view
@@ -0,0 +1,9 @@+{- $setup+>>> :m+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Unicode.Parser as Unicode++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Unicode.Parser as Unicode (number, mkDouble)+-}
+ src/DocTestUnicodeStream.hs view
@@ -0,0 +1,12 @@+{- $setup+>>> :m++>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Unicode.Stream as Unicode++For APIs that have not been released yet.++>>> :set -XMagicHash+>>> import qualified Streamly.Internal.Unicode.Stream as Unicode+-}
+ src/DocTestUnicodeString.hs view
@@ -0,0 +1,5 @@+{- $setup+>>> :m+>>> :set -XQuasiQuotes+>>> import Streamly.Internal.Unicode.String+-}
src/Streamly/Console/Stdio.hs view
@@ -24,33 +24,7 @@     -- * Write (stderr)     , writeErr     , writeErrChunks--    -- * Deprecated-    , read-    , readChunks     ) where -import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Unfold (Unfold)--import Streamly.Internal.Console.Stdio hiding (read, readChunks)-import Prelude hiding (read)---- Same as 'reader'------ @since 0.8.0-{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE read #-}-read :: MonadIO m => Unfold m () Word8-read = reader---- Same as 'chunkReader'------ @since 0.8.0-{-# DEPRECATED readChunks "Please use 'chunkReader' instead" #-}-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m () (Array Word8)-readChunks = chunkReader+import Streamly.Internal.Console.Stdio
src/Streamly/Data/Array.hs view
@@ -29,7 +29,7 @@     -- $overview      -- * The Array Type-      A.Array+      Array      -- * Construction     -- | When performance matters, the fastest way to generate an array is@@ -40,48 +40,61 @@     -- 'fromList' can be used to construct an array from a string literal.      -- Pure List APIs-    , A.fromListN-    , A.fromList+    , fromListN+    , fromList      -- Monadic APIs-    , A.writeN      -- drop new-    , A.write       -- full buffer+    , writeN      -- drop new+    , write       -- full buffer     , writeLastN    -- drop old (ring buffer)      -- * Conversion     -- 'GHC.Exts.toList' from "GHC.Exts" can be used to convert an array to a     -- list.-    , A.toList+    , toList +    -- * Pinning & Unpinning+    -- | Arrays are created unpinned by default unless pinned versions of+    -- creation APIs are used. Look for APIs with @pinned@ prefix in+    -- "Streamly.Internal.Data.Array" for some unreleased pinned creation APIs.+    -- If an array is to be sent to the OS without any further modification+    -- then it should be created pinned in the first place instead of pinning+    -- it later. Pinning an unpinned array has a copy overhead. OS interfacing+    -- APIs create a pinned array directly or convert an unpinned array to+    -- pinned array before sending it to the OS.+    , pin+    , unpin+    , isPinned++    -- * Streams+    , read+    , readRev+     -- * Unfolds-    , A.reader-    , A.readerRev+    , reader+    , readerRev      -- * Casting     , cast     , asBytes      -- * Random Access-    , A.length+    , length     -- , (!!)-    , A.getIndex+    , getIndex -    -- * Unbox Type Class+    -- * Re-exports     , Unbox (..) -    -- * Deprecated-    , read-    , readRev     ) where  #include "inline.hs" -import Streamly.Internal.Data.Unfold (Unfold)-import Streamly.Internal.Data.Array as A hiding (read, readRev)+import Streamly.Internal.Data.Array+import Streamly.Internal.Data.Unbox (Unbox (..)) -import Streamly.Internal.Data.Unboxed (Unbox (..))-import Prelude hiding (read)+import Prelude hiding (read, length)  #include "DocTestDataArray.hs" @@ -97,7 +110,7 @@ -- -- Convert array to stream, and fold the stream: ----- >>> fold f arr = Stream.unfold Array.reader arr & Stream.fold f+-- >>> fold f arr = Array.read arr & Stream.fold f -- >>> fold Fold.sum (Array.fromList [1,2,3::Int]) -- 6 --@@ -105,18 +118,17 @@ -- -- Convert array to stream, transform, and fold back to array: ----- >>> amap f arr = Stream.unfold Array.reader arr & fmap f & Stream.fold Array.write+-- >>> amap f arr = Array.read arr & fmap f & Stream.fold Array.write -- >>> amap (+1) (Array.fromList [1,2,3::Int]) -- fromList [2,3,4] -- -- == Pinned and Unpinned Arrays ----- The array type can use both pinned and unpinned memory under the hood.--- Currently the array creation APIs create arrays in pinned memory but it will--- change to unpinned in future releases. The change should not affect users--- functionally unless they are directly accessing the internal memory of the--- array via internal APIs. As of now unpinned arrays can be created using--- unreleased APIs.+-- The array type can use both pinned and unpinned memory under the hood. The+-- default array creation operations create unpinned arrays. IO operations+-- automatically copy an array to pinned memory if the array passed to it is+-- unpinned. Programmers can use appropriate pinned array generation APIs to+-- reduce the copying if it happens. -- -- Unpinned arrays have the advantage of allowing automatic defragmentation of -- the memory by GC. Whereas pinned arrays have the advantage of not requiring@@ -127,20 +139,14 @@ -- -- == Creating Arrays from Non-IO Streams ----- Array creation folds require 'MonadIO' because they need to sequence effects--- in IO streams. To operate on streams in pure Monads like 'Identity' you can--- morph it to IO monad as follows:+-- Array creation folds require 'MonadIO' otherwise the compiler may+-- incorrectly share the array memory thinking it is pure. ----- The 'MonadIO' based folds can be morphed to 'Identity' stream folds:+-- See the 'fromPureStream' unreleased API to generate an array from an+-- Identity stream safely without using MonadIO constraint. ----- >>> purely = Fold.morphInner (Identity . unsafePerformIO)--- >>> Stream.fold (purely Array.write) $ Stream.fromList [1,2,3::Int]--- Identity fromList [1,2,3] ----- Since it is a pure stream we can use 'unsafePerformIO' to extract the result--- of fold from IO.------ Alternatively, 'Identity' streams can be generalized to IO streams:+-- Note that 'Identity' streams can be generalized to IO streams: -- -- >>> pure = Stream.fromList [1,2,3] :: Stream Identity Int -- >>> generally = Stream.morphInner (return . runIdentity)@@ -152,17 +158,3 @@ -- This module is designed to be imported qualified: -- -- >>> import qualified Streamly.Data.Array as Array---- | Same as 'reader'----{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE_NORMAL read #-}-read :: (Monad m, Unbox a) => Unfold m (Array a) a-read = reader---- | Same as 'readerRev'----{-# DEPRECATED readRev "Please use 'readerRev' instead" #-}-{-# INLINE_NORMAL readRev #-}-readRev :: (Monad m, Unbox a) => Unfold m (Array a) a-readRev = readerRev
src/Streamly/Data/Array/Generic.hs view
@@ -22,15 +22,20 @@     , A.writeN     , A.write +    -- * Conversion+    , A.toList+     -- * Streams     , A.read     , A.readRev      -- * Unfolds     , A.reader+    -- , A.readerRev      -- * Random Access     , A.length+    , A.getIndex      -- -- * Folding Arrays     -- , A.streamFold
src/Streamly/Data/Fold.hs view
@@ -10,6 +10,156 @@ -- Fast, composable stream consumers with ability to terminate, supporting -- stream fusion. --+-- == Using Folds+--+-- This module provides elementary folds and fold combinators that can be used+-- to consume a stream of data and reduce it to a final value, or transform it+-- in a stateful manner using scans. A data stream can be reduced into a stream+-- of folded data elements by folding segments of the stream. Fold combinators+-- can be used to compose multiple folds in parallel or to create a pipeline of+-- folds such that the next fold consumes the result of the previous fold. To+-- run these folds on a stream see 'Streamly.Data.Stream.fold',+-- 'Streamly.Data.Stream.scan', 'Streamly.Data.Stream.postscan',+-- 'Streamly.Data.Stream.scanMaybe', 'Streamly.Data.Stream.foldMany' and other+-- operations accepting 'Fold' type as argument "Streamly.Data.Stream".+--+-- == Reducing a Stream+--+-- A 'Fold' is a consumer of a stream of values. A fold driver (such as+-- 'Streamly.Data.Stream.fold') initializes the fold @accumulator@, runs the+-- fold @step@ function in a loop, processing the input stream one element at a+-- time and accumulating the result. The loop continues until the fold+-- terminates, at which point the accumulated result is returned.+--+-- For example, a 'sum' Fold represents a stream consumer that adds the values+-- in the input stream:+--+-- >>> Stream.fold Fold.sum $ Stream.fromList [1..100]+-- 5050+--+-- Conceptually, a 'Fold' is a data type that mimics a strict left fold+-- ('Data.List.foldl').  The above example is similar to a left fold using+-- @(+)@ as the step and @0@ as the initial value of the accumulator:+--+-- >>> Data.List.foldl' (+) 0 [1..100]+-- 5050+--+-- 'Fold's have an early termination capability e.g. the 'one' fold terminates+-- after consuming one element:+--+-- >>> Stream.fold Fold.one $ Stream.fromList [1..]+-- Just 1+--+-- The above example is similar to the following right fold:+--+-- >>> Prelude.foldr (\x _ -> Just x) Nothing [1..]+-- Just 1+--+-- 'Fold's can be combined together using combinators. For example, to create a+-- fold that sums first two elements in a stream:+--+-- >>> sumTwo = Fold.take 2 Fold.sum+-- >>> Stream.fold sumTwo $ Stream.fromList [1..100]+-- 3+--+-- == Parallel Composition+--+-- Folds can be combined to run in parallel on the same input. For example, to+-- compute the average of numbers in a stream without going through the stream+-- twice:+--+-- >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)+-- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]+-- 50.5+--+-- Folds can be combined so as to partition the input stream over multiple+-- folds. For example, to count even and odd numbers in a stream:+--+-- >>> split n = if even n then Left n else Right n+-- >>> stream = fmap split $ Stream.fromList [1..100]+-- >>> countEven = fmap (("Even " ++) . show) Fold.length+-- >>> countOdd = fmap (("Odd "  ++) . show) Fold.length+-- >>> f = Fold.partition countEven countOdd+-- >>> Stream.fold f stream+-- ("Even 50","Odd 50")+--+-- == Sequential Composition+--+-- Terminating folds can be combined to parse the stream serially such that the+-- first fold consumes the input until it terminates and the second fold+-- consumes the rest of the input until it terminates:+--+-- >>> f = Fold.splitWith (,) (Fold.take 8 Fold.toList) (Fold.takeEndBy (== '\n') Fold.toList)+-- >>> Stream.fold f $ Stream.fromList "header: hello\n"+-- ("header: ","hello\n")+--+-- == Splitting a Stream+--+-- A 'Fold' can be applied repeatedly on a stream to transform it to a stream+-- of fold results. To split a stream on newlines:+--+-- >>> f = Fold.takeEndBy (== '\n') Fold.toList+-- >>> Stream.fold Fold.toList $ Stream.foldMany f $ Stream.fromList "Hello there!\nHow are you\n"+-- ["Hello there!\n","How are you\n"]+--+-- Similarly, we can split the input of a fold too:+--+-- >>> Stream.fold (Fold.many f Fold.toList) $ Stream.fromList "Hello there!\nHow are you\n"+-- ["Hello there!\n","How are you\n"]+--+-- == Folds vs. Streams+--+-- We can often use streams or folds to achieve the same goal. However, streams+-- are more efficient in composition of producers (e.g.+-- 'Data.Stream.append' or 'Data.Stream.mergeBy') whereas folds are+-- more efficient in composition of consumers (e.g.  'splitWith', 'partition'+-- or 'teeWith').+--+-- Streams are producers, transformations on streams happen on the output side:+--+-- >>> :{+--  f stream =+--        Stream.filter odd stream+--      & fmap (+1)+--      & Stream.fold Fold.sum+-- :}+--+-- >>> f $ Stream.fromList [1..100 :: Int]+-- 2550+--+-- Folds are stream consumers with an input stream and an output value, stream+-- transformations on folds happen on the input side:+--+-- >>> :{+-- f =+--        Fold.filter odd+--      $ Fold.lmap (+1)+--      $ Fold.sum+-- :}+--+-- >>> Stream.fold f $ Stream.fromList [1..100 :: Int]+-- 2550+--+-- Notice the similiarity in the definition of @f@ in both cases, the only+-- difference is the composition by @&@ vs @$@ and the use @lmap@ vs @map@, the+-- difference is due to output vs input side transformations.+--+-- == Fusion Limitations+--+-- Folds support stream fusion for generating loops comparable to the speed of+-- C. However, it has some limitations. For fusion to work, the folds must be+-- inlined, folds must be statically known and not generated dynamically, folds+-- should not be passed recursively.+--+-- Another limitation is due to the quadratic complexity causing slowdown when+-- too many nested compositions are used. Especially, the performance of the+-- Applicative instance and splitting operations (e.g. 'splitWith') degrades+-- quadratically (O(n^2)) when combined @n@ times, roughly 8 or less sequenced+-- operations are fine. For these cases folds can be converted to parsers and+-- then used as ParserK.+--+-- == Experimental APIs+-- -- Please refer to "Streamly.Internal.Data.Fold" for more functions that have -- not yet been released. @@ -21,9 +171,6 @@     --     -- $setup -    -- * Overview-    -- $overview-     -- * Running A Fold       drive     -- XXX Should we have a stream returning function in fold module?@@ -72,10 +219,6 @@     , toListRev     , toSet     , toIntSet-    , toMap-    , toMapIO-    , demuxToMap-    , demuxToMapIO     , topBy      -- ** Non-Empty Accumulators@@ -97,10 +240,6 @@     , uniqBy     , nub     , nubInt-    , classify-    , classifyIO-    , demux-    , demuxIO      -- ** Terminating Folds     , one@@ -193,8 +332,11 @@     , takeEndBy     , takeEndBy_ -    -- ** Serial Append+    -- ** Splitting     , splitWith+    , many+    , groupsOf+    -- , intervalsOf      -- ** Parallel Distribution     -- | For applicative composition using distribution see@@ -216,14 +358,21 @@     --, partitionByMinM     --, partitionBy +    -- ** Key-value Collectors+    , toMap+    , toMapIO+    , demuxToMap+    , demuxToMapIO++    -- ** Key-value Scanners+    , classify+    , classifyIO+    , demux+    , demuxIO+     -- ** Unzipping     , unzip -    -- ** Splitting-    , many-    , groupsOf-    -- , intervalsOf-     -- ** Nesting     , concatMap @@ -245,132 +394,16 @@ where  import Prelude-       hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,-               foldl, map, mapM_, sequence, all, any, sum, product, elem,-               notElem, maximum, minimum, head, last, tail, length, null,-               reverse, iterate, init, and, or, lookup, foldr1, (!!),-               scanl, scanl1, replicate, concatMap, mconcat, foldMap, unzip,+       hiding (Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith,+               map, mapM_, sequence, all, any,+               notElem, head, last, tail,+               reverse, iterate, init, and, or, lookup, (!!),+               scanl, scanl1, replicate, concatMap, mconcat, unzip,                span, splitAt, break, mapM, maybe)  import Streamly.Internal.Data.Fold-import Streamly.Internal.Data.Fold.Container  #include "DocTestDataFold.hs"---- $overview------ A 'Fold' is a consumer of a stream of values. A fold driver (such as--- 'Streamly.Data.Stream.fold') initializes the fold @accumulator@, runs the--- fold @step@ function in a loop, processing the input stream one element at a--- time and accumulating the result. The loop continues until the fold--- terminates, at which point the accumulated result is returned.------ For example, a 'sum' Fold represents a stream consumer that adds the values--- in the input stream:------ >>> Stream.fold Fold.sum $ Stream.fromList [1..100]--- 5050------ Conceptually, a 'Fold' is a data type that mimics a strict left fold--- ('Data.List.foldl').  The above example is similar to a left fold using--- @(+)@ as the step and @0@ as the initial value of the accumulator:------ >>> Data.List.foldl' (+) 0 [1..100]--- 5050------ 'Fold's have an early termination capability e.g. the 'one' fold terminates--- after consuming one element:------ >>> Stream.fold Fold.one $ Stream.fromList [1..]--- Just 1------ The above example is similar to the following right fold:------ >>> Prelude.foldr (\x _ -> Just x) Nothing [1..]--- Just 1------ 'Fold's can be combined together using combinators. For example, to create a--- fold that sums first two elements in a stream:------ >>> sumTwo = Fold.take 2 Fold.sum--- >>> Stream.fold sumTwo $ Stream.fromList [1..100]--- 3------ Folds can be combined to run in parallel on the same input. For example, to--- compute the average of numbers in a stream without going through the stream--- twice:------ >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]--- 50.5------ Folds can be combined so as to partition the input stream over multiple--- folds. For example, to count even and odd numbers in a stream:------ >>> split n = if even n then Left n else Right n--- >>> stream = fmap split $ Stream.fromList [1..100]--- >>> countEven = fmap (("Even " ++) . show) Fold.length--- >>> countOdd = fmap (("Odd "  ++) . show) Fold.length--- >>> f = Fold.partition countEven countOdd--- >>> Stream.fold f stream--- ("Even 50","Odd 50")------ Terminating folds can be combined to parse the stream serially such that the--- first fold consumes the input until it terminates and the second fold--- consumes the rest of the input until it terminates:------ >>> f = Fold.splitWith (,) (Fold.take 8 Fold.toList) (Fold.takeEndBy (== '\n') Fold.toList)--- >>> Stream.fold f $ Stream.fromList "header: hello\n"--- ("header: ","hello\n")------ A 'Fold' can be applied repeatedly on a stream to transform it to a stream--- of fold results. To split a stream on newlines:------ >>> f = Fold.takeEndBy (== '\n') Fold.toList--- >>> Stream.fold Fold.toList $ Stream.foldMany f $ Stream.fromList "Hello there!\nHow are you\n"--- ["Hello there!\n","How are you\n"]------ Similarly, we can split the input of a fold too:------ >>> Stream.fold (Fold.many f Fold.toList) $ Stream.fromList "Hello there!\nHow are you\n"--- ["Hello there!\n","How are you\n"]------ = Folds vs. Streams------ We can often use streams or folds to achieve the same goal. However, streams--- are more efficient in composition of producers (e.g.--- 'Data.Stream.append' or 'Data.Stream.mergeBy') whereas folds are--- more efficient in composition of consumers (e.g.  'splitWith', 'partition'--- or 'teeWith').------ Streams are producers, transformations on streams happen on the output side:------ >>> :{---  f stream =---        Stream.filter odd stream---      & fmap (+1)---      & Stream.fold Fold.sum--- :}------ >>> f $ Stream.fromList [1..100 :: Int]--- 2550------ Folds are stream consumers with an input stream and an output value, stream--- transformations on folds happen on the input side:------ >>> :{--- f =---        Fold.filter odd---      $ Fold.lmap (+1)---      $ Fold.sum--- :}------ >>> Stream.fold f $ Stream.fromList [1..100 :: Int]--- 2550------ Notice the similiarity in the definition of @f@ in both cases, the only--- difference is the composition by @&@ vs @$@ and the use @lmap@ vs @map@, the--- difference is due to output vs input side transformations.  -------------------------------------------------------------------------------- -- Deprecated
src/Streamly/Data/MutArray.hs view
@@ -12,7 +12,7 @@ -- contents of a mutable array can be modified in-place. For general -- documentation, please refer to the original module. ----- Please refer to "Streamly.Internal.Data.Array.Mut" for functions that have+-- Please refer to "Streamly.Internal.Data.MutArray" for functions that have -- not yet been released. -- -- For mutable arrays that work on boxed types, not requiring the 'Unbox'@@ -33,7 +33,7 @@      -- Uninitialized Arrays     , new-    , newPinned+    , pinnedNew      -- From containers     , fromListN@@ -42,22 +42,36 @@     , write       -- full buffer     -- writeLastN +    -- * Pinning & Unpinning+    , pin+    , unpin+    , isPinned+     -- * Appending elements     , snoc      -- * Appending streams-    , writeAppendN-    , writeAppend+    , writeAppendN -- XXX Rename to writeSnocN?+    , writeAppend -- XXX Rename to writeSnoc?      -- * Inplace mutation     , putIndex+    , putIndexUnsafe+    , modifyIndex+    , modifyIndexUnsafe+    , modify      -- * Random access     , getIndex+    , getIndexUnsafe      -- * Conversion     , toList +    -- * Streams+    , read+    , readRev+     -- * Unfolds     , reader     , readerRev@@ -69,13 +83,22 @@     -- * Size     , length -    -- * Unbox Type Class+    -- * Re-exports     , Unbox (..)++    -- * Deprecated+    , newPinned     ) where  import Prelude hiding (length, read)-import Streamly.Internal.Data.Array.Mut-import Streamly.Internal.Data.Unboxed (Unbox (..))+import Streamly.Internal.Data.MutArray+import Streamly.Internal.Data.Unbox (Unbox (..))+import Control.Monad.IO.Class (MonadIO)  #include "DocTestDataMutArray.hs"++{-# DEPRECATED newPinned "Please use pinnedNew instead." #-}+{-# INLINE newPinned #-}+newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+newPinned = pinnedNew
src/Streamly/Data/MutArray/Generic.hs view
@@ -23,27 +23,43 @@       MutArray      -- * Construction+    , new+    , fromListN+    , fromList     , writeN+    , write      -- * Appending elements-    , new     , snoc +    -- * Inplace mutation+    , putIndex+    , putIndexUnsafe+    , modifyIndex+    , modifyIndexUnsafe+    -- , modify++    -- * Random reads+    , getIndex+    , getIndexUnsafe+     -- * Conversion     , toList +    -- * Streams+    , read+    , readRev+     -- * Unfolds     , reader--    -- * Random reads-    , getIndex+    -- , readerRev -    -- * Inplace mutation-    , putIndex-    , modifyIndex+    -- * Size+    , length     ) where -import Streamly.Internal.Data.Array.Generic.Mut.Type+import Streamly.Internal.Data.MutArray.Generic+import  Prelude hiding (read, length)  #include "DocTestDataMutArrayGeneric.hs"
+ src/Streamly/Data/MutByteArray.hs view
@@ -0,0 +1,97 @@+-- |+-- Module      : Streamly.Data.MutByteArray+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- A low level byte Array type 'MutByteArray', along with type classes 'Unbox'+-- and 'Serialize' for fast binary serialization and deserialization of Haskell+-- values. Serialization, deserialization performance is similar to, and in+-- some cases many times better than the store package. Conceptually, the+-- 'Serialize' type class works in the same way as store.+--+-- Serialize instances are configurable to use constructor names (see+-- 'Streamly.Internal.Data.MutByteArray.encodeConstrNames'), record field names (see+-- 'Streamly.Internal.Data.MutByteArray.encodeRecordFields') instead of binary+-- encoded values. This is an experimental feature which allows JSON like+-- properties with faster speed. For example, you can change the order of+-- constructors or record fields without affecting serialized value.+--+-- Higher level unboxed array modules "Streamly.Data.Array" and+-- "Streamly.Data.MutArray" are built on top of this module. Unboxed arrays are+-- essentially serialized Haskell values. Array modules provide higher level+-- serialization routines like 'Streamly.Data.Array.pinnedSerialize'+-- and 'Streamly.Data.Array.deserialize' from the+-- "Streamly.Data.Array" module.+--+-- == Mutable Byte Array+--+-- 'MutByteArray' is a primitive mutable array in the IO monad. 'Unbox' and+-- 'Serialize' type classes use this primitive array to serialize data to and+-- deserialize it from. This array is used to build higher level unboxed+-- array types 'Streamly.Data.MutArray.MutArray' and 'Streamly.Data.Array.Array'.+--+-- == Using Unbox+--+-- The 'Unbox' type class is simple and used to serialize non-recursive fixed+-- size data types. This type class is primarily used to implement unboxed+-- arrays. Unboxed arrays are just a sequence of serialized fixed length+-- Haskell data types. Instances of this type class can be derived using+-- 'Generic' or template haskell based deriving functions provided in this+-- module.+--+-- Writing a data type to an array using the array creation routines in+-- "Streamly.Data.Array" or "Streamly.Data.MutArray" (e.g. @writeN@ or+-- @fromListN@), serializes the type to the array. Similarly, reading the data+-- type from the array deserializes it. You can also serialize and deserialize+-- directly to and from a 'MutByteArray', using the type class methods.+--+-- == Using Serialize+--+-- The 'Serialize' type class is a superset of the 'Unbox' type class, it can+-- serialize variable length data types as well e.g. Haskell lists. Use+-- 'deriveSerialize' to derive the instances of the type class automatically+-- and then use the type class methods to serialize and deserialize to and from+-- a 'MutByteArray'.+--+-- See 'Streamly.Data.Array.pinnedSerialize' and+-- 'Streamly.Data.Array.deserialize' for 'Array' type based+-- serialization.+--+module Streamly.Data.MutByteArray+    (++    -- * Mutable Byte Array+    -- | The standard way to read from or write to a 'MutByteArray' is by using+    -- the 'Unbox' or 'Serialize' type class methods.+      MutByteArray+    , isPinned+    , pin+    , unpin+    , new+    , pinnedNew++    -- * Unbox+    , Unbox(..)+    , deriveUnbox++    -- * Serialize+    , Serialize(..)++    -- ** Instance Config+    , SerializeConfig+    , inlineAddSizeTo+    , inlineSerializeAt+    , inlineDeserializeAt++    -- ** Instance Deriving+    , deriveSerialize+    , deriveSerializeWith+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Streamly.Internal.Data.MutByteArray
src/Streamly/Data/Parser.hs view
@@ -7,13 +7,138 @@ -- Stability   : pre-release -- Portability : GHC ----- Fast, composable stream consumers with ability to terminate, backtrack and--- fail, supporting stream fusion. Parsers are a natural extension of--- "Streamly.Data.Fold". Parsers and folds can be interconverted.+-- Parsers are stream consumers like folds with the following differences: ----- Please refer to "Streamly.Internal.Data.Parser" for functions that have--- not yet been released.+-- * folds cannot fail but parsers can fail and backtrack.+-- * folds can be composed as a Tee but parsers cannot.+-- * folds can be used for scanning but parsers cannot.+-- * folds can be converted to parsers. --+-- This module implements parsers with stream fusion which compile to efficient+-- loops comparable to the speed of C.+--+-- == Using Parsers+--+-- This module provides elementary parsers and parser combinators that can be+-- used to parse a stream of data. Additionally, all the folds from the+-- "Streamly.Data.Fold" module can be converted to parsers using 'fromFold'.+-- All the parsing functionality provided by popular parsing libraries, and+-- more is available. Also see "Streamly.Unicode.Parser" module for Char stream+-- parsers.+--+-- A data stream can be transformed to a stream of parsed data elements. Parser+-- combinators can be used to create a pipeline of folds or parsers such that+-- the next fold or parser consumes the result of the previous parser. See+-- 'Streamly.Data.Stream.parse' and 'Streamly.Data.Stream.parseMany' to run+-- these parsers on a stream.+--+-- == Parser vs ParserK+--+-- There are two functionally equivalent parsing modules,+-- "Streamly.Data.Parser" (this module) and "Streamly.Data.ParserK". The latter+-- is a CPS based wrapper over the former, and can be used for parsing in+-- general. "Streamly.Data.Parser" enables stream fusion and should be+-- preferred over "Streamly.Data.ParserK" for high performance stream parsing+-- use cases. However, there are a few cases where this module is not+-- suitable and ParserK should be used instead.+--+-- For static fusion, parser combinators have to use strict pattern matching on+-- arguments of type Parser. This leads to infinte loop when a parser is+-- defined recursively, due to strict evaluation of the recursive call. For+-- example, the following implementation loops infinitely because of the+-- recursive use of parser @p@ in the @*>@ combinator:+--+-- >>> import Streamly.Data.Parser (Parser)+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Parser as Parser+-- >>> import qualified Streamly.Data.Stream as Stream+-- >>> import Control.Applicative ((<|>))+--+-- >>> :{+-- >>> p :: Monad m => Parser Char m String+-- >>> p = Parser.satisfy (== '(') *> p <|> Parser.fromFold Fold.toList+-- >>> :}+--+-- Use ParserK when recursive use is required:+--+-- >>> import Streamly.Data.ParserK (ParserK)+-- >>> import qualified Streamly.Data.StreamK as StreamK+-- >>> import qualified Streamly.Internal.Data.StreamK as StreamK (parse)+-- >>> import qualified Streamly.Internal.Data.ParserK as ParserK (adapt)+--+-- >>> :{+-- >>> p :: Monad m => ParserK Char m String+-- >>> p = ParserK.adapt (Parser.satisfy (== '(')) *> p <|> ParserK.adapt (Parser.fromFold Fold.toList)+-- >>> :}+--+-- >>> StreamK.parse p $ StreamK.fromStream $ Stream.fromList "hello"+-- Right "hello"+--+-- For this reason Applicative, Alternative or Monad compositions with+-- recursion cannot be used with the 'Parser' type. Alternative type class based+-- operations like 'asum' and Alternative based generic parser combinators use+-- recursion. Similarly, Applicative type class based operations like+-- 'Prelude.sequence' use recursion. Custom implementations of many such+-- operations are provided in this module (e.g. 'some', 'many'), and those+-- should be used instead.+--+-- Another limitation of Parser type is due to the quadratic complexity causing+-- slowdown when too many nested compositions are used. Especially Applicative,+-- Monad, Alternative instances, and sequenced parsing operations (e.g. nested+-- 'one', and 'splitWith') degrade the performance quadratically (O(n^2)) when+-- combined @n@ times, roughly 8 or less sequenced parsers are fine. READ THE+-- DOCS OF APPLICATIVE, MONAD AND ALTERNATIVE INSTANCES.+--+-- == Streaming Parsers+--+-- With 'Streamly.Data.ParserK.ParserK' you can use the generic Alternative+-- type class based parsers from the+-- <https://hackage.haskell.org/package/parser-combinators parser-combinators>+-- library or similar. However, we recommend that you use the equivalent+-- functionality from this module for better performance and for streaming+-- behavior.+--+-- Firstly, the combinators in this module are faster due to stream fusion.+-- Secondly, these are streaming in nature as the results can be passed+-- directly to other stream consumers (folds or parsers). The Alternative type+-- class based parsers would end up buffering all the results in lists before+-- they can be consumed.+--+-- When recursion or heavy nesting is needed use ParserK.+--+-- == Error Reporting+--+-- These parsers do not report the error context (e.g. line number or column).+-- This may be supported in future.+--+-- == Monad Transformer Stack+--+-- 'MonadTrans' instance is not provided. If the 'Parser' type is the top most+-- layer (which should be the case almost always) you can just use 'fromEffect'+-- to execute the lower layer monad effects.+--+-- == Parser vs ParserK Implementation+--+-- The 'Parser' type represents a stream consumer by composing state as data+-- which enables stream fusion. Stream fusion generates a tight loop without+-- any constructor allocations between the stages, providing C like performance+-- for the loop. Stream fusion works when multiple functions are combined in a+-- pipeline statically. Therefore, the operations in this module must be+-- inlined and must not be used recursively to allow for stream fusion.+--+-- The 'ParserK' type represents a stream consumer by composing function calls,+-- therefore, a function call overhead is incurred at each composition. It is+-- quite fast in general but may be a few times slower than a fused parser.+-- However, it allows for scalable dynamic composition especially parsers can+-- be used in recursive calls. Using the 'ParserK' type operations like+-- 'splitWith' provide linear (O(n)) performance with respect to the number of+-- compositions.+--+-- == Experimental APIs+--+-- Please refer to "Streamly.Internal.Data.Parser" for functions that have not+-- yet been released.+-- module Streamly.Data.Parser     (     -- * Setup@@ -22,9 +147,6 @@     --     -- $setup -    -- * Overview-    -- $overview-     -- * Parser Type       Parser @@ -96,8 +218,8 @@      -- ** Grouping     , groupBy-    -- , groupByRolling-    -- , groupByRollingEither+    , groupByRolling+    , groupByRollingEither      -- ** Framing     -- , wordFramedBy@@ -123,55 +245,3 @@ import Prelude hiding (dropWhile, takeWhile, filter)  #include "DocTestDataParser.hs"---- $overview------ Several combinators in this module can be many times faster than CPS based--- parsers because of stream fusion. For example,--- 'Streamly.Internal.Data.Parser.many' combinator in this module is much--- faster than the 'Control.Applicative.many' combinator of--- 'Control.Applicative.Alternative' type class used by CPS based parsers.------ The use of 'Alternative' type class, in parsers has another drawback.--- Alternative based parsers use plain Haskell lists to collect the results. In--- a strict Monad like IO, the results are necessarily buffered before they can--- be consumed.  This may not perform optimally in streaming applications--- processing large amounts of data.  Equivalent combinators in this module can--- consume the results of parsing using a 'Fold' or another parser, thus--- providing a scalable and composable consumer.------ Note that these parsers do not report the error context (e.g. line number or--- column). This may be supported in future.------ mtl instances are not provided. If the 'Parser' type is the top most layer--- (which should be the case almost always) you can just use 'fromEffect' to--- execute the lower layer monad effects.------ == Performance Notes------ The 'Parser' type represents a stream consumer by composing state as data--- which enables stream fusion. Stream fusion generates a tight loop without--- any constructor allocations between the stages, providing C like performance--- for the loop. Stream fusion works when multiple functions are combined in a--- pipeline statically. Therefore, the operations in this module must be--- inlined and must not be used recursively to allow for stream fusion. Note--- that operations like 'sequence', and 'asum' that compose pasrers using--- recursion should be avoided with these parsers. You can use these with the--- 'ParserK' module instead.------ Using the 'Parser' type, parsing operations like 'one', 'splitWith' etc.--- degrade quadratically (O(n^2)) when combined many times. If you need to--- combine these operations, say more than 8 times in a single loop, then you--- should consider using the continuation style parser type 'ParserK' instead.--- Also, if you need to use these operations in a recursive loop you should use--- 'ParserK' instead.------ The 'ParserK' type represents a stream consumer by composing function calls,--- therefore, a function call overhead is incurred at each composition. It is--- quite fast in general but may be a few times slower than a fused parser.--- However, it allows for scalable dynamic composition especially parsers can--- be used in recursive calls. Using the 'ParserK' type operations like--- 'splitWith' provide linear (O(n)) performance with respect to the number of--- compositions..------ 'Parser' and 'ParserK' types can be interconverted.
src/Streamly/Data/ParserK.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Data.ParserK -- Copyright   : (c) 2023 Composewell Technologies@@ -6,39 +7,133 @@ -- Stability   : pre-release -- Portability : GHC ----- Parsers using Continuation Passing Style (CPS). See notes in--- "Streamly.Data.Parser" module to know when to use this module.+-- See the general notes about parsing in the "Streamly.Data.Parser" module.+-- This module implements a using Continuation Passing Style (CPS) wrapper over+-- the "Streamly.Data.Parser" module. It is as fast or faster than attoparsec. ----- To run a 'ParserK' use 'Streamly.Data.StreamK.parseChunks'.+-- == Parser vs ParserK --+-- 'ParserK' is preferred over 'Streamly.Data.Parser.Parser' when extensive+-- applicative, alternative and monadic composition is required, or when+-- recursive or dynamic composition of parsers is required. The+-- 'Streamly.Data.Parser.Parser' type fuses statically and creates efficient+-- loops whereas 'ParserK' uses function call based composition and has+-- comparatively larger runtime overhead but it is better suited to the+-- specific use cases mentioned above. 'ParserK' also allows to efficient parse+-- a stream of arrays, it can also break the input stream into a parse result+-- and remaining stream so that the stream can be parsed independently in+-- segments.+--+-- == Using ParserK+--+-- All the parsers from the "Streamly.Data.Parser" module can be adapted to+-- ParserK using the 'Streamly.Data.ParserK.adaptC',+-- 'Streamly.Internal.Data.ParserK.adapt', and+-- 'Streamly.Internal.Data.ParserK.adaptCG' combinators.+--+-- 'Streamly.Data.StreamK.parseChunks' runs a parser on a stream of unboxed+-- arrays, this is the preferred and most efficient way to parse chunked input.+-- The more general 'Streamly.Data.StreamK.parseBreakChunks' function returns+-- the remaining stream as well along with the parse result. There are+-- 'Streamly.Internal.Data.StreamK.parseChunksGeneric',+-- 'Streamly.Internal.Data.StreamK.parseBreakChunksGeneric' as well to run+-- parsers on boxed arrays. 'Streamly.Internal.Data.StreamK.parse',+-- 'Streamly.Internal.Data.StreamK.parseBreak' run parsers on a stream of+-- individual elements instead of stream of arrays.+--+-- == Monadic Composition+--+-- Monad composition can be used for lookbehind parsers, we can dynamically+-- compose new parsers based on the results of the previously parsed values.+--+-- If we have to parse "a9" or "9a" but not "99" or "aa" we can use the+-- following non-monadic, backtracking parser:+--+-- >>> digits p1 p2 = ((:) <$> p1 <*> ((:) <$> p2 <*> pure []))+-- >>> :{+-- backtracking :: Monad m => ParserK Char m String+-- backtracking = ParserK.adapt $+--     digits (Parser.satisfy isDigit) (Parser.satisfy isAlpha)+--     <|>+--     digits (Parser.satisfy isAlpha) (Parser.satisfy isDigit)+-- :}+--+-- We know that if the first parse resulted in a digit at the first place then+-- the second parse is going to fail.  However, we waste that information and+-- parse the first character again in the second parse only to know that it is+-- not an alphabetic char.  By using lookbehind in a 'Monad' composition we can+-- avoid redundant work:+--+-- >>> data DigitOrAlpha = Digit Char | Alpha Char+--+-- >>> :{+-- lookbehind :: Monad m => ParserK Char m String+-- lookbehind = do+--     x1 <- ParserK.adapt $+--              Digit <$> Parser.satisfy isDigit+--          <|> Alpha <$> Parser.satisfy isAlpha+--     -- Note: the parse depends on what we parsed already+--     x2 <- ParserK.adapt $+--           case x1 of+--              Digit _ -> Parser.satisfy isAlpha+--              Alpha _ -> Parser.satisfy isDigit+--     return $ case x1 of+--         Digit x -> [x,x2]+--         Alpha x -> [x,x2]+-- :}+--+-- == Experimental APIs+--+-- Please refer to "Streamly.Internal.Data.ParserK" for functions that have+-- not yet been released.+-- module Streamly.Data.ParserK     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Parser Type       ParserK      -- * Parsers     -- ** Conversions-    , fromFold-    , fromParser+    , adapt+    , adaptC+    , adaptCG     -- , toParser      -- ** Without Input     , fromPure     , fromEffect     , die++    -- * Deprecated+    , fromFold+    , fromParser     )  where  import Control.Monad.IO.Class (MonadIO) import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Unboxed (Unbox)-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.Data.Array (Array)+import qualified Streamly.Internal.Data.Parser as ParserD -import Streamly.Internal.Data.Parser.ParserK.Type+import Streamly.Internal.Data.ParserK.Type --- | Convert a 'Fold' to a 'ParserK'.---+#include "DocTestDataParserK.hs"++{-# DEPRECATED fromFold "Please use \"ParserK.adaptC . Parser.fromFold\" instead." #-} {-# INLINE fromFold #-}-fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK a m b-fromFold = fromParser . ParserD.fromFold+fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK (Array a) m b+fromFold = adaptC . ParserD.fromFold++{-# DEPRECATED fromParser "Please use \"adaptC\" instead." #-}+{-# INLINE fromParser #-}+fromParser ::+       (MonadIO m, Unbox a) => ParserD.Parser a m b -> ParserK (Array a) m b+fromParser = adaptC
src/Streamly/Data/Stream.hs view
@@ -8,15 +8,20 @@ -- Stability   : released -- Portability : GHC ----- Fast, composable stream producers with ability to terminate, supporting--- stream fusion.+-- Streams represented as state machines, that fuse together when composed+-- statically, eliminating function calls or intermediate constructor+-- allocations - generating tight, efficient loops. Suitable for high+-- performance looping operations. --+-- If you need to call these operations recursively in a loop (i.e. composed+-- dynamically) then it is recommended to use the continuation passing style+-- (CPS) stream operations from the "Streamly.Data.StreamK" module. 'Stream'+-- and 'StreamK' types are interconvertible.  See more details in the+-- documentation below regarding 'Stream' vs 'StreamK'.+-- -- Please refer to "Streamly.Internal.Data.Stream" for more functions that have -- not yet been released. ----- For continuation passing style (CPS) stream type, please refer to--- the "Streamly.Data.StreamK" module.--- -- Checkout the <https://github.com/composewell/streamly-examples> -- repository for many more real world examples of stream programming. @@ -37,15 +42,21 @@     -- * Construction     -- | Functions ending in the general shape @b -> Stream m a@.     ---    -- See also: "Streamly.Internal.Data.Stream.Generate" for-    -- @Pre-release@ functions.+    -- Useful Idioms:+    --+    -- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0+    -- >>> fromIndicesM f = Stream.mapM f $ Stream.enumerateFrom 0+    -- >>> fromListM = Stream.sequence . Stream.fromList+    -- >>> fromFoldable = StreamK.toStream . StreamK.fromFoldable+    -- >>> fromFoldableM = Stream.sequence . fromFoldable      -- ** Primitives-    -- | Primitives to construct a stream from pure values or monadic actions.-    -- All other stream construction and generation combinators described later-    -- can be expressed in terms of these primitives. However, the special-    -- versions provided in this module can be much more efficient in most-    -- cases. Users can create custom combinators using these primitives.+    -- | A fused 'Stream' is never constructed using these primitives, they are+    -- typically generated by converting containers like list into streams, or+    -- generated using custom functions provided in this module. The 'cons'+    -- primitive in this module has a rare use in fusing a small number of+    -- elements. On the other hand, it is common to construct 'StreamK' stream+    -- using the StreamK.'StreamK.cons' primitive.     , nil     , nilM     , cons@@ -103,8 +114,6 @@     -- | Functions ending in the general shape @Stream m a -> m b@ or @Stream m     -- a -> m (b, Stream m a)@     ---    -- See also: "Streamly.Internal.Data.Stream.Eliminate" for @Pre-release@-    -- functions.  -- EXPLANATION: In imperative terms a fold can be considered as a loop over the stream -- that reduces the stream to a single value.@@ -208,7 +217,16 @@     -- | Usually you can use the folds in "Streamly.Data.Fold". However, some     -- folds that may be commonly used or may have an edge in performance in     -- some cases are provided here.-    -- , drain+    --+    -- Useful idioms:+    --+    -- >>> foldlM' f a = Stream.fold (Fold.foldlM' f a)+    -- >>> foldl1 f = Stream.fold (Fold.foldl1' f)+    -- >>> foldl' f a = Stream.fold (Fold.foldl' f a)+    -- >>> drain = Stream.fold Fold.drain+    -- >>> mapM_ f = Stream.fold (Fold.drainMapM f)+    -- >>> length = Stream.fold Fold.length+    -- >>> head = Stream.fold Fold.one     , toList      -- * Mapping@@ -236,8 +254,6 @@     -- * Scanning     -- | Stateful one-to-one transformations.     ---    -- See also: "Streamly.Internal.Data.Stream.Transform" for-    -- @Pre-release@ functions.      {-     -- ** Left scans@@ -253,6 +269,14 @@     -}      -- ** Scanning By 'Fold'+    -- | Useful idioms:+    --+    -- >>> scanl' f z = Stream.scan (Fold.foldl' f z)+    -- >>> scanlM' f z = Stream.scan (Fold.foldlM' f z)+    -- >>> postscanl' f z = Stream.postscan (Fold.foldl' f z)+    -- >>> postscanlM' f z = Stream.postscan (Fold.foldlM' f z)+    -- >>> scanl1' f = Stream.catMaybes . Stream.scan (Fold.foldl1' f)+    -- >>> scanl1M' f = Stream.catMaybes . Stream.scan (Fold.foldlM1' f)     , scan     , postscan     -- XXX postscan1 can be implemented using Monoids or Refolds.@@ -298,6 +322,13 @@     -- filtering folds (folds returning a 'Maybe' type) in     -- "Streamly.Internal.Data.Fold" can be used along with 'scanMaybe' to     -- perform stateful filtering operations in general.+    --+    -- Useful idioms:+    --+    -- >>> deleteBy cmp x = Stream.scanMaybe (Fold.deleteBy cmp x)+    -- >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)+    -- >>> elemIndices a = findIndices (== a)+    -- >>> uniq = Stream.scanMaybe (Fold.uniqBy (==))     , scanMaybe     , take     , takeWhile@@ -326,32 +357,31 @@     -- , elemIndices      -- * Combining Two Streams+    -- | Note that these operations are suitable for statically fusing a few+    -- streams, they have a quadratic O(n^2) time complexity wrt to the number+    -- of streams. If you want to compose many streams dynamically using binary+    -- combining operations see the corresponding operations in+    -- "Streamly.Data.StreamK".+    --+    -- When fusing more than two streams it is more efficient if the binary+    -- operations are composed as a balanced tree rather than a right+    -- associative or left associative one e.g.:+    --+    -- >>> s1 = Stream.fromList [1,2] `Stream.append` Stream.fromList [3,4]+    -- >>> s2 = Stream.fromList [4,5] `Stream.append` Stream.fromList [6,7]+    -- >>> s = s1 `Stream.append` s2+     -- ** Appending     , append      -- ** Interleaving-    -- | When interleaving more than two streams you may want to interleave-    -- them pairwise creating a balanced binary merge tree.     , interleave      -- ** Merging-    -- | When merging more than two streams you may want to merging them-    -- pairwise creating a balanced binary merge tree.-    ---    -- Merging of @n@ streams can be performed by combining the streams pair-    -- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used-    -- with 'concatMapWith' it will have O(n^2) performance.-     , mergeBy     , mergeByM      -- ** Zipping-    -- | When zipping more than two streams you may want to zip them-    -- pairwise creating a balanced binary tree.-    ---    -- Zipping of @n@ streams can be performed by combining the streams pair-    -- wise using 'mergeMapWith' with O(n * log n) time complexity. If used-    -- with 'concatMapWith' it will have O(n^2) performance.     , zipWith     , zipWithM     -- , ZipStream (..)@@ -399,10 +429,21 @@     , concatMapM      -- * Repeated Fold+    -- | Useful idioms:+    --+    -- >>> splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)+    -- >>> splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)+    -- >>> groupsBy eq f = Stream.parseMany (Parser.groupBy eq f)+    -- >>> groupsByRolling eq f = Stream.parseMany (Parser.groupByRolling eq f)+    -- >>> groupsOf n f = Stream.foldMany (Fold.take n f)     , foldMany -- XXX Rename to foldRepeat+    , groupsOf     , parseMany-    , Array.chunksOf +    -- * Splitting+    , splitOn+    , wordsBy+     -- * Buffered Operations     -- | Operations that require buffering of the stream.     -- Reverse is essentially a left fold followed by an unfold.@@ -423,14 +464,20 @@     -- in Exception.Base      -- * Exceptions-    -- | Most of these combinators inhibit stream fusion, therefore, when+    -- | Note that the stream exception handling routines catch and handle+    -- exceptions only in the stream generation steps and not in the consumer+    -- of the stream. For example, if we are folding or parsing a stream - any+    -- exceptions in the fold or parse steps won't be observed by the stream+    -- exception handlers. Exceptions in the fold or parse steps can be handled+    -- using the fold or parse exception handling routines. You can wrap the+    -- stream elimination function in the monad exception handler to observe+    -- exceptions in the stream as well as the consumer.+    --+    -- Most of these combinators inhibit stream fusion, therefore, when     -- possible, they should be called in an outer loop to mitigate the cost.     -- For example, instead of calling them on a stream of chars call them on a     -- stream of arrays before flattening it to a stream of chars.     ---    -- See also: "Streamly.Internal.Data.Stream.Exception" for-    -- @Pre-release@ functions.-     , onException     , handle @@ -438,8 +485,19 @@     -- | 'bracket' is the most general resource management operation, all other     -- operations can be expressed using it. These functions have IO suffix     -- because the allocation and cleanup functions are IO actions. For-    -- generalized allocation and cleanup functions see the functions without+    -- generalized allocation and cleanup functions, see the functions without     -- the IO suffix in the "streamly" package.+    --+    -- Note that these operations bracket the stream generation only, they do+    -- not cover the stream consumer. This means if an exception occurs in+    -- the consumer of the stream (e.g. in a fold or parse step) then the+    -- exception won't be observed by the stream resource handlers, in that+    -- case the resource cleanup handler runs when the stream is garbage+    -- collected.+    --+    -- Monad level resource management can always be used around the stream+    -- elimination functions, such a function can observe exceptions in both+    -- the stream and its consumer.     , before     , afterIO     , finallyIO@@ -453,15 +511,14 @@     , runReaderT     , runStateT -    -- -- * Stream Types-    -- $serial-    -- , Interleave-    -- , Zip+    -- XXX Arrays could be different types, therefore, this should be in+    -- specific array module. Or maybe we should abstract over array types.+    -- * Stream of Arrays+    , Array.chunksOf     ) where -import qualified Streamly.Internal.Data.Array.Type as Array-import Streamly.Internal.Data.Stream.StreamD+import Streamly.Internal.Data.Stream import Prelude        hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,                foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem,@@ -469,6 +526,8 @@                reverse, iterate, init, and, or, lookup, foldr1, (!!),                scanl, scanl1, repeat, replicate, concatMap, span) +import qualified Streamly.Internal.Data.Array.Type as Array+ #include "DocTestDataStream.hs"  -- $overview@@ -506,11 +565,11 @@ -- -- == Stream Fusion ----- The fused 'Stream' type employs stream fusion for C-like performance when--- looping over data. It represents a stream source or transformation by--- defining a state machine with explicit state, and a step function working on--- the state. A typical stream operation consumes elements from the previous--- state machine in the pipeline, transforms them and yields new values for the+-- The fused 'Stream' type in this module employs stream fusion for C-like+-- performance when looping over data. It represents the stream as a state+-- machine using an explicit state, and a step function working on the state. A+-- typical stream operation consumes elements from the previous state machine+-- in a stream pipeline, transforms the elements and yields new values for the -- next stage to consume. The stream operations are modular and represent a -- single task, they have no knowledge of previous or next operation on the -- elements.@@ -519,7 +578,7 @@ -- transformation operations and a stream consumer. All these operations taken -- together form a closed loop processing the stream elements. Elements are -- transferred between stages using a boxed data constructor. However, all the--- stages of the pipeline are fused together by GHC, eliminating the+-- stages of the pipeline are fused together by GHC, eliminating the boxing of -- intermediate constructors, and thus forming a tight C like loop without any -- boxed data being used in the loop. --@@ -534,48 +593,45 @@ -- -- == Stream vs StreamK ----- The fused stream model avoids constructor allocations or function call--- overheads. However, the stream is represented as a state machine and to--- generate elements it has to navigate the decision tree of the state machine.--- Moreover, the state machine is cranked for each element in the stream. This--- performs extremely well when the number of states are limited. The state--- machine starts getting expensive as the number of states increase. For--- example, generating a million element stream from a list requires a single--- state and is very efficient. However, using fused 'cons' to generate a--- million element stream would be a disaster.+-- The fused stream model avoids constructor allocations and function call+-- overheads. However, the stream is represented as a state machine, and to+-- generate stream elements it has to navigate the decision tree of the state+-- machine. Moreover, the state machine is cranked for each element in the+-- stream. This performs extremely well when the number of states are limited.+-- The state machine starts getting expensive as the number of states increase.+-- For example, generating a stream from a list requires a single state and is+-- very efficient, even if it has millions of elements. However, using 'cons'+-- to construct a million element stream would be a disaster. -- -- A typical worst case scenario for fused stream model is a large number of -- `cons` or `append` operations. A few static `cons` or `append` operations--- are very fast and much faster than a CPS style stream. However, if we--- construct a large stream using `cons` it introduces as many states in the--- state machine as the number of elements. If we compose the `cons` as a--- binary tree it will take @n * log n@ time to navigate the tree, and @n * n@--- if it is a right associative composition.+-- are very fast and much faster than a CPS style stream because CPS involves a+-- function call for each element whereas fused stream involves a few+-- conditional branches in the state machine. However, constructing a large+-- stream using `cons` introduces as many states in the state machine as the+-- number of elements. If we compose `cons` as a balanced binary tree it will+-- take @n * log n@ time to navigate the tree, and @n * n@ if it is a right+-- associative composition. ----- For quadratic cases of fused stream, after a certain threshold the CPS--- stream would perform much better and exhibit linear performance behavior. -- Operations like 'cons' or 'append'; are typically recursively called to -- construct a lazy infinite stream. For such use cases the CPS style 'StreamK'--- type is provided. CPS streams do not have a state machine that needs to be+-- should be used. CPS streams do not have a state machine that needs to be -- cranked for each element, past state has no effect on the future element--- processing. However, it incurs a function call overhead for each operation--- for each element, which could be very large overhead compared to fused state--- machines even if it has many states and cranks it for each element. But in--- some cases scales tip in favor of the CPS stream. In those cases even though--- CPS has a large constant overhead, it has a linear performance rather than--- quadratic.+-- processing. However, CPS incurs a function call overhead for each element+-- processed, the overhead could be large compared to a fused state machine+-- even if it has many states. However, because of its linear performance+-- characterstics, after a certain threshold of stream compositions the CPS+-- stream would perform much better than the quadratic fused stream operations. ----- As a general guideline, if you have to use 'cons' or 'append' or operations--- of similar nature, at a large scale, then 'StreamK' should be used. When you--- need to compose the stream dynamically or recursively, then 'StreamK' should--- be used. Typically you would use a dynamically generated 'StreamK' with--- chunks of data which can then be processed by statically fused stream--- pipeline operations.+-- As a general guideline, you need to use 'StreamK' when you have to use+-- 'cons', 'append' or other operations having quadratic complexity at a large+-- scale. Typically, in such cases you need to compose the stream recursively,+-- by calling an operation in a loop. The decision to compose the stream is+-- taken at run time rather than statically at compile time. --+-- Typically you would compose a 'StreamK' of chunks of data so that the+-- StreamK overhead is not high, and then process  the chunks using 'Stream' by+-- using statically fused stream pipeline operations on the chunks.+-- -- 'Stream' and 'StreamK' types can be interconverted. See -- "Streamly.Data.StreamK" module for conversion operations.------ == Useful Idioms------ >>> fromListM = Stream.sequence . Stream.fromList--- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0
− src/Streamly/Data/Stream/Zip.hs 
@@ -1,16 +0,0 @@--- |--- Module      : Streamly.Data.Stream.Zip--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : released--- Portability : GHC----module Streamly.Data.Stream.Zip-    (-      ZipStream (..)-    )-where--import Streamly.Internal.Data.Stream.Zip
src/Streamly/Data/StreamK.hs view
@@ -8,12 +8,30 @@ -- Stability   : released -- Portability : GHC ----- Streams using Continuation Passing Style (CPS). See the @Stream vs StreamK@--- section in the "Streamly.Data.Stream" module to know when to use this--- module.+-- Streams represented as chains of functions calls using Continuation Passing+-- Style (CPS), suitable for dynamically composing potentially large number of+-- streams. ----- Please refer to "Streamly.Internal.Data.Stream.StreamK" for more functions--- that have not yet been released.+-- Unlike the statically fused operations in "Streamly.Data.Stream", StreamK+-- operations are less efficient, involving a function call overhead for each+-- element, but they exhibit linear O(n) time complexity wrt to the number of+-- stream compositions. Therefore, they are suitable for dynamically composing+-- streams e.g. appending potentially infinite streams in recursive loops.+-- While fused streams can be used to efficiently process elements as small as+-- a single byte, CPS streams are typically used on bigger chunks of data to+-- avoid the larger overhead per element. For more details See the @Stream vs+-- StreamK@ section in the "Streamly.Data.Stream" module.+--+-- In addition to the combinators in this module, you can use operations from+-- "Streamly.Data.Stream" for StreamK as well by converting StreamK to Stream+-- ('toStream'), and vice-versa ('fromStream'). Please refer to+-- "Streamly.Internal.Data.StreamK" for more functions that have not yet been+-- released.+--+-- For documentation see the corresponding combinators in+-- "Streamly.Data.Stream". Documentation has been omitted in this module unless+-- there is a difference worth mentioning or if the combinator does not exist+-- in "Streamly.Data.Stream".  -- Notes: --@@ -44,6 +62,11 @@      -- * Construction     -- ** Primitives+    -- | Primitives to construct a stream from pure values or monadic actions.+    -- All other stream construction and generation combinators described later+    -- can be expressed in terms of these primitives. However, the special+    -- versions provided in this module can be much more efficient in some+    -- cases. Users can create custom combinators using these primitives.     , nil     , nilM     , cons@@ -54,6 +77,8 @@     , fromEffect      -- ** From Stream+    -- | Please note that 'Stream' type does not observe any exceptions from+    -- the consumer of the stream whereas 'StreamK' does.     , fromStream     , toStream @@ -70,7 +95,8 @@     -- , foldBreak      -- ** Parsing-    -- , parseBreak+    , parse+    , parseBreak     , parseBreakChunks     , parseChunks @@ -80,6 +106,11 @@     , take      -- * Combining Two Streams+    -- | Unlike the operations in "Streamly.Data.Stream", these operations can+    -- be used to dynamically compose large number of streams e.g. using the+    -- 'concatMapWith' and 'mergeMapWith' operations. They have a linear O(n)+    -- time complexity wrt to the number of streams being composed.+     -- ** Appending     , append @@ -103,6 +134,12 @@     -- , CrossStreamK (..)      -- * Stream of streams+    -- | Some useful idioms:+    --+    -- >>> concatFoldableWith f = Prelude.foldr f StreamK.nil+    -- >>> concatMapFoldableWith f g = Prelude.foldr (f . g) StreamK.nil+    -- >>> concatForFoldableWith f xs g = Prelude.foldr (f . g) StreamK.nil xs+    --     , concatEffect     -- , concatMap     , concatMapWith@@ -111,10 +148,20 @@     -- * Buffered Operations     , reverse     , sortBy++    -- * Exceptions+    -- | Please note that 'Stream' type does not observe any exceptions from+    -- the consumer of the stream whereas 'StreamK' does.+    , handle++    -- * Resource Management+    -- | Please note that 'Stream' type does not observe any exceptions from+    -- the consumer of the stream whereas 'StreamK' does.+    , bracketIO     ) where -import Streamly.Internal.Data.Stream.StreamK+import Streamly.Internal.Data.StreamK import Prelude hiding (reverse, zipWith, mapM, dropWhile, take)  #include "DocTestDataStreamK.hs"@@ -145,9 +192,3 @@ -- 1 -- 2 -- [1,2]------ == Exception Handling------ There are no native exception handling operations in the StreamK module,--- please convert to 'Stream' type and use exception handling operations from--- "Streamly.Data.Stream".
src/Streamly/Data/Unfold.hs view
@@ -53,6 +53,9 @@     , replicateM     , iterateM +    -- ** Enumeration+    , Enumerable (..)+     -- ** From Containers     , fromList     , fromListM@@ -62,6 +65,8 @@     -- ** Mapping on Input     , lmap     , lmapM+    , first+    , second      -- ** Mapping on Output     , mapM
src/Streamly/FileSystem/Handle.hs view
@@ -1,4 +1,4 @@-#include "inline.hs"+{-# LANGUAGE CPP #-}  -- | -- Module      : Streamly.FileSystem.Handle@@ -40,6 +40,12 @@ -- module Streamly.FileSystem.Handle     (+     -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Singleton IO     -- | Read or write a single buffer.       getChunk@@ -75,13 +81,13 @@     -- position of the file handle. The stream ends as soon as EOF is     -- encountered. -    -- -- *** Streams-    -- , read-    -- , readWith-    -- , readChunks-    -- , readChunksWith+    -- *** Streams+    , read+    , readWith+    , readChunks+    , readChunksWith -    -- -- *** Unfolds+    -- *** Unfolds     , reader     , readerWith     , chunkReader@@ -98,34 +104,14 @@     , writeChunks       -- * Deprecated-    , read     , readWithBufferOf-    , readChunks     , readChunksWithBufferOf     , writeChunksWithBufferOf     , writeWithBufferOf     ) where -import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Unfold.Type (Unfold)-import System.IO (Handle)--import Streamly.Internal.FileSystem.Handle hiding (read, readChunks)+import Streamly.Internal.FileSystem.Handle import Prelude hiding (read) --- | Same as 'reader'----{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE read #-}-read :: MonadIO m => Unfold m Handle Word8-read = reader---- | Same as 'chunkReader'----{-# DEPRECATED readChunks "Please use 'chunkReader' instead" #-}-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Handle (Array Word8)-readChunks = chunkReader+#include "DocTestFileSystemHandle.hs"
src/Streamly/Internal/Console/Stdio.hs view
@@ -47,12 +47,12 @@ import Prelude hiding (read)  import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Unfold (Unfold) import Streamly.Internal.Data.Fold (Fold)  import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Stream as Stream     (intersperseMSuffix) import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Streamly.Internal.FileSystem.Handle as Handle
src/Streamly/Internal/Data/Array.hs view
@@ -17,42 +17,24 @@     -- $design      -- * The Array Type-      Array+      module Streamly.Internal.Data.Array.Type      -- * Construction--    -- Pure List APIs-    , A.fromListN-    , A.fromList-     -- Stream Folds     , fromStreamN     , fromStream      -- Monadic Folds-    , A.writeN      -- drop new-    , A.writeNAligned-    , A.write       -- full buffer     , writeLastN -    -- * Elimination-    -- ** Conversion-    , A.toList--    -- ** Streams-    , A.read-    , A.readRev--    -- ** Unfolds+    -- * Unfolds     , reader     , readerUnsafe-    , A.readerRev     , producer -- experimental      -- * Random Access     -- , (!!)     , getIndex-    , A.unsafeIndex -- XXX Rename to getIndexUnsafe??     , getIndexRev     , last           -- XXX getIndexLast?     , getIndices@@ -64,7 +46,6 @@     -- , getIndicesUptoRev  -- read from end to the given position in file      -- * Size-    , length     , null      -- * Search@@ -77,10 +58,7 @@     , cast     , asBytes     , castUnsafe-    , asPtrUnsafe     , asCStringUnsafe-    , A.unsafeFreeze -- asImmutableUnsafe?-    , A.unsafeThaw   -- asMutableUnsafe?      -- * Subarrays     , getSliceUnsafe@@ -92,20 +70,22 @@     -- * Streaming Operations     , streamTransform -    -- ** Folding+    -- * Folding     , streamFold     , fold -    -- * Deprecated-    , A.toStream-    , A.toStreamRev+    -- * Serialization+    , encodeAs+    , serialize+    , pinnedSerialize+    , deserialize     ) where +#include "assert.hs" #include "inline.hs" #include "ArrayMacros.h" -import Control.Exception (assert) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import Data.Functor.Identity (Identity)@@ -114,34 +94,32 @@ import Foreign.C.String (CString) import Foreign.Ptr (castPtr) import Foreign.Storable (Storable)-import Streamly.Internal.Data.Unboxed-    ( Unbox-    , peekWith-    , sizeOf-    )+import Streamly.Internal.Data.Unbox (Unbox(..)) import Prelude hiding (length, null, last, map, (!!), read, concat) -import Streamly.Internal.Data.Array.Mut.Type (ArrayUnsafe(..))-import Streamly.Internal.Data.Array.Type-    (Array(..), length, asPtrUnsafe)+import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..))+import Streamly.Internal.Data.Serialize.Type (Serialize) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) -import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Mut as MA+import qualified Streamly.Internal.Data.Serialize.Type as Serialize+import qualified Streamly.Internal.Data.MutByteArray.Type as MBA+import qualified Streamly.Internal.Data.MutArray as MA import qualified Streamly.Internal.Data.Array.Type as A import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Producer.Type as Producer import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Ring.Unboxed as RB-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamD as Stream+import qualified Streamly.Internal.Data.Ring as RB+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.Unfold as Unfold +import Streamly.Internal.Data.Array.Type+ #include "DocTestDataArray.hs"  -- $design@@ -239,13 +217,12 @@             --             -- This should be safe as the array contents are guaranteed to be             -- evaluated/written to before we peek at them.-            let !x = unsafeInlineIO $ peekWith contents p+            let !x = unsafeInlineIO $ peekAt p contents             let !p1 = INDEX_NEXT(p,a)             return $ D.Yield x (ArrayUnsafe contents end p1)  -- | ----- >>> import qualified Streamly.Internal.Data.Array.Type as Array -- >>> null arr = Array.byteLength arr == 0 -- -- /Pre-release/@@ -263,12 +240,11 @@         $ do                 let elemPtr = RINDEX_OF(arrEnd arr, i, a)                 if i >= 0 && elemPtr >= arrStart arr-                then Just <$> peekWith (arrContents arr) elemPtr+                then Just <$> peekAt elemPtr (arrContents arr)                 else return Nothing  -- | ----- >>> import qualified Streamly.Internal.Data.Array as Array -- >>> last arr = Array.getIndexRev arr 0 -- -- /Pre-release/@@ -288,7 +264,7 @@        (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a) writeLastN n     | n <= 0 = fmap (const mempty) FL.drain-    | otherwise = A.unsafeFreeze <$> Fold step initial done+    | otherwise = A.unsafeFreeze <$> Fold step initial done done      where @@ -301,7 +277,7 @@          in fmap f $ liftIO $ RB.new n      done (Tuple3Fused' rb rh i) = do-        arr <- liftIO $ MA.newPinned n+        arr <- liftIO $ MA.new n         foldFunc i rh snoc' arr rb      -- XXX We should write a read unfold for ring.@@ -425,7 +401,7 @@         $ do                 let elemPtr = INDEX_OF(arrStart arr, i, a)                 if i >= 0 && INDEX_VALID(elemPtr, arrEnd arr, a)-                then Just <$> peekWith (arrContents arr) elemPtr+                then Just <$> peekAt elemPtr (arrContents arr)                 else return Nothing  -- | Given a stream of array indices, read the elements on those indices from@@ -538,7 +514,9 @@         then Nothing         else Just $ castUnsafe arr --- | Convert an array of any type into a null terminated CString Ptr.+-- | Convert an array of any type into a null terminated CString Ptr.  If the+-- array is unpinned it is first converted to a pinned array which requires a+-- copy. -- -- /Unsafe/ --@@ -548,8 +526,8 @@ -- asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b asCStringUnsafe arr act = do-    -- XXX Ensure a pinned allocation here.     let arr1 = asBytes arr <> A.fromList [0]+    -- asPtrUnsafe makes sure the array is pinned     asPtrUnsafe arr1 $ \ptr -> act (castPtr ptr)  -------------------------------------------------------------------------------@@ -571,3 +549,39 @@ {-# INLINE streamFold #-} streamFold :: (Monad m, Unbox a) => (Stream m a -> m b) -> Array a -> m b streamFold f arr = f (A.read arr)++--------------------------------------------------------------------------------+-- Serialization+--------------------------------------------------------------------------------++{-# INLINE encodeAs #-}+encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8+encodeAs ps a =+    unsafeInlineIO $ do+        let len = Serialize.addSizeTo 0 a+        mbarr <- MBA.newBytesAs ps len+        off <- Serialize.serializeAt 0 mbarr a+        assertM(len == off)+        pure $ Array mbarr 0 off++{-# INLINE serialize #-}+serialize :: Serialize a => a -> Array Word8+serialize = encodeAs Unpinned++-- | Serialize a Haskell type to a pinned byte array. The array is allocated+-- using pinned memory so that it can be used directly in OS APIs for writing+-- to file or sending over the network.+{-# INLINE pinnedSerialize #-}+pinnedSerialize :: Serialize a => a -> Array Word8+pinnedSerialize = encodeAs Pinned++-- | Decode a Haskell type from a byte array containing its serialized+-- representation.+{-# INLINE deserialize #-}+deserialize :: Serialize a => Array Word8 -> a+deserialize arr@(Array {..}) = unsafeInlineIO $ do+    let lenArr = length arr+    (off, val) <-+        Serialize.deserializeAt arrStart arrContents (arrStart + lenArr)+    assertM(off == arrStart + lenArr)+    pure val
src/Streamly/Internal/Data/Array/Generic.hs view
@@ -4,7 +4,6 @@ -- -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com--- Stability   : pre-release -- Portability : GHC -- module Streamly.Internal.Data.Array.Generic@@ -19,10 +18,14 @@      , fromStreamN     , fromStream+    , fromPureStream+    , fromByteStr#      , fromListN     , fromList +    , chunksOf+     -- * Elimination     , length     , reader@@ -38,6 +41,7 @@      -- * Random Access     , getIndexUnsafe+    , getIndex     , getSliceUnsafe     , strip     )@@ -47,25 +51,28 @@  import Control.Monad (replicateM) import Control.Monad.IO.Class (MonadIO)+import Data.Functor.Identity (Identity(..))+import Data.Word (Word8) import GHC.Base (MutableArray#, RealWorld)+import GHC.Exts (Addr#) import GHC.IO (unsafePerformIO) import Text.Read (readPrec)  import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)+import Streamly.Internal.Data.Stream.Type (Stream) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) -import qualified Streamly.Internal.Data.Array.Generic.Mut.Type as MArray+import qualified Streamly.Internal.Data.MutArray.Generic as MArray import qualified Streamly.Internal.Data.Fold.Type as FL import qualified Streamly.Internal.Data.Producer.Type as Producer import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Ring as RB-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D+import qualified Streamly.Internal.Data.Ring.Generic as RB+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Generate as D import qualified Text.ParserCombinators.ReadPrec as ReadPrec -import Prelude hiding (foldr, length, read)+import Prelude hiding (Foldable(..), read)  ------------------------------------------------------------------------------- -- Array Data Type@@ -113,7 +120,25 @@ write :: MonadIO m => Fold m a (Array a) write = fmap unsafeFreeze MArray.write +fromPureStream :: Stream Identity a -> Array a+fromPureStream x =+    unsafePerformIO $ fmap (unsafeFreeze) (MArray.fromPureStream x)+-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)+-- fromPureStream = fromList . runIdentity . D.toList++fromByteStr# :: Addr# -> Array Word8+fromByteStr# addr = fromPureStream (D.fromByteStr# addr)+ -------------------------------------------------------------------------------+-- Stream Ops+-------------------------------------------------------------------------------++{-# INLINE_NORMAL chunksOf #-}+chunksOf :: forall m a. MonadIO m+    => Int -> Stream m a -> Stream m (Array a)+chunksOf n strm = fmap unsafeFreeze $ MArray.chunksOf n strm++------------------------------------------------------------------------------- -- Construction - from streams ------------------------------------------------------------------------------- @@ -208,6 +233,26 @@ getIndexUnsafe i arr =     unsafePerformIO $ MArray.getIndexUnsafe i (unsafeThaw arr) +-- | Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: Int -> Array a -> Maybe a+getIndex i arr@Array {..} =+    if i >= 0 && i < arrLen+    then Just $ getIndexUnsafe i arr+    else Nothing++-- >>> import qualified Streamly.Data.Stream as Stream+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Array.Generic as Array+-- >>> import Data.Function ((&))+-- >>> :{+--  Stream.fromList [1,2,3,4,5::Int]+--      & Stream.scan (Array.writeLastN 2)+--      & Stream.fold Fold.toList+--  :}+-- [fromList [],fromList [1],fromList [1,2],fromList [2,3],fromList [3,4],fromList [4,5]]+-- {-# INLINE writeLastN #-} writeLastN :: MonadIO m => Int -> Fold m a (Array a) writeLastN n = FL.rmapM f (RB.writeLastN n)@@ -215,7 +260,7 @@     where      f rb = do-        arr <- RB.toMutArray 0 n rb+        arr <- RB.copyToMutArray 0 n rb         return $ unsafeFreeze arr  {-# INLINE getSliceUnsafe #-}
− src/Streamly/Internal/Data/Array/Generic/Mut/Type.hs 
@@ -1,796 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnboxedTuples #-}--- |--- Module      : Streamly.Internal.Data.Array.Generic.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Generic.Mut.Type-(-    -- * Type-    -- $arrayNotes-      MutArray (..)--    -- * Constructing and Writing-    -- ** Construction-    , nil--    -- *** Uninitialized Arrays-    , new-    -- , newArrayWith--    -- *** From streams-    , writeNUnsafe-    , writeN-    , writeWith-    , write--    -- , writeRevN-    -- , writeRev--    -- ** From containers-    -- , fromListN-    -- , fromList-    -- , fromStreamDN-    -- , fromStreamD--    -- * Random writes-    , putIndex-    , putIndexUnsafe-    , putIndices-    -- , putFromThenTo-    -- , putFrom -- start writing at the given position-    -- , putUpto -- write from beginning up to the given position-    -- , putFromTo-    -- , putFromRev-    -- , putUptoRev-    , modifyIndexUnsafe-    , modifyIndex-    -- , modifyIndices-    -- , modify-    -- , swapIndices--    -- * Growing and Shrinking-    -- Arrays grow only at the end, though it is possible to grow on both sides-    -- and therefore have a cons as well as snoc. But that will require two-    -- bounds in the array representation.--    -- ** Reallocation-    , realloc-    , uninit--    -- ** Appending elements-    , snocWith-    , snoc-    -- , snocLinear-    -- , snocMay-    , snocUnsafe--    -- ** Appending streams-    -- , writeAppendNUnsafe-    -- , writeAppendN-    -- , writeAppendWith-    -- , writeAppend--    -- ** Truncation-    -- These are not the same as slicing the array at the beginning, they may-    -- reduce the length as well as the capacity of the array.-    -- , truncateWith-    -- , truncate-    -- , truncateExp--    -- * Eliminating and Reading--    -- ** Unfolds-    , reader-    -- , readerRev-    , producerWith -- experimental-    , producer -- experimental--    -- ** To containers-    , toStreamD-    , readRev-    , toStreamK-    -- , toStreamKRev-    , toList--    -- ** Random reads-    , getIndex-    , getIndexUnsafe-    -- , getIndices-    -- , getFromThenTo-    -- , getIndexRev--    -- * Size-    , length--    -- * In-place Mutation Algorithms-    , strip-    -- , reverse-    -- , permute-    -- , partitionBy-    -- , shuffleBy-    -- , divideBy-    -- , mergeBy--    -- * Folding-    -- , foldl'-    -- , foldr-    , cmp-    , eq--    -- * Arrays of arrays-    --  We can add dimensionality parameter to the array type to get-    --  multidimensional arrays. Multidimensional arrays would just be a-    --  convenience wrapper on top of single dimensional arrays.--    -- | Operations dealing with multiple arrays, streams of arrays or-    -- multidimensional array representations.--    -- ** Construct from streams-    -- , chunksOf-    -- , arrayStreamKFromStreamD-    -- , writeChunks--    -- ** Eliminate to streams-    -- , flattenArrays-    -- , flattenArraysRev-    -- , fromArrayStreamK--    -- ** Construct from arrays-    -- get chunks without copying-    , getSliceUnsafe-    , getSlice-    -- , getSlicesFromLenN-    -- , splitAt -- XXX should be able to express using getSlice-    -- , breakOn--    -- ** Appending arrays-    -- , spliceCopy-    -- , spliceWith-    -- , splice-    -- , spliceExp-    , putSliceUnsafe-    -- , appendSlice-    -- , appendSliceFrom--    , clone-    )-where--#include "inline.hs"-#include "assert.hs"--import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import GHC.Base-    ( MutableArray#-    , RealWorld-    , copyMutableArray#-    , newArray#-    , readArray#-    , writeArray#-    )-import GHC.IO (IO(..))-import GHC.Int (Int(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer (..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import Prelude hiding (read, length)--#include "DocTestDataMutArrayGeneric.hs"------------------------------------------------------------------------------------ MutArray Data Type----------------------------------------------------------------------------------data MutArray a =-    MutArray-        { arrContents# :: MutableArray# RealWorld a-          -- ^ The internal contents of the array representing the entire array.--        , arrStart :: {-# UNPACK #-}!Int-          -- ^ The starting index of this slice.--        , arrLen :: {-# UNPACK #-}!Int-          -- ^ The length of this slice.--        , arrTrueLen :: {-# UNPACK #-}!Int-          -- ^ This is the true length of the array. Coincidentally, this also-          -- represents the first index beyond the maximum acceptable index of-          -- the array. This is specific to the array contents itself and not-          -- dependent on the slice. This value should not change and is shared-          -- across all the slices.-        }--{-# INLINE bottomElement #-}-bottomElement :: a-bottomElement =-    error-        $ unwords-              [ funcName-              , "This is the bottom element of the array."-              , "This is a place holder and should never be reached!"-              ]--    where--    funcName = "Streamly.Internal.Data.Array.Generic.Mut.Type.bottomElement:"---- XXX Would be nice if GHC can provide something like newUninitializedArray# so--- that we do not have to write undefined or error in the whole array.---- | @new count@ allocates a zero length array that can be extended to hold--- up to 'count' items without reallocating.------ /Pre-release/-{-# INLINE new #-}-new :: MonadIO m => Int -> m (MutArray a)-new n@(I# n#) =-    liftIO-        $ IO-        $ \s# ->-              case newArray# n# bottomElement s# of-                  (# s1#, arr# #) ->-                      let ma = MutArray arr# 0 0 n-                       in (# s1#, ma #)---- XXX This could be pure?---- |--- Definition:------ >>> nil = MutArray.new 0-{-# INLINE nil #-}-nil :: MonadIO m => m (MutArray a)-nil = new 0------------------------------------------------------------------------------------ Random writes------------------------------------------------------------------------------------ | Write the given element to the given index of the array. Does not check if--- the index is out of bounds of the array.------ /Pre-release/-{-# INLINE putIndexUnsafe #-}-putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()-putIndexUnsafe i MutArray {..} x =-    assert (i >= 0 && i < arrLen)-    (liftIO-        $ IO-        $ \s# ->-              case i + arrStart of-                  I# n# ->-                      let s1# = writeArray# arrContents# n# x s#-                       in (# s1#, () #))--invalidIndex :: String -> Int -> a-invalidIndex label i =-    error $ label ++ ": invalid array index " ++ show i---- | /O(1)/ Write the given element at the given index in the array.--- Performs in-place mutation of the array.------ >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))------ /Pre-release/-{-# INLINE putIndex #-}-putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()-putIndex i arr@MutArray {..} x =-    if i >= 0 && i < arrLen-    then putIndexUnsafe i arr x-    else invalidIndex "putIndex" i---- | Write an input stream of (index, value) pairs to an array. Throws an--- error if any index is out of bounds.------ /Pre-release/-{-# INLINE putIndices #-}-putIndices :: MonadIO m-    => MutArray a -> Fold m (Int, a) ()-putIndices arr = FL.foldlM' step (return ())--    where--    step () (i, x) = liftIO (putIndex i arr x)---- | Modify a given index of an array using a modifier function without checking--- the bounds.------ Unsafe because it does not check the bounds of the array.------ /Pre-release/-modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndexUnsafe i MutArray {..} f = do-    liftIO-        $ IO-        $ \s# ->-              case i + arrStart of-                  I# n# ->-                      case readArray# arrContents# n# s# of-                          (# s1#, a #) ->-                              let (a1, b) = f a-                                  s2# = writeArray# arrContents# n# a1 s1#-                               in (# s2#, b #)---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndex i arr@MutArray {..} f = do-    if i >= 0 && i < arrLen-    then modifyIndexUnsafe i arr f-    else invalidIndex "modifyIndex" i------------------------------------------------------------------------------------ Resizing------------------------------------------------------------------------------------ | Reallocates the array according to the new size. This is a safe function--- that always creates a new array and copies the old array into the new one.--- If the reallocated size is less than the original array it results in a--- truncated version of the original array.----realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)-realloc n arr = do-    arr1 <- new n-    let !newLen@(I# newLen#) = min n (arrLen arr)-        !(I# arrS#) = arrStart arr-        !(I# arr1S#) = arrStart arr1-        arrC# = arrContents# arr-        arr1C# = arrContents# arr1-    liftIO-        $ IO-        $ \s# ->-              let s1# = copyMutableArray# arrC# arrS# arr1C# arr1S# newLen# s#-               in (# s1#, arr1 {arrLen = newLen, arrTrueLen = n} #)--reallocWith ::-       MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)-reallocWith label sizer reqSize arr = do-    let oldSize = arrLen arr-        newSize = sizer oldSize-        safeSize = max newSize (oldSize + reqSize)-    assert (newSize >= oldSize + reqSize || error badSize) (return ())-    realloc safeSize arr--    where--    badSize = concat-        [ label-        , ": new array size is less than required size "-        , show reqSize-        , ". Please check the sizing function passed."-        ]------------------------------------------------------------------------------------ Snoc------------------------------------------------------------------------------------ XXX Not sure of the behavior of writeArray# if we specify an index which is--- out of bounds. This comment should be rewritten based on that.--- | Really really unsafe, appends the element into the first array, may--- cause silent data corruption or if you are lucky a segfault if the index--- is out of bounds.------ /Internal/-{-# INLINE snocUnsafe #-}-snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)-snocUnsafe arr@MutArray {..} a = do-    assert (arrStart + arrLen < arrTrueLen) (return ())-    let arr1 = arr {arrLen = arrLen + 1}-    putIndexUnsafe arrLen arr1 a-    return arr1---- NOINLINE to move it out of the way and not pollute the instruction cache.-{-# NOINLINE snocWithRealloc #-}-snocWithRealloc :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)-snocWithRealloc sizer arr x = do-    arr1 <- reallocWith "snocWithRealloc" sizer 1 arr-    snocUnsafe arr1 x---- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of--- the array increases by 1.------ If there is no reserved space available in @arr@ it is reallocated to a size--- in bytes determined by the @sizer oldSize@ function, where @oldSize@ is the--- original size of the array.------ Note that the returned array may be a mutated version of the original array.------ /Pre-release/-{-# INLINE snocWith #-}-snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)-snocWith sizer arr@MutArray {..} x = do-    if arrStart + arrLen < arrTrueLen-    then snocUnsafe arr x-    else snocWithRealloc sizer arr x---- XXX round it to next power of 2.---- | The array is mutated to append an additional element to it. If there is no--- reserved space available in the array then it is reallocated to double the--- original size.------ This is useful to reduce allocations when appending unknown number of--- elements.------ Note that the returned array may be a mutated version of the original array.------ >>> snoc = MutArray.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.------ /Pre-release/-{-# INLINE snoc #-}-snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)-snoc = snocWith (* 2)---- | Make the uninitialized memory in the array available for use extending it--- by the supplied length beyond the current length of the array. The array may--- be reallocated.----{-# INLINE uninit #-}-uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)-uninit arr@MutArray{..} len =-    if arrStart + arrLen + len <= arrTrueLen-    then return $ arr {arrLen = arrLen + len}-    else realloc (arrLen + len) arr------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a-getIndexUnsafe n MutArray {..} =-    liftIO-        $ IO-        $ \s# ->-              let !(I# i#) = arrStart + n-               in readArray# arrContents# i# s#---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: MonadIO m => Int -> MutArray a -> m a-getIndex i arr@MutArray {..} =-    if i >= 0 && i < arrLen-    then getIndexUnsafe i arr-    else invalidIndex "getIndex" i------------------------------------------------------------------------------------ Subarrays------------------------------------------------------------------------------------ XXX We can also get immutable slices.---- | /O(1)/ Slice an array in constant time.------ Unsafe: The bounds of the slice are not checked.------ /Unsafe/------ /Pre-release/-{-# INLINE getSliceUnsafe #-}-getSliceUnsafe-    :: Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSliceUnsafe index len arr@MutArray {..} =-    assert (index >= 0 && len >= 0 && index + len <= arrLen)-        $ arr {arrStart = arrStart + index, arrLen = len}---- | /O(1)/ Slice an array in constant time. Throws an error if the slice--- extends out of the array bounds.------ /Pre-release/-{-# INLINE getSlice #-}-getSlice-    :: Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSlice index len arr@MutArray{..} =-    if index >= 0 && len >= 0 && index + len <= arrLen-    then arr {arrStart = arrStart + index, arrLen = len}-    else error-             $ "getSlice: invalid slice, index "-             ++ show index ++ " length " ++ show len------------------------------------------------------------------------------------ to Lists and streams------------------------------------------------------------------------------------ XXX Maybe faster to create a list explicitly instead of mapM, if list fusion--- does not work well.---- | Convert an 'Array' into a list.------ /Pre-release/-{-# INLINE toList #-}-toList :: MonadIO m => MutArray a -> m [a]-toList arr@MutArray{..} = mapM (`getIndexUnsafe` arr) [0 .. (arrLen - 1)]---- | Use the 'read' unfold instead.------ @toStreamD = D.unfold read@------ We can try this if the unfold has any performance issues.-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: MonadIO m => MutArray a -> D.Stream m a-toStreamD arr@MutArray{..} =-    D.mapM (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)---- Check equivalence with StreamK.fromStream . toStreamD and remove-{-# INLINE toStreamK #-}-toStreamK :: MonadIO m => MutArray a -> K.StreamK m a-toStreamK arr@MutArray{..} = K.unfoldrM step 0--    where--    step i-        | i == arrLen = return Nothing-        | otherwise = do-            x <- getIndexUnsafe i arr-            return $ Just (x, i + 1)--{-# INLINE_NORMAL readRev #-}-readRev :: MonadIO m => MutArray a -> D.Stream m a-readRev arr@MutArray{..} =-    D.mapM (`getIndexUnsafe` arr)-        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ XXX deduplicate this across unboxed array and this module?---- | The default chunk size by which the array creation routines increase the--- size of the array when the array is grown linearly.-arrayChunkSize :: Int-arrayChunkSize = 1024---- | Like 'writeN' but does not check the array bounds when writing. The fold--- driver must not call the step function more than 'n' times otherwise it will--- corrupt the memory and crash. This function exists mainly because any--- conditional in the step function blocks fusion causing 10x performance--- slowdown.------ /Pre-release/-{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)-writeNUnsafe n = Fold step initial return--    where--    initial = FL.Partial <$> new (max n 0)--    step arr x = FL.Partial <$> snocUnsafe arr x---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'Array'.------ >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)------ /Pre-release/-{-# INLINE_NORMAL writeN #-}-writeN :: MonadIO m => Int -> Fold m a (MutArray a)-writeN n = FL.take n $ writeNUnsafe n---- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)--- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)--- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)---- | @writeWith minCount@ folds the whole input to a single array. The array--- starts at a size big enough to hold minCount elements, the size is doubled--- every time the array needs to be grown.------ /Caution! Do not use this on infinite streams./------ /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: MonadIO m => Int -> Fold m a (MutArray a)--- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)-writeWith elemCount = FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ new elemCount--    step arr@(MutArray _ start end bound) x-        | end == bound = do-        let oldSize = end - start-            newSize = max (oldSize * 2) 1-        arr1 <- liftIO $ realloc newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x--    -- extract = liftIO . rightSize-    extract = return---- | Fold the whole input to a single array.------ Same as 'writeWith' using an initial array size of 'arrayChunkSize' bytes--- rounded up to the element size.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: MonadIO m => Fold m a (MutArray a)-write = writeWith arrayChunkSize------------------------------------------------------------------------------------ Unfolds------------------------------------------------------------------------------------ | Resumable unfold of an array.----{-# INLINE_NORMAL producerWith #-}-producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a-producerWith liftio = Producer step inject extract--    where--    {-# INLINE inject #-}-    inject arr = return (arr, 0)--    {-# INLINE extract #-}-    extract (arr, i) =-        return $ arr {arrStart = arrStart arr + i, arrLen = arrLen arr - i}--    {-# INLINE_LATE step #-}-    step (arr, i)-        | assert (arrLen arr >= 0) (i == arrLen arr) = return D.Stop-    step (arr, i) = do-        x <- liftio $ getIndexUnsafe i arr-        return $ D.Yield x (arr, i + 1)---- | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: MonadIO m => Producer m (MutArray a) a-producer = producerWith liftIO---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: MonadIO m => Unfold m (MutArray a) a-reader = Producer.simplify producer------------------------------------------------------------------------------------- Appending arrays------------------------------------------------------------------------------------- | Put a sub range of a source array into a subrange of a destination array.--- This is not safe as it does not check the bounds.-{-# INLINE putSliceUnsafe #-}-putSliceUnsafe :: MonadIO m =>-    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()-putSliceUnsafe src srcStart dst dstStart len = liftIO $ do-    assertM(len <= arrLen dst)-    assertM(len <= arrLen src)-    let !(I# srcStart#) = srcStart + arrStart src-        !(I# dstStart#) = dstStart + arrStart dst-        !(I# len#) = len-    let arrS# = arrContents# src-        arrD# = arrContents# dst-    IO $ \s# -> (# copyMutableArray#-                    arrS# srcStart# arrD# dstStart# len# s#-                , () #)--{-# INLINE clone #-}-clone :: MonadIO m => MutArray a -> m (MutArray a)-clone src = liftIO $ do-    let len = arrLen src-    dst <- new len-    putSliceUnsafe src 0 dst 0 len-    return dst------------------------------------------------------------------------------------ Size----------------------------------------------------------------------------------{-# INLINE length #-}-length :: MutArray a -> Int-length = arrLen------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Compare the length of the arrays. If the length is equal, compare the--- lexicographical ordering of two underlying byte arrays otherwise return the--- result of length comparison.------ /Pre-release/-{-# INLINE cmp #-}-cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering-cmp a1 a2 =-    case compare lenA1 lenA2 of-        EQ -> loop (lenA1 - 1)-        x -> return x--    where--    lenA1 = length a1-    lenA2 = length a2--    loop i-        | i < 0 = return EQ-        | otherwise = do-            v1 <- getIndexUnsafe i a1-            v2 <- getIndexUnsafe i a2-            case compare v1 v2 of-                EQ -> loop (i - 1)-                x -> return x--{-# INLINE eq #-}-eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool-eq a1 a2 =-    if lenA1 == lenA2-    then loop (lenA1 - 1)-    else return False--    where--    lenA1 = length a1-    lenA2 = length a2--    loop i-        | i < 0 = return True-        | otherwise = do-            v1 <- getIndexUnsafe i a1-            v2 <- getIndexUnsafe i a2-            if v1 == v2-            then loop (i - 1)-            else return False--{-# INLINE strip #-}-strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)-strip p arr = liftIO $ do-    let lastIndex = length arr - 1-    indexR <- getIndexR lastIndex -- last predicate failing index-    if indexR < 0-    then nil-    else do-        indexL <- getIndexL 0 -- first predicate failing index-        if indexL == 0 && indexR == lastIndex-        then return arr-        else-           let newLen = indexR - indexL + 1-            in return $ getSliceUnsafe indexL newLen arr--    where--    getIndexR idx-        | idx < 0 = return idx-        | otherwise = do-            r <- getIndexUnsafe idx arr-            if p r-            then getIndexR (idx - 1)-            else return idx--    getIndexL idx = do-        r <- getIndexUnsafe idx arr-        if p r-        then getIndexL (idx + 1)-        else return idx
− src/Streamly/Internal/Data/Array/Mut.hs 
@@ -1,86 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Mut--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Mut-    (-      module Streamly.Internal.Data.Array.Mut.Type-    , splitOn-    , genSlicesFromLen-    , getSlicesFromLen-    , fromStream-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Unfold as Unfold--import Prelude hiding (foldr, length, read, splitAt)-import Streamly.Internal.Data.Array.Mut.Type---- | Split the array into a stream of slices using a predicate. The element--- matching the predicate is dropped.------ /Pre-release/-{-# INLINE splitOn #-}-splitOn :: (MonadIO m, Unbox a) =>-    (a -> Bool) -> MutArray a -> Stream m (MutArray a)-splitOn predicate arr =-    fmap (\(i, len) -> getSliceUnsafe i len arr)-        $ D.sliceOnSuffix predicate (toStreamD arr)---- | Generate a stream of array slice descriptors ((index, len)) of specified--- length from an array, starting from the supplied array index. The last slice--- may be shorter than the requested length depending on the array length.------ /Pre-release/-{-# INLINE genSlicesFromLen #-}-genSlicesFromLen :: forall m a. (Monad m, Unbox a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (MutArray a) (Int, Int)-genSlicesFromLen from len =-    let fromThenTo n = (from, from + len, n - 1)-        mkSlice n i = return (i, min len (n - i))-     in Unfold.lmap length-        $ Unfold.mapM2 mkSlice-        $ Unfold.lmap fromThenTo Unfold.enumerateFromThenTo---- | Generate a stream of slices of specified length from an array, starting--- from the supplied array index. The last slice may be shorter than the--- requested length depending on the array length.------ /Pre-release/-{-# INLINE getSlicesFromLen #-}-getSlicesFromLen :: forall m a. (Monad m, Unbox a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (MutArray a) (MutArray a)-getSlicesFromLen from len =-    let mkSlice arr (i, n) = return $ getSliceUnsafe i n arr-     in Unfold.mapM2 mkSlice (genSlicesFromLen from len)---- | Create an 'Array' from a stream. This is useful when we want to create a--- single array from a stream of unknown size. 'writeN' is at least twice--- as efficient when the size is already known.------ Note that if the input stream is too large memory allocation for the array--- may fail.  When the stream size is not known, `chunksOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)-fromStream = fromStreamD--- fromStream (Stream m) = P.fold write m
− src/Streamly/Internal/Data/Array/Mut/Stream.hs 
@@ -1,323 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Mut.Stream--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Combinators to efficiently manipulate streams of mutable arrays.----module Streamly.Internal.Data.Array.Mut.Stream-    (-    -- * Generation-      chunksOf--    -- * Compaction-    , packArraysChunksOf-    , SpliceState (..)-    , lpackArraysChunksOf-    , compact-    , compactLE-    , compactEQ-    , compactGE-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (when)-import Data.Bifunctor (first)-import Data.Proxy (Proxy(..))-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Array.Mut.Type (MutArray(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser (ParseError)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Internal.Data.Array.Mut.Type as MArray-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD---- | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ > chunksOf n = Stream.foldMany (MArray.writeN n)------ /Pre-release/-{-# INLINE chunksOf #-}-chunksOf :: (MonadIO m, Unbox a)-    => Int -> Stream m a -> Stream m (MutArray a)-chunksOf = MArray.chunksOf------------------------------------------------------------------------------------ Compact----------------------------------------------------------------------------------data SpliceState s arr-    = SpliceInitial s-    | SpliceBuffering s arr-    | SpliceYielding arr (SpliceState s arr)-    | SpliceFinish---- XXX This can be removed once compactLEFold/compactLE are implemented.------ | This mutates the first array (if it has space) to append values from the--- second one. This would work for immutable arrays as well because an--- immutable array never has space so a new array is allocated instead of--- mutating it.------ | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size. Note that if a single array is bigger than the--- specified size we do not split it to fit. When we coalesce multiple arrays--- if the size would exceed the specified size we do not coalesce therefore the--- actual array size may be less than the specified chunk size.------ @since 0.7.0-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)-packArraysChunksOf n (D.Stream step state) =-    D.Stream step' (SpliceInitial state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (SpliceInitial st) = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Mut.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"-        r <- step gst st-        case r of-            D.Yield arr s -> return $-                let len = MArray.byteLength arr-                 in if len >= n-                    then D.Skip (SpliceYielding arr (SpliceInitial s))-                    else D.Skip (SpliceBuffering s arr)-            D.Skip s -> return $ D.Skip (SpliceInitial s)-            D.Stop -> return D.Stop--    step' gst (SpliceBuffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                let len = MArray.byteLength buf + MArray.byteLength arr-                if len > n-                then return $-                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))-                else do-                    buf' <- if MArray.byteCapacity buf < n-                            then liftIO $ MArray.realloc n buf-                            else return buf-                    buf'' <- MArray.splice buf' arr-                    return $ D.Skip (SpliceBuffering s buf'')-            D.Skip s -> return $ D.Skip (SpliceBuffering s buf)-            D.Stop -> return $ D.Skip (SpliceYielding buf SpliceFinish)--    step' _ SpliceFinish = return D.Stop--    step' _ (SpliceYielding arr next) = return $ D.Yield arr next---- XXX Remove this once compactLEFold is implemented--- lpackArraysChunksOf = Fold.many compactLEFold----{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()-lpackArraysChunksOf n (Fold step1 initial1 extract1) =-    Fold step initial extract--    where--    initial = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Mut.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"--        r <- initial1-        return $ first (Tuple' Nothing) r--    extract (Tuple' Nothing r1) = extract1 r1-    extract (Tuple' (Just buf) r1) = do-        r <- step1 r1 buf-        case r of-            FL.Partial rr -> extract1 rr-            FL.Done _ -> return ()--    step (Tuple' Nothing r1) arr =-            let len = MArray.byteLength arr-             in if len >= n-                then do-                    r <- step1 r1 arr-                    case r of-                        FL.Done _ -> return $ FL.Done ()-                        FL.Partial s -> do-                            extract1 s-                            res <- initial1-                            return $ first (Tuple' Nothing) res-                else return $ FL.Partial $ Tuple' (Just arr) r1--    step (Tuple' (Just buf) r1) arr = do-            let len = MArray.byteLength buf + MArray.byteLength arr-            buf' <- if MArray.byteCapacity buf < len-                    then liftIO $ MArray.realloc (max n len) buf-                    else return buf-            buf'' <- MArray.splice buf' arr--            -- XXX this is common in both the equations of step-            if len >= n-            then do-                r <- step1 r1 buf''-                case r of-                    FL.Done _ -> return $ FL.Done ()-                    FL.Partial s -> do-                        extract1 s-                        res <- initial1-                        return $ first (Tuple' Nothing) res-            else return $ FL.Partial $ Tuple' (Just buf'') r1---- XXX Same as compactLE, to be removed once that is implemented.------ | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ /Internal/-{-# INLINE compact #-}-compact :: (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compact = packArraysChunksOf---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size. Note that if a single array is bigger than the--- specified size we do not split it to fit. When we coalesce multiple arrays--- if the size would exceed the specified size we do not coalesce therefore the--- actual array size may be less than the specified chunk size.------ /Internal/-{-# INLINE_NORMAL compactLEParserD #-}-compactLEParserD ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> ParserD.Parser (MutArray a) m (MutArray a)-compactLEParserD n = ParserD.Parser step initial extract--    where--    nBytes = n * SIZE_OF(a)--    initial =-        return-            $ if n <= 0-              then error-                       $ functionPath-                       ++ ": the size of arrays ["-                       ++ show n ++ "] must be a natural number"-              else ParserD.IPartial Nothing--    step Nothing arr =-        return-            $ let len = MArray.byteLength arr-               in if len >= nBytes-                  then ParserD.Done 0 arr-                  else ParserD.Partial 0 (Just arr)-    step (Just buf) arr =-        let len = MArray.byteLength buf + MArray.byteLength arr-         in if len > nBytes-            then return $ ParserD.Done 1 buf-            else do-                buf1 <--                    if MArray.byteCapacity buf < nBytes-                    then liftIO $ MArray.realloc nBytes buf-                    else return buf-                buf2 <- MArray.splice buf1 arr-                return $ ParserD.Partial 0 (Just buf2)--    extract Nothing = return $ ParserD.Done 0 MArray.nil-    extract (Just buf) = return $ ParserD.Done 0 buf--    functionPath =-        "Streamly.Internal.Data.Array.Mut.Stream.compactLEParserD"---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- minimum specified size. Note that if all the arrays in the stream together--- are smaller than the specified size the resulting array will be smaller than--- the specified size. When we coalesce multiple arrays if the size would exceed--- the specified size we stop coalescing further.------ /Internal/-{-# INLINE_NORMAL compactGEFold #-}-compactGEFold ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> FL.Fold m (MutArray a) (MutArray a)-compactGEFold n = Fold step initial extract--    where--    nBytes = n * SIZE_OF(a)--    initial =-        return-            $ if n < 0-              then error-                       $ functionPath-                       ++ ": the size of arrays ["-                       ++ show n ++ "] must be a natural number"-              else FL.Partial Nothing--    step Nothing arr =-        return-            $ let len = MArray.byteLength arr-               in if len >= nBytes-                  then FL.Done arr-                  else FL.Partial (Just arr)-    step (Just buf) arr = do-        let len = MArray.byteLength buf + MArray.byteLength arr-        buf1 <--            if MArray.byteCapacity buf < len-            then liftIO $ MArray.realloc (max len nBytes) buf-            else return buf-        buf2 <- MArray.splice buf1 arr-        if len >= n-        then return $ FL.Done buf2-        else return $ FL.Partial (Just buf2)--    extract Nothing = return MArray.nil-    extract (Just buf) = return buf--    functionPath =-        "Streamly.Internal.Data.Array.Mut.Stream.compactGEFold"---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ /Internal/-compactLE :: (MonadIO m, Unbox a) =>-    Int -> Stream m (MutArray a) -> Stream m (Either ParseError (MutArray a))-compactLE n = D.parseManyD (compactLEParserD n)---- | Like 'compactLE' but generates arrays of exactly equal to the size--- specified except for the last array in the stream which could be shorter.------ /Unimplemented/-{-# INLINE compactEQ #-}-compactEQ :: -- (MonadIO m, Unbox a) =>-    Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compactEQ _n _xs = undefined-    -- IsStream.fromStreamD $ D.foldMany (compactEQFold n) (IsStream.toStreamD xs)---- | Like 'compactLE' but generates arrays of size greater than or equal to the--- specified except for the last array in the stream which could be shorter.------ /Internal/-{-# INLINE compactGE #-}-compactGE ::-       (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compactGE n = D.foldMany (compactGEFold n)
− src/Streamly/Internal/Data/Array/Mut/Type.hs 
@@ -1,2356 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnboxedTuples #-}--- |--- Module      : Streamly.Internal.Data.Array.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Pinned and unpinned mutable array for 'Unboxed' types. Fulfils the following--- goals:------ * Random access (array)--- * Efficient storage (unboxed)--- * Performance (unboxed access)--- * Performance - in-place operations (mutable)--- * Performance - GC (pinned, mutable)--- * interfacing with OS (pinned)------ Stream and Fold APIs allow easy, efficient and convenient operations on--- arrays.------ Mutable arrays and file system files are quite similar, they can grow and--- their content is mutable. Therefore, both have similar APIs as well. We--- strive to keep the API consistent for both. Ideally, you should be able to--- replace one with another with little changes to the code.--module Streamly.Internal.Data.Array.Mut.Type-    (-    -- * Type-    -- $arrayNotes-      MutArray (..)-    , MutableByteArray-    , touch-    , pin-    , unpin--    -- * Constructing and Writing-    -- ** Construction-    , nil--    -- *** Uninitialized Arrays-    , newPinned-    , newPinnedBytes-    , newAlignedPinned-    , new-    , newArrayWith--    -- *** Initialized Arrays-    , withNewArrayUnsafe--    -- *** From streams-    , ArrayUnsafe (..)-    , writeNWithUnsafe-    , writeNWith-    , writeNUnsafe-    , writeN-    , writeNAligned--    , writeWith-    , write--    , writeRevN-    -- , writeRev--    -- ** From containers-    , fromListN-    , fromList-    , fromListRevN-    , fromListRev-    , fromStreamDN-    , fromStreamD--    -- * Random writes-    , putIndex-    , putIndexUnsafe-    , putIndices-    -- , putFromThenTo-    -- , putFrom -- start writing at the given position-    -- , putUpto -- write from beginning up to the given position-    -- , putFromTo-    -- , putFromRev-    -- , putUptoRev-    , modifyIndexUnsafe-    , modifyIndex-    , modifyIndices-    , modify-    , swapIndices-    , unsafeSwapIndices--    -- * Growing and Shrinking-    -- Arrays grow only at the end, though it is possible to grow on both sides-    -- and therefore have a cons as well as snoc. But that will require two-    -- bounds in the array representation.--    -- ** Appending elements-    , snocWith-    , snoc-    , snocLinear-    , snocMay-    , snocUnsafe--    -- ** Appending streams-    , writeAppendNUnsafe-    , writeAppendN-    , writeAppendWith-    , writeAppend--    -- * Eliminating and Reading--    -- ** To streams-    , reader-    , readerRevWith-    , readerRev--    -- ** To containers-    , toStreamDWith-    , toStreamDRevWith-    , toStreamKWith-    , toStreamKRevWith-    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toList--    -- experimental-    , producerWith-    , producer--    -- ** Random reads-    , getIndex-    , getIndexUnsafe-    , getIndices-    , getIndicesD-    -- , getFromThenTo-    , getIndexRev--    -- * Memory Management-    , blockSize-    , arrayChunkBytes-    , allocBytesToElemCount-    , realloc-    , resize-    , resizeExp-    , rightSize--    -- * Size-    , length-    , byteLength-    -- , capacity-    , byteCapacity-    , bytesFree--    -- * In-place Mutation Algorithms-    , strip-    , reverse-    , permute-    , partitionBy-    , shuffleBy-    , divideBy-    , mergeBy-    , bubble--    -- * Casting-    , cast-    , castUnsafe-    , asBytes-    , asPtrUnsafe--    -- * Folding-    , foldl'-    , foldr-    , cmp--    -- * Arrays of arrays-    --  We can add dimensionality parameter to the array type to get-    --  multidimensional arrays. Multidimensional arrays would just be a-    --  convenience wrapper on top of single dimensional arrays.--    -- | Operations dealing with multiple arrays, streams of arrays or-    -- multidimensional array representations.--    -- ** Construct from streams-    , chunksOf-    , arrayStreamKFromStreamD-    , writeChunks--    -- ** Eliminate to streams-    , flattenArrays-    , flattenArraysRev-    , fromArrayStreamK--    -- ** Construct from arrays-    -- get chunks without copying-    , getSliceUnsafe-    , getSlice-    -- , getSlicesFromLenN-    , splitAt -- XXX should be able to express using getSlice-    , breakOn--    -- ** Appending arrays-    , spliceCopy-    , spliceWith-    , splice-    , spliceExp-    , spliceUnsafe-    , putSliceUnsafe-    -- , putSlice-    -- , appendSlice-    -- , appendSliceFrom--    -- * Utilities-    , roundUpToPower2-    , memcpy-    , memcmp-    , c_memchr-    )-where--#include "assert.hs"-#include "inline.hs"-#include "ArrayMacros.h"-#include "MachDeps.h"--import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, (.|.), (.&.))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Foreign.C.Types (CSize(..), CInt(..))-import Foreign.Ptr (plusPtr, minusPtr, nullPtr)-import Streamly.Internal.Data.Unboxed-    ( MutableByteArray(..)-    , Unbox-    , getMutableByteArray#-    , peekWith-    , pokeWith-    , sizeOf-    , touch-    )-import GHC.Base-    ( IO(..)-    , Int(..)-    , byteArrayContents#-    , compareByteArrays#-    , copyMutableByteArray#-    )-import GHC.Base (noinline)-import GHC.Exts (unsafeCoerce#)-import GHC.Ptr (Ptr(..))--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer (..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.StreamK.Type (StreamK)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Unboxed as Unboxed-import qualified Prelude--import Prelude hiding-    (length, foldr, read, unlines, splitAt, reverse, truncate)--#include "DocTestDataMutArray.hs"------------------------------------------------------------------------------------ Foreign helpers----------------------------------------------------------------------------------foreign import ccall unsafe "string.h memcpy" c_memcpy-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "string.h memchr" c_memchr-    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "string.h memcmp" c_memcmp-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt---- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return--- how many elements of that type will completely fit in those bytes.----{-# INLINE bytesToElemCount #-}-bytesToElemCount :: forall a. Unbox a => a -> Int -> Int-bytesToElemCount _ n = n `div` SIZE_OF(a)---- XXX we are converting Int to CSize-memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy dst src len = void (c_memcpy dst src (fromIntegral len))---- XXX we are converting Int to CSize--- return True if the memory locations have identical contents-{-# INLINE memcmp #-}-memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool-memcmp p1 p2 len = do-    r <- c_memcmp p1 p2 (fromIntegral len)-    return $ r == 0------------------------------------------------------------------------------------ MutArray Data Type------------------------------------------------------------------------------------ $arrayNotes------ We can use an 'Unboxed' constraint in the MutArray type and the constraint--- can be automatically provided to a function that pattern matches on the--- MutArray type. However, it has huge performance cost, so we do not use it.--- Investigate a GHC improvement possiblity.---- | An unboxed mutable array. An array is created with a given length--- and capacity. Length is the number of valid elements in the array.  Capacity--- is the maximum number of elements that the array can be expanded to without--- having to reallocate the memory.------ The elements in the array can be mutated in-place without changing the--- reference (constructor). However, the length of the array cannot be mutated--- in-place.  A new array reference is generated when the length changes.  When--- the length is increased (upto the maximum reserved capacity of the array),--- the array is not reallocated and the new reference uses the same underlying--- memory as the old one.------ Several routines in this module allow the programmer to control the capacity--- of the array. The programmer can control the trade-off between memory usage--- and performance impact due to reallocations when growing or shrinking the--- array.----data MutArray a =-#ifdef DEVBUILD-    Unbox a =>-#endif-    -- The array is a range into arrContents. arrContents may be a superset of-    -- the slice represented by the array. All offsets are in bytes.-    MutArray-    { arrContents :: {-# UNPACK #-} !MutableByteArray-    , arrStart :: {-# UNPACK #-} !Int  -- ^ index into arrContents-    , arrEnd   :: {-# UNPACK #-} !Int    -- ^ index into arrContents-                                       -- Represents the first invalid index of-                                       -- the array.-    , arrBound :: {-# UNPACK #-} !Int    -- ^ first invalid index of arrContents.-    }------------------------------------------------------------------------------------ Pinning & Unpinning----------------------------------------------------------------------------------{-# INLINE pin #-}-pin :: MutArray a -> IO (MutArray a)-pin arr@MutArray{..} = do-    contents <- Unboxed.pin arrContents-    return $ arr {arrContents = contents}--{-# INLINE unpin #-}-unpin :: MutArray a -> IO (MutArray a)-unpin arr@MutArray{..} = do-    contents <- Unboxed.unpin arrContents-    return $ arr {arrContents = contents}------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ XXX Change the names to use "new" instead of "newArray". That way we can use--- the same names for managed file system objects as well. For unmanaged ones--- we can use open/create etc as usual.------ A new array is similar to "touch" creating a zero length file. An mmapped--- array would be similar to a sparse file with holes. TBD: support mmapped--- files and arrays.---- GHC always guarantees word-aligned memory, alignment is important only when--- we need more than that.  See stg_newAlignedPinnedByteArrayzh and--- allocatePinned in GHC source.---- | @newArrayWith allocator alignment count@ allocates a new array of zero--- length and with a capacity to hold @count@ elements, using @allocator--- size alignment@ as the memory allocator function.------ Alignment must be greater than or equal to machine word size and a power of--- 2.------ Alignment is ignored if the allocator allocates unpinned memory.------ /Pre-release/-{-# INLINE newArrayWith #-}-newArrayWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> Int -> m MutableByteArray) -> Int -> Int -> m (MutArray a)-newArrayWith alloc alignSize count = do-    let size = max (count * SIZE_OF(a)) 0-    contents <- alloc size alignSize-    return $ MutArray-        { arrContents = contents-        , arrStart = 0-        , arrEnd   = 0-        , arrBound = size-        }--nil ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a-nil = MutArray Unboxed.nil 0 0 0----- | Allocates a pinned empty array that can hold 'count' items.  The memory of--- the array is uninitialized and the allocation is aligned as per the--- 'Unboxed' instance of the type.------ /Pre-release/-{-# INLINE newPinnedBytes #-}-newPinnedBytes :: MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    Int -> m (MutArray a)-newPinnedBytes bytes = do-    contents <- liftIO $ Unboxed.newPinnedBytes bytes-    return $ MutArray-        { arrContents = contents-        , arrStart = 0-        , arrEnd   = 0-        , arrBound = bytes-        }---- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and--- the alignment is dictated by the 'Unboxed' instance of the type.------ /Internal/-{-# INLINE newAlignedPinned #-}-newAlignedPinned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)-newAlignedPinned =-    newArrayWith (\s a -> liftIO $ Unboxed.newAlignedPinnedBytes s a)---- XXX can unaligned allocation be more efficient when alignment is not needed?------ | Allocates an empty pinned array that can hold 'count' items.  The memory of--- the array is uninitialized and the allocation is aligned as per the 'Unboxed'--- instance of the type.----{-# INLINE newPinned #-}-newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)-newPinned =-    newArrayWith-        (\s _ -> liftIO $ Unboxed.newPinnedBytes s)-        (error "newPinned: alignSize is not used")---- | Allocates an empty unpinned array that can hold 'count' items.  The memory--- of the array is uninitialized.----{-# INLINE new #-}-new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)-new =-    newArrayWith-        (\s _ -> liftIO $ Unboxed.newUnpinnedBytes s)-        (error "new: alignment is not used in unpinned arrays.")---- XXX This should create a full length uninitialzed array so that the pointer--- can be used.---- | Allocate a pinned MutArray of the given size and run an IO action passing--- the array start pointer.------ /Internal/-{-# INLINE withNewArrayUnsafe #-}-withNewArrayUnsafe ::-       (MonadIO m, Unbox a) => Int -> (Ptr a -> m ()) -> m (MutArray a)-withNewArrayUnsafe count f = do-    arr <- newPinned count-    asPtrUnsafe arr-        $ \p -> f p >> return arr------------------------------------------------------------------------------------ Random writes------------------------------------------------------------------------------------ | Write the given element to the given index of the array. Does not check if--- the index is out of bounds of the array.------ /Pre-release/-{-# INLINE putIndexUnsafe #-}-putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> MutArray a -> a -> m ()-putIndexUnsafe i MutArray{..} x = do-    let index = INDEX_OF(arrStart, i, a)-    assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())-    liftIO $ pokeWith arrContents index x--invalidIndex :: String -> Int -> a-invalidIndex label i =-    error $ label ++ ": invalid array index " ++ show i---- | /O(1)/ Write the given element at the given index in the array.--- Performs in-place mutation of the array.------ >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))--- >>> f = MutArray.putIndices--- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))----{-# INLINE putIndex #-}-putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()-putIndex i MutArray{..} x = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ pokeWith arrContents index x-    else invalidIndex "putIndex" i---- | Write an input stream of (index, value) pairs to an array. Throws an--- error if any index is out of bounds.------ /Pre-release/-{-# INLINE putIndices #-}-putIndices :: forall m a. (MonadIO m, Unbox a)-    => MutArray a -> Fold m (Int, a) ()-putIndices arr = FL.foldlM' step (return ())--    where--    step () (i, x) = liftIO (putIndex i arr x)---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndexUnsafe i MutArray{..} f = liftIO $ do-        let index = INDEX_OF(arrStart,i,a)-        assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())-        r <- peekWith arrContents index-        let (x, res) = f r-        pokeWith arrContents index x-        return res---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndex i MutArray{..} f = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ do-        r <- peekWith arrContents index-        let (x, res) = f r-        pokeWith arrContents index x-        return res-    else invalidIndex "modifyIndex" i----- | Modify the array indices generated by the supplied stream.------ /Pre-release/-{-# INLINE modifyIndices #-}-modifyIndices :: forall m a . (MonadIO m, Unbox a)-    => MutArray a -> (Int -> a -> a) -> Fold m Int ()-modifyIndices arr f = FL.foldlM' step initial--    where--    initial = return ()--    step () i =-        let f1 x = (f i x, ())-         in modifyIndex i arr f1---- | Modify each element of an array using the supplied modifier function.------ /Pre-release/-modify :: forall m a. (MonadIO m, Unbox a)-    => MutArray a -> (a -> a) -> m ()-modify MutArray{..} f = liftIO $-    go arrStart--    where--    go i =-        when (INDEX_VALID(i,arrEnd,a)) $ do-            r <- peekWith arrContents i-            pokeWith arrContents i (f r)-            go (INDEX_NEXT(i,a))---- XXX We could specify the number of bytes to swap instead of Proxy. Need--- to ensure that the memory does not overlap.-{-# INLINE swapArrayByteIndices #-}-swapArrayByteIndices ::-       forall a. Unbox a-    => Proxy a-    -> MutableByteArray-    -> Int-    -> Int-    -> IO ()-swapArrayByteIndices _ arrContents i1 i2 = do-    r1 <- peekWith arrContents i1-    r2 <- peekWith arrContents i2-    pokeWith arrContents i1 (r2 :: a)-    pokeWith arrContents i2 (r1 :: a)---- | Swap the elements at two indices without validating the indices.------ /Unsafe/: This could result in memory corruption if indices are not valid.------ /Pre-release/-{-# INLINE unsafeSwapIndices #-}-unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> MutArray a -> m ()-unsafeSwapIndices i1 i2 MutArray{..} = liftIO $ do-        let t1 = INDEX_OF(arrStart,i1,a)-            t2 = INDEX_OF(arrStart,i2,a)-        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2---- | Swap the elements at two indices.------ /Pre-release/-swapIndices :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> MutArray a -> m ()-swapIndices i1 i2 MutArray{..} = liftIO $ do-        let t1 = INDEX_OF(arrStart,i1,a)-            t2 = INDEX_OF(arrStart,i2,a)-        when (i1 < 0 || INDEX_INVALID(t1,arrEnd,a))-            $ invalidIndex "swapIndices" i1-        when (i2 < 0 || INDEX_INVALID(t2,arrEnd,a))-            $ invalidIndex "swapIndices" i2-        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2------------------------------------------------------------------------------------ Rounding------------------------------------------------------------------------------------ XXX Should we use bitshifts in calculations or it gets optimized by the--- compiler/processor itself?------ | The page or block size used by the GHC allocator. Allocator allocates at--- least a block and then allocates smaller allocations from within a block.-blockSize :: Int-blockSize = 4 * 1024---- | Allocations larger than 'largeObjectThreshold' are in multiples of block--- size and are always pinned. The space beyond the end of a large object up to--- the end of the block is unused.-largeObjectThreshold :: Int-largeObjectThreshold = (blockSize * 8) `div` 10---- XXX Should be done only when we are using the GHC allocator.--- | Round up an array larger than 'largeObjectThreshold' to use the whole--- block.-{-# INLINE roundUpLargeArray #-}-roundUpLargeArray :: Int -> Int-roundUpLargeArray size =-    if size >= largeObjectThreshold-    then-        assert-            (blockSize /= 0 && ((blockSize .&. (blockSize - 1)) == 0))-            ((size + blockSize - 1) .&. negate blockSize)-    else size--{-# INLINE isPower2 #-}-isPower2 :: Int -> Bool-isPower2 n = n .&. (n - 1) == 0--{-# INLINE roundUpToPower2 #-}-roundUpToPower2 :: Int -> Int-roundUpToPower2 n =-#if WORD_SIZE_IN_BITS == 64-    1 + z6-#else-    1 + z5-#endif--    where--    z0 = n - 1-    z1 = z0 .|. z0 `shiftR` 1-    z2 = z1 .|. z1 `shiftR` 2-    z3 = z2 .|. z2 `shiftR` 4-    z4 = z3 .|. z3 `shiftR` 8-    z5 = z4 .|. z4 `shiftR` 16-    z6 = z5 .|. z5 `shiftR` 32---- | @allocBytesToBytes elem allocatedBytes@ returns the array size in bytes--- such that the real allocation is less than or equal to @allocatedBytes@,--- unless @allocatedBytes@ is less than the size of one array element in which--- case it returns one element's size.----{-# INLINE allocBytesToBytes #-}-allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int-allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))---- | Given an 'Unboxed' type (unused first arg) and real allocation size--- (including overhead), return how many elements of that type will completely--- fit in it, returns at least 1.----{-# INLINE allocBytesToElemCount #-}-allocBytesToElemCount :: Unbox a => a -> Int -> Int-allocBytesToElemCount x bytes =-    let n = bytesToElemCount x (allocBytesToBytes x bytes)-     in assert (n >= 1) n---- | The default chunk size by which the array creation routines increase the--- size of the array when the array is grown linearly.-arrayChunkBytes :: Int-arrayChunkBytes = 1024------------------------------------------------------------------------------------ Resizing------------------------------------------------------------------------------------ | Round the second argument down to multiples of the first argument.-{-# INLINE roundDownTo #-}-roundDownTo :: Int -> Int -> Int-roundDownTo elemSize size = size - (size `mod` elemSize)---- XXX See if resizing can be implemented by reading the old array as a stream--- and then using writeN to the new array.------ NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.--- Since this is not inlined Unboxed consrraint leads to dictionary passing--- which complicates some inspection tests.----{-# NOINLINE reallocExplicit #-}-reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)-reallocExplicit elemSize newCapacityInBytes MutArray{..} = do-    assertM(arrEnd <= arrBound)--    -- Allocate new array-    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes-    contents <- Unboxed.newPinnedBytes newCapMaxInBytes-    let !(MutableByteArray mbarrFrom#) = arrContents-        !(MutableByteArray mbarrTo#) = contents--    -- Copy old data-    let oldStart = arrStart-        !(I# oldStartInBytes#) = oldStart-        oldSizeInBytes = arrEnd - oldStart-        newCapInBytes = roundDownTo elemSize newCapMaxInBytes-        !newLenInBytes@(I# newLenInBytes#) = min oldSizeInBytes newCapInBytes-    assert (oldSizeInBytes `mod` elemSize == 0) (return ())-    assert (newLenInBytes >= 0) (return ())-    assert (newLenInBytes `mod` elemSize == 0) (return ())-    IO $ \s# -> (# copyMutableByteArray# mbarrFrom# oldStartInBytes#-                        mbarrTo# 0# newLenInBytes# s#, () #)--    return $ MutArray-        { arrStart = 0-        , arrContents = contents-        , arrEnd   = newLenInBytes-        , arrBound = newCapInBytes-        }---- | @realloc newCapacity array@ reallocates the array to the specified--- capacity in bytes.------ If the new size is less than the original array the array gets truncated.--- If the new size is not a multiple of array element size then it is rounded--- down to multiples of array size.  If the new size is more than--- 'largeObjectThreshold' then it is rounded up to the block size (4K).----{-# INLINABLE realloc #-}-realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)-realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr---- | @reallocWith label capSizer minIncrBytes array@. The label is used--- in error messages and the capSizer is used to determine the capacity of the--- new array in bytes given the current byte length of the array.-reallocWith :: forall m a. (MonadIO m , Unbox a) =>-       String-    -> (Int -> Int)-    -> Int-    -> MutArray a-    -> m (MutArray a)-reallocWith label capSizer minIncrBytes arr = do-    let oldSizeBytes = arrEnd arr - arrStart arr-        newCapBytes = capSizer oldSizeBytes-        newSizeBytes = oldSizeBytes + minIncrBytes-        safeCapBytes = max newCapBytes newSizeBytes-    assertM(safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))--    realloc safeCapBytes arr--    where--    badSize newSize =-        concat-            [ label-            , ": new array size (in bytes) is less than required size "-            , show newSize-            , ". Please check the sizing function passed."-            ]---- | @resize newCapacity array@ changes the total capacity of the array so that--- it is enough to hold the specified number of elements.  Nothing is done if--- the specified capacity is less than the length of the array.------ If the capacity is more than 'largeObjectThreshold' then it is rounded up to--- the block size (4K).------ /Pre-release/-{-# INLINE resize #-}-resize :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resize nElems arr@MutArray{..} = do-    let req = SIZE_OF(a) * nElems-        len = arrEnd - arrStart-    if req < len-    then return arr-    else realloc req arr---- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'--- then it is rounded up to the closest power of 2.------ /Pre-release/-{-# INLINE resizeExp #-}-resizeExp :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resizeExp nElems arr@MutArray{..} = do-    let req = roundUpLargeArray (SIZE_OF(a) * nElems)-        req1 =-            if req > largeObjectThreshold-            then roundUpToPower2 req-            else req-        len = arrEnd - arrStart-    if req1 < len-    then return arr-    else realloc req1 arr---- | Resize the allocated memory to drop any reserved free space at the end of--- the array and reallocate it to reduce wastage.------ Up to 25% wastage is allowed to avoid reallocations.  If the capacity is--- more than 'largeObjectThreshold' then free space up to the 'blockSize' is--- retained.------ /Pre-release/-{-# INLINE rightSize #-}-rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)-rightSize arr@MutArray{..} = do-    assert (arrEnd <= arrBound) (return ())-    let start = arrStart-        len = arrEnd - start-        capacity = arrBound - start-        target = roundUpLargeArray len-        waste = arrBound - arrEnd-    assert (target >= len) (return ())-    assert (len `mod` SIZE_OF(a) == 0) (return ())-    -- We trade off some wastage (25%) to avoid reallocations and copying.-    if target < capacity && len < 3 * waste-    then realloc target arr-    else return arr------------------------------------------------------------------------------------ Snoc------------------------------------------------------------------------------------ XXX We can possibly use a smallMutableByteArray to hold the start, end,--- bound pointers.  Using fully mutable handle will ensure that we do not have--- multiple references to the same array of different lengths lying around and--- potentially misused. In that case "snoc" need not return a new array (snoc--- :: MutArray a -> a -> m ()), it will just modify the old reference.  The array--- length will be mutable.  This means the length function would also be--- monadic.  Mutable arrays would behave more like files that grow in that--- case.---- | Snoc using a 'Ptr'. Low level reusable function.------ /Internal/-{-# INLINE snocNewEnd #-}-snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)-snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do-    assert (newEnd <= arrBound) (return ())-    pokeWith arrContents arrEnd x-    return $ arr {arrEnd = newEnd}---- | Really really unsafe, appends the element into the first array, may--- cause silent data corruption or if you are lucky a segfault if the first--- array does not have enough space to append the element.------ /Internal/-{-# INLINE snocUnsafe #-}-snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>-    MutArray a -> a -> m (MutArray a)-snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr---- | Like 'snoc' but does not reallocate when pre-allocated array capacity--- becomes full.------ /Internal/-{-# INLINE snocMay #-}-snocMay :: forall m a. (MonadIO m, Unbox a) =>-    MutArray a -> a -> m (Maybe (MutArray a))-snocMay arr@MutArray{..} x = liftIO $ do-    let newEnd = INDEX_NEXT(arrEnd,a)-    if newEnd <= arrBound-    then Just <$> snocNewEnd newEnd arr x-    else return Nothing---- NOINLINE to move it out of the way and not pollute the instruction cache.-{-# NOINLINE snocWithRealloc #-}-snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray a-    -> a-    -> m (MutArray a)-snocWithRealloc sizer arr x = do-    arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr-    snocUnsafe arr1 x---- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of--- the array increases by 1.------ If there is no reserved space available in @arr@ it is reallocated to a size--- in bytes determined by the @sizer oldSizeBytes@ function, where--- @oldSizeBytes@ is the original size of the array in bytes.------ If the new array size is more than 'largeObjectThreshold' we automatically--- round it up to 'blockSize'.------ Note that the returned array may be a mutated version of the original array.------ /Pre-release/-{-# INLINE snocWith #-}-snocWith :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray a-    -> a-    -> m (MutArray a)-snocWith allocSize arr x = liftIO $ do-    let newEnd = INDEX_NEXT(arrEnd arr,a)-    if newEnd <= arrBound arr-    then snocNewEnd newEnd arr x-    else snocWithRealloc allocSize arr x---- | The array is mutated to append an additional element to it. If there--- is no reserved space available in the array then it is reallocated to grow--- it by 'arrayChunkBytes' rounded up to 'blockSize' when the size becomes more--- than 'largeObjectThreshold'.------ Note that the returned array may be a mutated version of the original array.------ Performs O(n^2) copies to grow but is thrifty on memory.------ /Pre-release/-{-# INLINE snocLinear #-}-snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)-snocLinear = snocWith (+ allocBytesToBytes (undefined :: a) arrayChunkBytes)---- | The array is mutated to append an additional element to it. If there is no--- reserved space available in the array then it is reallocated to double the--- original size.------ This is useful to reduce allocations when appending unknown number of--- elements.------ Note that the returned array may be a mutated version of the original array.------ >>> snoc = MutArray.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.----{-# INLINE snoc #-}-snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)-snoc = snocWith f--    where--    f oldSize =-        if isPower2 oldSize-        then oldSize * 2-        else roundUpToPower2 oldSize * 2------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ XXX Can this be deduplicated with array/foreign---- | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndexUnsafe i MutArray{..} = do-    let index = INDEX_OF(arrStart,i,a)-    assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())-    liftIO $ peekWith arrContents index---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndex i MutArray{..} = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ peekWith arrContents index-    else invalidIndex "getIndex" i---- | /O(1)/ Lookup the element at the given index from the end of the array.--- Index starts from 0.------ Slightly faster than computing the forward index and using getIndex.----{-# INLINE getIndexRev #-}-getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndexRev i MutArray{..} = do-    let index = RINDEX_OF(arrEnd,i,a)-    if i >= 0 && index >= arrStart-    then liftIO $ peekWith arrContents index-    else invalidIndex "getIndexRev" i--data GetIndicesState contents start end st =-    GetIndicesState contents start end st---- | Given an unfold that generates array indices, read the elements on those--- indices from the supplied MutArray. An error is thrown if an index is out of--- bounds.------ /Pre-release/-{-# INLINE getIndicesD #-}-getIndicesD :: (Monad m, Unbox a) =>-    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a-getIndicesD liftio (D.Stream stepi sti) = Unfold step inject--    where--    inject (MutArray contents start end _) =-        return $ GetIndicesState contents start end sti--    {-# INLINE_LATE step #-}-    step (GetIndicesState contents start end st) = do-        r <- stepi defState st-        case r of-            D.Yield i s -> do-                x <- liftio $ getIndex i (MutArray contents start end undefined)-                return $ D.Yield x (GetIndicesState contents start end s)-            D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)-            D.Stop -> return D.Stop--{-# INLINE getIndices #-}-getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a-getIndices = getIndicesD liftIO------------------------------------------------------------------------------------ Subarrays------------------------------------------------------------------------------------ XXX We can also get immutable slices.---- | /O(1)/ Slice an array in constant time.------ Unsafe: The bounds of the slice are not checked.------ /Unsafe/------ /Pre-release/-{-# INLINE getSliceUnsafe #-}-getSliceUnsafe :: forall a. Unbox a-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSliceUnsafe index len (MutArray contents start e _) =-    let fp1 = INDEX_OF(start,index,a)-        end = fp1 + (len * SIZE_OF(a))-     in assert-            (index >= 0 && len >= 0 && end <= e)-            -- Note: In a slice we always use bound = end so that the slice-            -- user cannot overwrite elements beyond the end of the slice.-            (MutArray contents fp1 end end)---- | /O(1)/ Slice an array in constant time. Throws an error if the slice--- extends out of the array bounds.------ /Pre-release/-{-# INLINE getSlice #-}-getSlice :: forall a. Unbox a =>-       Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSlice index len (MutArray contents start e _) =-    let fp1 = INDEX_OF(start,index,a)-        end = fp1 + (len * SIZE_OF(a))-     in if index >= 0 && len >= 0 && end <= e-        -- Note: In a slice we always use bound = end so that the slice user-        -- cannot overwrite elements beyond the end of the slice.-        then MutArray contents fp1 end end-        else error-                $ "getSlice: invalid slice, index "-                ++ show index ++ " length " ++ show len------------------------------------------------------------------------------------ In-place mutation algorithms------------------------------------------------------------------------------------ XXX consider the bulk update/accumulation/permutation APIs from vector.---- | You may not need to reverse an array because you can consume it in reverse--- using 'readerRev'. To reverse large arrays you can read in reverse and write--- to another array. However, in-place reverse can be useful to take adavantage--- of cache locality and when you do not want to allocate additional memory.----{-# INLINE reverse #-}-reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()-reverse MutArray{..} = liftIO $ do-    let l = arrStart-        h = INDEX_PREV(arrEnd,a)-     in swap l h--    where--    swap l h = do-        when (l < h) $ do-            swapArrayByteIndices (Proxy :: Proxy a) arrContents l h-            swap (INDEX_NEXT(l,a)) (INDEX_PREV(h,a))---- | Generate the next permutation of the sequence, returns False if this is--- the last permutation.------ /Unimplemented/-{-# INLINE permute #-}-permute :: MutArray a -> m Bool-permute = undefined---- | Partition an array into two halves using a partitioning predicate. The--- first half retains values where the predicate is 'False' and the second half--- retains values where the predicate is 'True'.------ /Pre-release/-{-# INLINE partitionBy #-}-partitionBy :: forall m a. (MonadIO m, Unbox a)-    => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)-partitionBy f arr@MutArray{..} = liftIO $ do-    if arrStart >= arrEnd-    then return (arr, arr)-    else do-        ptr <- go arrStart (INDEX_PREV(arrEnd,a))-        let pl = MutArray arrContents arrStart ptr ptr-            pr = MutArray arrContents ptr arrEnd arrEnd-        return (pl, pr)--    where--    -- Invariant low < high on entry, and on return as well-    moveHigh low high = do-        h <- peekWith arrContents high-        if f h-        then-            -- Correctly classified, continue the loop-            let high1 = INDEX_PREV(high,a)-             in if low == high1-                then return Nothing-                else moveHigh low high1-        else return (Just (high, h)) -- incorrectly classified--    -- Keep a low pointer starting at the start of the array (first partition)-    -- and a high pointer starting at the end of the array (second partition).-    -- Keep incrementing the low ptr and decrementing the high ptr until both-    -- are wrongly classified, at that point swap the two and continue until-    -- the two pointer cross each other.-    ---    -- Invariants when entering this loop:-    -- low <= high-    -- Both low and high are valid locations within the array-    go low high = do-        l <- peekWith arrContents low-        if f l-        then-            -- low is wrongly classified-            if low == high-            then return low-            else do -- low < high-                r <- moveHigh low high-                case r of-                    Nothing -> return low-                    Just (high1, h) -> do -- low < high1-                        pokeWith arrContents low h-                        pokeWith arrContents high1 l-                        let low1 = INDEX_NEXT(low,a)-                            high2 = INDEX_PREV(high1,a)-                        if low1 <= high2-                        then go low1 high2-                        else return low1 -- low1 > high2--        else do-            -- low is correctly classified-            let low1 = INDEX_NEXT(low,a)-            if low == high-            then return low1-            else go low1 high---- | Shuffle corresponding elements from two arrays using a shuffle function.--- If the shuffle function returns 'False' then do nothing otherwise swap the--- elements. This can be used in a bottom up fold to shuffle or reorder the--- elements.------ /Unimplemented/-{-# INLINE shuffleBy #-}-shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()-shuffleBy = undefined---- XXX we can also make the folds partial by stopping at a certain level.------ | @divideBy level partition array@  performs a top down hierarchical--- recursive partitioning fold of items in the container using the given--- function as the partition function.  Level indicates the level in the tree--- where the fold would stop.------ This performs a quick sort if the partition function is--- 'partitionBy (< pivot)'.------ /Unimplemented/-{-# INLINABLE divideBy #-}-divideBy ::-    Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()-divideBy = undefined---- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively--- merging the pairs using the supplied merge function. Level indicates the--- level in the tree where the fold would stop.------ This performs a random shuffle if the merge function is random.  If we--- stop at level 0 and repeatedly apply the function then we can do a bubble--- sort.------ /Unimplemented/-mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()-mergeBy = undefined------------------------------------------------------------------------------------ Size------------------------------------------------------------------------------------ | /O(1)/ Get the byte length of the array.----{-# INLINE byteLength #-}-byteLength :: MutArray a -> Int-byteLength MutArray{..} =-    let len = arrEnd - arrStart-    in assert (len >= 0) len---- Note: try to avoid the use of length in performance sensitive internal--- routines as it involves a costly 'div' operation. Instead use the end ptr--- in the array to check the bounds etc.------ | /O(1)/ Get the length of the array i.e. the number of elements in the--- array.------ Note that 'byteLength' is less expensive than this operation, as 'length'--- involves a costly division operation.----{-# INLINE length #-}-length :: forall a. Unbox a => MutArray a -> Int-length arr =-    let elemSize = SIZE_OF(a)-        blen = byteLength arr-     in assert (blen `mod` elemSize == 0) (blen `div` elemSize)---- | Get the total capacity of an array. An array may have space reserved--- beyond the current used length of the array.------ /Pre-release/-{-# INLINE byteCapacity #-}-byteCapacity :: MutArray a -> Int-byteCapacity MutArray{..} =-    let len = arrBound - arrStart-    in assert (len >= 0) len---- | The remaining capacity in the array for appending more elements without--- reallocation.------ /Pre-release/-{-# INLINE bytesFree #-}-bytesFree :: MutArray a -> Int-bytesFree MutArray{..} =-    let n = arrBound - arrEnd-    in assert (n >= 0) n------------------------------------------------------------------------------------ Streams of arrays - Creation----------------------------------------------------------------------------------data GroupState s contents start end bound-    = GroupStart s-    | GroupBuffer s contents start end bound-    | GroupYield-        contents start end bound (GroupState s contents start end bound)-    | GroupFinish---- | @chunksOf n stream@ groups the input stream into a stream of--- arrays of size n.------ @chunksOf n = StreamD.foldMany (MutArray.writeN n)@------ /Pre-release/-{-# INLINE_NORMAL chunksOf #-}-chunksOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> D.Stream m (MutArray a)--- XXX the idiomatic implementation leads to large regression in the D.reverse'--- benchmark. It seems it has difficulty producing optimized code when--- converting to StreamK. Investigate GHC optimizations.--- chunksOf n = D.foldMany (writeN n)-chunksOf n (D.Stream step state) =-    D.Stream step' (GroupStart state)--    where--    {-# INLINE_LATE step' #-}-    step' _ (GroupStart st) = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "-                    ++ "the size of arrays [" ++ show n-                    ++ "] must be a natural number"-        (MutArray contents start end bound :: MutArray a) <- liftIO $ newPinned n-        return $ D.Skip (GroupBuffer st contents start end bound)--    step' gst (GroupBuffer st contents start end bound) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                liftIO $ pokeWith contents end x-                let end1 = INDEX_NEXT(end,a)-                return $-                    if end1 >= bound-                    then D.Skip-                            (GroupYield-                                contents start end1 bound (GroupStart s))-                    else D.Skip (GroupBuffer s contents start end1 bound)-            D.Skip s ->-                return $ D.Skip (GroupBuffer s contents start end bound)-            D.Stop ->-                return-                    $ D.Skip (GroupYield contents start end bound GroupFinish)--    step' _ (GroupYield contents start end bound next) =-        return $ D.Yield (MutArray contents start end bound) next--    step' _ GroupFinish = return D.Stop---- XXX buffer to a list instead?--- | Buffer the stream into arrays in memory.-{-# INLINE arrayStreamKFromStreamD #-}-arrayStreamKFromStreamD :: forall m a. (MonadIO m, Unbox a) =>-    D.Stream m a -> m (StreamK m (MutArray a))-arrayStreamKFromStreamD =-    let n = allocBytesToElemCount (undefined :: a) defaultChunkSize-     in D.foldr K.cons K.nil . chunksOf n------------------------------------------------------------------------------------ Streams of arrays - Flattening----------------------------------------------------------------------------------data FlattenState s contents a =-      OuterLoop s-    | InnerLoop s contents !Int !Int---- | Use the "reader" unfold instead.------ @flattenArrays = unfoldMany reader@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArrays #-}-flattenArrays :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield MutArray{..} s ->-                D.Skip (InnerLoop s arrContents arrStart arrEnd)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st contents p end) = do-        x <- liftIO $ peekWith contents p-        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)---- | Use the "readerRev" unfold instead.------ @flattenArrays = unfoldMany readerRev@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArraysRev #-}-flattenArraysRev :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield MutArray{..} s ->-                let p = INDEX_PREV(arrEnd,a)-                 in D.Skip (InnerLoop s arrContents p arrStart)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p start) | p < start =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st contents p start) = do-        x <- liftIO $ peekWith contents p-        let cur = INDEX_PREV(p,a)-        return $ D.Yield x (InnerLoop st contents cur start)------------------------------------------------------------------------------------ Unfolds----------------------------------------------------------------------------------data ArrayUnsafe a = ArrayUnsafe-    {-# UNPACK #-} !MutableByteArray   -- contents-    {-# UNPACK #-} !Int                -- index 1-    {-# UNPACK #-} !Int                -- index 2--toArrayUnsafe :: MutArray a -> ArrayUnsafe a-toArrayUnsafe (MutArray contents start end _) = ArrayUnsafe contents start end--fromArrayUnsafe ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    ArrayUnsafe a -> MutArray a-fromArrayUnsafe (ArrayUnsafe contents start end) =-         MutArray contents start end end--{-# INLINE_NORMAL producerWith #-}-producerWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> Producer m (MutArray a) a-producerWith liftio = Producer step (return . toArrayUnsafe) extract-    where--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe _ cur end)-        | assert (cur <= end) (cur == end) = return D.Stop-    step (ArrayUnsafe contents cur end) = do-            -- When we use a purely lazy Monad like Identity, we need to force a-            -- few actions for correctness and execution order sanity. We want-            -- the peek to occur right here and not lazily at some later point-            -- because we want the peek to be ordered with respect to the touch.-            !x <- liftio $ peekWith contents cur-            return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)--    extract = return . fromArrayUnsafe---- | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a-producer = producerWith liftIO---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a-reader = Producer.simplify producer--{-# INLINE_NORMAL readerRevWith #-}-readerRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> Unfold m (MutArray a) a-readerRevWith liftio = Unfold step inject-    where--    inject (MutArray contents start end _) =-        let p = INDEX_PREV(end,a)-         in return $ ArrayUnsafe contents start p--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe _ start p) | p < start = return D.Stop-    step (ArrayUnsafe contents start p) = do-        !x <- liftio $ peekWith contents p-        return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))---- | Unfold an array into a stream in reverse order.----{-# INLINE_NORMAL readerRev #-}-readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a-readerRev = readerRevWith liftIO------------------------------------------------------------------------------------ to Lists and streams----------------------------------------------------------------------------------{---- Use foldr/build fusion to fuse with list consumers--- This can be useful when using the IsList instance-{-# INLINE_LATE toListFB #-}-toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b-toListFB c n MutArray{..} = go arrStart-    where--    go p | assert (p <= arrEnd) (p == arrEnd) = n-    go p =-        -- unsafeInlineIO allows us to run this in Identity monad for pure-        -- toList/foldr case which makes them much faster due to not-        -- accumulating the list and fusing better with the pure consumers.-        ---        -- This should be safe as the array contents are guaranteed to be-        -- evaluated/written to before we peek at them.-        -- XXX-        let !x = unsafeInlineIO $ do-                    r <- peekWith arrContents p-                    return r-        in c x (go (PTR_NEXT(p,a)))--}---- XXX Monadic foldr/build fusion?--- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion---- | Convert a 'MutArray' into a list.----{-# INLINE toList #-}-toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]-toList MutArray{..} = liftIO $ go arrStart-    where--    go p | assert (p <= arrEnd) (p == arrEnd) = return []-    go p = do-        x <- peekWith arrContents p-        (:) x <$> go (INDEX_NEXT(p,a))--{-# INLINE_NORMAL toStreamDWith #-}-toStreamDWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamDWith liftio MutArray{..} = D.Stream step arrStart--    where--    {-# INLINE_LATE step #-}-    step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop-    step _ p = liftio $ do-        r <- peekWith arrContents p-        return $ D.Yield r (INDEX_NEXT(p,a))---- | Use the 'reader' unfold instead.------ @toStreamD = D.unfold reader@------ We can try this if the unfold has any performance issues.-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a-toStreamD = toStreamDWith liftIO--{-# INLINE toStreamKWith #-}-toStreamKWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a-toStreamKWith liftio MutArray{..} = go arrStart--    where--    go p | assert (p <= arrEnd) (p == arrEnd) = K.nil-         | otherwise =-        let elemM = peekWith arrContents p-        in liftio elemM `K.consM` go (INDEX_NEXT(p,a))--{-# INLINE toStreamK #-}-toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a-toStreamK = toStreamKWith liftIO--{-# INLINE_NORMAL toStreamDRevWith #-}-toStreamDRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamDRevWith liftio MutArray{..} =-    let p = INDEX_PREV(arrEnd,a)-    in D.Stream step p--    where--    {-# INLINE_LATE step #-}-    step _ p | p < arrStart = return D.Stop-    step _ p = liftio $ do-        r <- peekWith arrContents p-        return $ D.Yield r (INDEX_PREV(p,a))---- | Use the 'readerRev' unfold instead.------ @toStreamDRev = D.unfold readerRev@------ We can try this if the unfold has any perf issues.-{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a-toStreamDRev = toStreamDRevWith liftIO--{-# INLINE toStreamKRevWith #-}-toStreamKRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a-toStreamKRevWith liftio MutArray {..} =-    let p = INDEX_PREV(arrEnd,a)-    in go p--    where--    go p | p < arrStart = K.nil-         | otherwise =-        let elemM = peekWith arrContents p-        in liftio elemM `K.consM` go (INDEX_PREV(p,a))--{-# INLINE toStreamKRev #-}-toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a-toStreamKRev = toStreamKRevWith liftIO------------------------------------------------------------------------------------ Folding------------------------------------------------------------------------------------ XXX Need something like "MutArray m a" enforcing monadic action to avoid the--- possibility of such APIs.------ | Strict left fold of an array.-{-# INLINE_NORMAL foldl' #-}-foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b-foldl' f z arr = D.foldl' f z $ toStreamD arr---- | Right fold of an array.-{-# INLINE_NORMAL foldr #-}-foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b-foldr f z arr = D.foldr f z $ toStreamD arr------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ Note: Arrays may be allocated with a specific alignment at the beginning of--- the array. If you need to maintain that alignment on reallocations then you--- can resize the array manually before append, using an aligned resize--- operation.---- XXX Keep the bound intact to not lose any free space? Perf impact?---- | @writeAppendNUnsafe n alloc@ appends up to @n@ input items to the supplied--- array.------ Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory--- corruption or segfault.------ Any free space left in the array after appending @n@ elements is lost.------ /Internal/-{-# INLINE_NORMAL writeAppendNUnsafe #-}-writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>-       Int-    -> m (MutArray a)-    -> Fold m a (MutArray a)-writeAppendNUnsafe n action =-    fmap fromArrayUnsafe $ FL.foldlM' step initial--    where--    initial = do-        assert (n >= 0) (return ())-        arr@(MutArray _ _ end bound) <- action-        let free = bound - end-            needed = n * SIZE_OF(a)-        -- XXX We can also reallocate if the array has too much free space,-        -- otherwise we lose that space.-        arr1 <--            if free < needed-            then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr-            else return arr-        return $ toArrayUnsafe arr1--    step (ArrayUnsafe contents start end) x = do-        liftIO $ pokeWith contents end x-        return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))---- | Append @n@ elements to an existing array. Any free space left in the array--- after appending @n@ elements is lost.------ >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)----{-# INLINE_NORMAL writeAppendN #-}-writeAppendN :: forall m a. (MonadIO m, Unbox a) =>-    Int -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)---- | @writeAppendWith realloc action@ mutates the array generated by @action@ to--- append the input stream. If there is no reserved space available in the--- array it is reallocated to a size in bytes  determined by @realloc oldSize@,--- where @oldSize@ is the current size of the array in bytes.------ Note that the returned array may be a mutated version of original array.------ >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)------ /Pre-release/-{-# INLINE writeAppendWith #-}-writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendWith sizer = FL.foldlM' (snocWith sizer)---- | @append action@ mutates the array generated by @action@ to append the--- input stream. If there is no reserved space available in the array it is--- reallocated to double the size.------ Note that the returned array may be a mutated version of original array.------ >>> writeAppend = MutArray.writeAppendWith (* 2)----{-# INLINE writeAppend #-}-writeAppend :: forall m a. (MonadIO m, Unbox a) =>-    m (MutArray a) -> Fold m a (MutArray a)-writeAppend = writeAppendWith (* 2)---- XXX We can carry bound as well in the state to make sure we do not lose the--- remaining capacity. Need to check perf impact.------ | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function--- as argument.------ >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n------ /Pre-release/-{-# INLINE_NORMAL writeNWithUnsafe #-}-writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial--    where--    initial = toArrayUnsafe <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        liftIO $ pokeWith contents end x-        return-          $ ArrayUnsafe contents start (INDEX_NEXT(end,a))---- | Like 'writeN' but does not check the array bounds when writing. The fold--- driver must not call the step function more than 'n' times otherwise it will--- corrupt the memory and crash. This function exists mainly because any--- conditional in the step function blocks fusion causing 10x performance--- slowdown.------ >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.newPinned----{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-writeNUnsafe = writeNWithUnsafe newPinned---- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array--- allocated using the @alloc@ function.------ >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)--- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n----{-# INLINE_NORMAL writeNWith #-}-writeNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'MutArray'.------ >>> writeN = MutArray.writeNWith MutArray.newPinned--- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)--- >>> writeN n = MutArray.writeAppendN n (MutArray.newPinned n)----{-# INLINE_NORMAL writeN #-}-writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeN = writeNWith newPinned---- | Like writeNWithUnsafe but writes the array in reverse order.------ /Internal/-{-# INLINE_NORMAL writeRevNWithUnsafe #-}-writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial--    where--    toArrayUnsafeRev (MutArray contents _ _ bound) =-         ArrayUnsafe contents bound bound--    initial = toArrayUnsafeRev <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        let ptr = INDEX_PREV(start,a)-        liftIO $ pokeWith contents ptr x-        return-          $ ArrayUnsafe contents ptr end---- | Like writeNWith but writes the array in reverse order.------ /Internal/-{-# INLINE_NORMAL writeRevNWith #-}-writeRevNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)---- | Like writeN but writes the array in reverse order.------ /Pre-release/-{-# INLINE_NORMAL writeRevN #-}-writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeRevN = writeRevNWith newPinned---- | @writeNAligned align n@ folds a maximum of @n@ elements from the input--- stream to a 'MutArray' aligned to the given size.------ >>> writeNAligned align = MutArray.writeNWith (MutArray.newAlignedPinned align)--- >>> writeNAligned align n = MutArray.writeAppendN n (MutArray.newAlignedPinned align n)------ /Pre-release/----{-# INLINE_NORMAL writeNAligned #-}-writeNAligned :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> Fold m a (MutArray a)-writeNAligned align = writeNWith (newAlignedPinned align)---- XXX Buffer to a list instead?------ | Buffer a stream into a stream of arrays.------ >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK------ Breaking an array into an array stream  can be useful to consume a large--- array sequentially such that memory of the array is released incrementatlly.------ See also: 'arrayStreamKFromStreamD'.------ /Unimplemented/----{-# INLINE_NORMAL writeChunks #-}-writeChunks :: (MonadIO m, Unbox a) =>-    Int -> Fold m a (StreamK n (MutArray a))-writeChunks n = FL.many (writeN n) FL.toStreamK---- XXX Compare writeWith with fromStreamD which uses an array of streams--- implementation. We can write this using writeChunks above if that is faster.--- If writeWith is faster then we should use that to implement--- fromStreamD.------ XXX The realloc based implementation needs to make one extra copy if we use--- shrinkToFit.  On the other hand, the stream of arrays implementation may--- buffer the array chunk pointers in memory but it does not have to shrink as--- we know the exact size in the end. However, memory copying does not seem to--- be as expensive as the allocations. Therefore, we need to reduce the number--- of allocations instead. Also, the size of allocations matters, right sizing--- an allocation even at the cost of copying sems to help.  Should be measured--- on a big stream with heavy calls to toArray to see the effect.------ XXX check if GHC's memory allocator is efficient enough. We can try the C--- malloc to compare against.---- | @writeWith minCount@ folds the whole input to a single array. The array--- starts at a size big enough to hold minCount elements, the size is doubled--- every time the array needs to be grown.------ /Caution! Do not use this on infinite streams./------ >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)--- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)--- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)------ /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)--- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)-writeWith elemCount =-    FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ newPinned elemCount--    step arr@(MutArray _ start end bound) x-        | INDEX_NEXT(end,a) > bound = do-        let oldSize = end - start-            newSize = max (oldSize * 2) 1-        arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x--    extract = liftIO . rightSize---- | Fold the whole input to a single array.------ Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes--- rounded up to the element size.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)------------------------------------------------------------------------------------ construct from streams, known size------------------------------------------------------------------------------------ | Use the 'writeN' fold instead.------ >>> fromStreamDN n = Stream.fold (MutArray.writeN n)----{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> m (MutArray a)--- fromStreamDN n = D.fold (writeN n)-fromStreamDN limit str = do-    (arr :: MutArray a) <- liftIO $ newPinned limit-    end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str-    return $ arr {arrEnd = end}--    where--    fwrite arrContents ptr x = do-        liftIO $ pokeWith arrContents ptr x-        return $ INDEX_NEXT(ptr,a)---- | Create a 'MutArray' from the first N elements of a list. The array is--- allocated to size N, if the list terminates before N elements then the--- array may hold less than N elements.----{-# INLINABLE fromListN #-}-fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-fromListN n xs = fromStreamDN n $ D.fromList xs---- | Like fromListN but writes the array in reverse order.------ /Pre-release/-{-# INLINE fromListRevN #-}-fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs------------------------------------------------------------------------------------ convert stream to a single array----------------------------------------------------------------------------------{-# INLINE arrayStreamKLength #-}-arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int-arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)---- | Convert an array stream to an array. Note that this requires peak memory--- that is double the size of the array stream.----{-# INLINE fromArrayStreamK #-}-fromArrayStreamK :: (Unbox a, MonadIO m) =>-    StreamK m (MutArray a) -> m (MutArray a)-fromArrayStreamK as = do-    len <- arrayStreamKLength as-    fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as---- CAUTION: a very large number (millions) of arrays can degrade performance--- due to GC overhead because we need to buffer the arrays before we flatten--- all the arrays.------ XXX Compare if this is faster or "fold write".------ | We could take the approach of doubling the memory allocation on each--- overflow. This would result in more or less the same amount of copying as in--- the chunking approach. However, if we have to shrink in the end then it may--- result in an extra copy of the entire data.------ >>> fromStreamD = StreamD.fold MutArray.write----{-# INLINE fromStreamD #-}-fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)-fromStreamD m = arrayStreamKFromStreamD m >>= fromArrayStreamK---- | Create a 'MutArray' from a list. The list must be of finite size.----{-# INLINE fromList #-}-fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-fromList xs = fromStreamD $ D.fromList xs---- XXX We are materializing the whole list first for getting the length. Check--- if the 'fromList' like chunked implementation would fare better.---- | Like 'fromList' but writes the contents of the list in reverse order.-{-# INLINE fromListRev #-}-fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-fromListRev xs = fromListRevN (Prelude.length xs) xs------------------------------------------------------------------------------------ Combining------------------------------------------------------------------------------------ | Put a sub range of a source array into a subrange of a destination array.--- This is not safe as it does not check the bounds.-{-# INLINE putSliceUnsafe #-}-putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()-putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do-    assertM(lenBytes <= arrBound dst - dstStartBytes)-    assertM(lenBytes <= arrEnd src - srcStartBytes)-    let !(I# srcStartBytes#) = srcStartBytes-        !(I# dstStartBytes#) = dstStartBytes-        !(I# lenBytes#) = lenBytes-    let arrS# = getMutableByteArray# (arrContents src)-        arrD# = getMutableByteArray# (arrContents dst)-    IO $ \s# -> (# copyMutableByteArray#-                    arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#-                , () #)---- | Copy two arrays into a newly allocated array.-{-# INLINE spliceCopy #-}-spliceCopy :: forall m a. MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a -> MutArray a -> m (MutArray a)-spliceCopy arr1 arr2 = liftIO $ do-    let start1 = arrStart arr1-        start2 = arrStart arr2-        len1 = arrEnd arr1 - start1-        len2 = arrEnd arr2 - start2-    newArrContents <- liftIO $ Unboxed.newPinnedBytes (len1 + len2)-    let len = len1 + len2-        newArr = MutArray newArrContents 0 len len-    putSliceUnsafe arr1 start1 newArr 0 len1-    putSliceUnsafe arr2 start2 newArr len1 len2-    return newArr---- | Really really unsafe, appends the second array into the first array. If--- the first array does not have enough space it may cause silent data--- corruption or if you are lucky a segfault.-{-# INLINE spliceUnsafe #-}-spliceUnsafe :: MonadIO m =>-    MutArray a -> MutArray a -> m (MutArray a)-spliceUnsafe dst src =-    liftIO $ do-         let startSrc = arrStart src-             srcLen = arrEnd src - startSrc-             endDst = arrEnd dst-         assertM(endDst + srcLen <= arrBound dst)-         putSliceUnsafe src startSrc dst endDst srcLen-         return $ dst {arrEnd = endDst + srcLen}---- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no--- reserved space available in @dst@ it is reallocated to a size determined by--- the @sizer dstBytes srcBytes@ function, where @dstBytes@ is the size of the--- first array and @srcBytes@ is the size of the second array, in bytes.------ Note that the returned array may be a mutated version of first array.------ /Pre-release/-{-# INLINE spliceWith #-}-spliceWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)-spliceWith sizer dst@(MutArray _ start end bound) src = do-{--    let f = writeAppendWith (`sizer` byteLength src) (return dst)-     in D.fold f (toStreamD src)--}-    assert (end <= bound) (return ())-    let srcBytes = arrEnd src - arrStart src--    dst1 <--        if end + srcBytes >= bound-        then do-            let dstBytes = end - start-                newSizeInBytes = sizer dstBytes srcBytes-            when (newSizeInBytes < dstBytes + srcBytes)-                $ error-                    $ "splice: newSize is less than the total size "-                    ++ "of arrays being appended. Please check the "-                    ++ "sizer function passed."-            liftIO $ realloc newSizeInBytes dst-        else return dst-    spliceUnsafe dst1 src---- | The first array is mutated to append the second array. If there is no--- reserved space available in the first array a new allocation of exact--- required size is done.------ Note that the returned array may be a mutated version of first array.------ >>> splice = MutArray.spliceWith (+)------ /Pre-release/-{-# INLINE splice #-}-splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)-splice = spliceWith (+)---- | Like 'append' but the growth of the array is exponential. Whenever a new--- allocation is required the previous array size is at least doubled.------ This is useful to reduce allocations when folding many arrays together.------ Note that the returned array may be a mutated version of first array.------ >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------ /Pre-release/-{-# INLINE spliceExp #-}-spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)-spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------------------------------------------------------------------------------------ Splitting------------------------------------------------------------------------------------ | Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m-    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))-breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do-    -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted-    -- Addr# to memchr and it should be safe (from ghc 8.4).-    -- XXX We do not need memchr here, we can use a Haskell equivalent.-    loc <- c_memchr p sep (fromIntegral $ byteLength arr)-    let sepIndex = loc `minusPtr` p-    return $-        if loc == nullPtr-        then (arr, Nothing)-        else-            ( MutArray-                { arrContents = arrContents-                , arrStart = arrStart-                , arrEnd = arrStart + sepIndex -- exclude the separator-                , arrBound = arrStart + sepIndex-                }-            , Just $ MutArray-                    { arrContents = arrContents-                    , arrStart = arrStart + (sepIndex + 1)-                    , arrEnd = arrEnd-                    , arrBound = arrBound-                    }-            )---- | Create two slices of an array without copying the original array. The--- specified index @i@ is the first index of the second slice.----splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)-splitAt i arr@MutArray{..} =-    let maxIndex = length arr - 1-    in  if i < 0-        then error "sliceAt: negative array index"-        else if i > maxIndex-             then error $ "sliceAt: specified array index " ++ show i-                        ++ " is beyond the maximum index " ++ show maxIndex-             else let off = i * SIZE_OF(a)-                      p = arrStart + off-                in ( MutArray-                  { arrContents = arrContents-                  , arrStart = arrStart-                  , arrEnd = p-                  , arrBound = p-                  }-                , MutArray-                  { arrContents = arrContents-                  , arrStart = p-                  , arrEnd = arrEnd-                  , arrBound = arrBound-                  }-                )------------------------------------------------------------------------------------ Casting------------------------------------------------------------------------------------ | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The array size must be a multiple of the size of type @b@--- otherwise accessing the last element of the array may result into a crash or--- a random value.------ /Pre-release/----castUnsafe ::-#ifdef DEVBUILD-    Unbox b =>-#endif-    MutArray a -> MutArray b-castUnsafe (MutArray contents start end bound) =-    MutArray contents start end bound---- | Cast an @MutArray a@ into an @MutArray Word8@.----asBytes :: MutArray a -> MutArray Word8-asBytes = castUnsafe---- | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The length of the array should be a multiple of the size of the--- target element otherwise 'Nothing' is returned.----cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)-cast arr =-    let len = byteLength arr-        r = len `mod` SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr---- XXX We can provide another API for "unsafe" FFI calls passing an unlifted--- pointer to the FFI call. For unsafe calls we do not need to pin the array.--- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in--- before the pointer is wrapped.------ From the GHC manual:------ GHC, since version 8.4, guarantees that garbage collection will never occur--- during an unsafe call, even in the bytecode interpreter, and further--- guarantees that unsafe calls will be performed in the calling thread. Making--- it safe to pass heap-allocated objects to unsafe functions.---- Unsafe because of direct pointer operations. The user must ensure that they--- are writing within the legal bounds of the array. Should we just name it--- asPtr, the unsafety is implicit for any pointer operations. And we are safe--- from Haskell perspective because we will be pinning the memory.---- | Use an @MutArray a@ as @Ptr a@. This is useful when we want to pass an array--- as a pointer to some operating system call or to a "safe" FFI call.------ If the array is not pinned it is copied to pinned memory before passing it--- to the monadic action.------ /Performance Notes:/ Forces a copy if the array is not pinned. It is advised--- that the programmer keeps this in mind and creates a pinned array--- opportunistically before this operation occurs, to avoid the cost of a copy--- if possible.------ /Unsafe/------ /Pre-release/----asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-asPtrUnsafe arr f = do-  let contents = arrContents arr-      !ptr = Ptr (byteArrayContents#-                     (unsafeCoerce# (getMutableByteArray# contents)))-  -- XXX Check if the array is pinned, if not, copy it to a pinned array-  -- XXX We should probably pass to the IO action the byte length of the array-  -- as well so that bounds can be checked.-  r <- f (ptr `plusPtr` arrStart arr)-  liftIO $ touch contents-  return r------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Compare the length of the arrays. If the length is equal, compare the--- lexicographical ordering of two underlying byte arrays otherwise return the--- result of length comparison.------ /Pre-release/-{-# INLINE cmp #-}-cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering-cmp arr1 arr2 =-    liftIO-        $ do-            let marr1 = getMutableByteArray# (arrContents arr1)-                marr2 = getMutableByteArray# (arrContents arr2)-                !(I# st1#) = arrStart arr1-                !(I# st2#) = arrStart arr2-                !(I# len#) = byteLength arr1-            case compare (byteLength arr1) (byteLength arr2) of-                EQ -> do-                    r <- liftIO $ IO $ \s# ->-                             let res =-                                     I#-                                         (compareByteArrays#-                                              (unsafeCoerce# marr1)-                                              st1#-                                              (unsafeCoerce# marr2)-                                              st2#-                                              len#)-                              in (# s#, res #)-                    return $ compare r 0-                x -> return x------------------------------------------------------------------------------------ NFData------------------------------------------------------------------------------------ | Strip elements which match with predicate from both ends.------ /Pre-release/-{-# INLINE strip #-}-strip :: forall a m. (Unbox a, MonadIO m) =>-    (a -> Bool) -> MutArray a -> m (MutArray a)-strip eq arr@MutArray{..} = liftIO $ do-    st <- getStart arrStart-    end <- getLast arrEnd st-    return arr {arrStart = st, arrEnd = end, arrBound = end}--    where--    {--    -- XXX This should have the same perf but it does not, investigate.-    getStart = do-        r <- liftIO $ D.head $ D.findIndices (not . eq) $ toStreamD arr-        pure $-            case r of-                Nothing -> arrEnd-                Just i -> PTR_INDEX(arrStart,i,a)-    -}--    getStart cur = do-        if cur < arrEnd-        then do-            r <- peekWith arrContents cur-            if eq r-            then getStart (INDEX_NEXT(cur,a))-            else return cur-        else return cur--    getLast cur low = do-        if cur > low-        then do-            let prev = INDEX_PREV(cur,a)-            r <- peekWith arrContents prev-            if eq r-            then getLast prev low-            else return cur-        else return cur---- | Given an array sorted in ascending order except the last element being out--- of order, use bubble sort to place the last element at the right place such--- that the array remains sorted in ascending order.------ /Pre-release/-{-# INLINE bubble #-}-bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()-bubble cmp0 arr =-    when (l > 1) $ do-        x <- getIndexUnsafe (l - 1) arr-        go x (l - 2)--        where--        l = length arr--        go x i =-            if i >= 0-            then do-                x1 <- getIndexUnsafe i arr-                case x `cmp0` x1 of-                    LT -> do-                        putIndexUnsafe (i + 1) arr x1-                        go x (i - 1)-                    _ -> putIndexUnsafe (i + 1) arr x-            else putIndexUnsafe (i + 1) arr x
+ src/Streamly/Internal/Data/Array/Stream.hs view
@@ -0,0 +1,1232 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+-- |+-- Module      : Streamly.Internal.Data.Array.Stream+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Combinators to efficiently manipulate streams of immutable arrays.+--+-- We can either push these in the MutArray module with a "chunks" prefix or+-- keep this as a separate module and release it.+--+module Streamly.Internal.Data.Array.Stream+    (+    -- * Creation+      Array.chunksOf+    , Array.pinnedChunksOf+    , Array.bufferChunks++    -- * Flattening to elements+    , concat+    , Array.flattenArrays+    , concatRev+    , Array.flattenArraysRev+    , interpose+    , interposeSuffix+    , intercalateSuffix+    , unlines++    -- * Elimination+    -- ** Element Folds+    -- The byte level foldBreak can work as efficiently as the chunk level. We+    -- can flatten the stream to byte stream and use that. But if we want the+    -- remaining stream to be a chunk stream then this could be handy. But it+    -- could also be implemented using parseBreak.+    , foldBreak+    , foldBreakD+    -- The byte level parseBreak cannot work efficiently. Because the stream+    -- will have to be a StreamK for backtracking, StreamK at byte level would+    -- not be efficient.+    , parseBreak -- StreamK.parseBreakChunks+    -- , parseBreakD+    -- , foldManyChunks+    -- , parseManyChunks+    , K.parseBreakChunks+    , K.parseChunks++    -- ** Array Folds+    -- XXX Use parseBreakChunks/parseChunks instead+    -- foldBreak can be implemented using parseBreak. Use StreamK.+    , runArrayFold+    , runArrayFoldBreak+    -- , parseArr+    , runArrayParserDBreak -- StreamK.parseBreakChunks+    , runArrayFoldMany++    , toArray++    -- * Compaction+    -- We can use something like foldManyChunks, parseManyChunks with a take+    -- fold.+    , lpackArraysChunksOf -- Fold.compactChunks+    , compact -- rechunk, compactChunks++    -- * Splitting+    -- We can use something like foldManyChunks, parseManyChunks with an+    -- appropriate splitting fold.+    , splitOn       -- Stream.rechunkOn+    , splitOnSuffix -- Stream.rechunkOnSuffix+    )+where++#include "ArrayMacros.h"+#include "inline.hs"++import Data.Bifunctor (second)+import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Proxy (Proxy(..))+import Data.Word (Word8)+import Streamly.Internal.Data.Unbox (Unbox(..))+import Fusion.Plugin.Types (Fuse(..))+import GHC.Exts (SpecConstrAnnotation(..))+import GHC.Types (SPEC(..))+import Prelude hiding (null, last, (!!), read, concat, unlines)++import Streamly.Data.Fold (Fold)+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Chunked (ChunkFold(..))+import Streamly.Internal.Data.Parser (ParseError(..))+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.StreamK (StreamK, fromStream, toStream)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))++import qualified Streamly.Data.Fold as FL+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.MutArray.Stream as AS+import qualified Streamly.Internal.Data.Fold.Type as FL (Fold(..), Step(..))+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.Parser as PRD+    (Parser(..), Initial(..))+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K++-- XXX Since these are immutable arrays MonadIO constraint can be removed from+-- most places.++-------------------------------------------------------------------------------+-- 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 :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+-- concat m = fromStreamD $ A.flattenArrays (toStreamD m)+-- concat m = fromStreamD $ D.concatMap A.toStreamD (toStreamD m)+concat = D.unfoldMany A.reader++-- | Convert a stream of arrays into a stream of their elements reversing the+-- contents of each array before flattening.+--+-- > concatRev = Stream.unfoldMany Array.readerRev+--+-- @since 0.7.0+{-# INLINE concatRev #-}+concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+-- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m)+concatRev = D.unfoldMany A.readerRev++-------------------------------------------------------------------------------+-- Intersperse and append+-------------------------------------------------------------------------------++-- | Flatten a stream of arrays after inserting the given element between+-- arrays.+--+-- /Pre-release/+{-# INLINE interpose #-}+interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+interpose x = D.interpose x A.reader++{-# INLINE intercalateSuffix #-}+intercalateSuffix :: (Monad m, Unbox a)+    => Array a -> Stream m (Array a) -> Stream m a+intercalateSuffix = D.intercalateSuffix A.reader++-- | Flatten a stream of arrays appending the given element after each+-- array.+--+-- @since 0.7.0+{-# INLINE interposeSuffix #-}+interposeSuffix :: (Monad m, Unbox a)+    => a -> Stream m (Array a) -> Stream m a+-- interposeSuffix x = fromStreamD . A.unlines x . toStreamD+interposeSuffix x = D.interposeSuffix x A.reader++data FlattenState s =+      OuterLoop s+    | InnerLoop s !MA.MutableByteArray !Int !Int++-- XXX This is a special case of interposeSuffix, can be removed.+-- XXX Remove monadIO constraint+{-# INLINE_NORMAL unlines #-}+unlines :: forall m a. (MonadIO m, Unbox a)+    => a -> D.Stream m (Array a) -> D.Stream m a+unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state)+    where+    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield Array{..} s ->+                D.Skip (InnerLoop s arrContents arrStart arrEnd)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p end) | p == end =+        return $ D.Yield sep $ OuterLoop st++    step' _ (InnerLoop st contents p end) = do+        x <- liftIO $ peekByteIndex p contents+        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- XXX These would not be needed once we implement compactLEFold, see+-- module Streamly.Internal.Data.Stream.MutChunked+--+-- XXX Note that this thaws immutable arrays for appending, that may be+-- problematic if multiple users do the same thing, however, immutable arrays+-- would usually have no capacity to append, therefore, a copy will be forced+-- anyway. Confirm this. We can forcefully trim the array capacity before thaw+-- to ensure this.+{-# INLINE_NORMAL packArraysChunksOf #-}+packArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)+packArraysChunksOf n str =+    D.map A.unsafeFreeze $ AS.packArraysChunksOf n $ D.map A.unsafeThaw str++-- XXX instead of writing two different versions of this operation, we should+-- write it as a pipe.+--+-- XXX Confirm that immutable arrays won't be modified.+{-# INLINE_NORMAL lpackArraysChunksOf #-}+lpackArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> Fold m (Array a) () -> Fold m (Array a) ()+lpackArraysChunksOf n fld =+    FL.lmap A.unsafeThaw $ AS.lpackArraysChunksOf n (FL.lmap A.unsafeFreeze 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, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+compact = packArraysChunksOf++-------------------------------------------------------------------------------+-- 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 byte (D.Stream step state) = D.Stream step' (Initial state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Initial st) = do+        r <- step gst st+        case r of+            D.Yield arr s -> do+                (arr1, marr2) <- A.breakOn byte arr+                return $ case marr2 of+                    Nothing   -> D.Skip (Buffering s arr1)+                    Just arr2 -> D.Skip (Yielding arr1 (Splitting s arr2))+            D.Skip s -> return $ D.Skip (Initial s)+            D.Stop -> return D.Stop++    step' gst (Buffering st buf) = do+        r <- step gst st+        case r of+            D.Yield arr s -> do+                (arr1, marr2) <- A.breakOn byte arr+                buf' <- A.splice buf arr1+                return $ case marr2 of+                    Nothing -> D.Skip (Buffering s buf')+                    Just x -> D.Skip (Yielding buf' (Splitting s x))+            D.Skip s -> return $ D.Skip (Buffering s buf)+            D.Stop -> return $+                if A.byteLength buf == 0+                then D.Stop+                else D.Skip (Yielding buf Finishing)++    step' _ (Splitting st buf) = do+        (arr1, marr2) <- A.breakOn byte buf+        return $ case marr2 of+                Nothing -> D.Skip $ Buffering st arr1+                Just arr2 -> D.Skip $ Yielding arr1 (Splitting st arr2)++    step' _ (Yielding arr next) = return $ D.Yield arr next+    step' _ Finishing = return 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+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+splitOn byte = D.splitInnerBy (A.breakOn byte) A.splice++{-# INLINE splitOnSuffix #-}+splitOnSuffix+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+-- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s+splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice++-------------------------------------------------------------------------------+-- Elimination - Running folds+-------------------------------------------------------------------------------++{-# INLINE_NORMAL foldBreakD #-}+foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))+foldBreakD (FL.Fold fstep initial _ final) stream@(D.Stream step state) = do+    res <- initial+    case res of+        FL.Partial fs -> go SPEC state fs+        FL.Done fb -> return $! (fb, stream)++    where++    {-# INLINE go #-}+    go !_ st !fs = do+        r <- step defState st+        case r of+            D.Yield (Array contents start end) s ->+                let fp = Tuple' end contents+                 in goArray SPEC s fp start fs+            D.Skip s -> go SPEC s fs+            D.Stop -> do+                b <- final fs+                return (b, D.nil)++    goArray !_ s (Tuple' end _) !cur !fs+        | cur == end = do+            go SPEC s fs+    goArray !_ st fp@(Tuple' end contents) !cur !fs = do+        x <- liftIO $ peekByteIndex cur contents+        res <- fstep fs x+        let next = INDEX_NEXT(cur,a)+        case res of+            FL.Done b -> do+                let arr = Array contents next end+                return $! (b, D.cons arr (D.Stream step st))+            FL.Partial fs1 -> goArray SPEC st fp next fs1++{-# INLINE_NORMAL foldBreakK #-}+foldBreakK :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> K.StreamK m (Array a) -> m (b, K.StreamK m (Array a))+foldBreakK (FL.Fold fstep initial _ final) stream = do+    res <- initial+    case res of+        FL.Partial fs -> go fs stream+        FL.Done fb -> return (fb, stream)++    where++    {-# INLINE go #-}+    go !fs st = do+        let stop = (, K.nil) <$> final fs+            single a = yieldk a K.nil+            yieldk (Array contents start end) r =+                let fp = Tuple' end contents+                 in goArray fs r fp start+         in K.foldStream defState yieldk single stop st++    goArray !fs st (Tuple' end _) !cur+        | cur == end = do+            go fs st+    goArray !fs st fp@(Tuple' end contents) !cur = do+        x <- liftIO $ peekByteIndex cur contents+        res <- fstep fs x+        let next = INDEX_NEXT(cur,a)+        case res of+            FL.Done b -> do+                let arr = Array contents next end+                return $! (b, K.cons arr st)+            FL.Partial fs1 -> goArray fs1 st fp next++-- | Fold an array stream using the supplied 'Fold'. Returns the fold result+-- and the unconsumed stream.+--+-- > foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)+--+-- /Internal/+--+{-# INLINE_NORMAL foldBreak #-}+foldBreak ::+       (MonadIO m, Unbox a)+    => Fold m a b+    -> StreamK m (A.Array a)+    -> m (b, StreamK m (A.Array a))+-- foldBreak f s = fmap fromStreamD <$> foldBreakD f (toStreamD s)+foldBreak = foldBreakK+-- If foldBreak performs better than runArrayFoldBreak we can use a rewrite+-- rule to rewrite runArrayFoldBreak to fold.+-- foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)++-------------------------------------------------------------------------------+-- 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. Unbox a => Int -> [Array a] -> [Array a]+takeArrayListRev = go++    where++    go _ [] = []+    go n _ | n <= 0 = []+    go n (x:xs) =+        let len = Array.length x+        in if n > len+           then x : go (n - len) xs+           else if n == len+           then [x]+           else let !(Array contents _ end) = x+                    !start = end - (n * SIZE_OF(a))+                 in [Array contents start 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. Unbox a => Int -> [Array a] -> ([Array a],[Array a])+splitAtArrayListRev n ls+  | n <= 0 = ([], ls)+  | otherwise = go n ls+    where+        go :: Int -> [Array a] -> ([Array a], [Array a])+        go _  []     = ([], [])+        go m (x:xs) =+            let len = Array.length x+                (xs', xs'') = go (m - len) xs+             in if m > len+                then (x:xs', xs'')+                else if m == len+                then ([x],xs)+                else let !(Array contents start end) = x+                         end1 = end - (m * SIZE_OF(a))+                         arr2 = Array contents start end1+                         arr1 = Array contents end1 end+                      in ([arr1], arr2: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, Unbox a)+    => Int -> Stream m (MutArray a) -> m (MutArray a)+spliceArraysLenUnsafe len buffered = do+    -- XXX The new array's pinned state should depend on the first element+    -- of the stream. We should uncons the stream and do the required.+    arr <- undefined+    D.foldlM' MA.spliceUnsafe (return arr) buffered++{-# INLINE _spliceArrays #-}+_spliceArrays :: (MonadIO m, Unbox a)+    => Stream m (Array a) -> m (Array a)+_spliceArrays s = do+    buffered <- D.foldr K.cons K.nil s+    len <- K.fold FL.sum (fmap Array.length buffered)+    -- XXX The new array's pinned state should depend on the first element+    -- of the stream. We should uncons the stream and do the required.+    arr <- undefined+    final <- D.foldlM' writeArr (return arr) (toStream buffered)+    return $ A.unsafeFreeze final++    where++    writeArr dst arr = MA.spliceUnsafe dst (A.unsafeThaw arr)++{-# INLINE _spliceArraysBuffered #-}+_spliceArraysBuffered :: (MonadIO m, Unbox a)+    => Stream m (Array a) -> m (Array a)+_spliceArraysBuffered s = do+    buffered <- D.foldr K.cons K.nil s+    len <- K.fold FL.sum (fmap Array.length buffered)+    A.unsafeFreeze <$>+        spliceArraysLenUnsafe len (fmap A.unsafeThaw (toStream buffered))++-}++{-# INLINE spliceArraysRealloced #-}+spliceArraysRealloced :: forall m a. (MonadIO m, Unbox a)+    => Stream m (Array a) -> m (Array a)+spliceArraysRealloced s = do+    res <- D.uncons s+    case res of+        Just (a, strm) -> do+            arr <-+                D.foldlM'+                    MA.spliceExp+                    (pure (A.unsafeThaw a))+                    (fmap A.unsafeThaw strm)+            liftIO $ A.unsafeFreeze <$> MA.rightSize arr+        Nothing -> pure A.nil++-- 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, Unbox a) => Stream m (Array a) -> m (Array a)+toArray = 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 :: (MonadIO m, Unbox 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, Unbox a)+    => Int -> Fold m a (Stream Identity (Array a))+_toArraysOf n = FL.groupsOf 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 {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 parseBreakD #-}+parseBreakD ::+       forall m a b. (MonadIO m, MonadThrow m, Unbox a)+    => PRD.Parser a m b+    -> D.Stream m (Array.Array a)+    -> m (b, D.Stream m (Array.Array a))+parseBreakD+    (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do++    res <- initial+    case res of+        PRD.IPartial s -> go SPEC state (List []) s+        PRD.IDone b -> return (b, stream)+        PRD.IError err -> throwM $ ParseError 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 !_ st backBuf !pst = do+        r <- step defState st+        case r of+            D.Yield (Array contents start end) s ->+                gobuf SPEC s backBuf+                    (Tuple' end contents) start pst+            D.Skip s -> go SPEC s backBuf pst+            D.Stop -> do+                b <- extract pst+                return (b, D.nil)++    -- Use strictness on "cur" to keep it unboxed+    gobuf !_ s backBuf (Tuple' end _) !cur !pst+        | cur == end = do+            go SPEC s backBuf pst+    gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do+        x <- liftIO $ peekByteIndex contents cur+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            PR.Partial 0 pst1 ->+                 gobuf SPEC s (List []) fp next pst1+            PR.Partial n pst1 -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let src0 = Prelude.take n (x:getList backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                let !(Array cont1 start end1) = src+                    fp1 = Tuple' end1 cont1+                gobuf SPEC s (List []) fp1 start pst1+            PR.Continue 0 pst1 ->+                gobuf SPEC s (List (x:getList backBuf)) fp next pst1+            PR.Continue n pst1 -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let (src0, buf1) = splitAt n (x:getList backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                let !(Array cont1 start end1) = src+                    fp1 = Tuple' end1 cont1+                gobuf SPEC s (List buf1) fp1 start pst1+            PR.Done 0 b -> do+                let arr = Array contents next end+                return (b, D.cons arr (D.Stream step s))+            PR.Done n b -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let src0 = Prelude.take n (x:getList backBuf)+                    -- XXX create the array in reverse instead+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    -- XXX Use StreamK to avoid adding arbitrary layers of+                    -- constructors every time.+                    str = D.cons arr0 (D.cons arr1 (D.Stream step s))+                return (b, str)+            PR.Error err -> throwM $ ParseError err+-}++{-# INLINE_NORMAL parseBreakK #-}+parseBreakK ::+       forall m a b. (MonadIO m, Unbox a)+    => PRD.Parser a m b+    -> K.StreamK m (Array.Array a)+    -> m (Either ParseError b, K.StreamK m (Array.Array a))+parseBreakK (PRD.Parser pstep initial extract) stream = do+    res <- initial+    case res of+        PRD.IPartial s -> go s stream []+        PRD.IDone b -> return (Right b, stream)+        PRD.IError err -> return (Left (ParseError err), stream)++    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 !pst st backBuf = do+        let stop = goStop pst backBuf -- (, K.nil) <$> extract pst+            single a = yieldk a K.nil+            yieldk arr r = goArray pst backBuf r arr+         in K.foldStream defState yieldk single stop st++    -- Use strictness on "cur" to keep it unboxed+    goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf+    goArray !pst backBuf st (Array contents cur end) = do+        x <- liftIO $ peekByteIndex cur contents+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            PR.Partial 0 s ->+                 goArray s [] st (Array contents next end)+            PR.Partial n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let src0 = Prelude.take n (x:backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goArray s [] st src+            PR.Continue 0 s ->+                goArray s (x:backBuf) st (Array contents next end)+            PR.Continue n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let (src0, buf1) = splitAt n (x:backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goArray s buf1 st src+            PR.Done 0 b -> do+                let arr = Array contents next end+                return (Right b, K.cons arr st)+            PR.Done n b -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let src0 = Prelude.take n (x:backBuf)+                    -- XXX Use fromListRevN once implemented+                    -- arr0 = A.fromListRevN n src0+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    str = K.cons arr0 (K.cons arr1 st)+                return (Right b, str)+            PR.Error err -> do+                let n = Prelude.length backBuf+                    arr0 = A.fromListN n (Prelude.reverse backBuf)+                    arr1 = Array contents cur end+                    str = K.cons arr0 (K.cons arr1 stream)+                return (Left (ParseError err), str)++    -- This is a simplified goArray+    goExtract !pst backBuf (Array _ cur end)+        | cur == end = goStop pst backBuf+    goExtract !pst backBuf (Array contents cur end) = do+        x <- liftIO $ peekByteIndex cur contents+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            PR.Partial 0 s ->+                 goExtract s [] (Array contents next end)+            PR.Partial n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let src0 = Prelude.take n (x:backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goExtract s [] src+            PR.Continue 0 s ->+                goExtract s backBuf (Array contents next end)+            PR.Continue n s -> do+                assert (n <= Prelude.length (x:backBuf)) (return ())+                let (src0, buf1) = splitAt n (x:backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                goExtract s buf1 src+            PR.Done 0 b -> do+                let arr = Array contents next end+                return (Right b, K.fromPure arr)+            PR.Done n b -> do+                assert (n <= Prelude.length backBuf) (return ())+                let src0 = Prelude.take n backBuf+                    -- XXX Use fromListRevN once implemented+                    -- arr0 = A.fromListRevN n src0+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    str = K.cons arr0 (K.fromPure arr1)+                return (Right b, str)+            PR.Error err -> do+                let n = Prelude.length backBuf+                    arr0 = A.fromListN n (Prelude.reverse backBuf)+                    arr1 = Array contents cur end+                    str = K.cons arr0 (K.cons arr1 stream)+                return (Left (ParseError err), str)++    -- This is a simplified goExtract+    {-# INLINE goStop #-}+    goStop !pst backBuf = do+        pRes <- extract pst+        case pRes of+            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"+            PR.Continue 0 s ->+                goStop s backBuf+            PR.Continue n s -> do+                assert (n <= Prelude.length backBuf) (return ())+                let (src0, buf1) = splitAt n backBuf+                    arr = A.fromListN n (Prelude.reverse src0)+                goExtract s buf1 arr+            PR.Done 0 b ->+                return (Right b, K.nil)+            PR.Done n b -> do+                assert (n <= Prelude.length backBuf) (return ())+                let src0 = Prelude.take n backBuf+                    -- XXX Use fromListRevN once implemented+                    -- arr0 = A.fromListRevN n src0+                    arr0 = A.fromListN n (Prelude.reverse src0)+                return (Right b, K.fromPure arr0)+            PR.Error err -> do+                let n = Prelude.length backBuf+                    arr0 = A.fromListN n (Prelude.reverse backBuf)+                return (Left (ParseError err), K.fromPure arr0)++-- | 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 parseBreak #-}+parseBreak ::+       (MonadIO m, Unbox a)+    => PR.Parser a m b+    -> StreamK m (A.Array a)+    -> m (Either ParseError b, StreamK m (A.Array a))+{-+parseBreak p s =+    fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)+-}+parseBreak = parseBreakK++-------------------------------------------------------------------------------+-- Elimination - Running Array Folds and parsers+-------------------------------------------------------------------------------++-- | Note that this is not the same as using a @Parser (Array a) m b@ with the+-- regular "Streamly.Internal.Data.IsStream.parse" function. The regular parse+-- would consume the input arrays as single unit. This parser parses in the way+-- as described in the ChunkFold module. The input arrays are treated as @n@+-- element units and can be consumed partially. The remaining elements are+-- inserted in the source stream as an array.+--+{-# INLINE_NORMAL runArrayParserDBreak #-}+runArrayParserDBreak ::+       forall m a b. (MonadIO m, Unbox a)+    => PRD.Parser (Array a) m b+    -> D.Stream m (Array.Array a)+    -> m (Either ParseError b, D.Stream m (Array.Array a))+runArrayParserDBreak+    (PRD.Parser pstep initial extract)+    stream@(D.Stream step state) = do++    res <- initial+    case res of+        PRD.IPartial s -> go SPEC state (List []) s+        PRD.IDone b -> return (Right b, stream)+        PRD.IError err -> return (Left (ParseError err), stream)++    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 _ st backBuf !pst = do+        r <- step defState st+        case r of+            D.Yield x s -> gobuf SPEC [x] s backBuf pst+            D.Skip s -> go SPEC s backBuf pst+            D.Stop -> goStop backBuf pst++    gobuf !_ [] s backBuf !pst = go SPEC s backBuf pst+    gobuf !_ (x:xs) s backBuf !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                 gobuf SPEC xs s (List []) pst1+            PR.Partial n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                gobuf SPEC src s (List []) pst1+            PR.Continue 0 pst1 ->+                gobuf SPEC xs s (List (x:getList backBuf)) pst1+            PR.Continue n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                gobuf SPEC src s (List buf1) pst1+            PR.Done 0 b -> do+                let str = D.append (D.fromList xs) (D.Stream step s)+                return (Right b, str)+            PR.Done n b -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src = Prelude.reverse src0 ++ xs+                return (Right b, D.append (D.fromList src) (D.Stream step s))+            PR.Error err -> do+                let src0 = x:getList backBuf+                    src = Prelude.reverse src0 ++ x:xs+                    strm = D.append (D.fromList src) (D.Stream step s)+                return (Left (ParseError err), strm)++    -- This is a simplified gobuf+    goExtract _ [] backBuf !pst = goStop backBuf pst+    goExtract _ (x:xs) backBuf !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                 goExtract SPEC xs (List []) pst1+            PR.Partial n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                goExtract SPEC src (List []) pst1+            PR.Continue 0 pst1 ->+                goExtract SPEC xs (List (x:getList backBuf)) pst1+            PR.Continue n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                goExtract SPEC src (List buf1) pst1+            PR.Done 0 b ->+                return (Right b, D.fromList xs)+            PR.Done n b -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src = Prelude.reverse src0 ++ xs+                return (Right b, D.fromList src)+            PR.Error err -> do+                let src0 = getList backBuf+                    src = Prelude.reverse src0 ++ x:xs+                return (Left (ParseError err), D.fromList src)++    -- This is a simplified goExtract+    {-# INLINE goStop #-}+    goStop backBuf pst = do+        pRes <- extract pst+        case pRes of+            PR.Partial _ _ -> error "Bug: runArrayParserDBreak: Partial in extract"+            PR.Continue 0 pst1 ->+                goStop backBuf pst1+            PR.Continue n pst1 -> do+                assert+                    (n <= sum (map Array.length (getList backBuf)))+                    (return ())+                let (src0, buf1) = splitAtArrayListRev n (getList backBuf)+                    src = Prelude.reverse src0+                goExtract SPEC src (List buf1) pst1+            PR.Done 0 b -> return (Right b, D.nil)+            PR.Done n b -> do+                assert+                    (n <= sum (map Array.length (getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (getList backBuf)+                    src = Prelude.reverse src0+                return (Right b, D.fromList src)+            PR.Error err -> do+                let src0 = getList backBuf+                    src = Prelude.reverse src0+                return (Left (ParseError err), D.fromList src)++{-+-- | 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, Unbox a)+    => ASF.Parser a m b+    -> Stream m (A.Array a)+    -> m (b, Stream m (A.Array a))+parseArr p s = fmap fromStreamD <$> parseBreakD p (toStreamD s)+-}++-- | Fold an array stream using the supplied array stream 'Fold'.+--+-- /Pre-release/+--+{-# INLINE runArrayFold #-}+runArrayFold :: (MonadIO m, Unbox a) =>+    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b)+runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStream s)++-- | Like 'fold' but also returns the remaining stream.+--+-- /Pre-release/+--+{-# INLINE runArrayFoldBreak #-}+runArrayFoldBreak :: (MonadIO m, Unbox a) =>+    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b, StreamK m (A.Array a))+runArrayFoldBreak (ChunkFold p) s =+    second fromStream <$> runArrayParserDBreak p (toStream s)++{-# ANN type ParseChunksState Fuse #-}+data ParseChunksState x inpBuf st pst =+      ParseChunksInit inpBuf st+    | ParseChunksInitBuf inpBuf+    | ParseChunksInitLeftOver inpBuf+    | ParseChunksStream st inpBuf !pst+    | ParseChunksStop inpBuf !pst+    | ParseChunksBuf inpBuf st inpBuf !pst+    | ParseChunksExtract inpBuf inpBuf !pst+    | ParseChunksYield x (ParseChunksState x inpBuf st pst)++{-# INLINE_NORMAL runArrayFoldManyD #-}+runArrayFoldManyD+    :: (Monad m, Unbox a)+    => ChunkFold m a b+    -> D.Stream m (Array a)+    -> D.Stream m (Either ParseError b)+runArrayFoldManyD+    (ChunkFold (PRD.Parser pstep initial extract)) (D.Stream step state) =++    D.Stream stepOuter (ParseChunksInit [] 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 gst (ParseChunksInit [] st) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                res <- initial+                case res of+                    PRD.IPartial ps ->+                        return $ D.Skip $ ParseChunksBuf [x] s [] ps+                    PRD.IDone pb -> do+                        let next = ParseChunksInit [x] s+                        return $ D.Skip $ ParseChunksYield (Right pb) next+                    PRD.IError err -> do+                        let next = ParseChunksInitLeftOver []+                        return+                            $ D.Skip+                            $ ParseChunksYield (Left (ParseError err)) next+            D.Skip s -> return $ D.Skip $ ParseChunksInit [] s+            D.Stop   -> return D.Stop++    -- Buffer is not empty, go to buffered processing loop+    stepOuter _ (ParseChunksInit src st) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ D.Skip $ ParseChunksBuf src st [] ps+            PRD.IDone pb ->+                let next = ParseChunksInit src st+                 in return $ D.Skip $ ParseChunksYield (Right pb) next+            PRD.IError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    -- This is a simplified ParseChunksInit+    stepOuter _ (ParseChunksInitBuf src) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ D.Skip $ ParseChunksExtract src [] ps+            PRD.IDone pb ->+                let next = ParseChunksInitBuf src+                 in return $ D.Skip $ ParseChunksYield (Right pb) next+            PRD.IError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    -- XXX we just discard any leftover input at the end+    stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop++    -- Buffer is empty, process elements from the stream+    stepOuter gst (ParseChunksStream st backBuf pst) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.Partial 0 pst1 ->+                        return $ D.Skip $ ParseChunksStream s [] pst1+                    PR.Partial n pst1 -> do+                        assert+                            (n <= sum (map Array.length (x:backBuf)))+                            (return ())+                        let src0 = takeArrayListRev n (x:backBuf)+                            src  = Prelude.reverse src0+                        return $ D.Skip $ ParseChunksBuf src s [] pst1+                    PR.Continue 0 pst1 ->+                        return $ D.Skip $ ParseChunksStream s (x:backBuf) pst1+                    PR.Continue n pst1 -> do+                        assert+                            (n <= sum (map Array.length (x:backBuf)))+                            (return ())+                        let (src0, buf1) = splitAtArrayListRev n (x:backBuf)+                            src  = Prelude.reverse src0+                        return $ D.Skip $ ParseChunksBuf src s buf1 pst1+                    PR.Done 0 b -> do+                        return $ D.Skip $+                            ParseChunksYield (Right b) (ParseChunksInit [] s)+                    PR.Done n b -> do+                        assert+                            (n <= sum (map Array.length (x:backBuf)))+                            (return ())+                        let src0 = takeArrayListRev n (x:backBuf)+                            src = Prelude.reverse src0+                            next = ParseChunksInit src s+                        return+                            $ D.Skip+                            $ ParseChunksYield (Right b) next+                    PR.Error err -> do+                        let next = ParseChunksInitLeftOver []+                        return+                            $ D.Skip+                            $ ParseChunksYield (Left (ParseError err)) next++            D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst+            D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst++    -- go back to stream processing mode+    stepOuter _ (ParseChunksBuf [] s buf pst) =+        return $ D.Skip $ ParseChunksStream s buf pst++    -- buffered processing loop+    stepOuter _ (ParseChunksBuf (x:xs) s backBuf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ D.Skip $ ParseChunksBuf xs s [] pst1+            PR.Partial n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksBuf src s [] pst1+            PR.Continue 0 pst1 ->+                return $ D.Skip $ ParseChunksBuf xs s (x:backBuf) pst1+            PR.Continue n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksBuf src s buf1 pst1+            PR.Done 0 b ->+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)+            PR.Done n b -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src = Prelude.reverse src0 ++ xs+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit src s)+            PR.Error err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    -- This is a simplified ParseChunksBuf+    stepOuter _ (ParseChunksExtract [] buf pst) =+        return $ D.Skip $ ParseChunksStop buf pst++    stepOuter _ (ParseChunksExtract (x:xs) backBuf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ D.Skip $ ParseChunksExtract xs [] pst1+            PR.Partial n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksExtract src [] pst1+            PR.Continue 0 pst1 ->+                return $ D.Skip $ ParseChunksExtract xs (x:backBuf) pst1+            PR.Continue n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksExtract src buf1 pst1+            PR.Done 0 b ->+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)+            PR.Done n b -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src = Prelude.reverse src0 ++ xs+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)+            PR.Error err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next+++    -- This is a simplified ParseChunksExtract+    stepOuter _ (ParseChunksStop backBuf pst) = do+        pRes <- extract pst+        case pRes of+            PR.Partial _ _ -> error "runArrayFoldManyD: Partial in extract"+            PR.Continue 0 pst1 ->+                return $ D.Skip $ ParseChunksStop backBuf pst1+            PR.Continue n pst1 -> do+                assert (n <= sum (map Array.length backBuf)) (return ())+                let (src0, buf1) = splitAtArrayListRev n backBuf+                    src  = Prelude.reverse src0+                return $ D.Skip $ ParseChunksExtract src buf1 pst1+            PR.Done 0 b ->+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitLeftOver [])+            PR.Done n b -> do+                assert (n <= sum (map Array.length backBuf)) (return ())+                let src0 = takeArrayListRev n backBuf+                    src = Prelude.reverse src0+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)+            PR.Error err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next++-- | Apply an 'ChunkFold' repeatedly on an array stream and emit the+-- fold outputs in the output stream.+--+-- See "Streamly.Data.Stream.foldMany" for more details.+--+-- /Pre-release/+{-# INLINE runArrayFoldMany #-}+runArrayFoldMany+    :: (Monad m, Unbox a)+    => ChunkFold m a b+    -> StreamK m (Array a)+    -> StreamK m (Either ParseError b)+runArrayFoldMany p m = fromStream $ runArrayFoldManyD p (toStream m)
src/Streamly/Internal/Data/Array/Type.hs view
@@ -8,39 +8,50 @@ -- Stability   : experimental -- Portability : GHC ----- See notes in "Streamly.Internal.Data.Array.Mut.Type"+-- See notes in "Streamly.Internal.Data.MutArray.Type" -- module Streamly.Internal.Data.Array.Type     (+    -- ** Type     -- $arrayNotes       Array (..)     , asPtrUnsafe+    , nil -    -- * Freezing and Thawing+    -- ** Freezing and Thawing     , unsafeFreeze     , unsafeFreezeWithShrink     , unsafeThaw -    -- * Pinning and Unpinning+    -- ** Pinning and Unpinning     , pin     , unpin+    , isPinned -    -- * Construction+    -- ** Construction     , splice      , fromList+    , pinnedFromList     , fromListN+    , pinnedFromListN     , fromListRev     , fromListRevN     , fromStreamDN     , fromStreamD+    , fromPureStream+    , fromByteStr# -    -- * Split+    -- ** Split     , breakOn -    -- * Elimination+    -- ** Cloning arrays+    , clone+    , pinnedClone++    -- ** Elimination     , unsafeIndexIO-    , unsafeIndex -- getIndexUnsafe+    , getIndexUnsafe     , byteLength     , length @@ -59,19 +70,27 @@     , readerRev     , toList -    -- * Folds+    -- ** Folds     , writeWith     , writeN+    , pinnedWriteN     , writeNUnsafe+    , pinnedWriteNUnsafe     , MA.ArrayUnsafe (..)-    , writeNAligned+    , pinnedWriteNAligned     , write+    , pinnedWrite+    , unsafeMakePure -    -- * Streams of arrays+    -- ** Streams of arrays     , chunksOf+    , pinnedChunksOf     , bufferChunks     , flattenArrays     , flattenArraysRev++    -- ** Deprecated+    , unsafeIndex     ) where @@ -85,24 +104,25 @@ import Data.Proxy (Proxy(..)) import Data.Word (Word8) import GHC.Base (build)-import GHC.Exts (IsList, IsString(..))+import GHC.Exts (IsList, IsString(..), Addr#)  import GHC.IO (unsafePerformIO) import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.Array.Mut.Type (MutArray(..), MutableByteArray)+import Streamly.Internal.Data.MutArray.Type (MutArray(..), MutByteArray) import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Unboxed (Unbox, peekWith, sizeOf)+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Unbox (Unbox(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Text.Read (readPrec) -import Prelude hiding (length, foldr, read, unlines, splitAt)+import Prelude hiding (Foldable(..), read, unlines, splitAt)  import qualified GHC.Exts as Exts-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Unboxed as Unboxed+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Generate as D+import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed import qualified Streamly.Internal.Data.Unfold.Type as Unfold import qualified Text.ParserCombinators.ReadPrec as ReadPrec @@ -111,6 +131,24 @@ #include "DocTestDataArray.hs"  -------------------------------------------------------------------------------+-- Notes+-------------------------------------------------------------------------------++-- IMPORTANT:++-- We need to be careful while using unsafePerformIO when array creation is+-- involved.+--+-- * We need to make sure the unsafe IO line does not float out of the binding.+-- * The order of the IO actions should be sane. For example, `touch` after `f`.+--+-- Assume the unsafe IO action floats up. If it makes sense given this+-- assumption, it's probably OK to use usafe IO.+--+-- A general approach should be never to use unsafe IO where Array creation is+-- involved or touch is involved.++------------------------------------------------------------------------------- -- Array Data Type ------------------------------------------------------------------------------- @@ -127,7 +165,7 @@ #endif     -- All offsets are in terms of bytes from the start of arraycontents     Array-    { arrContents :: {-# UNPACK #-} !MutableByteArray+    { arrContents :: {-# UNPACK #-} !MutByteArray     , arrStart :: {-# UNPACK #-} !Int -- offset     , arrEnd   :: {-# UNPACK #-} !Int   -- offset + len     }@@ -144,6 +182,7 @@ -- -- /Pre-release/ --+{-# INLINE asPtrUnsafe #-} asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b asPtrUnsafe arr = MA.asPtrUnsafe (unsafeThaw arr) @@ -192,14 +231,23 @@ -- Pinning & Unpinning ------------------------------------------------------------------------------- +-- | Return a copy of the 'Array' in pinned memory if unpinned, else return the+-- original array. {-# INLINE pin #-} pin :: Array a -> IO (Array a) pin = fmap unsafeFreeze . MA.pin . unsafeThaw +-- | Return a copy of the 'Array' in unpinned memory if pinned, else return the+-- original array. {-# INLINE unpin #-} unpin :: Array a -> IO (Array a) unpin = fmap unsafeFreeze . MA.unpin . unsafeThaw +-- | Return 'True' if the array is allocated in pinned memory.+{-# INLINE isPinned #-}+isPinned :: Array a -> Bool+isPinned = MA.isPinned . unsafeThaw+ ------------------------------------------------------------------------------- -- Construction -------------------------------------------------------------------------------@@ -218,6 +266,12 @@ fromListN :: Unbox a => Int -> [a] -> Array a fromListN n xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListN n xs +-- | Like 'fromListN' but creates a pinned array.+{-# INLINABLE pinnedFromListN #-}+pinnedFromListN :: Unbox a => Int -> [a] -> Array a+pinnedFromListN n xs =+    unsafePerformIO $ unsafeFreeze <$> MA.pinnedFromListN n xs+ -- | Create an 'Array' from the first N elements of a list in reverse order. -- The array is allocated to size N, if the list terminates before N elements -- then the array may hold less than N elements.@@ -233,6 +287,11 @@ fromList :: Unbox a => [a] -> Array a fromList xs = unsafePerformIO $ unsafeFreeze <$> MA.fromList xs +-- | Like 'fromList' but creates a pinned array.+{-# INLINE pinnedFromList #-}+pinnedFromList :: Unbox a => [a] -> Array a+pinnedFromList xs = unsafePerformIO $ unsafeFreeze <$> MA.pinnedFromList xs+ -- | Create an 'Array' from a list in reverse order. The list must be of finite -- size. --@@ -252,6 +311,30 @@ fromStreamD str = unsafeFreeze <$> MA.fromStreamD str  -------------------------------------------------------------------------------+-- Cloning+-------------------------------------------------------------------------------++{-# INLINE clone #-}+clone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => Array a -> m (Array a)+clone = fmap unsafeFreeze . MA.clone . unsafeThaw++{-# INLINE pinnedClone #-}+pinnedClone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => Array a -> m (Array a)+pinnedClone = fmap unsafeFreeze . MA.pinnedClone . unsafeThaw++------------------------------------------------------------------------------- -- Streams of arrays ------------------------------------------------------------------------------- @@ -273,6 +356,12 @@     => Int -> D.Stream m a -> D.Stream m (Array a) chunksOf n str = D.map unsafeFreeze $ MA.chunksOf n str +-- | Like 'chunksOf' but creates pinned arrays.+{-# INLINE_NORMAL pinnedChunksOf #-}+pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (Array a)+pinnedChunksOf n str = D.map unsafeFreeze $ MA.pinnedChunksOf n str+ -- | Use the "read" unfold instead. -- -- @flattenArrays = unfoldMany read@@@ -315,9 +404,14 @@ unsafeIndexIO i arr = MA.getIndexUnsafe i (unsafeThaw arr)  -- | Return element at the specified index without checking the bounds.+{-# INLINE_NORMAL getIndexUnsafe #-}+getIndexUnsafe :: forall a. Unbox a => Int -> Array a -> a+getIndexUnsafe i arr = let !r = unsafeInlineIO $ unsafeIndexIO i arr in r++{-# DEPRECATED unsafeIndex "Please use 'getIndexUnsafe' instead" #-} {-# INLINE_NORMAL unsafeIndex #-} unsafeIndex :: forall a. Unbox a => Int -> Array a -> a-unsafeIndex i arr = let !r = unsafeInlineIO $ unsafeIndexIO i arr in r+unsafeIndex = getIndexUnsafe  -- | /O(1)/ Get the byte length of the array. --@@ -421,8 +515,8 @@         -- accumulating the list and fusing better with the pure consumers.         --         -- This should be safe as the array contents are guaranteed to be-        -- evaluated/written to before we peekWith at them.-        let !x = unsafeInlineIO $ peekWith arrContents p+        -- evaluated/written to before we peekAt at them.+        let !x = unsafeInlineIO $ peekAt p arrContents         in c x (go (INDEX_NEXT(p,a)))  -- | Convert an 'Array' into a list.@@ -442,15 +536,20 @@ writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a) writeN = fmap unsafeFreeze . MA.writeN --- | @writeNAligned alignment n@ folds a maximum of @n@ elements from the input+-- | Like 'fromListN' but creates a pinned array.+{-# INLINE_NORMAL pinnedWriteN #-}+pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+pinnedWriteN = fmap unsafeFreeze . MA.pinnedWriteN++-- | @pinnedWriteNAligned alignment n@ folds a maximum of @n@ elements from the input -- stream to an 'Array' aligned to the given size. -- -- /Pre-release/ ---{-# INLINE_NORMAL writeNAligned #-}-writeNAligned :: forall m a. (MonadIO m, Unbox a)+{-# INLINE_NORMAL pinnedWriteNAligned #-}+pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)     => Int -> Int -> Fold m a (Array a)-writeNAligned alignSize = fmap unsafeFreeze . MA.writeNAligned alignSize+pinnedWriteNAligned alignSize = fmap unsafeFreeze . MA.pinnedWriteNAligned alignSize  -- | Like 'writeN' but does not check the array bounds when writing. The fold -- driver must not call the step function more than 'n' times otherwise it will@@ -463,6 +562,11 @@     => Int -> Fold m a (Array a) writeNUnsafe n = unsafeFreeze <$> MA.writeNUnsafe n +{-# INLINE_NORMAL pinnedWriteNUnsafe #-}+pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+pinnedWriteNUnsafe n = unsafeFreeze <$> MA.pinnedWriteNUnsafe n+ {-# INLINE_NORMAL writeWith #-} writeWith :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)@@ -477,6 +581,65 @@ write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a) write = fmap unsafeFreeze MA.write +-- | Like 'write' but creates a pinned array.+{-# INLINE pinnedWrite #-}+pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+pinnedWrite = fmap unsafeFreeze MA.pinnedWrite++-- | Fold "step" has a dependency on "initial", and each step is dependent on+-- the previous invocation of step due to state passing, finally extract+-- depends on the result of step, therefore, as long as the fold is driven in+-- the correct order the operations would be correctly ordered. We need to+-- ensure that we strictly evaluate the previous step completely before the+-- next step.+--+-- To not share the same array we need to make sure that the result of+-- "initial" is not shared. Existential type ensures that it does not get+-- shared across different folds. However, if we invoke "initial" multiple+-- times for the same fold, there is a possiblity of sharing the two because+-- the compiler would consider it as a pure value. One such example is the+-- chunksOf combinator, or using an array creation fold with foldMany+-- combinator. Is there a proper way in GHC to tell it to not share a pure+-- expression in a particular case?+--+-- For this reason array creation folds have a MonadIO constraint. Pure folds+-- could be unsafe and dangerous. This is dangerous especially when used with+-- foldMany like operations.+--+-- >>> unsafePureWrite = Array.unsafeMakePure Array.write+--+{-# INLINE unsafeMakePure #-}+unsafeMakePure :: Monad m => Fold IO a b -> Fold m a b+unsafeMakePure (Fold step initial extract final) =+    Fold (\x a -> return $! unsafeInlineIO (step x a))+         (return $! unsafePerformIO initial)+         (\s -> return $! unsafeInlineIO $ extract s)+         (\s -> return $! unsafeInlineIO $ final s)++-- | Convert a pure stream in Identity monad to an immutable array.+--+-- Same as the following but with better performance:+--+-- >>> fromPureStream = Array.fromList . runIdentity . Stream.toList+--+fromPureStream :: Unbox a => Stream Identity a -> Array a+fromPureStream x = unsafePerformIO $ fmap (unsafeFreeze) (MA.fromPureStream x)+-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)+-- fromPureStream = fromList . runIdentity . D.toList++-- | Copy a null terminated immutable 'Addr#' Word8 sequence into an array.+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- Note that this is completely safe when reading from Haskell string+-- literals because they are guaranteed to be NULL terminated:+--+-- >>> Array.toList $ Array.fromByteStr# "\1\2\3\0"#+-- [1,2,3]+--+fromByteStr# :: Addr# -> Array Word8+fromByteStr# addr = fromPureStream (D.fromByteStr# addr)+ ------------------------------------------------------------------------------- -- Instances -------------------------------------------------------------------------------@@ -554,7 +717,7 @@     {-# INLINE_LATE step #-}     step _ p | p == arrEnd = return D.Stop     step _ p = liftIO $ do-        x <- peekWith arrContents p+        x <- peekAt p arrContents         return $ D.Yield x (p + size)  {-
+ src/Streamly/Internal/Data/Binary/Parser.hs view
@@ -0,0 +1,399 @@+-- |+-- Module      : Streamly.Internal.Data.Binary.Parser+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Decode Haskell data types from byte streams.+--+-- It would be inefficient to use this to compose parsers for general algebraic+-- data types. For general deserialization of ADTs please use the Serialize+-- type class instances. The fastest way to deserialize byte streams+-- representing Haskell data types is to write them to arrays and deserialize+-- the array using the Serialize type class.++module Streamly.Internal.Data.Binary.Parser+    (+    -- * Type class+      FromBytes (..)++    -- * Decoders+    , unit+    , bool+    , ordering+    , eqWord8 -- XXX rename to word8Eq+    , word8+    , word16be+    , word16le+    , word32be+    , word32le+    , word64be+    , word64le+    , word64host+    , int8+    , int16be+    , int16le+    , int32be+    , int32le+    , int64be+    , int64le+    , float32be+    , float32le+    , double64be+    , double64le+    , charLatin1+    )+where++import Control.Monad.IO.Class (MonadIO)+import Data.Bits ((.|.), unsafeShiftL)+import Data.Char (chr)+import Data.Int (Int8, Int16, Int32, Int64)+import GHC.Float (castWord32ToFloat, castWord64ToDouble)+import Data.Word (Word8, Word16, Word32, Word64)+import Streamly.Internal.Data.Parser (Parser)+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))+import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Data.Array as A+    (getIndexUnsafe, castUnsafe)+import qualified Streamly.Internal.Data.Parser as PR+    (fromPure, either, satisfy, takeEQ)+import qualified Streamly.Internal.Data.Parser as PRD+    (Parser(..), Initial(..), Step(..))++-- Note: The () type does not need to have an on-disk representation in theory.+-- But we use a concrete representation for it so that we count how many ()+-- types we have. Or when we have an array of units the array a concrete+-- length.++-- | A value of type '()' is encoded as @0@ in binary encoding.+--+-- @+-- 0 ==> ()+-- @+--+-- /Pre-release/+--+{-# INLINE unit #-}+unit :: Monad m => Parser Word8 m ()+unit = eqWord8 0 *> PR.fromPure ()++{-# INLINE word8ToBool #-}+word8ToBool :: Word8 -> Either String Bool+word8ToBool 0 = Right False+word8ToBool 1 = Right True+word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)++-- | A value of type 'Bool' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> False+-- 1 ==> True+-- @+--+-- /Pre-release/+--+{-# INLINE bool #-}+bool :: Monad m => Parser Word8 m Bool+bool = PR.either word8ToBool++{-# INLINE word8ToOrdering #-}+word8ToOrdering :: Word8 -> Either String Ordering+word8ToOrdering 0 = Right LT+word8ToOrdering 1 = Right EQ+word8ToOrdering 2 = Right GT+word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)++-- | A value of type 'Ordering' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> LT+-- 1 ==> EQ+-- 2 ==> GT+-- @+--+-- /Pre-release/+--+{-# INLINE ordering #-}+ordering :: Monad m => Parser Word8 m Ordering+ordering = PR.either word8ToOrdering++-- XXX should go in a Word8 parser module?+-- | Accept the input byte only if it is equal to the specified value.+--+-- /Pre-release/+--+{-# INLINE eqWord8 #-}+eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8+eqWord8 b = PR.satisfy (== b)++-- | Accept any byte.+--+-- /Pre-release/+--+{-# INLINE word8 #-}+word8 :: Monad m => Parser Word8 m Word8+word8 = PR.satisfy (const True)++-- | Big endian (MSB first) Word16+{-# INLINE word16beD #-}+word16beD :: Monad m => PRD.Parser Word8 m Word16+word16beD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial Nothing'++    step Nothing' a =+        -- XXX We can use a non-failing parser or a fold so that we do not+        -- have to buffer for backtracking which is inefficient.+        return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))+    step (Just' w) a =+        return $ PRD.Done 0 (w .|. fromIntegral a)++    extract _ = return $ PRD.Error "word16be: end of input"++-- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and+-- second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word16be #-}+word16be :: Monad m => Parser Word8 m Word16+word16be = word16beD++-- | Little endian (LSB first) Word16+{-# INLINE word16leD #-}+word16leD :: Monad m => PRD.Parser Word8 m Word16+word16leD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial Nothing'++    step Nothing' a =+        return $ PRD.Continue 0 (Just' (fromIntegral a))+    step (Just' w) a =+        return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)++    extract _ = return $ PRD.Error "word16le: end of input"++-- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and+-- second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE word16le #-}+word16le :: Monad m => Parser Word8 m Word16+word16le = word16leD++-- | Big endian (MSB first) Word32+{-# INLINE word32beD #-}+word32beD :: Monad m => PRD.Parser Word8 m Word32+word32beD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 24++    step (Tuple' w sh) a = return $+        if sh /= 0+        then+            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+             in PRD.Continue 0 (Tuple' w1 (sh - 8))+        else PRD.Done 0 (w .|. fromIntegral a)++    extract _ = return $ PRD.Error "word32beD: end of input"++-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word32be #-}+word32be :: Monad m => Parser Word8 m Word32+word32be = word32beD++-- | Little endian (LSB first) Word32+{-# INLINE word32leD #-}+word32leD :: Monad m => PRD.Parser Word8 m Word32+word32leD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 0++    step (Tuple' w sh) a = return $+        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+         in if sh /= 24+            then PRD.Continue 0 (Tuple' w1 (sh + 8))+            else PRD.Done 0 w1++    extract _ = return $ PRD.Error "word32leD: end of input"++-- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word32le #-}+word32le :: Monad m => Parser Word8 m Word32+word32le = word32leD++-- | Big endian (MSB first) Word64+{-# INLINE word64beD #-}+word64beD :: Monad m => PRD.Parser Word8 m Word64+word64beD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 56++    step (Tuple' w sh) a = return $+        if sh /= 0+        then+            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+             in PRD.Continue 0 (Tuple' w1 (sh - 8))+        else PRD.Done 0 (w .|. fromIntegral a)++    extract _ = return $ PRD.Error "word64beD: end of input"++-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word64be #-}+word64be :: Monad m => Parser Word8 m Word64+word64be = word64beD++-- | Little endian (LSB first) Word64+{-# INLINE word64leD #-}+word64leD :: Monad m => PRD.Parser Word8 m Word64+word64leD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 0++    step (Tuple' w sh) a = return $+        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+         in if sh /= 56+            then PRD.Continue 0 (Tuple' w1 (sh + 8))+            else PRD.Done 0 w1++    extract _ = return $ PRD.Error "word64leD: end of input"++-- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word64le #-}+word64le :: Monad m => Parser Word8 m Word64+word64le = word64leD++{-# INLINE int8 #-}+int8 :: Monad m => Parser Word8 m Int8+int8 = fromIntegral <$> word8++-- | Parse two bytes as a 'Int16', the first byte is the MSB of the Int16 and+-- second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int16be #-}+int16be :: Monad m => Parser Word8 m Int16+int16be = fromIntegral <$> word16be++-- | Parse two bytes as a 'Int16', the first byte is the LSB of the Int16 and+-- second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE int16le #-}+int16le :: Monad m => Parser Word8 m Int16+int16le = fromIntegral <$> word16le++-- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int32be #-}+int32be :: Monad m => Parser Word8 m Int32+int32be = fromIntegral <$> word32be++-- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int32le #-}+int32le :: Monad m => Parser Word8 m Int32+int32le = fromIntegral <$> word32le++-- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int64be #-}+int64be :: Monad m => Parser Word8 m Int64+int64be = fromIntegral <$> word64be++-- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int64le #-}+int64le :: Monad m => Parser Word8 m Int64+int64le = fromIntegral <$> word64le++{-# INLINE float32be #-}+float32be :: MonadIO m => Parser Word8 m Float+float32be = castWord32ToFloat <$> word32be++{-# INLINE float32le #-}+float32le :: MonadIO m => Parser Word8 m Float+float32le = castWord32ToFloat <$> word32le++{-# INLINE double64be #-}+double64be :: MonadIO m => Parser Word8 m Double+double64be =  castWord64ToDouble <$> word64be++{-# INLINE double64le #-}+double64le :: MonadIO m => Parser Word8 m Double+double64le = castWord64ToDouble <$> word64le++-- | Accept any byte.+--+-- /Pre-release/+--+{-# INLINE charLatin1 #-}+charLatin1 :: Monad m => Parser Word8 m Char+charLatin1 = fmap (chr . fromIntegral) word8++-------------------------------------------------------------------------------+-- Host byte order+-------------------------------------------------------------------------------++-- | Parse eight bytes as a 'Word64' in the host byte order.+--+-- /Pre-release/+--+{-# INLINE word64host #-}+word64host :: MonadIO m => Parser Word8 m Word64+word64host =+    fmap (A.getIndexUnsafe 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)++-------------------------------------------------------------------------------+-- Type class+-------------------------------------------------------------------------------++class FromBytes a where+    -- | Decode a byte stream to a Haskell type.+    fromBytes :: Parser Word8 m a
+ src/Streamly/Internal/Data/Binary/Stream.hs view
@@ -0,0 +1,383 @@+-- |+-- Module      : Streamly.Internal.Data.Binary.Stream+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Encode Haskell data types to byte streams.+--+-- The primary purpose of this module is to serialize primitive Haskell types+-- to streams for convenient byte by byte processing when such a need arises.+--+-- It would be inefficient to use this to build byte streams from algebraic+-- data types. For general serialization of ADTs please use the Serialize type+-- class instances. The fastest way to convert general Haskell types to byte+-- streams is to serialize them to an array and then stream the array.++-- XXX remove unit, bool, ordering, and the type class as well++module Streamly.Internal.Data.Binary.Stream+    (+    -- * Type class+      ToBytes (..)++    -- * Encoders+    , unit+    , bool+    , ordering+    , word8+    , word16be+    , word16le+    , word32be+    , word32le+    , word64be+    , word64le+    , word64host+    , int8+    , int16be+    , int16le+    , int32be+    , int32le+    , int64be+    , int64le+    , float32be+    , float32le+    , double64be+    , double64le+    , charLatin1+    , charUtf8+    )+where++#include "MachDeps.h"++import Data.Bits (shiftR)+import Data.Char (ord)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Float (castDoubleToWord64, castFloatToWord32)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream (Step(..))+import Streamly.Internal.Unicode.Stream (readCharUtf8)++import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D++-- XXX Use StreamD directly?++-- | A value of type '()' is encoded as @0@ in binary encoding.+--+-- @+-- 0 ==> ()+-- @+--+-- /Pre-release/+--+{-# INLINE unit #-}+unit :: Applicative m => Stream m Word8+unit = Stream.fromPure 0++{-# INLINE boolToWord8 #-}+boolToWord8 :: Bool -> Word8+boolToWord8 False = 0+boolToWord8 True = 1++-- | A value of type 'Bool' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> False+-- 1 ==> True+-- @+--+-- /Pre-release/+--+{-# INLINE bool #-}+bool :: Applicative m => Bool -> Stream m Word8+bool = Stream.fromPure . boolToWord8++{-# INLINE orderingToWord8 #-}+orderingToWord8 :: Ordering -> Word8+orderingToWord8 LT = 0+orderingToWord8 EQ = 1+orderingToWord8 GT = 2++-- | A value of type 'Ordering' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> LT+-- 1 ==> EQ+-- 2 ==> GT+-- @+--+-- /Pre-release/+--+{-# INLINE ordering #-}+ordering :: Applicative m => Ordering -> Stream m Word8+ordering = Stream.fromPure . orderingToWord8++-- | Stream a 'Word8'.+--+-- /Pre-release/+--+{-# INLINE word8 #-}+word8 :: Applicative m => Word8 -> Stream m Word8+word8 = Stream.fromPure++data W16State = W16B1 | W16B2 | W16Done++{-# INLINE word16beD #-}+word16beD :: Applicative m => Word16 -> D.Stream m Word8+word16beD w = D.Stream step W16B1++    where++    step _ W16B1 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16B2+    step _ W16B2 = pure $ Yield (fromIntegral w :: Word8) W16Done+    step _ W16Done = pure Stop++-- | Stream a 'Word16' as two bytes, the first byte is the MSB of the Word16+-- and second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word16be #-}+word16be :: Monad m => Word16 -> Stream m Word8+word16be = word16beD++-- | Little endian (LSB first) Word16+{-# INLINE word16leD #-}+word16leD :: Applicative m => Word16 -> D.Stream m Word8+word16leD w = D.Stream step W16B1++    where++    step _ W16B1 = pure $ Yield (fromIntegral w :: Word8) W16B2+    step _ W16B2 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16Done+    step _ W16Done = pure Stop++-- | Stream a 'Word16' as two bytes, the first byte is the LSB of the Word16+-- and second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE word16le #-}+word16le :: Monad m => Word16 -> Stream m Word8+word16le = word16leD++data W32State = W32B1 | W32B2 | W32B3 | W32B4 | W32Done++-- | Big endian (MSB first) Word32+{-# INLINE word32beD #-}+word32beD :: Applicative m => Word32 -> D.Stream m Word8+word32beD w = D.Stream step W32B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W32B1 = yield 24 W32B2+    step _ W32B2 = yield 16 W32B3+    step _ W32B3 = yield 8 W32B4+    step _ W32B4 = pure $ Yield (fromIntegral w :: Word8) W32Done+    step _ W32Done = pure Stop++-- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word32be #-}+word32be :: Monad m => Word32 -> Stream m Word8+word32be = word32beD++-- | Little endian (LSB first) Word32+{-# INLINE word32leD #-}+word32leD :: Applicative m => Word32 -> D.Stream m Word8+word32leD w = D.Stream step W32B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W32B1 = pure $ Yield (fromIntegral w :: Word8) W32B2+    step _ W32B2 = yield 8 W32B3+    step _ W32B3 = yield 16 W32B4+    step _ W32B4 = yield 24 W32Done+    step _ W32Done = pure Stop++-- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word32le #-}+word32le :: Monad m => Word32 -> Stream m Word8+word32le = word32leD++data W64State =+    W64B1 | W64B2 | W64B3 | W64B4 | W64B5 | W64B6 | W64B7 | W64B8 | W64Done++-- | Big endian (MSB first) Word64+{-# INLINE word64beD #-}+word64beD :: Applicative m => Word64 -> D.Stream m Word8+word64beD w = D.Stream step W64B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W64B1 = yield 56 W64B2+    step _ W64B2 = yield 48 W64B3+    step _ W64B3 = yield 40 W64B4+    step _ W64B4 = yield 32 W64B5+    step _ W64B5 = yield 24 W64B6+    step _ W64B6 = yield 16 W64B7+    step _ W64B7 = yield  8 W64B8+    step _ W64B8 = pure $ Yield (fromIntegral w :: Word8) W64Done+    step _ W64Done = pure Stop++-- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word64be #-}+word64be :: Monad m => Word64 -> Stream m Word8+word64be = word64beD++-- | Little endian (LSB first) Word64+{-# INLINE word64leD #-}+word64leD :: Applicative m => Word64 -> D.Stream m Word8+word64leD w = D.Stream step W64B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W64B1 = pure $ Yield (fromIntegral w :: Word8) W64B2+    step _ W64B2 = yield  8 W64B3+    step _ W64B3 = yield 16 W64B4+    step _ W64B4 = yield 24 W64B5+    step _ W64B5 = yield 32 W64B6+    step _ W64B6 = yield 40 W64B7+    step _ W64B7 = yield 48 W64B8+    step _ W64B8 = yield 56 W64Done+    step _ W64Done = pure Stop++-- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word64le #-}+word64le :: Monad m => Word64 -> Stream m Word8+word64le = word64leD++{-# INLINE int8 #-}+int8 :: Applicative m => Int8 -> Stream m Word8+int8 i = word8 (fromIntegral i :: Word8)++-- | Stream a 'Int16' as two bytes, the first byte is the MSB of the Int16+-- and second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int16be #-}+int16be :: Monad m => Int16 -> Stream m Word8+int16be i = word16be (fromIntegral i :: Word16)++-- | Stream a 'Int16' as two bytes, the first byte is the LSB of the Int16+-- and second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE int16le #-}+int16le :: Monad m => Int16 -> Stream m Word8+int16le i = word16le (fromIntegral i :: Word16)++-- | Stream a 'Int32' as four bytes, the first byte is the MSB of the Int32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int32be #-}+int32be :: Monad m => Int32 -> Stream m Word8+int32be i = word32be (fromIntegral i :: Word32)++{-# INLINE int32le #-}+int32le :: Monad m => Int32 -> Stream m Word8+int32le i = word32le (fromIntegral i :: Word32)++-- | Stream a 'Int64' as eight bytes, the first byte is the MSB of the Int64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int64be #-}+int64be :: Monad m => Int64 -> Stream m Word8+int64be i = word64be (fromIntegral i :: Word64)++-- | Stream a 'Int64' as eight bytes, the first byte is the LSB of the Int64+-- and last byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE int64le #-}+int64le :: Monad m => Int64 -> Stream m Word8+int64le i = word64le (fromIntegral i :: Word64)++-- | Big endian (MSB first) Float+{-# INLINE float32be #-}+float32be :: Monad m => Float -> Stream m Word8+float32be = word32beD . castFloatToWord32++-- | Little endian (LSB first) Float+{-# INLINE float32le #-}+float32le :: Monad m => Float -> Stream m Word8+float32le = word32leD . castFloatToWord32++-- | Big endian (MSB first) Double+{-# INLINE double64be #-}+double64be :: Monad m => Double -> Stream m Word8+double64be = word64beD . castDoubleToWord64++-- | Little endian (LSB first) Double+{-# INLINE double64le #-}+double64le :: Monad m => Double -> Stream m Word8+double64le = word64leD . castDoubleToWord64++-- | Encode a Unicode character to stream of bytes in 0-255 range.+--+{-# INLINE charLatin1 #-}+charLatin1 :: Applicative m => Char -> Stream m Word8+charLatin1 = Stream.fromPure . fromIntegral . ord++{-# INLINE charUtf8 #-}+charUtf8 :: Monad m => Char -> Stream m Word8+charUtf8 = Stream.unfold readCharUtf8++-------------------------------------------------------------------------------+-- Host byte order+-------------------------------------------------------------------------------++-- | Stream a 'Word64' as eight bytes in the host byte order.+--+-- /Pre-release/+--+{-# INLINE word64host #-}+word64host :: Monad m => Word64 -> Stream m Word8+word64host =+#ifdef WORDS_BIGENDIAN+    word64be+#else+    word64le+#endif++-------------------------------------------------------------------------------+-- Type class+-------------------------------------------------------------------------------++class ToBytes a where+    -- | Convert a Haskell type to a byte stream.+    toBytes :: a -> Stream m Word8
src/Streamly/Internal/Data/Builder.hs view
@@ -16,7 +16,9 @@     ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif  ------------------------------------------------------------------------------ -- The Builder type@@ -27,16 +29,16 @@ -- or even a Fold. Unlike fold the step function is one-shot and not called in -- a loop. newtype Builder s m a =-  Builder (s -> m (s, a))+  Builder (s -> m (a, s))  -- | Maps a function on the output of the fold (the type @b@). instance Functor m => Functor (Builder s m) where     {-# INLINE fmap #-}-    fmap f (Builder step1) = Builder (fmap (fmap f) . step1)+    fmap f (Builder step1) = Builder (fmap (\ (a, s) -> (f a, s)) . step1)  {-# INLINE fromPure #-} fromPure :: Applicative m => b -> Builder s m b-fromPure b = Builder (\s -> pure (s, b))+fromPure b = Builder (\s -> pure (b, s))  -- | Chain the actions and zip the outputs. {-# INLINE sequenceWith #-}@@ -47,9 +49,9 @@     where      step s = do-        (s1, x) <- stepL s-        (s2, y) <- stepR s1-        pure (s2, func x y)+        (x, s1) <- stepL s+        (y, s2) <- stepR s1+        pure (func x y, s2)  instance Monad m => Applicative (Builder a m) where     {-# INLINE pure #-}@@ -74,7 +76,7 @@         where          step s = do-            (s1, x) <- stepL s+            (x, s1) <- stepL s             let Builder stepR = f x-            (s2, y) <- stepR s1-            pure (s2, y)+            (y, s2) <- stepR s1+            pure (y, s2)
src/Streamly/Internal/Data/Fold.hs view
@@ -16,2583 +16,18 @@     -- * Imports     -- $setup -    -- * Fold Type-      Step (..)-    , Fold (..)-    , Tee (..)--    -- * Constructors-    -- | Which constructor to use?-    ---    -- * @foldl*@: If the fold never terminates i.e. does not use the 'Done'-    -- constructor otherwise use the @foldt*@ variants.-    -- * @*M@: Use the @M@ suffix variants if any of the step, initial, or-    -- extract function is monadic, otherwise use the pure variants.-    ---    , foldl'-    , foldlM'-    , foldl1'-    , foldlM1'-    , foldt'-    , foldtM'-    , foldr'-    , foldrM'--    -- * Mappers-    -- | Monadic functions useful with mapM/lmapM on folds or streams.-    , tracing-    , trace--    -- * Folds--    -- ** Accumulators-    -- *** Semigroups and Monoids-    , sconcat-    , mconcat-    , foldMap-    , foldMapM--    -- *** Reducers-    , drain-    , drainMapM-    , the-    , length-    , lengthGeneric-    , mean-    , rollingHash-    , defaultSalt-    , rollingHashWithSalt-    , rollingHashFirstN-    -- , rollingHashLastN--    -- *** Saturating Reducers-    -- | 'product' terminates if it becomes 0. Other folds can theoretically-    -- saturate on bounded types, and therefore terminate, however, they will-    -- run forever on unbounded types like Integer/Double.-    , sum-    , product-    , maximumBy-    , maximum-    , minimumBy-    , minimum--    -- *** Collectors-    -- | Avoid using these folds in scalable or performance critical-    -- applications, they buffer all the input in GC memory which can be-    -- detrimental to performance if the input is large.-    , toList-    , toListRev-    -- $toListRev-    , toStream-    , toStreamRev-    , toStreamK-    , toStreamKRev-    , topBy-    , top-    , bottomBy-    , bottom--    -- *** Scanners-    -- | Stateful transformation of the elements. Useful in combination with-    -- the 'scanMaybe' combinator. For scanners the result of the fold is-    -- usually a transformation of the current element rather than an-    -- aggregation of all elements till now.-    , latest- -- , nthLast -- using Ring array-    , indexingWith-    , indexing-    , indexingRev-    , rollingMapM--    -- *** Filters-    -- | Useful in combination with the 'scanMaybe' combinator.-    , filtering-    , deleteBy-    , uniqBy-    , uniq-    , repeated-    , findIndices-    , elemIndices--    -- ** Terminating Folds-    -- *** Empty folds-    -- | Folds that return a result without consuming any input.-    , fromPure-    , fromEffect-    , fromRefold--    -- *** Singleton folds-    -- | Folds that terminate after consuming exactly one input element. All-    -- these can be implemented in terms of the 'maybe' fold.-    , one-    , null -- XXX not very useful and could be problematic, remove it?-    , satisfy-    , maybe--    -- *** Multi folds-    -- | Terminate after consuming one or more elements.-    , drainN-    -- , lastN-    -- , (!!)-    , indexGeneric-    , index-    , findM-    , find-    , lookup-    , findIndex-    , elemIndex-    , elem-    , notElem-    , all-    , any-    , and-    , or--    -- ** Trimmers-    -- | Useful in combination with the 'scanMaybe' combinator.-    , taking-    , dropping-    , takingEndByM-    , takingEndBy-    , takingEndByM_-    , takingEndBy_-    , droppingWhileM-    , droppingWhile-    , prune--    -- * Running A Fold-    , drive-    -- , breakStream--    -- * Building Incrementally-    , extractM-    , reduce-    , close-    , isClosed-    , snoc-    , snocl-    , snocM-    , snoclM--    , addOne-    , addStream--    -- * Combinators-    -- ** Utilities-    , with--    -- ** Transforming the Monad-    , morphInner-    , generalizeInner--    -- ** Mapping on output-    , rmapM--    -- ** Mapping on Input-    , transform-    , lmap-    --, lsequence-    , lmapM--    -- ** Sliding Window-    , slide2--    -- ** Scanning Input-    , scan-    , scanMany-    , postscan-    , indexed--    -- ** Zipping Input-    , zipStreamWithM-    , zipStream--    -- ** Filtering Input-    , catMaybes-    , mapMaybeM-    , mapMaybe-    , scanMaybe-    , filter-    , filterM-    , sampleFromthen--    -- Either streams-    , catLefts-    , catRights-    , catEithers--    {--    -- ** Insertion-    -- | Insertion adds more elements to the stream.--    , insertBy-    , intersperseM--    -- ** Reordering-    , reverse-    -}--    -- ** Trimming-    , take--    -- By elements-    , takeEndBy-    , takeEndBy_-    , takeEndBySeq-    , takeEndBySeq_-    {--    , drop-    , dropWhile-    , dropWhileM-    -}--    -- ** Serial Append-    , splitWith-    , split_-    -- , tail-    -- , init-    , splitAt -- spanN-    -- , splitIn -- sessionN--    -- ** Parallel Distribution-    , teeWith-    , tee-    , teeWithFst-    , teeWithMin-    , distribute-    -- , distributeFst-    -- , distributeMin--    -- ** Unzipping-    , unzip-    -- These two can be expressed using lmap/lmapM and unzip-    , unzipWith-    , unzipWithM-    , unzipWithFstM-    , unzipWithMinM--    -- ** Parallel Alternative-    , shortest-    , longest--    -- ** Partitioning-    , partitionByM-    , partitionByFstM-    , partitionByMinM-    , partitionBy-    , partition--    -- ** Splitting-    , many-    , manyPost-    , groupsOf-    , chunksBetween-    , refoldMany-    , refoldMany1-    , intersperseWithQuotes--    -- ** Nesting-    , unfoldMany-    , concatSequence-    , concatMap-    , duplicate-    , refold--    -- * Deprecated-    , foldr-    , drainBy-    , last-    , head-    , sequence-    , mapM-    , variance-    , stdDev-    , serialWith-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bifunctor (first)-import Data.Bits (shiftL, shiftR, (.|.), (.&.))-import Data.Either (isLeft, isRight, fromLeft, fromRight)-import Data.Int (Int64)-import Data.Proxy (Proxy(..))-import Data.Word (Word32)-import Foreign.Storable (Storable, peek)-import Streamly.Internal.Data.Array.Mut.Type (MutArray(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)--import qualified Prelude-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Fold.Window as FoldW-import qualified Streamly.Internal.Data.Pipe.Type as Pipe-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring-import qualified Streamly.Internal.Data.Stream.StreamD.Type as StreamD--import Prelude hiding-       ( filter, foldl1, drop, dropWhile, take, takeWhile, zipWith-       , foldl, foldr, map, mapM_, sequence, all, any, sum, product, elem-       , notElem, maximum, minimum, head, last, tail, length, null-       , reverse, iterate, init, and, or, lookup, (!!)-       , scanl, scanl1, replicate, concatMap, mconcat, foldMap, unzip-       , span, splitAt, break, mapM, zip, maybe)-import Streamly.Internal.Data.Fold.Type-import Streamly.Internal.Data.Fold.Tee--#include "DocTestDataFold.hs"----------------------------------------------------------------------------------- Running----------------------------------------------------------------------------------- | Drive a fold using the supplied 'Stream', reducing the resulting--- expression strictly at each step.------ Definition:------ >>> drive = flip Stream.fold------ Example:------ >>> Fold.drive (Stream.enumerateFromTo 1 100) Fold.sum--- 5050----{-# INLINE drive #-}-drive :: Monad m => Stream m a -> Fold m a b -> m b-drive = flip StreamD.fold--{---- | Like 'drive' but also returns the remaining stream. The resulting stream--- would be 'Stream.nil' if the stream finished before the fold.------ Definition:------ >>> breakStream = flip Stream.foldBreak------ /CPS/----{-# INLINE breakStreamK #-}-breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a)-breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm)--    where--    f (b, str) = (b, Stream.fromStreamK str)--}---- | Append a stream to a fold to build the fold accumulator incrementally. We--- can repeatedly call 'addStream' on the same fold to continue building the--- fold and finally use 'drive' to finish the fold and extract the result. Also--- see the 'Streamly.Data.Fold.addOne' operation which is a singleton version--- of 'addStream'.------ Definitions:------ >>> addStream stream = Fold.drive stream . Fold.duplicate------ Example, build a list incrementally:------ >>> :{--- pure (Fold.toList :: Fold IO Int [Int])---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- [1,2,3,4]------ This can be used as an O(n) list append compared to the O(n^2) @++@ when--- used for incrementally building a list.------ Example, build a stream incrementally:------ >>> :{--- pure (Fold.toStream :: Fold IO Int (Stream Identity Int))---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- fromList [1,2,3,4]------ This can be used as an O(n) stream append compared to the O(n^2) @<>@ when--- used for incrementally building a stream.------ Example, build an array incrementally:------ >>> :{--- pure (Array.write :: Fold IO Int (Array Int))---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- fromList [1,2,3,4]------ Example, build an array stream incrementally:------ >>> :{--- let f :: Fold IO Int (Stream Identity (Array Int))---     f = Fold.groupsOf 2 (Array.writeN 3) Fold.toStream--- in pure f---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- fromList [fromList [1,2],fromList [3,4]]----addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)-addStream stream = drive stream . duplicate----------------------------------------------------------------------------------- Transformations on fold inputs----------------------------------------------------------------------------------- | Flatten the monadic output of a fold to pure output.----{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}-{-# INLINE sequence #-}-sequence :: Monad m => Fold m a (m b) -> Fold m a b-sequence = rmapM id---- | Map a monadic function on the output of a fold.----{-# DEPRECATED mapM "Use rmapM instead" #-}-{-# INLINE mapM #-}-mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-mapM = rmapM---- |--- >>> mapMaybeM f = Fold.lmapM f . Fold.catMaybes----{-# INLINE mapMaybeM #-}-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Fold m b r -> Fold m a r-mapMaybeM f = lmapM f . catMaybes---- | @mapMaybe f fold@ maps a 'Maybe' returning function @f@ on the input of--- the fold, filters out 'Nothing' elements, and return the values extracted--- from 'Just'.------ >>> mapMaybe f = Fold.lmap f . Fold.catMaybes--- >>> mapMaybe f = Fold.mapMaybeM (return . f)------ >>> f x = if even x then Just x else Nothing--- >>> fld = Fold.mapMaybe f Fold.toList--- >>> Stream.fold fld (Stream.enumerateFromTo 1 10)--- [2,4,6,8,10]----{-# INLINE mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r-mapMaybe f = lmap f . catMaybes----------------------------------------------------------------------------------- Transformations on fold inputs----------------------------------------------------------------------------------- | Apply a monadic function on the input and return the input.------ >>> Stream.fold (Fold.lmapM (Fold.tracing print) Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)--- 1--- 2------ /Pre-release/----{-# INLINE tracing #-}-tracing :: Monad m => (a -> m b) -> (a -> m a)-tracing f x = void (f x) >> return x---- | Apply a monadic function to each element flowing through and discard the--- results.------ >>> Stream.fold (Fold.trace print Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)--- 1--- 2------ >>> trace f = Fold.lmapM (Fold.tracing f)------ /Pre-release/-{-# INLINE trace #-}-trace :: Monad m => (a -> m b) -> Fold m a r -> Fold m a r-trace f = lmapM (tracing f)---- rename to lpipe?------ | Apply a transformation on a 'Fold' using a 'Pipe'.------ /Pre-release/-{-# INLINE transform #-}-transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c-transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =-    Fold step initial extract--    where--    initial = first (Tuple' pinitial) <$> finitial--    step (Tuple' ps fs) x = do-        r <- pstep1 ps x-        go fs r--        where--        -- XXX use SPEC?-        go acc (Pipe.Yield b (Consume ps')) = do-            acc' <- fstep acc b-            return-                $ case acc' of-                      Partial s -> Partial $ Tuple' ps' s-                      Done b2 -> Done b2-        go acc (Pipe.Yield b (Produce ps')) = do-            acc' <- fstep acc b-            r <- pstep2 ps'-            case acc' of-                Partial s -> go s r-                Done b2 -> return $ Done b2-        go acc (Pipe.Continue (Consume ps')) =-            return $ Partial $ Tuple' ps' acc-        go acc (Pipe.Continue (Produce ps')) = do-            r <- pstep2 ps'-            go acc r--    extract (Tuple' _ fs) = fextract fs--{-# INLINE scanWith #-}-scanWith :: Monad m => Bool -> Fold m a b -> Fold m b c -> Fold m a c-scanWith isMany (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract--    where--    {-# INLINE runStep #-}-    runStep actionL sR = do-        rL <- actionL-        case rL of-            Done bL -> do-                rR <- stepR sR bL-                case rR of-                    Partial sR1 ->-                        if isMany-                        then runStep initialL sR1-                        else Done <$> extractR sR1-                    Done bR -> return $ Done bR-            Partial sL -> do-                !b <- extractL sL-                rR <- stepR sR b-                return-                    $ case rR of-                        Partial sR1 -> Partial (sL, sR1)-                        Done bR -> Done bR--    initial = do-        r <- initialR-        case r of-            Partial sR -> runStep initialL sR-            Done b -> return $ Done b--    step (sL, sR) x = runStep (stepL sL x) sR--    extract = extractR . snd---- | Scan the input of a 'Fold' to change it in a stateful manner using another--- 'Fold'. The scan stops as soon as the fold terminates.------ /Pre-release/-{-# INLINE scan #-}-scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-scan = scanWith False---- XXX This does not fuse beacuse of the recursive step. Need to investigate.------ | Scan the input of a 'Fold' to change it in a stateful manner using another--- 'Fold'. The scan restarts with a fresh state if the fold terminates.------ /Pre-release/-{-# INLINE scanMany #-}-scanMany :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-scanMany = scanWith True----------------------------------------------------------------------------------- Filters----------------------------------------------------------------------------------- | Returns the latest element omitting the first occurrence that satisfies--- the given equality predicate.------ Example:------ >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.deleteBy (==) 3) input--- [1,3,5]----{-# INLINE_NORMAL deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Fold m a (Maybe a)-deleteBy eq x0 = fmap extract $ foldl' step (Tuple' False Nothing)--    where--    step (Tuple' False _) x =-        if eq x x0-        then Tuple' True Nothing-        else Tuple' False (Just x)-    step (Tuple' True _) x = Tuple' True (Just x)--    extract (Tuple' _ x) = x---- | Provide a sliding window of length 2 elements.------ See "Streamly.Internal.Data.Fold.Window".----{-# INLINE slide2 #-}-slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b-slide2 (Fold step1 initial1 extract1) = Fold step initial extract--    where--    initial =-        first (Tuple' Nothing) <$> initial1--    step (Tuple' prev s) cur =-        first (Tuple' (Just cur)) <$> step1 s (cur, prev)--    extract (Tuple' _ s) = extract1 s---- | Return the latest unique element using the supplied comparison function.--- Returns 'Nothing' if the current element is same as the last element--- otherwise returns 'Just'.------ Example, strip duplicate path separators:------ >>> input = Stream.fromList "//a//b"--- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.uniqBy f) input--- "/a/b"------ Space: @O(1)@------ /Pre-release/----{-# INLINE uniqBy #-}-uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)-uniqBy eq = rollingMap f--    where--    f pre curr =-        case pre of-            Nothing -> Just curr-            Just x -> if x `eq` curr then Nothing else Just curr---- | See 'uniqBy'.------ Definition:------ >>> uniq = Fold.uniqBy (==)----{-# INLINE uniq #-}-uniq :: (Monad m, Eq a) => Fold m a (Maybe a)-uniq = uniqBy (==)---- | Strip all leading and trailing occurrences of an element passing a--- predicate and make all other consecutive occurrences uniq.------ >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)------ @--- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")--- "hello world!"------ @------ Space: @O(1)@------ /Unimplemented/-{-# INLINE prune #-}-prune ::-    -- (Monad m, Eq a) =>-    (a -> Bool) -> Fold m a (Maybe a)-prune = error "Not implemented yet!"---- | Emit only repeated elements, once.------ /Unimplemented/-repeated :: -- (Monad m, Eq a) =>-    Fold m a (Maybe a)-repeated = error "Not implemented yet!"----------------------------------------------------------------------------------- Left folds------------------------------------------------------------------------------------------------------------------------------------------------------------------ Run Effects----------------------------------------------------------------------------------- |--- Definitions:------ >>> drainMapM f = Fold.lmapM f Fold.drain--- >>> drainMapM f = Fold.foldMapM (void . f)------ Drain all input after passing it through a monadic function. This is the--- dual of mapM_ on stream producers.----{-# INLINE drainMapM #-}-drainMapM ::  Monad m => (a -> m b) -> Fold m a ()-drainMapM f = lmapM f drain--{-# DEPRECATED drainBy "Please use 'drainMapM' instead." #-}-{-# INLINE drainBy #-}-drainBy ::  Monad m => (a -> m b) -> Fold m a ()-drainBy = drainMapM---- | Returns the latest element of the input stream, if any.------ >>> latest = Fold.foldl1' (\_ x -> x)--- >>> latest = fmap getLast $ Fold.foldMap (Last . Just)----{-# INLINE latest #-}-latest :: Monad m => Fold m a (Maybe a)-latest = foldl1' (\_ x -> x)--{-# DEPRECATED last "Please use 'latest' instead." #-}-{-# INLINE last #-}-last :: Monad m => Fold m a (Maybe a)-last = latest---- | Terminates with 'Nothing' as soon as it finds an element different than--- the previous one, returns 'the' element if the entire input consists of the--- same element.----{-# INLINE the #-}-the :: (Monad m, Eq a) => Fold m a (Maybe a)-the = foldt' step initial id--    where--    initial = Partial Nothing--    step Nothing x = Partial (Just x)-    step old@(Just x0) x =-            if x0 == x-            then Partial old-            else Done Nothing----------------------------------------------------------------------------------- To Summary----------------------------------------------------------------------------------- | Like 'length', except with a more general 'Num' return value------ Definition:------ >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const  1)--- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0------ /Pre-release/-{-# INLINE lengthGeneric #-}-lengthGeneric :: (Monad m, Num b) => Fold m a b-lengthGeneric = foldl' (\n _ -> n + 1) 0---- | Determine the length of the input stream.------ Definition:------ >>> length = Fold.lengthGeneric--- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)----{-# INLINE length #-}-length :: Monad m => Fold m a Int-length = lengthGeneric----- | Determine the sum of all elements of a stream of numbers. Returns additive--- identity (@0@) when the stream is empty. Note that this is not numerically--- stable for floating point numbers.------ >>> sum = FoldW.cumulative FoldW.sum------ Same as following but numerically stable:------ >>> sum = Fold.foldl' (+) 0--- >>> sum = fmap Data.Monoid.getSum $ Fold.foldMap Data.Monoid.Sum----{-# INLINE sum #-}-sum :: (Monad m, Num a) => Fold m a a-sum = FoldW.cumulative FoldW.sum---- | Determine the product of all elements of a stream of numbers. Returns--- multiplicative identity (@1@) when the stream is empty. The fold terminates--- when it encounters (@0@) in its input.------ Same as the following but terminates on multiplication by @0@:------ >>> product = fmap Data.Monoid.getProduct $ Fold.foldMap Data.Monoid.Product----{-# INLINE product #-}-product :: (Monad m, Num a, Eq a) => Fold m a a-product =  foldt' step (Partial 1) id--    where--    step x a =-        if a == 0-        then Done 0-        else Partial $ x * a----------------------------------------------------------------------------------- To Summary (Maybe)----------------------------------------------------------------------------------- | Determine the maximum element in a stream using the supplied comparison--- function.----{-# INLINE maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)-maximumBy cmp = foldl1' max'--    where--    max' x y =-        case cmp x y of-            GT -> x-            _ -> y---- | Determine the maximum element in a stream.------ Definitions:------ >>> maximum = Fold.maximumBy compare--- >>> maximum = Fold.foldl1' max------ Same as the following but without a default maximum. The 'Max' Monoid uses--- the 'minBound' as the default maximum:------ >>> maximum = fmap Data.Semigroup.getMax $ Fold.foldMap Data.Semigroup.Max----{-# INLINE maximum #-}-maximum :: (Monad m, Ord a) => Fold m a (Maybe a)-maximum = foldl1' max---- | Computes the minimum element with respect to the given comparison function----{-# INLINE minimumBy #-}-minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)-minimumBy cmp = foldl1' min'--    where--    min' x y =-        case cmp x y of-            GT -> y-            _ -> x---- | Determine the minimum element in a stream using the supplied comparison--- function.------ Definitions:------ >>> minimum = Fold.minimumBy compare--- >>> minimum = Fold.foldl1' min------ Same as the following but without a default minimum. The 'Min' Monoid uses the--- 'maxBound' as the default maximum:------ >>> maximum = fmap Data.Semigroup.getMin $ Fold.foldMap Data.Semigroup.Min----{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => Fold m a (Maybe a)-minimum = foldl1' min----------------------------------------------------------------------------------- To Summary (Statistical)----------------------------------------------------------------------------------- | Compute a numerically stable arithmetic mean of all elements in the input--- stream.----{-# INLINE mean #-}-mean :: (Monad m, Fractional a) => Fold m a a-mean = fmap done $ foldl' step begin--    where--    begin = Tuple' 0 0--    step (Tuple' x n) y =-        let n1 = n + 1-         in Tuple' (x + (y - x) / n1) n1--    done (Tuple' x _) = x---- | Compute a numerically stable (population) variance over all elements in--- the input stream.----{-# DEPRECATED variance "Use the streamly-statistics package instead" #-}-{-# INLINE variance #-}-variance :: (Monad m, Fractional a) => Fold m a a-variance = fmap done $ foldl' step begin--    where--    begin = Tuple3' 0 0 0--    step (Tuple3' n mean_ m2) x = Tuple3' n' mean' m2'--        where--        n' = n + 1-        mean' = (n * mean_ + x) / (n + 1)-        delta = x - mean_-        m2' = m2 + delta * delta * n / (n + 1)--    done (Tuple3' n _ m2) = m2 / n---- | Compute a numerically stable (population) standard deviation over all--- elements in the input stream.----{-# DEPRECATED stdDev "Use the streamly-statistics package instead" #-}-{-# INLINE stdDev #-}-stdDev :: (Monad m, Floating a) => Fold m a a-stdDev = sqrt <$> variance---- | Compute an 'Int' sized polynomial rolling hash------ > H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0------ Where @c1@, @c2@, @cn@ are the elements in the input stream and @k@ is a--- constant.------ This hash is often used in Rabin-Karp string search algorithm.------ See https://en.wikipedia.org/wiki/Rolling_hash----{-# INLINE rollingHashWithSalt #-}-rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64-rollingHashWithSalt = foldl' step--    where--    k = 2891336453 :: Int64--    step cksum a = cksum * k + fromIntegral (fromEnum a)---- | A default salt used in the implementation of 'rollingHash'.-{-# INLINE defaultSalt #-}-defaultSalt :: Int64-defaultSalt = -2578643520546668380---- | Compute an 'Int' sized polynomial rolling hash of a stream.------ >>> rollingHash = Fold.rollingHashWithSalt Fold.defaultSalt----{-# INLINE rollingHash #-}-rollingHash :: (Monad m, Enum a) => Fold m a Int64-rollingHash = rollingHashWithSalt defaultSalt---- | Compute an 'Int' sized polynomial rolling hash of the first n elements of--- a stream.------ >>> rollingHashFirstN n = Fold.take n Fold.rollingHash------ /Pre-release/-{-# INLINE rollingHashFirstN #-}-rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64-rollingHashFirstN n = take n rollingHash---- XXX Compare this with the implementation in Fold.Window, preferrably use the--- latter if performance is good.---- | Apply a function on every two successive elements of a stream. The first--- argument of the map function is the previous element and the second argument--- is the current element. When processing the very first element in the--- stream, the previous element is 'Nothing'.------ /Pre-release/----{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b-rollingMapM f = Fold step initial extract--    where--    -- XXX We need just a postscan. We do not need an initial result here.-    -- Or we can supply a default initial result as an argument to rollingMapM.-    initial = return $ Partial (Nothing, error "Empty stream")--    step (prev, _) cur = do-        x <- f prev cur-        return $ Partial (Just cur, x)--    extract = return . snd---- |--- >>> rollingMap f = Fold.rollingMapM (\x y -> return $ f x y)----{-# INLINE rollingMap #-}-rollingMap :: Monad m => (Maybe a -> a -> b) -> Fold m a b-rollingMap f = rollingMapM (\x y -> return $ f x y)----------------------------------------------------------------------------------- Monoidal left folds----------------------------------------------------------------------------------- | Semigroup concat. Append the elements of an input stream to a provided--- starting value.------ Definition:------ >>> sconcat = Fold.foldl' (<>)------ >>> semigroups = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10--- >>> Stream.fold (Fold.sconcat 10) semigroups--- Sum {getSum = 65}----{-# INLINE sconcat #-}-sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-sconcat = foldl' (<>)---- | Monoid concat. Fold an input stream consisting of monoidal elements using--- 'mappend' and 'mempty'.------ Definition:------ >>> mconcat = Fold.sconcat mempty------ >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10--- >>> Stream.fold Fold.mconcat monoids--- Sum {getSum = 55}----{-# INLINE mconcat #-}-mconcat ::-    ( Monad m-    , Monoid a) => Fold m a a-mconcat = sconcat mempty---- |--- Definition:------ >>> foldMap f = Fold.lmap f Fold.mconcat------ Make a fold from a pure function that folds the output of the function--- using 'mappend' and 'mempty'.------ >>> sum = Fold.foldMap Data.Monoid.Sum--- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10--- Sum {getSum = 55}----{-# INLINE foldMap #-}-foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b-foldMap f = lmap f mconcat---- |--- Definition:------ >>> foldMapM f = Fold.lmapM f Fold.mconcat------ Make a fold from a monadic function that folds the output of the function--- using 'mappend' and 'mempty'.------ >>> sum = Fold.foldMapM (return . Data.Monoid.Sum)--- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10--- Sum {getSum = 55}----{-# INLINE foldMapM #-}-foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b-foldMapM act = foldlM' step (pure mempty)--    where--    step m a = do-        m' <- act a-        return $! mappend m m'----------------------------------------------------------------------------------- To Containers----------------------------------------------------------------------------------- $toListRev--- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is--- exactly the same as reversing the list after 'toListRev'.---- | Buffers the input stream to a list in the reverse order of the input.------ Definition:------ >>> toListRev = Fold.foldl' (flip (:)) []------ /Warning!/ working on large lists accumulated as buffers in memory could be--- very inefficient, consider using "Streamly.Array" instead.-------  xn : ... : x2 : x1 : []-{-# INLINE toListRev #-}-toListRev :: Monad m => Fold m a [a]-toListRev = foldl' (flip (:)) []----------------------------------------------------------------------------------- Partial Folds----------------------------------------------------------------------------------- | A fold that drains the first n elements of its input, running the effects--- and discarding the results.------ Definition:------ >>> drainN n = Fold.take n Fold.drain------ /Pre-release/-{-# INLINE drainN #-}-drainN :: Monad m => Int -> Fold m a ()-drainN n = take n drain----------------------------------------------------------------------------------- To Elements----------------------------------------------------------------------------------- | Like 'index', except with a more general 'Integral' argument------ /Pre-release/-{-# INLINE indexGeneric #-}-indexGeneric :: (Integral i, Monad m) => i -> Fold m a (Maybe a)-indexGeneric i = foldt' step (Partial 0) (const Nothing)--    where--    step j a =-        if i == j-        then Done $ Just a-        else Partial (j + 1)---- | Return the element at the given index.------ Definition:------ >>> index = Fold.indexGeneric----{-# INLINE index #-}-index :: Monad m => Int -> Fold m a (Maybe a)-index = indexGeneric---- | Consume a single input and transform it using the supplied 'Maybe'--- returning function.------ /Pre-release/----{-# INLINE maybe #-}-maybe :: Monad m => (a -> Maybe b) -> Fold m a (Maybe b)-maybe f = foldt' (const (Done . f)) (Partial Nothing) id---- | Consume a single element and return it if it passes the predicate else--- return 'Nothing'.------ Definition:------ >>> satisfy f = Fold.maybe (\a -> if f a then Just a else Nothing)------ /Pre-release/-{-# INLINE satisfy #-}-satisfy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-satisfy f = maybe (\a -> if f a then Just a else Nothing)-{--satisfy f = Fold step (return $ Partial ()) (const (return Nothing))--    where--    step () a = return $ Done $ if f a then Just a else Nothing--}---- Naming notes:------ "head" and "next" are two alternative names for the same API. head sounds--- apt in the context of lists but next sounds more apt in the context of--- streams where we think in terms of generating and consuming the next element--- rather than taking the head of some static/persistent structure.------ We also want to keep the nomenclature consistent across folds and parsers,--- "head" becomes even more unintuitive for parsers because there are two--- possible variants viz. peek and next.------ Also, the "head" fold creates confusion in situations like--- https://github.com/composewell/streamly/issues/1404 where intuitive--- expectation from head is to consume the entire stream and just give us the--- head. There we want to convey the notion that we consume one element from--- the stream and stop. The name "one" already being used in parsers for this--- purpose sounds more apt from this perspective.------ The source of confusion is perhaps due to the fact that some folds consume--- the entire stream and others terminate early. It may have been clearer if we--- had separate abstractions for the two use cases.---- XXX We can possibly use "head" for the purposes of reducing the entire--- stream to the head element i.e. take the head and drain the rest.---- | Take one element from the stream and stop.------ Definition:------ >>> one = Fold.maybe Just------ This is similar to the stream 'Stream.uncons' operation.----{-# INLINE one #-}-one :: Monad m => Fold m a (Maybe a)-one = maybe Just---- | Extract the first element of the stream, if any.------ >>> head = Fold.one----{-# DEPRECATED head "Please use \"one\" instead" #-}-{-# INLINE head #-}-head :: Monad m => Fold m a (Maybe a)-head = one---- | Returns the first element that satisfies the given predicate.------ /Pre-release/-{-# INLINE findM #-}-findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-findM predicate = Fold step (return $ Partial ()) (const $ return Nothing)--    where--    step () a =-        let f r =-                if r-                then Done (Just a)-                else Partial ()-         in f <$> predicate a---- | Returns the first element that satisfies the given predicate.----{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-find p = findM (return . p)---- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the--- first pair where the key equals the given value @a@.------ Definition:------ >>> lookup x = fmap snd <$> Fold.find ((== x) . fst)----{-# INLINE lookup #-}-lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)-lookup a0 = foldt' step (Partial ()) (const Nothing)--    where--    step () (a, b) =-        if a == a0-        then Done $ Just b-        else Partial ()---- | Returns the first index that satisfies the given predicate.----{-# INLINE findIndex #-}-findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)-findIndex predicate = foldt' step (Partial 0) (const Nothing)--    where--    step i a =-        if predicate a-        then Done $ Just i-        else Partial (i + 1)---- | Returns the index of the latest element if the element satisfies the given--- predicate.----{-# INLINE findIndices #-}-findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)-findIndices predicate =-    -- XXX implement by combining indexing and filtering scans-    fmap (either (const Nothing) Just) $ foldl' step (Left (-1))--    where--    step i a =-        if predicate a-        then Right (either id id i + 1)-        else Left (either id id i + 1)---- | Returns the index of the latest element if the element matches the given--- value.------ Definition:------ >>> elemIndices a = Fold.findIndices (== a)----{-# INLINE elemIndices #-}-elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)-elemIndices a = findIndices (== a)---- | Returns the first index where a given value is found in the stream.------ Definition:------ >>> elemIndex a = Fold.findIndex (== a)----{-# INLINE elemIndex #-}-elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)-elemIndex a = findIndex (== a)----------------------------------------------------------------------------------- To Boolean----------------------------------------------------------------------------------- Similar to 'eof' parser, but the fold consumes and discards an input element--- when not at eof. XXX Remove or Rename to "eof"?---- | Consume one element, return 'True' if successful else return 'False'. In--- other words, test if the input is empty or not.------ WARNING! It consumes one element if the stream is not empty. If that is not--- what you want please use the eof parser instead.------ Definition:------ >>> null = fmap isJust Fold.one----{-# INLINE null #-}-null :: Monad m => Fold m a Bool-null = foldt' (\() _ -> Done False) (Partial ()) (const True)---- | Returns 'True' if any element of the input satisfies the predicate.------ Definition:------ >>> any p = Fold.lmap p Fold.or------ Example:------ >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]--- True----{-# INLINE any #-}-any :: Monad m => (a -> Bool) -> Fold m a Bool-any predicate = foldt' step initial id--    where--    initial = Partial False--    step _ a =-        if predicate a-        then Done True-        else Partial False---- | Return 'True' if the given element is present in the stream.------ Definition:------ >>> elem a = Fold.any (== a)----{-# INLINE elem #-}-elem :: (Eq a, Monad m) => a -> Fold m a Bool-elem a = any (== a)---- | Returns 'True' if all elements of the input satisfy the predicate.------ Definition:------ >>> all p = Fold.lmap p Fold.and------ Example:------ >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]--- False----{-# INLINE all #-}-all :: Monad m => (a -> Bool) -> Fold m a Bool-all predicate = foldt' step initial id--    where--    initial = Partial True--    step _ a =-        if predicate a-        then Partial True-        else Done False---- | Returns 'True' if the given element is not present in the stream.------ Definition:------ >>> notElem a = Fold.all (/= a)----{-# INLINE notElem #-}-notElem :: (Eq a, Monad m) => a -> Fold m a Bool-notElem a = all (/= a)---- | Returns 'True' if all elements are 'True', 'False' otherwise------ Definition:------ >>> and = Fold.all (== True)----{-# INLINE and #-}-and :: Monad m => Fold m Bool Bool-and = all (== True)---- | Returns 'True' if any element is 'True', 'False' otherwise------ Definition:------ >>> or = Fold.any (== True)----{-# INLINE or #-}-or :: Monad m => Fold m Bool Bool-or = any (== True)----------------------------------------------------------------------------------- Grouping/Splitting------------------------------------------------------------------------------------------------------------------------------------------------------------------ Grouping without looking at elements------------------------------------------------------------------------------------------------------------------------------------------------------------------ Binary APIs----------------------------------------------------------------------------------- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@--- elements of its input are consumed by fold @f1@ and the rest of the stream--- is consumed by fold @f2@.------ >>> let splitAt_ n xs = Stream.fold (Fold.splitAt n Fold.toList Fold.toList) $ Stream.fromList xs------ >>> splitAt_ 6 "Hello World!"--- ("Hello ","World!")------ >>> splitAt_ (-1) [1,2,3]--- ([],[1,2,3])------ >>> splitAt_ 0 [1,2,3]--- ([],[1,2,3])------ >>> splitAt_ 1 [1,2,3]--- ([1],[2,3])------ >>> splitAt_ 3 [1,2,3]--- ([1,2,3],[])------ >>> splitAt_ 4 [1,2,3]--- ([1,2,3],[])------ > splitAt n f1 f2 = Fold.splitWith (,) (Fold.take n f1) f2------ /Internal/--{-# INLINE splitAt #-}-splitAt-    :: Monad m-    => Int-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-splitAt n fld = splitWith (,) (take n fld)----------------------------------------------------------------------------------- Element Aware APIs-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Binary APIs---------------------------------------------------------------------------------{-# INLINE takingEndByM #-}-takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-takingEndByM p = Fold step initial (return . toMaybe)--    where--    initial = return $ Partial Nothing'--    step _ a = do-        r <- p a-        return-            $ if r-              then Done $ Just a-              else Partial $ Just' a---- |------ >>> takingEndBy p = Fold.takingEndByM (return . p)----{-# INLINE takingEndBy #-}-takingEndBy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-takingEndBy p = takingEndByM (return . p)--{-# INLINE takingEndByM_ #-}-takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-takingEndByM_ p = Fold step initial (return . toMaybe)--    where--    initial = return $ Partial Nothing'--    step _ a = do-        r <- p a-        return-            $ if r-              then Done Nothing-              else Partial $ Just' a---- |------ >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)----{-# INLINE takingEndBy_ #-}-takingEndBy_ :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-takingEndBy_ p = takingEndByM_ (return . p)--{-# INLINE droppingWhileM #-}-droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-droppingWhileM p = Fold step initial (return . toMaybe)--    where--    initial = return $ Partial Nothing'--    step Nothing' a = do-        r <- p a-        return-            $ Partial-            $ if r-              then Nothing'-              else Just' a-    step _ a = return $ Partial $ Just' a---- |--- >>> droppingWhile p = Fold.droppingWhileM (return . p)----{-# INLINE droppingWhile #-}-droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-droppingWhile p = droppingWhileM (return . p)---- Note: Keep this consistent with S.splitOn. In fact we should eliminate--- S.splitOn in favor of the fold.------ XXX Use Fold.many instead once it is fixed.--- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)---- | Like 'takeEndBy' but drops the element on which the predicate succeeds.------ Example:------ >>> input = Stream.fromList "hello\nthere\n"--- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList--- >>> Stream.fold line input--- "hello"------ >>> Stream.fold Fold.toList $ Stream.foldMany line input--- ["hello","there"]----{-# INLINE takeEndBy_ #-}-takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b--- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)-takeEndBy_ predicate (Fold fstep finitial fextract) =-    Fold step finitial fextract--    where--    step s a =-        if not (predicate a)-        then fstep s a-        else Done <$> fextract s---- Note:--- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)---- | Take the input, stop when the predicate succeeds taking the succeeding--- element as well.------ Example:------ >>> input = Stream.fromList "hello\nthere\n"--- >>> line = Fold.takeEndBy (== '\n') Fold.toList--- >>> Stream.fold line input--- "hello\n"------ >>> Stream.fold Fold.toList $ Stream.foldMany line input--- ["hello\n","there\n"]----{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b--- takeEndBy predicate = scanMaybe (takingEndBy predicate)-takeEndBy predicate (Fold fstep finitial fextract) =-    Fold step finitial fextract--    where--    step s a = do-        res <- fstep s a-        if not (predicate a)-        then return res-        else do-            case res of-                Partial s1 -> Done <$> fextract s1-                Done b -> return $ Done b----------------------------------------------------------------------------------- Binary splitting on a separator---------------------------------------------------------------------------------data SplitOnSeqState acc a rb rh w ck =-      SplitOnSeqEmpty !acc-    | SplitOnSeqSingle !acc !a-    | SplitOnSeqWord !acc !Int !w-    | SplitOnSeqWordLoop !acc !w-    | SplitOnSeqKR !acc !Int !rb !rh-    | SplitOnSeqKRLoop !acc !ck !rb !rh---- XXX Need to add tests for takeEndBySeq, we have tests for takeEndBySeq_ .---- | Continue taking the input until the input sequence matches the supplied--- sequence, taking the supplied sequence as well. If the pattern is empty this--- acts as an identity fold.------ >>> s = Stream.fromList "hello there. How are you?"--- >>> f = Fold.takeEndBySeq (Array.fromList "re") Fold.toList--- >>> Stream.fold f s--- "hello there"------ >>> Stream.fold Fold.toList $ Stream.foldMany f s--- ["hello there",". How are"," you?"]------ /Pre-release/-{-# INLINE takeEndBySeq #-}-takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>-       Array.Array a-    -> Fold m a b-    -> Fold m a b-takeEndBySeq patArr (Fold fstep finitial fextract) =-    Fold step initial extract--    where--    patLen = Array.length patArr--    initial = do-        res <- finitial-        case res of-            Partial acc-                | patLen == 0 ->-                    -- XXX Should we match nothing or everything on empty-                    -- pattern?-                    -- Done <$> fextract acc-                    return $ Partial $ SplitOnSeqEmpty acc-                | patLen == 1 -> do-                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr-                    return $ Partial $ SplitOnSeqSingle acc pat-                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->-                    return $ Partial $ SplitOnSeqWord acc 0 0-                | otherwise -> do-                    (rb, rhead) <- liftIO $ Ring.new patLen-                    return $ Partial $ SplitOnSeqKR acc 0 rb rhead-            Done b -> return $ Done b--    -- Word pattern related-    maxIndex = patLen - 1--    elemBits = SIZE_OF(a) * 8--    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    wordPat :: Word-    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    -- XXX Need to keep this cached across fold calls in foldmany-    -- XXX We may need refold to inject the cached state instead of-    -- initializing the state every time.-    -- XXX Allocation of ring buffer should also be done once-    patHash = Array.foldl' addCksum 0 patArr--    step (SplitOnSeqEmpty s) x = do-        res <- fstep s x-        case res of-            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1-            Done b -> return $ Done b-    step (SplitOnSeqSingle s pat) x = do-        res <- fstep s x-        case res of-            Partial s1-                | pat /= x -> return $ Partial $ SplitOnSeqSingle s1 pat-                | otherwise -> Done <$> fextract s1-            Done b -> return $ Done b-    step (SplitOnSeqWord s idx wrd) x = do-        res <- fstep s x-        let wrd1 = addToWord wrd x-        case res of-            Partial s1-                | idx == maxIndex -> do-                    if wrd1 .&. wordMask == wordPat-                    then Done <$> fextract s1-                    else return $ Partial $ SplitOnSeqWordLoop s1 wrd1-                | otherwise ->-                    return $ Partial $ SplitOnSeqWord s1 (idx + 1) wrd1-            Done b -> return $ Done b-    step (SplitOnSeqWordLoop s wrd) x = do-        res <- fstep s x-        let wrd1 = addToWord wrd x-        case res of-            Partial s1-                | wrd1 .&. wordMask == wordPat ->-                    Done <$> fextract s1-                | otherwise ->-                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1-            Done b -> return $ Done b-    step (SplitOnSeqKR s idx rb rh) x = do-        res <- fstep s x-        case res of-            Partial s1 -> do-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                if idx == maxIndex-                then do-                    let fld = Ring.unsafeFoldRing (Ring.ringBound rb)-                    let !ringHash = fld addCksum 0 rb-                    if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-                    then Done <$> fextract s1-                    else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1-                else-                    return $ Partial $ SplitOnSeqKR s1 (idx + 1) rb rh1-            Done b -> return $ Done b-    step (SplitOnSeqKRLoop s cksum rb rh) x = do-        res <- fstep s x-        case res of-            Partial s1 -> do-                old <- liftIO $ peek rh-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                let ringHash = deltaCksum cksum old x-                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-                then Done <$> fextract s1-                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1-            Done b -> return $ Done b--    extract state =-        let st =-                case state of-                    SplitOnSeqEmpty s -> s-                    SplitOnSeqSingle s _ -> s-                    SplitOnSeqWord s _ _ -> s-                    SplitOnSeqWordLoop s _ -> s-                    SplitOnSeqKR s _ _ _ -> s-                    SplitOnSeqKRLoop s _ _ _ -> s-         in fextract st---- | Like 'takeEndBySeq' but discards the matched sequence.------ /Pre-release/----{-# INLINE takeEndBySeq_ #-}-takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>-       Array.Array a-    -> Fold m a b-    -> Fold m a b-takeEndBySeq_ patArr (Fold fstep finitial fextract) =-    Fold step initial extract--    where--    patLen = Array.length patArr--    initial = do-        res <- finitial-        case res of-            Partial acc-                | patLen == 0 ->-                    -- XXX Should we match nothing or everything on empty-                    -- pattern?-                    -- Done <$> fextract acc-                    return $ Partial $ SplitOnSeqEmpty acc-                | patLen == 1 -> do-                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr-                    return $ Partial $ SplitOnSeqSingle acc pat-                -- XXX Need to add tests for this case-                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->-                    return $ Partial $ SplitOnSeqWord acc 0 0-                | otherwise -> do-                    (rb, rhead) <- liftIO $ Ring.new patLen-                    return $ Partial $ SplitOnSeqKR acc 0 rb rhead-            Done b -> return $ Done b--    -- Word pattern related-    maxIndex = patLen - 1--    elemBits = SIZE_OF(a) * 8--    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    elemMask :: Word-    elemMask = (1 `shiftL` elemBits) - 1--    wordPat :: Word-    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    -- XXX Need to keep this cached across fold calls in foldMany-    -- XXX We may need refold to inject the cached state instead of-    -- initializing the state every time.-    -- XXX Allocation of ring buffer should also be done once-    patHash = Array.foldl' addCksum 0 patArr--    step (SplitOnSeqEmpty s) x = do-        res <- fstep s x-        case res of-            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1-            Done b -> return $ Done b-    step (SplitOnSeqSingle s pat) x = do-        if pat /= x-        then do-            res <- fstep s x-            case res of-                Partial s1 -> return $ Partial $ SplitOnSeqSingle s1 pat-                Done b -> return $ Done b-        else Done <$> fextract s-    step (SplitOnSeqWord s idx wrd) x = do-        let wrd1 = addToWord wrd x-        if idx == maxIndex-        then do-            if wrd1 .&. wordMask == wordPat-            then Done <$> fextract s-            else return $ Partial $ SplitOnSeqWordLoop s wrd1-        else return $ Partial $ SplitOnSeqWord s (idx + 1) wrd1-    step (SplitOnSeqWordLoop s wrd) x = do-        let wrd1 = addToWord wrd x-            old = (wordMask .&. wrd)-                    `shiftR` (elemBits * (patLen - 1))-        res <- fstep s (toEnum $ fromIntegral old)-        case res of-            Partial s1-                | wrd1 .&. wordMask == wordPat ->-                    Done <$> fextract s1-                | otherwise ->-                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1-            Done b -> return $ Done b-    step (SplitOnSeqKR s idx rb rh) x = do-        rh1 <- liftIO $ Ring.unsafeInsert rb rh x-        if idx == maxIndex-        then do-            let fld = Ring.unsafeFoldRing (Ring.ringBound rb)-            let !ringHash = fld addCksum 0 rb-            if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-            then Done <$> fextract s-            else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1-        else return $ Partial $ SplitOnSeqKR s (idx + 1) rb rh1-    step (SplitOnSeqKRLoop s cksum rb rh) x = do-        old <- liftIO $ peek rh-        res <- fstep s old-        case res of-            Partial s1 -> do-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                let ringHash = deltaCksum cksum old x-                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-                then Done <$> fextract s1-                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1-            Done b -> return $ Done b--    -- XXX extract should return backtrack count as well. If the fold-    -- terminates early inside extract, we may still have buffered data-    -- remaining which will be lost if we do not communicate that to the-    -- driver.-    extract state = do-        let consumeWord s n wrd = do-                if n == 0-                then fextract s-                else do-                    let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))-                    r <- fstep s (toEnum $ fromIntegral old)-                    case r of-                        Partial s1 -> consumeWord s1 (n - 1) wrd-                        Done b -> return b--        let consumeRing s n rb rh =-                if n == 0-                then fextract s-                else do-                    old <- liftIO $ peek rh-                    let rh1 = Ring.advance rb rh-                    r <- fstep s old-                    case r of-                        Partial s1 -> consumeRing s1 (n - 1) rb rh1-                        Done b -> return b--        case state of-            SplitOnSeqEmpty s -> fextract s-            SplitOnSeqSingle s _ -> fextract s-            SplitOnSeqWord s idx wrd -> consumeWord s idx wrd-            SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd-            SplitOnSeqKR s idx rb _ -> consumeRing s idx rb (Ring.startOf rb)-            SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh----------------------------------------------------------------------------------- Distributing------------------------------------------------------------------------------------- | Distribute one copy of the stream to each fold and zip the results.------ @---                 |-------Fold m a b--------|--- ---stream m a---|                         |---m (b,c)---                 |-------Fold m a c--------|--- @------  Definition:------ >>> tee = Fold.teeWith (,)------ Example:------ >>> t = Fold.tee Fold.sum Fold.length--- >>> Stream.fold t (Stream.enumerateFromTo 1.0 100.0)--- (5050.0,100)----{-# INLINE tee #-}-tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)-tee = teeWith (,)---- XXX use "List" instead of "[]"?, use Array for output to scale it to a large--- number of consumers? For polymorphic case a vector could be helpful. For--- Storables we can use arrays. Will need separate APIs for those.------ | Distribute one copy of the stream to each fold and collect the results in--- a container.------ @------                 |-------Fold m a b--------|--- ---stream m a---|                         |---m [b]---                 |-------Fold m a b--------|---                 |                         |---                            ...--- @------ >>> Stream.fold (Fold.distribute [Fold.sum, Fold.length]) (Stream.enumerateFromTo 1 5)--- [15,5]------ >>> distribute = Prelude.foldr (Fold.teeWith (:)) (Fold.fromPure [])------ This is the consumer side dual of the producer side 'sequence' operation.------ Stops when all the folds stop.----{-# INLINE distribute #-}-distribute :: Monad m => [Fold m a b] -> Fold m a [b]-distribute = Prelude.foldr (teeWith (:)) (fromPure [])----------------------------------------------------------------------------------- Partitioning---------------------------------------------------------------------------------{-# INLINE partitionByMUsing #-}-partitionByMUsing :: Monad m =>-       (  (x -> y -> (x, y))-       -> Fold m (Either b c) x-       -> Fold m (Either b c) y-       -> Fold m (Either b c) (x, y)-       )-    -> (a -> m (Either b c))-    -> Fold m b x-    -> Fold m c y-    -> Fold m a (x, y)-partitionByMUsing t f fld1 fld2 =-    let l = lmap (fromLeft undefined) fld1  -- :: Fold m (Either b c) x-        r = lmap (fromRight undefined) fld2 -- :: Fold m (Either b c) y-     in lmapM f (t (,) (filter isLeft l) (filter isRight r))---- | Partition the input over two folds using an 'Either' partitioning--- predicate.------ @------                                     |-------Fold b x--------|--- -----stream m a --> (Either b c)----|                       |----(x,y)---                                     |-------Fold c y--------|--- @------ Example, send input to either fold randomly:------ >>> :set -package random--- >>> import System.Random (randomIO)--- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a--- >>> f = Fold.partitionByM randomly Fold.length Fold.length--- >>> Stream.fold f (Stream.enumerateFromTo 1 100)--- ...------ Example, send input to the two folds in a proportion of 2:1:------ >>> :{--- proportionately m n = do---  ref <- newIORef $ cycle $ concat [replicate m Left, replicate n Right]---  return $ \a -> do---      r <- readIORef ref---      writeIORef ref $ tail r---      return $ Prelude.head r a--- :}------ >>> :{--- main = do---  g <- proportionately 2 1---  let f = Fold.partitionByM g Fold.length Fold.length---  r <- Stream.fold f (Stream.enumerateFromTo (1 :: Int) 100)---  print r--- :}------ >>> main--- (67,33)--------- This is the consumer side dual of the producer side 'mergeBy' operation.------ When one fold is done, any input meant for it is ignored until the other--- fold is also done.------ Stops when both the folds stop.------ /See also: 'partitionByFstM' and 'partitionByMinM'./------ /Pre-release/-{-# INLINE partitionByM #-}-partitionByM :: Monad m-    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByM = partitionByMUsing teeWith---- | Similar to 'partitionByM' but terminates when the first fold terminates.----{-# INLINE partitionByFstM #-}-partitionByFstM :: Monad m-    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByFstM = partitionByMUsing teeWithFst---- | Similar to 'partitionByM' but terminates when any fold terminates.----{-# INLINE partitionByMinM #-}-partitionByMinM :: Monad m =>-    (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByMinM = partitionByMUsing teeWithMin---- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter--- makes the signature clearer as to which case belongs to which fold.--- XXX need to check the performance in both cases.---- | Same as 'partitionByM' but with a pure partition function.------ Example, count even and odd numbers in a stream:------ >>> :{---  let f = Fold.partitionBy (\n -> if even n then Left n else Right n)---                      (fmap (("Even " ++) . show) Fold.length)---                      (fmap (("Odd "  ++) . show) Fold.length)---   in Stream.fold f (Stream.enumerateFromTo 1 100)--- :}--- ("Even 50","Odd 50")------ /Pre-release/-{-# INLINE partitionBy #-}-partitionBy :: Monad m-    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionBy f = partitionByM (return . f)---- | Compose two folds such that the combined fold accepts a stream of 'Either'--- and routes the 'Left' values to the first fold and 'Right' values to the--- second fold.------ Definition:------ >>> partition = Fold.partitionBy id----{-# INLINE partition #-}-partition :: Monad m-    => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)-partition = partitionBy id--{---- | Send one item to each fold in a round-robin fashion. This is the consumer--- side dual of producer side 'mergeN' operation.------ partitionN :: Monad m => [Fold m a b] -> Fold m a [b]--- partitionN fs = Fold step begin done--}----------------------------------------------------------------------------------- Unzipping---------------------------------------------------------------------------------{-# INLINE unzipWithMUsing #-}-unzipWithMUsing :: Monad m =>-       (  (x -> y -> (x, y))-       -> Fold m (b, c) x-       -> Fold m (b, c) y-       -> Fold m (b, c) (x, y)-       )-    -> (a -> m (b, c))-    -> Fold m b x-    -> Fold m c y-    -> Fold m a (x, y)-unzipWithMUsing t f fld1 fld2 =-    let f1 = lmap fst fld1  -- :: Fold m (b, c) b-        f2 = lmap snd fld2  -- :: Fold m (b, c) c-     in lmapM f (t (,) f1 f2)---- | Like 'unzipWith' but with a monadic splitter function.------ Definition:------ >>> unzipWithM k f1 f2 = Fold.lmapM k (Fold.unzip f1 f2)------ /Pre-release/-{-# INLINE unzipWithM #-}-unzipWithM :: Monad m-    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWithM = unzipWithMUsing teeWith---- | Similar to 'unzipWithM' but terminates when the first fold terminates.----{-# INLINE unzipWithFstM #-}-unzipWithFstM :: Monad m =>-    (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-unzipWithFstM = unzipWithMUsing teeWithFst---- | Similar to 'unzipWithM' but terminates when any fold terminates.----{-# INLINE unzipWithMinM #-}-unzipWithMinM :: Monad m =>-    (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWithMinM = unzipWithMUsing teeWithMin---- | Split elements in the input stream into two parts using a pure splitter--- function, direct each part to a different fold and zip the results.------ Definitions:------ >>> unzipWith f = Fold.unzipWithM (return . f)--- >>> unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)------ This fold terminates when both the input folds terminate.------ /Pre-release/-{-# INLINE unzipWith #-}-unzipWith :: Monad m-    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWith f = unzipWithM (return . f)---- | Send the elements of tuples in a stream of tuples through two different--- folds.------ @------                           |-------Fold m a x--------|--- ---------stream of (a,b)--|                         |----m (x,y)---                           |-------Fold m b y--------|------ @------ Definition:------ >>> unzip = Fold.unzipWith id------ This is the consumer side dual of the producer side 'zip' operation.----{-# INLINE unzip #-}-unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)-unzip = unzipWith id----------------------------------------------------------------------------------- Combining streams and folds - Zipping----------------------------------------------------------------------------------- XXX These can be implemented using the fold scan, using the stream as a--- state.--- XXX Stream Skip state cannot be efficiently handled in folds but can be--- handled in parsers using the Continue facility. See zipWithM in the Parser--- module.------ cmpBy, eqBy, isPrefixOf, isSubsequenceOf etc can be implemented using--- zipStream.---- | Zip a stream with the input of a fold using the supplied function.------ /Unimplemented/----{-# INLINE zipStreamWithM #-}-zipStreamWithM :: -- Monad m =>-    (a -> b -> m c) -> Stream m a -> Fold m c x -> Fold m b x-zipStreamWithM = undefined---- | Zip a stream with the input of a fold.------ >>> zip = Fold.zipStreamWithM (curry return)------ /Unimplemented/----{-# INLINE zipStream #-}-zipStream :: Monad m => Stream m a -> Fold m (a, b) x -> Fold m b x-zipStream = zipStreamWithM (curry return)---- | Pair each element of a fold input with its index, starting from index 0.----{-# INLINE indexingWith #-}-indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))-indexingWith i f = fmap toMaybe $ foldl' step initial--    where--    initial = Nothing'--    step Nothing' a = Just' (i, a)-    step (Just' (n, _)) a = Just' (f n, a)---- |--- >>> indexing = Fold.indexingWith 0 (+ 1)----{-# INLINE indexing #-}-indexing :: Monad m => Fold m a (Maybe (Int, a))-indexing = indexingWith 0 (+ 1)---- |--- >>> indexingRev n = Fold.indexingWith n (subtract 1)----{-# INLINE indexingRev #-}-indexingRev :: Monad m => Int -> Fold m a (Maybe (Int, a))-indexingRev n = indexingWith n (subtract 1)---- | Pair each element of a fold input with its index, starting from index 0.------ >>> indexed = Fold.scanMaybe Fold.indexing----{-# INLINE indexed #-}-indexed :: Monad m => Fold m (Int, a) b -> Fold m a b-indexed = scanMaybe indexing---- | Change the predicate function of a Fold from @a -> b@ to accept an--- additional state input @(s, a) -> b@. Convenient to filter with an--- addiitonal index or time input.------ >>> filterWithIndex = Fold.with Fold.indexed Fold.filter------ @--- filterWithAbsTime = with timestamped filter--- filterWithRelTime = with timeIndexed filter--- @------ /Pre-release/-{-# INLINE with #-}-with ::-       (Fold m (s, a) b -> Fold m a b)-    -> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)-    -> (((s, a) -> c) -> Fold m a b -> Fold m a b)-with f comb g = f . comb g . lmap snd---- XXX Implement as a filter--- sampleFromthen :: Monad m => Int -> Int -> Fold m a (Maybe a)---- | @sampleFromthen offset stride@ samples the element at @offset@ index and--- then every element at strides of @stride@.----{-# INLINE sampleFromthen #-}-sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Fold m a b-sampleFromthen offset size =-    with indexed filter (\(i, _) -> (i + offset) `mod` size == 0)----------------------------------------------------------------------------------- Nesting----------------------------------------------------------------------------------- | @concatSequence f t@ applies folds from stream @t@ sequentially and--- collects the results using the fold @f@.------ /Unimplemented/----{-# INLINE concatSequence #-}-concatSequence ::-    -- IsStream t =>-    Fold m b c -> t (Fold m a b) -> Fold m a c-concatSequence _f _p = undefined---- | Group the input stream into groups of elements between @low@ and @high@.--- Collection starts in chunks of @low@ and then keeps doubling until we reach--- @high@. Each chunk is folded using the provided fold function.------ This could be useful, for example, when we are folding a stream of unknown--- size to a stream of arrays and we want to minimize the number of--- allocations.------ NOTE: this would be an application of "many" using a terminating fold.------ /Unimplemented/----{-# INLINE chunksBetween #-}-chunksBetween :: -- Monad m =>-       Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c-chunksBetween _low _high _f1 _f2 = undefined---- | A fold that buffers its input to a pure stream.------ /Warning!/ working on large streams accumulated as buffers in memory could--- be very inefficient, consider using "Streamly.Data.Array" instead.------ >>> toStream = fmap Stream.fromList Fold.toList------ /Pre-release/-{-# INLINE toStream #-}-toStream :: (Monad m, Monad n) => Fold m a (Stream n a)-toStream = fmap StreamD.fromList toList---- This is more efficient than 'toStream'. toStream is exactly the same as--- reversing the stream after toStreamRev.------ | Buffers the input stream to a pure stream in the reverse order of the--- input.------ >>> toStreamRev = fmap Stream.fromList Fold.toListRev------ /Warning!/ working on large streams accumulated as buffers in memory could--- be very inefficient, consider using "Streamly.Data.Array" instead.------ /Pre-release/----  xn : ... : x2 : x1 : []-{-# INLINE toStreamRev #-}-toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)-toStreamRev = fmap StreamD.fromList toListRev---- XXX This does not fuse. It contains a recursive step function. We will need--- a Skip input constructor in the fold type to make it fuse.------ | Unfold and flatten the input stream of a fold.------ @--- Stream.fold (unfoldMany u f) = Stream.fold f . Stream.unfoldMany u--- @------ /Pre-release/-{-# INLINE unfoldMany #-}-unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c-unfoldMany (Unfold ustep inject) (Fold fstep initial extract) =-    Fold consume initial extract--    where--    {-# INLINE produce #-}-    produce fs us = do-        ures <- ustep us-        case ures of-            StreamD.Yield b us1 -> do-                fres <- fstep fs b-                case fres of-                    Partial fs1 -> produce fs1 us1-                    -- XXX What to do with the remaining stream?-                    Done c -> return $ Done c-            StreamD.Skip us1 -> produce fs us1-            StreamD.Stop -> return $ Partial fs--    {-# INLINE_LATE consume #-}-    consume s a = inject a >>= produce s---- | Get the bottom most @n@ elements using the supplied comparison function.----{-# INLINE bottomBy #-}-bottomBy :: (MonadIO m, Unbox a) =>-       (a -> a -> Ordering)-    -> Int-    -> Fold m a (MutArray a)-bottomBy cmp n = Fold step initial extract--    where--    initial = do-        arr <- MA.newPinned n-        if n <= 0-        then return $ Done arr-        else return $ Partial (arr, 0)--    step (arr, i) x =-        if i < n-        then do-            arr' <- MA.snoc arr x-            MA.bubble cmp arr'-            return $ Partial (arr', i + 1)-        else do-            x1 <- MA.getIndexUnsafe (i - 1) arr-            case x `cmp` x1 of-                LT -> do-                    MA.putIndexUnsafe (i - 1) arr x-                    MA.bubble cmp arr-                    return $ Partial (arr, i)-                _ -> return $ Partial (arr, i)--    extract = return . fst---- | Get the top @n@ elements using the supplied comparison function.------ To get bottom n elements instead:------ >>> bottomBy cmp = Fold.topBy (flip cmp)------ Example:------ >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]--- >>> Stream.fold (Fold.topBy compare 3) stream >>= MutArray.toList--- [17,11,9]------ /Pre-release/----{-# INLINE topBy #-}-topBy :: (MonadIO m, Unbox a) =>-       (a -> a -> Ordering)-    -> Int-    -> Fold m a (MutArray a)-topBy cmp = bottomBy (flip cmp)---- | Fold the input stream to top n elements.------ Definition:------ >>> top = Fold.topBy compare------ >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]--- >>> Stream.fold (Fold.top 3) stream >>= MutArray.toList--- [17,11,9]------ /Pre-release/-{-# INLINE top #-}-top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)-top = bottomBy $ flip compare---- | Fold the input stream to bottom n elements.------ Definition:------ >>> bottom = Fold.bottomBy compare------ >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]--- >>> Stream.fold (Fold.bottom 3) stream >>= MutArray.toList--- [1,2,3]------ /Pre-release/-{-# INLINE bottom #-}-bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)-bottom = bottomBy compare----------------------------------------------------------------------------------- Interspersed parsing---------------------------------------------------------------------------------data IntersperseQState fs ps =-      IntersperseQUnquoted !fs !ps-    | IntersperseQQuoted !fs !ps-    | IntersperseQQuotedEsc !fs !ps---- Useful for parsing CSV with quoting and escaping-{-# INLINE intersperseWithQuotes #-}-intersperseWithQuotes :: (Monad m, Eq a) =>-    a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c-intersperseWithQuotes-    quote-    esc-    separator-    (Fold stepL initialL extractL)-    (Fold stepR initialR extractR) = Fold step initial extract--    where--    errMsg p status =-        error $ "intersperseWithQuotes: " ++ p ++ " parsing fold cannot "-                ++ status ++ " without input"--    {-# INLINE initL #-}-    initL mkState = do-        resL <- initialL-        case resL of-            Partial sL ->-                return $ Partial $ mkState sL-            Done _ ->-                errMsg "content" "succeed"--    initial = do-        res <- initialR-        case res of-            Partial sR -> initL (IntersperseQUnquoted sR)-            Done b -> return $ Done b--    {-# INLINE collect #-}-    collect nextS sR b = do-        res <- stepR sR b-        case res of-            Partial s ->-                initL (nextS s)-            Done c -> return (Done c)--    {-# INLINE process #-}-    process a sL sR nextState = do-        r <- stepL sL a-        case r of-            Partial s -> return $ Partial (nextState sR s)-            Done b -> collect nextState sR b--    {-# INLINE processQuoted #-}-    processQuoted a sL sR nextState = do-        r <- stepL sL a-        case r of-            Partial s -> return $ Partial (nextState sR s)-            Done _ -> error "Collecting fold finished inside quote"--    step (IntersperseQUnquoted sR sL) a-        | a == separator = do-            b <- extractL sL-            collect IntersperseQUnquoted sR b-        | a == quote = processQuoted a sL sR IntersperseQQuoted-        | otherwise = process a sL sR IntersperseQUnquoted--    step (IntersperseQQuoted sR sL) a-        | a == esc = processQuoted a sL sR IntersperseQQuotedEsc-        | a == quote = process a sL sR IntersperseQUnquoted-        | otherwise = processQuoted a sL sR IntersperseQQuoted--    step (IntersperseQQuotedEsc sR sL) a =-        processQuoted a sL sR IntersperseQQuoted--    extract (IntersperseQUnquoted sR _) = extractR sR-    extract (IntersperseQQuoted _ _) =-        error "intersperseWithQuotes: finished inside quote"-    extract (IntersperseQQuotedEsc _ _) =-        error "intersperseWithQuotes: finished inside quote, at escape char"+      module Streamly.Internal.Data.Fold.Type+    , module Streamly.Internal.Data.Fold.Tee+    , module Streamly.Internal.Data.Fold.Combinators+    , module Streamly.Internal.Data.Fold.Container+    , module Streamly.Internal.Data.Fold.Window+    )+where++import Streamly.Internal.Data.Fold.Combinators+import Streamly.Internal.Data.Fold.Container+import Streamly.Internal.Data.Fold.Tee+import Streamly.Internal.Data.Fold.Type+import Streamly.Internal.Data.Fold.Window++#include "DocTestDataFold.hs"
src/Streamly/Internal/Data/Fold/Chunked.hs view
@@ -6,7 +6,7 @@ -- Stability   : experimental -- Portability : GHC ----- Use "Streamly.Data.Parser.Chunked" instead.+-- Use "Streamly.Data.Parser" instead. -- -- Fold a stream of foreign arrays.  @Fold m a b@ in this module works -- on a stream of "Array a" and produces an output of type @b@.@@ -19,18 +19,19 @@ -- folds in Data.Fold to correctly work on an array stream as if it is an -- element stream. For example: ----- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Stream.Chunked as ArrayStream--- >>> import qualified Streamly.Internal.Data.Fold.Chunked as ChunkFold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Data.StreamK as StreamK+-- >> import qualified Streamly.Data.Fold as Fold+-- >> import qualified Streamly.Internal.Data.Array.Stream as ArrayStream+-- >> import qualified Streamly.Internal.Data.Fold.Chunked as ChunkFold+-- >> import qualified Streamly.Data.Stream as Stream+-- >> import qualified Streamly.Data.StreamK as StreamK ----- >>> f = ChunkFold.fromFold (Fold.take 7 Fold.toList)--- >>> s = Stream.chunksOf 5 $ Stream.fromList "hello world"--- >>> ArrayStream.runArrayFold f (StreamK.fromStream s)+-- >> f = ChunkFold.fromFold (Fold.take 7 Fold.toList)+-- >> s = Stream.chunksOf 5 $ Stream.fromList "hello world"+-- >> ArrayStream.runArrayFold f (StreamK.fromStream s) -- Right "hello w" -- module Streamly.Internal.Data.Fold.Chunked+    {-# DEPRECATED "Please use Streamly.Data.Parser instead." #-}     (       ChunkFold (..) @@ -58,22 +59,22 @@  #include "ArrayMacros.h" +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.Exception (assert) import Control.Monad.IO.Class (MonadIO(..)) import Data.Bifunctor (first) import Data.Proxy (Proxy(..))-import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unbox)+import Streamly.Internal.Data.Unbox (Unbox(..)) import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Mut.Type (touch)-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Parser.ParserD (Initial(..), Step(..))+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Internal.Data.Parser (Initial(..), Step(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) -import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD+import qualified Streamly.Internal.Data.Parser as ParserD import qualified Streamly.Internal.Data.Parser as Parser  import Prelude hiding (concatMap, take)@@ -102,8 +103,8 @@ {-# INLINE fromFold #-} fromFold :: forall m a b. (MonadIO m, Unbox a) =>     Fold.Fold m a b -> ChunkFold m a b-fromFold (Fold.Fold fstep finitial fextract) =-    ChunkFold (ParserD.Parser step initial (fmap (Done 0) . fextract))+fromFold (Fold.Fold fstep finitial _ ffinal) =+    ChunkFold (ParserD.Parser step initial extract)      where @@ -123,7 +124,7 @@             assert (cur == end) (return ())             return $ Partial 0 fs         goArray !_ !cur !fs = do-            x <- liftIO $ peekWith contents cur+            x <- liftIO $ peekAt cur contents             res <- fstep fs x             let elemSize = SIZE_OF(a)                 next = INDEX_NEXT(cur,a)@@ -133,6 +134,8 @@                 Fold.Partial fs1 ->                     goArray SPEC next fs1 +    extract = fmap (Done 0) . ffinal+ -- | Convert an element 'ParserD.Parser' into an array stream fold. If the -- parser fails the fold would throw an exception. --@@ -160,8 +163,7 @@             else return $ st (arrRem + n) fs1          goArray !_ !cur !fs = do-            x <- liftIO $ peekWith contents cur-            liftIO $ touch contents+            x <- liftIO $ peekAt cur contents             res <- step1 fs x             let elemSize = SIZE_OF(a)                 next = INDEX_NEXT(cur,a)
+ src/Streamly/Internal/Data/Fold/Combinators.hs view
@@ -0,0 +1,2544 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.Combinators+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- See "Streamly.Data.Fold" for an overview and+-- "Streamly.Internal.Data.Fold.Type" for design notes.++module Streamly.Internal.Data.Fold.Combinators+    (+    -- * Mappers+    -- | Monadic functions useful with mapM/lmapM on folds or streams.+      tracing+    , trace++    -- * Folds++    -- ** Accumulators+    -- *** Semigroups and Monoids+    , sconcat+    , mconcat+    , foldMap+    , foldMapM++    -- *** Reducers+    , drainMapM+    , the+    , length+    , lengthGeneric+    , mean+    , rollingHash+    , defaultSalt+    , rollingHashWithSalt+    , rollingHashFirstN+    -- , rollingHashLastN++    -- *** Saturating Reducers+    -- | 'product' terminates if it becomes 0. Other folds can theoretically+    -- saturate on bounded types, and therefore terminate, however, they will+    -- run forever on unbounded types like Integer/Double.+    , sum+    , product+    , maximumBy+    , maximum+    , minimumBy+    , minimum++    -- *** Collectors+    -- | Avoid using these folds in scalable or performance critical+    -- applications, they buffer all the input in GC memory which can be+    -- detrimental to performance if the input is large.+    , toListRev+    -- $toListRev+    , toStream+    , toStreamRev+    , topBy+    , top+    , bottomBy+    , bottom++    -- *** Scanners+    -- | Stateful transformation of the elements. Useful in combination with+    -- the 'scanMaybe' combinator. For scanners the result of the fold is+    -- usually a transformation of the current element rather than an+    -- aggregation of all elements till now.+    , latest+ -- , nthLast -- using Ring array+    , indexingWith+    , indexing+    , indexingRev+    , rollingMapM++    -- *** Filters+    -- | Useful in combination with the 'scanMaybe' combinator.+    , deleteBy+    , uniqBy+    , uniq+    , repeated+    , findIndices+    , elemIndices++    -- *** Singleton folds+    -- | Folds that terminate after consuming exactly one input element. All+    -- these can be implemented in terms of the 'maybe' fold.+    , one+    , null -- XXX not very useful and could be problematic, remove it?+    , satisfy+    , maybe++    -- *** Multi folds+    -- | Terminate after consuming one or more elements.+    , drainN+    -- , lastN+    -- , (!!)+    , indexGeneric+    , index+    , findM+    , find+    , lookup+    , findIndex+    , elemIndex+    , elem+    , notElem+    , all+    , any+    , and+    , or++    -- ** Trimmers+    -- | Useful in combination with the 'scanMaybe' combinator.+    , takingEndByM+    , takingEndBy+    , takingEndByM_+    , takingEndBy_+    , droppingWhileM+    , droppingWhile+    , prune++    -- * Running A Fold+    , drive+    -- , breakStream++    -- * Building Incrementally+    , addStream++    -- * Combinators+    -- ** Utilities+    , with++    -- ** Mapping on Input+    , transform++    -- ** Sliding Window+    , slide2++    -- ** Scanning Input+    , scan+    , scanMany+    , indexed++    -- ** Zipping Input+    , zipStreamWithM+    , zipStream++    -- ** Filtering Input+    , mapMaybeM+    , mapMaybe+    , sampleFromthen++    {-+    -- ** Insertion+    -- | Insertion adds more elements to the stream.++    , insertBy+    , intersperseM++    -- ** Reordering+    , reverse+    -}++    -- ** Trimming++    -- By elements+    , takeEndBy+    , takeEndBy_+    , takeEndBySeq+    , takeEndBySeq_+    {-+    , drop+    , dropWhile+    , dropWhileM+    -}++    -- ** Serial Append+    -- , tail+    -- , init+    , splitAt -- spanN+    -- , splitIn -- sessionN++    -- ** Parallel Distribution+    , tee+    , distribute+    -- , distributeFst+    -- , distributeMin++    -- ** Unzipping+    , unzip+    -- These two can be expressed using lmap/lmapM and unzip+    , unzipWith+    , unzipWithM+    , unzipWithFstM+    , unzipWithMinM++    -- ** Partitioning+    , partitionByM+    , partitionByFstM+    , partitionByMinM+    , partitionBy+    , partition++    -- ** Splitting+    , chunksBetween+    , intersperseWithQuotes++    -- ** Nesting+    , unfoldMany+    , concatSequence++    -- * Deprecated+    , drainBy+    , last+    , head+    , sequence+    , mapM+    , variance+    , stdDev+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bifunctor (first)+import Data.Bits (shiftL, shiftR, (.|.), (.&.))+import Data.Either (isLeft, isRight, fromLeft, fromRight)+import Data.Int (Int64)+import Data.Proxy (Proxy(..))+import Data.Word (Word32)+import Foreign.Storable (Storable, peek)+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))+import Streamly.Internal.Data.Unbox (Unbox, sizeOf)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))+import Streamly.Internal.Data.Stream.Type (Stream)++import qualified Prelude+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Fold.Window as Fold+import qualified Streamly.Internal.Data.Pipe.Type as Pipe+import qualified Streamly.Internal.Data.Ring as Ring+import qualified Streamly.Internal.Data.Stream.Type as StreamD++import Prelude hiding+       ( Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith+       , map, mapM_, sequence, all, any+       , notElem, head, last, tail+       , reverse, iterate, init, and, or, lookup, (!!)+       , scanl, scanl1, replicate, concatMap, mconcat, unzip+       , span, splitAt, break, mapM, zip, maybe)+import Streamly.Internal.Data.Fold.Type++#include "DocTestDataFold.hs"++------------------------------------------------------------------------------+-- Running+------------------------------------------------------------------------------++-- | Drive a fold using the supplied 'Stream', reducing the resulting+-- expression strictly at each step.+--+-- Definition:+--+-- >>> drive = flip Stream.fold+--+-- Example:+--+-- >>> Fold.drive (Stream.enumerateFromTo 1 100) Fold.sum+-- 5050+--+{-# INLINE drive #-}+drive :: Monad m => Stream m a -> Fold m a b -> m b+drive = flip StreamD.fold++{-+-- | Like 'drive' but also returns the remaining stream. The resulting stream+-- would be 'Stream.nil' if the stream finished before the fold.+--+-- Definition:+--+-- >>> breakStream = flip Stream.foldBreak+--+-- /CPS/+--+{-# INLINE breakStreamK #-}+breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a)+breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm)++    where++    f (b, str) = (b, Stream.fromStreamK str)+-}++-- | Append a stream to a fold to build the fold accumulator incrementally. We+-- can repeatedly call 'addStream' on the same fold to continue building the+-- fold and finally use 'drive' to finish the fold and extract the result. Also+-- see the 'Streamly.Data.Fold.addOne' operation which is a singleton version+-- of 'addStream'.+--+-- Definitions:+--+-- >>> addStream stream = Fold.drive stream . Fold.duplicate+--+-- Example, build a list incrementally:+--+-- >>> :{+-- pure (Fold.toList :: Fold IO Int [Int])+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- [1,2,3,4]+--+-- This can be used as an O(n) list append compared to the O(n^2) @++@ when+-- used for incrementally building a list.+--+-- Example, build a stream incrementally:+--+-- >>> :{+-- pure (Fold.toStream :: Fold IO Int (Stream Identity Int))+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- fromList [1,2,3,4]+--+-- This can be used as an O(n) stream append compared to the O(n^2) @<>@ when+-- used for incrementally building a stream.+--+-- Example, build an array incrementally:+--+-- >>> :{+-- pure (Array.write :: Fold IO Int (Array Int))+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- fromList [1,2,3,4]+--+-- Example, build an array stream incrementally:+--+-- >>> :{+-- let f :: Fold IO Int (Stream Identity (Array Int))+--     f = Fold.groupsOf 2 (Array.writeN 3) Fold.toStream+-- in pure f+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- fromList [fromList [1,2],fromList [3,4]]+--+addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)+addStream stream = drive stream . duplicate++------------------------------------------------------------------------------+-- Transformations on fold inputs+------------------------------------------------------------------------------++-- | Flatten the monadic output of a fold to pure output.+--+{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}+{-# INLINE sequence #-}+sequence :: Monad m => Fold m a (m b) -> Fold m a b+sequence = rmapM id++-- | Map a monadic function on the output of a fold.+--+{-# DEPRECATED mapM "Use rmapM instead" #-}+{-# INLINE mapM #-}+mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c+mapM = rmapM++-- |+-- >>> mapMaybeM f = Fold.lmapM f . Fold.catMaybes+--+{-# INLINE mapMaybeM #-}+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Fold m b r -> Fold m a r+mapMaybeM f = lmapM f . catMaybes++-- | @mapMaybe f fold@ maps a 'Maybe' returning function @f@ on the input of+-- the fold, filters out 'Nothing' elements, and return the values extracted+-- from 'Just'.+--+-- >>> mapMaybe f = Fold.lmap f . Fold.catMaybes+-- >>> mapMaybe f = Fold.mapMaybeM (return . f)+--+-- >>> f x = if even x then Just x else Nothing+-- >>> fld = Fold.mapMaybe f Fold.toList+-- >>> Stream.fold fld (Stream.enumerateFromTo 1 10)+-- [2,4,6,8,10]+--+{-# INLINE mapMaybe #-}+mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r+mapMaybe f = lmap f . catMaybes++------------------------------------------------------------------------------+-- Transformations on fold inputs+------------------------------------------------------------------------------++-- | Apply a monadic function on the input and return the input.+--+-- >>> Stream.fold (Fold.lmapM (Fold.tracing print) Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)+-- 1+-- 2+--+-- /Pre-release/+--+{-# INLINE tracing #-}+tracing :: Monad m => (a -> m b) -> (a -> m a)+tracing f x = void (f x) >> return x++-- | Apply a monadic function to each element flowing through and discard the+-- results.+--+-- >>> Stream.fold (Fold.trace print Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)+-- 1+-- 2+--+-- >>> trace f = Fold.lmapM (Fold.tracing f)+--+-- /Pre-release/+{-# INLINE trace #-}+trace :: Monad m => (a -> m b) -> Fold m a r -> Fold m a r+trace f = lmapM (tracing f)++-- rename to lpipe?+--+-- | Apply a transformation on a 'Fold' using a 'Pipe'.+--+-- /Pre-release/+{-# INLINE transform #-}+transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c+transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract ffinal) =+    Fold step initial extract final++    where++    initial = first (Tuple' pinitial) <$> finitial++    step (Tuple' ps fs) x = do+        r <- pstep1 ps x+        go fs r++        where++        -- XXX use SPEC?+        go acc (Pipe.Yield b (Consume ps')) = do+            acc' <- fstep acc b+            return+                $ case acc' of+                      Partial s -> Partial $ Tuple' ps' s+                      Done b2 -> Done b2+        go acc (Pipe.Yield b (Produce ps')) = do+            acc' <- fstep acc b+            r <- pstep2 ps'+            case acc' of+                Partial s -> go s r+                Done b2 -> return $ Done b2+        go acc (Pipe.Continue (Consume ps')) =+            return $ Partial $ Tuple' ps' acc+        go acc (Pipe.Continue (Produce ps')) = do+            r <- pstep2 ps'+            go acc r++    extract (Tuple' _ fs) = fextract fs++    final (Tuple' _ fs) = ffinal fs++{-# INLINE scanWith #-}+scanWith :: Monad m => Bool -> Fold m a b -> Fold m b c -> Fold m a c+scanWith isMany+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final++    where++    {-# INLINE runStep #-}+    runStep actionL sR = do+        rL <- actionL+        case rL of+            Done bL -> do+                rR <- stepR sR bL+                case rR of+                    Partial sR1 ->+                        if isMany+                        then runStep initialL sR1+                        else Done <$> finalR sR1+                    Done bR -> return $ Done bR+            Partial sL -> do+                !b <- extractL sL+                rR <- stepR sR b+                case rR of+                    Partial sR1 -> return $ Partial (sL, sR1)+                    Done bR -> finalL sL >> return (Done bR)++    initial = do+        r <- initialR+        case r of+            Partial sR -> runStep initialL sR+            Done b -> return $ Done b++    step (sL, sR) x = runStep (stepL sL x) sR++    extract = extractR . snd++    final (sL, sR) = finalL sL *> finalR sR++-- | Scan the input of a 'Fold' to change it in a stateful manner using another+-- 'Fold'. The scan stops as soon as the fold terminates.+--+-- /Pre-release/+{-# INLINE scan #-}+scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+scan = scanWith False++-- XXX This does not fuse beacuse of the recursive step. Need to investigate.+--+-- | Scan the input of a 'Fold' to change it in a stateful manner using another+-- 'Fold'. The scan restarts with a fresh state if the fold terminates.+--+-- /Pre-release/+{-# INLINE scanMany #-}+scanMany :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+scanMany = scanWith True++------------------------------------------------------------------------------+-- Filters+------------------------------------------------------------------------------++-- | Returns the latest element omitting the first occurrence that satisfies+-- the given equality predicate.+--+-- Example:+--+-- >>> input = Stream.fromList [1,3,3,5]+-- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.deleteBy (==) 3) input+-- [1,3,5]+--+{-# INLINE_NORMAL deleteBy #-}+deleteBy :: Monad m => (a -> a -> Bool) -> a -> Fold m a (Maybe a)+deleteBy eq x0 = fmap extract $ foldl' step (Tuple' False Nothing)++    where++    step (Tuple' False _) x =+        if eq x x0+        then Tuple' True Nothing+        else Tuple' False (Just x)+    step (Tuple' True _) x = Tuple' True (Just x)++    extract (Tuple' _ x) = x++-- | Provide a sliding window of length 2 elements.+--+-- See "Streamly.Internal.Data.Fold.Window".+--+{-# INLINE slide2 #-}+slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b+slide2 (Fold step1 initial1 extract1 final1) = Fold step initial extract final++    where++    initial =+        first (Tuple' Nothing) <$> initial1++    step (Tuple' prev s) cur =+        first (Tuple' (Just cur)) <$> step1 s (cur, prev)++    extract (Tuple' _ s) = extract1 s++    final (Tuple' _ s) = final1 s++-- | Return the latest unique element using the supplied comparison function.+-- Returns 'Nothing' if the current element is same as the last element+-- otherwise returns 'Just'.+--+-- Example, strip duplicate path separators:+--+-- >>> input = Stream.fromList "//a//b"+-- >>> f x y = x == '/' && y == '/'+-- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.uniqBy f) input+-- "/a/b"+--+-- Space: @O(1)@+--+-- /Pre-release/+--+{-# INLINE uniqBy #-}+uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)+uniqBy eq = rollingMap f++    where++    f pre curr =+        case pre of+            Nothing -> Just curr+            Just x -> if x `eq` curr then Nothing else Just curr++-- | See 'uniqBy'.+--+-- Definition:+--+-- >>> uniq = Fold.uniqBy (==)+--+{-# INLINE uniq #-}+uniq :: (Monad m, Eq a) => Fold m a (Maybe a)+uniq = uniqBy (==)++-- | Strip all leading and trailing occurrences of an element passing a+-- predicate and make all other consecutive occurrences uniq.+--+-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)+--+-- @+-- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")+-- "hello world!"+--+-- @+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE prune #-}+prune ::+    -- (Monad m, Eq a) =>+    (a -> Bool) -> Fold m a (Maybe a)+prune = error "Not implemented yet!"++-- | Emit only repeated elements, once.+--+-- /Unimplemented/+repeated :: -- (Monad m, Eq a) =>+    Fold m a (Maybe a)+repeated = error "Not implemented yet!"++------------------------------------------------------------------------------+-- Left folds+------------------------------------------------------------------------------++------------------------------------------------------------------------------+-- Run Effects+------------------------------------------------------------------------------++-- |+-- Definitions:+--+-- >>> drainMapM f = Fold.lmapM f Fold.drain+-- >>> drainMapM f = Fold.foldMapM (void . f)+--+-- Drain all input after passing it through a monadic function. This is the+-- dual of mapM_ on stream producers.+--+{-# INLINE drainMapM #-}+drainMapM ::  Monad m => (a -> m b) -> Fold m a ()+drainMapM f = lmapM f drain++{-# DEPRECATED drainBy "Please use 'drainMapM' instead." #-}+{-# INLINE drainBy #-}+drainBy ::  Monad m => (a -> m b) -> Fold m a ()+drainBy = drainMapM++-- | Returns the latest element of the input stream, if any.+--+-- >>> latest = Fold.foldl1' (\_ x -> x)+-- >>> latest = fmap getLast $ Fold.foldMap (Last . Just)+--+{-# INLINE latest #-}+latest :: Monad m => Fold m a (Maybe a)+latest = foldl1' (\_ x -> x)++{-# DEPRECATED last "Please use 'latest' instead." #-}+{-# INLINE last #-}+last :: Monad m => Fold m a (Maybe a)+last = latest++-- | Terminates with 'Nothing' as soon as it finds an element different than+-- the previous one, returns 'the' element if the entire input consists of the+-- same element.+--+{-# INLINE the #-}+the :: (Monad m, Eq a) => Fold m a (Maybe a)+the = foldt' step initial id++    where++    initial = Partial Nothing++    step Nothing x = Partial (Just x)+    step old@(Just x0) x =+            if x0 == x+            then Partial old+            else Done Nothing++------------------------------------------------------------------------------+-- To Summary+------------------------------------------------------------------------------++-- | Like 'length', except with a more general 'Num' return value+--+-- Definition:+--+-- >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const  1)+-- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0+--+-- /Pre-release/+{-# INLINE lengthGeneric #-}+lengthGeneric :: (Monad m, Num b) => Fold m a b+lengthGeneric = foldl' (\n _ -> n + 1) 0++-- | Determine the length of the input stream.+--+-- Definition:+--+-- >>> length = Fold.lengthGeneric+-- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)+--+{-# INLINE length #-}+length :: Monad m => Fold m a Int+length = lengthGeneric+++-- | Determine the sum of all elements of a stream of numbers. Returns additive+-- identity (@0@) when the stream is empty. Note that this is not numerically+-- stable for floating point numbers.+--+-- >>> sum = Fold.cumulative Fold.windowSum+--+-- Same as following but numerically stable:+--+-- >>> sum = Fold.foldl' (+) 0+-- >>> sum = fmap Data.Monoid.getSum $ Fold.foldMap Data.Monoid.Sum+--+{-# INLINE sum #-}+sum :: (Monad m, Num a) => Fold m a a+sum = Fold.cumulative Fold.windowSum++-- | Determine the product of all elements of a stream of numbers. Returns+-- multiplicative identity (@1@) when the stream is empty. The fold terminates+-- when it encounters (@0@) in its input.+--+-- Same as the following but terminates on multiplication by @0@:+--+-- >>> product = fmap Data.Monoid.getProduct $ Fold.foldMap Data.Monoid.Product+--+{-# INLINE product #-}+product :: (Monad m, Num a, Eq a) => Fold m a a+product =  foldt' step (Partial 1) id++    where++    step x a =+        if a == 0+        then Done 0+        else Partial $ x * a++------------------------------------------------------------------------------+-- To Summary (Maybe)+------------------------------------------------------------------------------++-- | Determine the maximum element in a stream using the supplied comparison+-- function.+--+{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)+maximumBy cmp = foldl1' max'++    where++    max' x y =+        case cmp x y of+            GT -> x+            _ -> y++-- | Determine the maximum element in a stream.+--+-- Definitions:+--+-- >>> maximum = Fold.maximumBy compare+-- >>> maximum = Fold.foldl1' max+--+-- Same as the following but without a default maximum. The 'Max' Monoid uses+-- the 'minBound' as the default maximum:+--+-- >>> maximum = fmap Data.Semigroup.getMax $ Fold.foldMap Data.Semigroup.Max+--+{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => Fold m a (Maybe a)+maximum = foldl1' max++-- | Computes the minimum element with respect to the given comparison function+--+{-# INLINE minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)+minimumBy cmp = foldl1' min'++    where++    min' x y =+        case cmp x y of+            GT -> y+            _ -> x++-- | Determine the minimum element in a stream using the supplied comparison+-- function.+--+-- Definitions:+--+-- >>> minimum = Fold.minimumBy compare+-- >>> minimum = Fold.foldl1' min+--+-- Same as the following but without a default minimum. The 'Min' Monoid uses the+-- 'maxBound' as the default maximum:+--+-- >>> maximum = fmap Data.Semigroup.getMin $ Fold.foldMap Data.Semigroup.Min+--+{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => Fold m a (Maybe a)+minimum = foldl1' min++------------------------------------------------------------------------------+-- To Summary (Statistical)+------------------------------------------------------------------------------++-- | Compute a numerically stable arithmetic mean of all elements in the input+-- stream.+--+{-# INLINE mean #-}+mean :: (Monad m, Fractional a) => Fold m a a+mean = fmap done $ foldl' step begin++    where++    begin = Tuple' 0 0++    step (Tuple' x n) y =+        let n1 = n + 1+         in Tuple' (x + (y - x) / n1) n1++    done (Tuple' x _) = x++-- | Compute a numerically stable (population) variance over all elements in+-- the input stream.+--+{-# DEPRECATED variance "Use the streamly-statistics package instead" #-}+{-# INLINE variance #-}+variance :: (Monad m, Fractional a) => Fold m a a+variance = fmap done $ foldl' step begin++    where++    begin = Tuple3' 0 0 0++    step (Tuple3' n mean_ m2) x = Tuple3' n' mean' m2'++        where++        n' = n + 1+        mean' = (n * mean_ + x) / (n + 1)+        delta = x - mean_+        m2' = m2 + delta * delta * n / (n + 1)++    done (Tuple3' n _ m2) = m2 / n++-- | Compute a numerically stable (population) standard deviation over all+-- elements in the input stream.+--+{-# DEPRECATED stdDev "Use the streamly-statistics package instead" #-}+{-# INLINE stdDev #-}+stdDev :: (Monad m, Floating a) => Fold m a a+stdDev = sqrt <$> variance++-- | Compute an 'Int' sized polynomial rolling hash+--+-- > H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0+--+-- Where @c1@, @c2@, @cn@ are the elements in the input stream and @k@ is a+-- constant.+--+-- This hash is often used in Rabin-Karp string search algorithm.+--+-- See https://en.wikipedia.org/wiki/Rolling_hash+--+{-# INLINE rollingHashWithSalt #-}+rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64+rollingHashWithSalt = foldl' step++    where++    k = 2891336453 :: Int64++    step cksum a = cksum * k + fromIntegral (fromEnum a)++-- | A default salt used in the implementation of 'rollingHash'.+{-# INLINE defaultSalt #-}+defaultSalt :: Int64+defaultSalt = -2578643520546668380++-- | Compute an 'Int' sized polynomial rolling hash of a stream.+--+-- >>> rollingHash = Fold.rollingHashWithSalt Fold.defaultSalt+--+{-# INLINE rollingHash #-}+rollingHash :: (Monad m, Enum a) => Fold m a Int64+rollingHash = rollingHashWithSalt defaultSalt++-- | Compute an 'Int' sized polynomial rolling hash of the first n elements of+-- a stream.+--+-- >>> rollingHashFirstN n = Fold.take n Fold.rollingHash+--+-- /Pre-release/+{-# INLINE rollingHashFirstN #-}+rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64+rollingHashFirstN n = take n rollingHash++-- XXX Compare this with the implementation in Fold.Window, preferrably use the+-- latter if performance is good.++-- | Apply a function on every two successive elements of a stream. The first+-- argument of the map function is the previous element and the second argument+-- is the current element. When processing the very first element in the+-- stream, the previous element is 'Nothing'.+--+-- /Pre-release/+--+{-# INLINE rollingMapM #-}+rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b+rollingMapM f = Fold step initial extract extract++    where++    -- XXX We need just a postscan. We do not need an initial result here.+    -- Or we can supply a default initial result as an argument to rollingMapM.+    initial = return $ Partial (Nothing, error "Empty stream")++    step (prev, _) cur = do+        x <- f prev cur+        return $ Partial (Just cur, x)++    extract = return . snd++-- |+-- >>> rollingMap f = Fold.rollingMapM (\x y -> return $ f x y)+--+{-# INLINE rollingMap #-}+rollingMap :: Monad m => (Maybe a -> a -> b) -> Fold m a b+rollingMap f = rollingMapM (\x y -> return $ f x y)++------------------------------------------------------------------------------+-- Monoidal left folds+------------------------------------------------------------------------------++-- | Semigroup concat. Append the elements of an input stream to a provided+-- starting value.+--+-- Definition:+--+-- >>> sconcat = Fold.foldl' (<>)+--+-- >>> semigroups = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10+-- >>> Stream.fold (Fold.sconcat 10) semigroups+-- Sum {getSum = 65}+--+{-# INLINE sconcat #-}+sconcat :: (Monad m, Semigroup a) => a -> Fold m a a+sconcat = foldl' (<>)++-- | Monoid concat. Fold an input stream consisting of monoidal elements using+-- 'mappend' and 'mempty'.+--+-- Definition:+--+-- >>> mconcat = Fold.sconcat mempty+--+-- >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10+-- >>> Stream.fold Fold.mconcat monoids+-- Sum {getSum = 55}+--+{-# INLINE mconcat #-}+mconcat ::+    ( Monad m+    , Monoid a) => Fold m a a+mconcat = sconcat mempty++-- |+-- Definition:+--+-- >>> foldMap f = Fold.lmap f Fold.mconcat+--+-- Make a fold from a pure function that folds the output of the function+-- using 'mappend' and 'mempty'.+--+-- >>> sum = Fold.foldMap Data.Monoid.Sum+-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10+-- Sum {getSum = 55}+--+{-# INLINE foldMap #-}+foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b+foldMap f = lmap f mconcat++-- |+-- Definition:+--+-- >>> foldMapM f = Fold.lmapM f Fold.mconcat+--+-- Make a fold from a monadic function that folds the output of the function+-- using 'mappend' and 'mempty'.+--+-- >>> sum = Fold.foldMapM (return . Data.Monoid.Sum)+-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10+-- Sum {getSum = 55}+--+{-# INLINE foldMapM #-}+foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b+foldMapM act = foldlM' step (pure mempty)++    where++    step m a = do+        m' <- act a+        return $! mappend m m'++------------------------------------------------------------------------------+-- To Containers+------------------------------------------------------------------------------++-- $toListRev+-- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is+-- exactly the same as reversing the list after 'toListRev'.++-- | Buffers the input stream to a list in the reverse order of the input.+--+-- Definition:+--+-- >>> toListRev = Fold.foldl' (flip (:)) []+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Array" instead.+--++--  xn : ... : x2 : x1 : []+{-# INLINE toListRev #-}+toListRev :: Monad m => Fold m a [a]+toListRev = foldl' (flip (:)) []++------------------------------------------------------------------------------+-- Partial Folds+------------------------------------------------------------------------------++-- | A fold that drains the first n elements of its input, running the effects+-- and discarding the results.+--+-- Definition:+--+-- >>> drainN n = Fold.take n Fold.drain+--+-- /Pre-release/+{-# INLINE drainN #-}+drainN :: Monad m => Int -> Fold m a ()+drainN n = take n drain++------------------------------------------------------------------------------+-- To Elements+------------------------------------------------------------------------------++-- | Like 'index', except with a more general 'Integral' argument+--+-- /Pre-release/+{-# INLINE indexGeneric #-}+indexGeneric :: (Integral i, Monad m) => i -> Fold m a (Maybe a)+indexGeneric i = foldt' step (Partial 0) (const Nothing)++    where++    step j a =+        if i == j+        then Done $ Just a+        else Partial (j + 1)++-- | Return the element at the given index.+--+-- Definition:+--+-- >>> index = Fold.indexGeneric+--+{-# INLINE index #-}+index :: Monad m => Int -> Fold m a (Maybe a)+index = indexGeneric++-- | Consume a single input and transform it using the supplied 'Maybe'+-- returning function.+--+-- /Pre-release/+--+{-# INLINE maybe #-}+maybe :: Monad m => (a -> Maybe b) -> Fold m a (Maybe b)+maybe f = foldt' (const (Done . f)) (Partial Nothing) id++-- | Consume a single element and return it if it passes the predicate else+-- return 'Nothing'.+--+-- Definition:+--+-- >>> satisfy f = Fold.maybe (\a -> if f a then Just a else Nothing)+--+-- /Pre-release/+{-# INLINE satisfy #-}+satisfy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+satisfy f = maybe (\a -> if f a then Just a else Nothing)+{-+satisfy f = Fold step (return $ Partial ()) (const (return Nothing))++    where++    step () a = return $ Done $ if f a then Just a else Nothing+-}++-- Naming notes:+--+-- "head" and "next" are two alternative names for the same API. head sounds+-- apt in the context of lists but next sounds more apt in the context of+-- streams where we think in terms of generating and consuming the next element+-- rather than taking the head of some static/persistent structure.+--+-- We also want to keep the nomenclature consistent across folds and parsers,+-- "head" becomes even more unintuitive for parsers because there are two+-- possible variants viz. peek and next.+--+-- Also, the "head" fold creates confusion in situations like+-- https://github.com/composewell/streamly/issues/1404 where intuitive+-- expectation from head is to consume the entire stream and just give us the+-- head. There we want to convey the notion that we consume one element from+-- the stream and stop. The name "one" already being used in parsers for this+-- purpose sounds more apt from this perspective.+--+-- The source of confusion is perhaps due to the fact that some folds consume+-- the entire stream and others terminate early. It may have been clearer if we+-- had separate abstractions for the two use cases.++-- XXX We can possibly use "head" for the purposes of reducing the entire+-- stream to the head element i.e. take the head and drain the rest.++-- | Take one element from the stream and stop.+--+-- Definition:+--+-- >>> one = Fold.maybe Just+--+-- This is similar to the stream 'Stream.uncons' operation.+--+{-# INLINE one #-}+one :: Monad m => Fold m a (Maybe a)+one = maybe Just++-- | Extract the first element of the stream, if any.+--+-- >>> head = Fold.one+--+{-# DEPRECATED head "Please use \"one\" instead" #-}+{-# INLINE head #-}+head :: Monad m => Fold m a (Maybe a)+head = one++-- | Returns the first element that satisfies the given predicate.+--+-- /Pre-release/+{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+findM predicate =+    Fold step (return $ Partial ()) extract extract++    where++    step () a =+        let f r =+                if r+                then Done (Just a)+                else Partial ()+         in f <$> predicate a++    extract = const $ return Nothing++-- | Returns the first element that satisfies the given predicate.+--+{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+find p = findM (return . p)++-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the+-- first pair where the key equals the given value @a@.+--+-- Definition:+--+-- >>> lookup x = fmap snd <$> Fold.find ((== x) . fst)+--+{-# INLINE lookup #-}+lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)+lookup a0 = foldt' step (Partial ()) (const Nothing)++    where++    step () (a, b) =+        if a == a0+        then Done $ Just b+        else Partial ()++-- | Returns the first index that satisfies the given predicate.+--+{-# INLINE findIndex #-}+findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)+findIndex predicate = foldt' step (Partial 0) (const Nothing)++    where++    step i a =+        if predicate a+        then Done $ Just i+        else Partial (i + 1)++-- | Returns the index of the latest element if the element satisfies the given+-- predicate.+--+{-# INLINE findIndices #-}+findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)+findIndices predicate =+    -- XXX implement by combining indexing and filtering scans+    fmap (either (const Nothing) Just) $ foldl' step (Left (-1))++    where++    step i a =+        if predicate a+        then Right (either id id i + 1)+        else Left (either id id i + 1)++-- | Returns the index of the latest element if the element matches the given+-- value.+--+-- Definition:+--+-- >>> elemIndices a = Fold.findIndices (== a)+--+{-# INLINE elemIndices #-}+elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)+elemIndices a = findIndices (== a)++-- | Returns the first index where a given value is found in the stream.+--+-- Definition:+--+-- >>> elemIndex a = Fold.findIndex (== a)+--+{-# INLINE elemIndex #-}+elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)+elemIndex a = findIndex (== a)++------------------------------------------------------------------------------+-- To Boolean+------------------------------------------------------------------------------++-- Similar to 'eof' parser, but the fold consumes and discards an input element+-- when not at eof. XXX Remove or Rename to "eof"?++-- | Consume one element, return 'True' if successful else return 'False'. In+-- other words, test if the input is empty or not.+--+-- WARNING! It consumes one element if the stream is not empty. If that is not+-- what you want please use the eof parser instead.+--+-- Definition:+--+-- >>> null = fmap isJust Fold.one+--+{-# INLINE null #-}+null :: Monad m => Fold m a Bool+null = foldt' (\() _ -> Done False) (Partial ()) (const True)++-- | Returns 'True' if any element of the input satisfies the predicate.+--+-- Definition:+--+-- >>> any p = Fold.lmap p Fold.or+--+-- Example:+--+-- >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]+-- True+--+{-# INLINE any #-}+any :: Monad m => (a -> Bool) -> Fold m a Bool+any predicate = foldt' step initial id++    where++    initial = Partial False++    step _ a =+        if predicate a+        then Done True+        else Partial False++-- | Return 'True' if the given element is present in the stream.+--+-- Definition:+--+-- >>> elem a = Fold.any (== a)+--+{-# INLINE elem #-}+elem :: (Eq a, Monad m) => a -> Fold m a Bool+elem a = any (== a)++-- | Returns 'True' if all elements of the input satisfy the predicate.+--+-- Definition:+--+-- >>> all p = Fold.lmap p Fold.and+--+-- Example:+--+-- >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]+-- False+--+{-# INLINE all #-}+all :: Monad m => (a -> Bool) -> Fold m a Bool+all predicate = foldt' step initial id++    where++    initial = Partial True++    step _ a =+        if predicate a+        then Partial True+        else Done False++-- | Returns 'True' if the given element is not present in the stream.+--+-- Definition:+--+-- >>> notElem a = Fold.all (/= a)+--+{-# INLINE notElem #-}+notElem :: (Eq a, Monad m) => a -> Fold m a Bool+notElem a = all (/= a)++-- | Returns 'True' if all elements are 'True', 'False' otherwise+--+-- Definition:+--+-- >>> and = Fold.all (== True)+--+{-# INLINE and #-}+and :: Monad m => Fold m Bool Bool+and = all (== True)++-- | Returns 'True' if any element is 'True', 'False' otherwise+--+-- Definition:+--+-- >>> or = Fold.any (== True)+--+{-# INLINE or #-}+or :: Monad m => Fold m Bool Bool+or = any (== True)++------------------------------------------------------------------------------+-- Grouping/Splitting+------------------------------------------------------------------------------++------------------------------------------------------------------------------+-- Grouping without looking at elements+------------------------------------------------------------------------------++------------------------------------------------------------------------------+-- Binary APIs+------------------------------------------------------------------------------++-- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@+-- elements of its input are consumed by fold @f1@ and the rest of the stream+-- is consumed by fold @f2@.+--+-- >>> let splitAt_ n xs = Stream.fold (Fold.splitAt n Fold.toList Fold.toList) $ Stream.fromList xs+--+-- >>> splitAt_ 6 "Hello World!"+-- ("Hello ","World!")+--+-- >>> splitAt_ (-1) [1,2,3]+-- ([],[1,2,3])+--+-- >>> splitAt_ 0 [1,2,3]+-- ([],[1,2,3])+--+-- >>> splitAt_ 1 [1,2,3]+-- ([1],[2,3])+--+-- >>> splitAt_ 3 [1,2,3]+-- ([1,2,3],[])+--+-- >>> splitAt_ 4 [1,2,3]+-- ([1,2,3],[])+--+-- > splitAt n f1 f2 = Fold.splitWith (,) (Fold.take n f1) f2+--+-- /Internal/++{-# INLINE splitAt #-}+splitAt+    :: Monad m+    => Int+    -> Fold m a b+    -> Fold m a c+    -> Fold m a (b, c)+splitAt n fld = splitWith (,) (take n fld)++------------------------------------------------------------------------------+-- Element Aware APIs+------------------------------------------------------------------------------+--+------------------------------------------------------------------------------+-- Binary APIs+------------------------------------------------------------------------------++{-# INLINE takingEndByM #-}+takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+takingEndByM p = Fold step initial extract extract++    where++    initial = return $ Partial Nothing'++    step _ a = do+        r <- p a+        return+            $ if r+              then Done $ Just a+              else Partial $ Just' a++    extract = return . toMaybe++-- |+--+-- >>> takingEndBy p = Fold.takingEndByM (return . p)+--+{-# INLINE takingEndBy #-}+takingEndBy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+takingEndBy p = takingEndByM (return . p)++{-# INLINE takingEndByM_ #-}+takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+takingEndByM_ p = Fold step initial extract extract++    where++    initial = return $ Partial Nothing'++    step _ a = do+        r <- p a+        return+            $ if r+              then Done Nothing+              else Partial $ Just' a++    extract = return . toMaybe++-- |+--+-- >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)+--+{-# INLINE takingEndBy_ #-}+takingEndBy_ :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+takingEndBy_ p = takingEndByM_ (return . p)++{-# INLINE droppingWhileM #-}+droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+droppingWhileM p = Fold step initial extract extract++    where++    initial = return $ Partial Nothing'++    step Nothing' a = do+        r <- p a+        return+            $ Partial+            $ if r+              then Nothing'+              else Just' a+    step _ a = return $ Partial $ Just' a++    extract = return . toMaybe++-- |+-- >>> droppingWhile p = Fold.droppingWhileM (return . p)+--+{-# INLINE droppingWhile #-}+droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+droppingWhile p = droppingWhileM (return . p)++-- Note: Keep this consistent with S.splitOn. In fact we should eliminate+-- S.splitOn in favor of the fold.+--+-- XXX Use Fold.many instead once it is fixed.+-- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)++-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList+-- >>> Stream.fold line input+-- "hello"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany line input+-- ["hello","there"]+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)+takeEndBy_ predicate (Fold fstep finitial fextract ffinal) =+    Fold step finitial fextract ffinal++    where++    step s a =+        if not (predicate a)+        then fstep s a+        else Done <$> ffinal s++-- Note:+-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)++-- | Take the input, stop when the predicate succeeds taking the succeeding+-- element as well.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Fold.takeEndBy (== '\n') Fold.toList+-- >>> Stream.fold line input+-- "hello\n"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany line input+-- ["hello\n","there\n"]+--+{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+-- takeEndBy predicate = scanMaybe (takingEndBy predicate)+takeEndBy predicate (Fold fstep finitial fextract ffinal) =+    Fold step finitial fextract ffinal++    where++    step s a = do+        res <- fstep s a+        if not (predicate a)+        then return res+        else do+            case res of+                Partial s1 -> Done <$> ffinal s1+                Done b -> return $ Done b++------------------------------------------------------------------------------+-- Binary splitting on a separator+------------------------------------------------------------------------------++data SplitOnSeqState acc a rb rh w ck =+      SplitOnSeqEmpty !acc+    | SplitOnSeqSingle !acc !a+    | SplitOnSeqWord !acc !Int !w+    | SplitOnSeqWordLoop !acc !w+    | SplitOnSeqKR !acc !Int !rb !rh+    | SplitOnSeqKRLoop !acc !ck !rb !rh++-- XXX Need to add tests for takeEndBySeq, we have tests for takeEndBySeq_ .++-- | Continue taking the input until the input sequence matches the supplied+-- sequence, taking the supplied sequence as well. If the pattern is empty this+-- acts as an identity fold.+--+-- >>> s = Stream.fromList "hello there. How are you?"+-- >>> f = Fold.takeEndBySeq (Array.fromList "re") Fold.toList+-- >>> Stream.fold f s+-- "hello there"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany f s+-- ["hello there",". How are"," you?"]+--+-- /Pre-release/+{-# INLINE takeEndBySeq #-}+takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>+       Array.Array a+    -> Fold m a b+    -> Fold m a b+takeEndBySeq patArr (Fold fstep finitial fextract ffinal) =+    Fold step initial extract final++    where++    patLen = Array.length patArr++    initial = do+        res <- finitial+        case res of+            Partial acc+                | patLen == 0 ->+                    -- XXX Should we match nothing or everything on empty+                    -- pattern?+                    -- Done <$> ffinal acc+                    return $ Partial $ SplitOnSeqEmpty acc+                | patLen == 1 -> do+                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr+                    return $ Partial $ SplitOnSeqSingle acc pat+                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->+                    return $ Partial $ SplitOnSeqWord acc 0 0+                | otherwise -> do+                    (rb, rhead) <- liftIO $ Ring.new patLen+                    return $ Partial $ SplitOnSeqKR acc 0 rb rhead+            Done b -> return $ Done b++    -- Word pattern related+    maxIndex = patLen - 1++    elemBits = SIZE_OF(a) * 8++    wordMask :: Word+    wordMask = (1 `shiftL` (elemBits * patLen)) - 1++    wordPat :: Word+    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr++    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)++    -- For Rabin-Karp search+    k = 2891336453 :: Word32+    coeff = k ^ patLen++    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)++    deltaCksum cksum old new =+        addCksum cksum new - coeff * fromIntegral (fromEnum old)++    -- XXX shall we use a random starting hash or 1 instead of 0?+    -- XXX Need to keep this cached across fold calls in foldmany+    -- XXX We may need refold to inject the cached state instead of+    -- initializing the state every time.+    -- XXX Allocation of ring buffer should also be done once+    patHash = Array.foldl' addCksum 0 patArr++    step (SplitOnSeqEmpty s) x = do+        res <- fstep s x+        case res of+            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1+            Done b -> return $ Done b+    step (SplitOnSeqSingle s pat) x = do+        res <- fstep s x+        case res of+            Partial s1+                | pat /= x -> return $ Partial $ SplitOnSeqSingle s1 pat+                | otherwise -> Done <$> ffinal s1+            Done b -> return $ Done b+    step (SplitOnSeqWord s idx wrd) x = do+        res <- fstep s x+        let wrd1 = addToWord wrd x+        case res of+            Partial s1+                | idx == maxIndex -> do+                    if wrd1 .&. wordMask == wordPat+                    then Done <$> ffinal s1+                    else return $ Partial $ SplitOnSeqWordLoop s1 wrd1+                | otherwise ->+                    return $ Partial $ SplitOnSeqWord s1 (idx + 1) wrd1+            Done b -> return $ Done b+    step (SplitOnSeqWordLoop s wrd) x = do+        res <- fstep s x+        let wrd1 = addToWord wrd x+        case res of+            Partial s1+                | wrd1 .&. wordMask == wordPat ->+                    Done <$> ffinal s1+                | otherwise ->+                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1+            Done b -> return $ Done b+    step (SplitOnSeqKR s idx rb rh) x = do+        res <- fstep s x+        case res of+            Partial s1 -> do+                rh1 <- liftIO $ Ring.unsafeInsert rb rh x+                if idx == maxIndex+                then do+                    let fld = Ring.unsafeFoldRing (Ring.ringBound rb)+                    let !ringHash = fld addCksum 0 rb+                    if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+                    then Done <$> ffinal s1+                    else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1+                else+                    return $ Partial $ SplitOnSeqKR s1 (idx + 1) rb rh1+            Done b -> return $ Done b+    step (SplitOnSeqKRLoop s cksum rb rh) x = do+        res <- fstep s x+        case res of+            Partial s1 -> do+                old <- liftIO $ peek rh+                rh1 <- liftIO $ Ring.unsafeInsert rb rh x+                let ringHash = deltaCksum cksum old x+                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+                then Done <$> ffinal s1+                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1+            Done b -> return $ Done b++    extractFunc fex state =+        let st =+                case state of+                    SplitOnSeqEmpty s -> s+                    SplitOnSeqSingle s _ -> s+                    SplitOnSeqWord s _ _ -> s+                    SplitOnSeqWordLoop s _ -> s+                    SplitOnSeqKR s _ _ _ -> s+                    SplitOnSeqKRLoop s _ _ _ -> s+        in fex st++    extract state = extractFunc fextract state++    final state = extractFunc ffinal state++-- | Like 'takeEndBySeq' but discards the matched sequence.+--+-- /Pre-release/+--+{-# INLINE takeEndBySeq_ #-}+takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>+       Array.Array a+    -> Fold m a b+    -> Fold m a b+takeEndBySeq_ patArr (Fold fstep finitial fextract ffinal) =+    Fold step initial extract final++    where++    patLen = Array.length patArr++    initial = do+        res <- finitial+        case res of+            Partial acc+                | patLen == 0 ->+                    -- XXX Should we match nothing or everything on empty+                    -- pattern?+                    -- Done <$> ffinal acc+                    return $ Partial $ SplitOnSeqEmpty acc+                | patLen == 1 -> do+                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr+                    return $ Partial $ SplitOnSeqSingle acc pat+                -- XXX Need to add tests for this case+                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->+                    return $ Partial $ SplitOnSeqWord acc 0 0+                | otherwise -> do+                    (rb, rhead) <- liftIO $ Ring.new patLen+                    return $ Partial $ SplitOnSeqKR acc 0 rb rhead+            Done b -> return $ Done b++    -- Word pattern related+    maxIndex = patLen - 1++    elemBits = SIZE_OF(a) * 8++    wordMask :: Word+    wordMask = (1 `shiftL` (elemBits * patLen)) - 1++    elemMask :: Word+    elemMask = (1 `shiftL` elemBits) - 1++    wordPat :: Word+    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr++    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)++    -- For Rabin-Karp search+    k = 2891336453 :: Word32+    coeff = k ^ patLen++    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)++    deltaCksum cksum old new =+        addCksum cksum new - coeff * fromIntegral (fromEnum old)++    -- XXX shall we use a random starting hash or 1 instead of 0?+    -- XXX Need to keep this cached across fold calls in foldMany+    -- XXX We may need refold to inject the cached state instead of+    -- initializing the state every time.+    -- XXX Allocation of ring buffer should also be done once+    patHash = Array.foldl' addCksum 0 patArr++    step (SplitOnSeqEmpty s) x = do+        res <- fstep s x+        case res of+            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1+            Done b -> return $ Done b+    step (SplitOnSeqSingle s pat) x = do+        if pat /= x+        then do+            res <- fstep s x+            case res of+                Partial s1 -> return $ Partial $ SplitOnSeqSingle s1 pat+                Done b -> return $ Done b+        else Done <$> ffinal s+    step (SplitOnSeqWord s idx wrd) x = do+        let wrd1 = addToWord wrd x+        if idx == maxIndex+        then do+            if wrd1 .&. wordMask == wordPat+            then Done <$> ffinal s+            else return $ Partial $ SplitOnSeqWordLoop s wrd1+        else return $ Partial $ SplitOnSeqWord s (idx + 1) wrd1+    step (SplitOnSeqWordLoop s wrd) x = do+        let wrd1 = addToWord wrd x+            old = (wordMask .&. wrd)+                    `shiftR` (elemBits * (patLen - 1))+        res <- fstep s (toEnum $ fromIntegral old)+        case res of+            Partial s1+                | wrd1 .&. wordMask == wordPat ->+                    Done <$> ffinal s1+                | otherwise ->+                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1+            Done b -> return $ Done b+    step (SplitOnSeqKR s idx rb rh) x = do+        rh1 <- liftIO $ Ring.unsafeInsert rb rh x+        if idx == maxIndex+        then do+            let fld = Ring.unsafeFoldRing (Ring.ringBound rb)+            let !ringHash = fld addCksum 0 rb+            if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+            then Done <$> ffinal s+            else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1+        else return $ Partial $ SplitOnSeqKR s (idx + 1) rb rh1+    step (SplitOnSeqKRLoop s cksum rb rh) x = do+        old <- liftIO $ peek rh+        res <- fstep s old+        case res of+            Partial s1 -> do+                rh1 <- liftIO $ Ring.unsafeInsert rb rh x+                let ringHash = deltaCksum cksum old x+                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+                then Done <$> ffinal s1+                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1+            Done b -> return $ Done b++    -- XXX extract should return backtrack count as well. If the fold+    -- terminates early inside extract, we may still have buffered data+    -- remaining which will be lost if we do not communicate that to the+    -- driver.+    extractFunc fex state = do+        let consumeWord s n wrd = do+                if n == 0+                then fex s+                else do+                    let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))+                    r <- fstep s (toEnum $ fromIntegral old)+                    case r of+                        Partial s1 -> consumeWord s1 (n - 1) wrd+                        Done b -> return b++        let consumeRing s n rb rh =+                if n == 0+                then fex s+                else do+                    old <- liftIO $ peek rh+                    let rh1 = Ring.advance rb rh+                    r <- fstep s old+                    case r of+                        Partial s1 -> consumeRing s1 (n - 1) rb rh1+                        Done b -> return b++        case state of+            SplitOnSeqEmpty s -> fex s+            SplitOnSeqSingle s _ -> fex s+            SplitOnSeqWord s idx wrd -> consumeWord s idx wrd+            SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd+            SplitOnSeqKR s idx rb _ -> consumeRing s idx rb (Ring.startOf rb)+            SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh++    extract state = extractFunc fextract state++    final state = extractFunc ffinal state++------------------------------------------------------------------------------+-- Distributing+------------------------------------------------------------------------------+--+-- | Distribute one copy of the stream to each fold and zip the results.+--+-- @+--                 |-------Fold m a b--------|+-- ---stream m a---|                         |---m (b,c)+--                 |-------Fold m a c--------|+-- @+--+--  Definition:+--+-- >>> tee = Fold.teeWith (,)+--+-- Example:+--+-- >>> t = Fold.tee Fold.sum Fold.length+-- >>> Stream.fold t (Stream.enumerateFromTo 1.0 100.0)+-- (5050.0,100)+--+{-# INLINE tee #-}+tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)+tee = teeWith (,)++-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large+-- number of consumers? For polymorphic case a vector could be helpful. For+-- Storables we can use arrays. Will need separate APIs for those.+--+-- | Distribute one copy of the stream to each fold and collect the results in+-- a container.+--+-- @+--+--                 |-------Fold m a b--------|+-- ---stream m a---|                         |---m [b]+--                 |-------Fold m a b--------|+--                 |                         |+--                            ...+-- @+--+-- >>> Stream.fold (Fold.distribute [Fold.sum, Fold.length]) (Stream.enumerateFromTo 1 5)+-- [15,5]+--+-- >>> distribute = Prelude.foldr (Fold.teeWith (:)) (Fold.fromPure [])+--+-- This is the consumer side dual of the producer side 'sequence' operation.+--+-- Stops when all the folds stop.+--+{-# INLINE distribute #-}+distribute :: Monad m => [Fold m a b] -> Fold m a [b]+distribute = Prelude.foldr (teeWith (:)) (fromPure [])++------------------------------------------------------------------------------+-- Partitioning+------------------------------------------------------------------------------++{-# INLINE partitionByMUsing #-}+partitionByMUsing :: Monad m =>+       (  (x -> y -> (x, y))+       -> Fold m (Either b c) x+       -> Fold m (Either b c) y+       -> Fold m (Either b c) (x, y)+       )+    -> (a -> m (Either b c))+    -> Fold m b x+    -> Fold m c y+    -> Fold m a (x, y)+partitionByMUsing t f fld1 fld2 =+    let l = lmap (fromLeft undefined) fld1  -- :: Fold m (Either b c) x+        r = lmap (fromRight undefined) fld2 -- :: Fold m (Either b c) y+     in lmapM f (t (,) (filter isLeft l) (filter isRight r))++-- | Partition the input over two folds using an 'Either' partitioning+-- predicate.+--+-- @+--+--                                     |-------Fold b x--------|+-- -----stream m a --> (Either b c)----|                       |----(x,y)+--                                     |-------Fold c y--------|+-- @+--+-- Example, send input to either fold randomly:+--+-- >>> :set -package random+-- >>> import System.Random (randomIO)+-- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a+-- >>> f = Fold.partitionByM randomly Fold.length Fold.length+-- >>> Stream.fold f (Stream.enumerateFromTo 1 100)+-- ...+--+-- Example, send input to the two folds in a proportion of 2:1:+--+-- >>> :{+-- proportionately m n = do+--  ref <- newIORef $ cycle $ concat [replicate m Left, replicate n Right]+--  return $ \a -> do+--      r <- readIORef ref+--      writeIORef ref $ tail r+--      return $ Prelude.head r a+-- :}+--+-- >>> :{+-- main = do+--  g <- proportionately 2 1+--  let f = Fold.partitionByM g Fold.length Fold.length+--  r <- Stream.fold f (Stream.enumerateFromTo (1 :: Int) 100)+--  print r+-- :}+--+-- >>> main+-- (67,33)+--+--+-- This is the consumer side dual of the producer side 'mergeBy' operation.+--+-- When one fold is done, any input meant for it is ignored until the other+-- fold is also done.+--+-- Stops when both the folds stop.+--+-- /See also: 'partitionByFstM' and 'partitionByMinM'./+--+-- /Pre-release/+{-# INLINE partitionByM #-}+partitionByM :: Monad m+    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionByM = partitionByMUsing teeWith++-- | Similar to 'partitionByM' but terminates when the first fold terminates.+--+{-# INLINE partitionByFstM #-}+partitionByFstM :: Monad m+    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionByFstM = partitionByMUsing teeWithFst++-- | Similar to 'partitionByM' but terminates when any fold terminates.+--+{-# INLINE partitionByMinM #-}+partitionByMinM :: Monad m =>+    (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionByMinM = partitionByMUsing teeWithMin++-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter+-- makes the signature clearer as to which case belongs to which fold.+-- XXX need to check the performance in both cases.++-- | Same as 'partitionByM' but with a pure partition function.+--+-- Example, count even and odd numbers in a stream:+--+-- >>> :{+--  let f = Fold.partitionBy (\n -> if even n then Left n else Right n)+--                      (fmap (("Even " ++) . show) Fold.length)+--                      (fmap (("Odd "  ++) . show) Fold.length)+--   in Stream.fold f (Stream.enumerateFromTo 1 100)+-- :}+-- ("Even 50","Odd 50")+--+-- /Pre-release/+{-# INLINE partitionBy #-}+partitionBy :: Monad m+    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionBy f = partitionByM (return . f)++-- | Compose two folds such that the combined fold accepts a stream of 'Either'+-- and routes the 'Left' values to the first fold and 'Right' values to the+-- second fold.+--+-- Definition:+--+-- >>> partition = Fold.partitionBy id+--+{-# INLINE partition #-}+partition :: Monad m+    => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+partition = partitionBy id++{-+-- | Send one item to each fold in a round-robin fashion. This is the consumer+-- side dual of producer side 'mergeN' operation.+--+-- partitionN :: Monad m => [Fold m a b] -> Fold m a [b]+-- partitionN fs = Fold step begin done+-}++------------------------------------------------------------------------------+-- Unzipping+------------------------------------------------------------------------------++{-# INLINE unzipWithMUsing #-}+unzipWithMUsing :: Monad m =>+       (  (x -> y -> (x, y))+       -> Fold m (b, c) x+       -> Fold m (b, c) y+       -> Fold m (b, c) (x, y)+       )+    -> (a -> m (b, c))+    -> Fold m b x+    -> Fold m c y+    -> Fold m a (x, y)+unzipWithMUsing t f fld1 fld2 =+    let f1 = lmap fst fld1  -- :: Fold m (b, c) b+        f2 = lmap snd fld2  -- :: Fold m (b, c) c+     in lmapM f (t (,) f1 f2)++-- | Like 'unzipWith' but with a monadic splitter function.+--+-- Definition:+--+-- >>> unzipWithM k f1 f2 = Fold.lmapM k (Fold.unzip f1 f2)+--+-- /Pre-release/+{-# INLINE unzipWithM #-}+unzipWithM :: Monad m+    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+unzipWithM = unzipWithMUsing teeWith++-- | Similar to 'unzipWithM' but terminates when the first fold terminates.+--+{-# INLINE unzipWithFstM #-}+unzipWithFstM :: Monad m =>+    (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+unzipWithFstM = unzipWithMUsing teeWithFst++-- | Similar to 'unzipWithM' but terminates when any fold terminates.+--+{-# INLINE unzipWithMinM #-}+unzipWithMinM :: Monad m =>+    (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+unzipWithMinM = unzipWithMUsing teeWithMin++-- | Split elements in the input stream into two parts using a pure splitter+-- function, direct each part to a different fold and zip the results.+--+-- Definitions:+--+-- >>> unzipWith f = Fold.unzipWithM (return . f)+-- >>> unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)+--+-- This fold terminates when both the input folds terminate.+--+-- /Pre-release/+{-# INLINE unzipWith #-}+unzipWith :: Monad m+    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+unzipWith f = unzipWithM (return . f)++-- | Send the elements of tuples in a stream of tuples through two different+-- folds.+--+-- @+--+--                           |-------Fold m a x--------|+-- ---------stream of (a,b)--|                         |----m (x,y)+--                           |-------Fold m b y--------|+--+-- @+--+-- Definition:+--+-- >>> unzip = Fold.unzipWith id+--+-- This is the consumer side dual of the producer side 'zip' operation.+--+{-# INLINE unzip #-}+unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)+unzip = unzipWith id++------------------------------------------------------------------------------+-- Combining streams and folds - Zipping+------------------------------------------------------------------------------++-- XXX These can be implemented using the fold scan, using the stream as a+-- state.+-- XXX Stream Skip state cannot be efficiently handled in folds but can be+-- handled in parsers using the Continue facility. See zipWithM in the Parser+-- module.+--+-- cmpBy, eqBy, isPrefixOf, isSubsequenceOf etc can be implemented using+-- zipStream.++-- | Zip a stream with the input of a fold using the supplied function.+--+-- /Unimplemented/+--+{-# INLINE zipStreamWithM #-}+zipStreamWithM :: -- Monad m =>+    (a -> b -> m c) -> Stream m a -> Fold m c x -> Fold m b x+zipStreamWithM = undefined++-- | Zip a stream with the input of a fold.+--+-- >>> zip = Fold.zipStreamWithM (curry return)+--+-- /Unimplemented/+--+{-# INLINE zipStream #-}+zipStream :: Monad m => Stream m a -> Fold m (a, b) x -> Fold m b x+zipStream = zipStreamWithM (curry return)++-- | Pair each element of a fold input with its index, starting from index 0.+--+{-# INLINE indexingWith #-}+indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))+indexingWith i f = fmap toMaybe $ foldl' step initial++    where++    initial = Nothing'++    step Nothing' a = Just' (i, a)+    step (Just' (n, _)) a = Just' (f n, a)++-- |+-- >>> indexing = Fold.indexingWith 0 (+ 1)+--+{-# INLINE indexing #-}+indexing :: Monad m => Fold m a (Maybe (Int, a))+indexing = indexingWith 0 (+ 1)++-- |+-- >>> indexingRev n = Fold.indexingWith n (subtract 1)+--+{-# INLINE indexingRev #-}+indexingRev :: Monad m => Int -> Fold m a (Maybe (Int, a))+indexingRev n = indexingWith n (subtract 1)++-- | Pair each element of a fold input with its index, starting from index 0.+--+-- >>> indexed = Fold.scanMaybe Fold.indexing+--+{-# INLINE indexed #-}+indexed :: Monad m => Fold m (Int, a) b -> Fold m a b+indexed = scanMaybe indexing++-- | Change the predicate function of a Fold from @a -> b@ to accept an+-- additional state input @(s, a) -> b@. Convenient to filter with an+-- addiitonal index or time input.+--+-- >>> filterWithIndex = Fold.with Fold.indexed Fold.filter+--+-- @+-- filterWithAbsTime = with timestamped filter+-- filterWithRelTime = with timeIndexed filter+-- @+--+-- /Pre-release/+{-# INLINE with #-}+with ::+       (Fold m (s, a) b -> Fold m a b)+    -> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)+    -> (((s, a) -> c) -> Fold m a b -> Fold m a b)+with f comb g = f . comb g . lmap snd++-- XXX Implement as a filter+-- sampleFromthen :: Monad m => Int -> Int -> Fold m a (Maybe a)++-- | @sampleFromthen offset stride@ samples the element at @offset@ index and+-- then every element at strides of @stride@.+--+{-# INLINE sampleFromthen #-}+sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Fold m a b+sampleFromthen offset size =+    with indexed filter (\(i, _) -> (i + offset) `mod` size == 0)++------------------------------------------------------------------------------+-- Nesting+------------------------------------------------------------------------------++-- | @concatSequence f t@ applies folds from stream @t@ sequentially and+-- collects the results using the fold @f@.+--+-- /Unimplemented/+--+{-# INLINE concatSequence #-}+concatSequence ::+    -- IsStream t =>+    Fold m b c -> t (Fold m a b) -> Fold m a c+concatSequence _f _p = undefined++-- | Group the input stream into groups of elements between @low@ and @high@.+-- Collection starts in chunks of @low@ and then keeps doubling until we reach+-- @high@. Each chunk is folded using the provided fold function.+--+-- This could be useful, for example, when we are folding a stream of unknown+-- size to a stream of arrays and we want to minimize the number of+-- allocations.+--+-- NOTE: this would be an application of "many" using a terminating fold.+--+-- /Unimplemented/+--+{-# INLINE chunksBetween #-}+chunksBetween :: -- Monad m =>+       Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c+chunksBetween _low _high _f1 _f2 = undefined++-- | A fold that buffers its input to a pure stream.+--+-- /Warning!/ working on large streams accumulated as buffers in memory could+-- be very inefficient, consider using "Streamly.Data.Array" instead.+--+-- >>> toStream = fmap Stream.fromList Fold.toList+--+-- /Pre-release/+{-# INLINE toStream #-}+toStream :: (Monad m, Monad n) => Fold m a (Stream n a)+toStream = fmap StreamD.fromList toList++-- This is more efficient than 'toStream'. toStream is exactly the same as+-- reversing the stream after toStreamRev.+--+-- | Buffers the input stream to a pure stream in the reverse order of the+-- input.+--+-- >>> toStreamRev = fmap Stream.fromList Fold.toListRev+--+-- /Warning!/ working on large streams accumulated as buffers in memory could+-- be very inefficient, consider using "Streamly.Data.Array" instead.+--+-- /Pre-release/++--  xn : ... : x2 : x1 : []+{-# INLINE toStreamRev #-}+toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)+toStreamRev = fmap StreamD.fromList toListRev++-- XXX This does not fuse. It contains a recursive step function. We will need+-- a Skip input constructor in the fold type to make it fuse.+--+-- | Unfold and flatten the input stream of a fold.+--+-- @+-- Stream.fold (unfoldMany u f) = Stream.fold f . Stream.unfoldMany u+-- @+--+-- /Pre-release/+{-# INLINE unfoldMany #-}+unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c+unfoldMany (Unfold ustep inject) (Fold fstep initial extract final) =+    Fold consume initial extract final++    where++    {-# INLINE produce #-}+    produce fs us = do+        ures <- ustep us+        case ures of+            StreamD.Yield b us1 -> do+                fres <- fstep fs b+                case fres of+                    Partial fs1 -> produce fs1 us1+                    -- XXX What to do with the remaining stream?+                    Done c -> return $ Done c+            StreamD.Skip us1 -> produce fs us1+            StreamD.Stop -> return $ Partial fs++    {-# INLINE_LATE consume #-}+    consume s a = inject a >>= produce s++-- | Get the bottom most @n@ elements using the supplied comparison function.+--+{-# INLINE bottomBy #-}+bottomBy :: (MonadIO m, Unbox a) =>+       (a -> a -> Ordering)+    -> Int+    -> Fold m a (MutArray a)+bottomBy cmp n = Fold step initial extract extract++    where++    initial = do+        arr <- MA.pinnedNew n+        if n <= 0+        then return $ Done arr+        else return $ Partial (arr, 0)++    step (arr, i) x =+        if i < n+        then do+            arr' <- MA.snoc arr x+            MA.bubble cmp arr'+            return $ Partial (arr', i + 1)+        else do+            x1 <- MA.getIndexUnsafe (i - 1) arr+            case x `cmp` x1 of+                LT -> do+                    MA.putIndexUnsafe (i - 1) arr x+                    MA.bubble cmp arr+                    return $ Partial (arr, i)+                _ -> return $ Partial (arr, i)++    extract = return . fst++-- | Get the top @n@ elements using the supplied comparison function.+--+-- To get bottom n elements instead:+--+-- >>> bottomBy cmp = Fold.topBy (flip cmp)+--+-- Example:+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.fold (Fold.topBy compare 3) stream >>= MutArray.toList+-- [17,11,9]+--+-- /Pre-release/+--+{-# INLINE topBy #-}+topBy :: (MonadIO m, Unbox a) =>+       (a -> a -> Ordering)+    -> Int+    -> Fold m a (MutArray a)+topBy cmp = bottomBy (flip cmp)++-- | Fold the input stream to top n elements.+--+-- Definition:+--+-- >>> top = Fold.topBy compare+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.fold (Fold.top 3) stream >>= MutArray.toList+-- [17,11,9]+--+-- /Pre-release/+{-# INLINE top #-}+top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)+top = bottomBy $ flip compare++-- | Fold the input stream to bottom n elements.+--+-- Definition:+--+-- >>> bottom = Fold.bottomBy compare+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.fold (Fold.bottom 3) stream >>= MutArray.toList+-- [1,2,3]+--+-- /Pre-release/+{-# INLINE bottom #-}+bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)+bottom = bottomBy compare++------------------------------------------------------------------------------+-- Interspersed parsing+------------------------------------------------------------------------------++data IntersperseQState fs ps =+      IntersperseQUnquoted !fs !ps+    | IntersperseQQuoted !fs !ps+    | IntersperseQQuotedEsc !fs !ps++-- Useful for parsing CSV with quoting and escaping+{-# INLINE intersperseWithQuotes #-}+intersperseWithQuotes :: (Monad m, Eq a) =>+    a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c+intersperseWithQuotes+    quote+    esc+    separator+    (Fold stepL initialL _ finalL)+    (Fold stepR initialR extractR finalR) = Fold step initial extract final++    where++    errMsg p status =+        error $ "intersperseWithQuotes: " ++ p ++ " parsing fold cannot "+                ++ status ++ " without input"++    {-# INLINE initL #-}+    initL mkState = do+        resL <- initialL+        case resL of+            Partial sL ->+                return $ Partial $ mkState sL+            Done _ ->+                errMsg "content" "succeed"++    initial = do+        res <- initialR+        case res of+            Partial sR -> initL (IntersperseQUnquoted sR)+            Done b -> return $ Done b++    {-# INLINE collect #-}+    collect nextS sR b = do+        res <- stepR sR b+        case res of+            Partial s ->+                initL (nextS s)+            Done c -> return (Done c)++    {-# INLINE process #-}+    process a sL sR nextState = do+        r <- stepL sL a+        case r of+            Partial s -> return $ Partial (nextState sR s)+            Done b -> collect nextState sR b++    {-# INLINE processQuoted #-}+    processQuoted a sL sR nextState = do+        r <- stepL sL a+        case r of+            Partial s -> return $ Partial (nextState sR s)+            Done _ -> do+                _ <- finalR sR+                error "Collecting fold finished inside quote"++    step (IntersperseQUnquoted sR sL) a+        | a == separator = do+            b <- finalL sL+            collect IntersperseQUnquoted sR b+        | a == quote = processQuoted a sL sR IntersperseQQuoted+        | otherwise = process a sL sR IntersperseQUnquoted++    step (IntersperseQQuoted sR sL) a+        | a == esc = processQuoted a sL sR IntersperseQQuotedEsc+        | a == quote = process a sL sR IntersperseQUnquoted+        | otherwise = processQuoted a sL sR IntersperseQQuoted++    step (IntersperseQQuotedEsc sR sL) a =+        processQuoted a sL sR IntersperseQQuoted++    extract (IntersperseQUnquoted sR _) = extractR sR+    extract (IntersperseQQuoted _ _) =+        error "intersperseWithQuotes: finished inside quote"+    extract (IntersperseQQuotedEsc _ _) =+        error "intersperseWithQuotes: finished inside quote, at escape char"++    final (IntersperseQUnquoted sR sL) = finalL sL *> finalR sR+    final (IntersperseQQuoted sR sL) = do+        _ <- finalR sR+        _ <- finalL sL+        error "intersperseWithQuotes: finished inside quote"+    final (IntersperseQQuotedEsc sR sL) = do+        _ <- finalR sR+        _ <- finalL sL+        error "intersperseWithQuotes: finished inside quote, at escape char"
src/Streamly/Internal/Data/Fold/Container.hs view
@@ -9,9 +9,6 @@  module Streamly.Internal.Data.Fold.Container     (-    -- * Imports-    -- $setup-     -- * Set operations       toSet     , toIntSet@@ -27,14 +24,27 @@     -- | Direct values in the input stream to different folds using an n-ary     -- fold selector. 'demux' is a generalization of 'classify' (and     -- 'partition') where each key of the classifier can use a different fold.-    , demuxKvToContainer-    , demuxKvToMap+    --+    -- You need to see only 'demux' if you are looking to find the capabilities+    -- of these combinators, all others are variants of that. +    -- *** Output is a container+    -- | The fold state snapshot returns the key-value container of in-progress+    -- folds.     , demuxToContainer     , demuxToContainerIO     , demuxToMap     , demuxToMapIO +    -- *** Input is explicit key-value tuple+    -- | Like above but inputs are in explicit key-value pair form.+    , demuxKvToContainer+    , demuxKvToMap++    -- *** Scan of finished fold results+    -- | Like above, but the resulting fold state snapshot contains the key+    -- value container as well as the finished key result if a fold in the+    -- container finished.     , demuxGeneric     , demux     , demuxGenericIO@@ -89,8 +99,9 @@ import qualified Data.Set as Set import qualified Streamly.Internal.Data.IsMap as IsMap -import Prelude hiding (length)-import Streamly.Internal.Data.Fold+import Prelude hiding (Foldable(..))+import Streamly.Internal.Data.Fold.Type+import Streamly.Internal.Data.Fold.Combinators  -- $setup -- >>> :m@@ -251,19 +262,23 @@ -- because key is to be determined on each input whereas fold is to be -- determined only once for a key. +-- | This is the most general of all demux, classify operations.+--+-- See 'demux' for documentation. {-# INLINE demuxGeneric #-} demuxGeneric :: (Monad m, IsMap f, Traversable f) =>        (a -> Key f)     -> (a -> m (Fold m a b))     -> Fold m a (m (f b), Maybe (Key f, b))-demuxGeneric getKey getFold = fmap extract $ foldlM' step initial+demuxGeneric getKey getFold =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where      initial = return $ Tuple' IsMap.mapEmpty Nothing      {-# INLINE runFold #-}-    runFold kv (Fold step1 initial1 extract1) (k, a) = do+    runFold kv (Fold step1 initial1 extract1 final1) (k, a) = do          res <- initial1          case res of             Partial s -> do@@ -271,7 +286,7 @@                 return                     $ case res1 of                         Partial _ ->-                            let fld = Fold step1 (return res1) extract1+                            let fld = Fold step1 (return res1) extract1 final1                              in Tuple' (IsMap.mapInsert k fld kv) Nothing                         Done b -> Tuple' (IsMap.mapDelete k kv) (Just (k, b))             Done b -> return $ Tuple' kv (Just (k, b))@@ -284,25 +299,50 @@                 runFold kv fld (k, a)             Just f -> runFold kv f (k, a) -    extract (Tuple' kv x) = (Prelude.mapM f kv, x)+    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)          where -        f (Fold _ i e) = do+        f (Fold _ i e _) = do             r <- i             case r of                 Partial s -> e s-                Done b -> return b+                _ -> error "demuxGeneric: unreachable code" --- | In a key value stream, fold values corresponding to each key with a key--- specific fold. The fold returns the fold result as the second component of--- the output tuple whenever a fold terminates. The first component of the--- tuple is a Map of in-progress folds. If a fold terminates, another--- instance of the fold is started upon receiving an input with that key.+    final (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f (Fold _ i _ fin) = do+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxGeneric: unreachable code"++-- | @demux getKey getFold@: In a key value stream, fold values corresponding+-- to each key using a key specific fold. @getFold@ is invoked to generate a+-- key specific fold when a key is encountered for the first time in the+-- stream. --+-- The first component of the output tuple is a key-value Map of in-progress+-- folds. The fold returns the fold result as the second component of the+-- output tuple whenever a fold terminates.+--+-- If a fold terminates, another instance of the fold is started upon receiving+-- an input with that key, @getFold@ is invoked again whenever the key is+-- encountered again.+-- -- This can be used to scan a stream and collect the results from the scan -- output. --+-- Since the fold generator function is monadic we can add folds dynamically.+-- For example, we can maintain a Map of keys to folds in an IORef and lookup+-- the fold from that corresponding to a key. This Map can be changed+-- dynamically, folds for new keys can be added or folds for old keys can be+-- deleted or modified.+--+-- Compare with 'classify', the fold in 'classify' is a static fold.+-- -- /Pre-release/ -- {-# INLINE demux #-}@@ -312,40 +352,43 @@     -> Fold m a (m (Map k b), Maybe (k, b)) demux = demuxGeneric +-- | This is specialized version of 'demuxGeneric' that uses mutable IO cells+-- as fold accumulators for better performance. {-# INLINE demuxGenericIO #-} demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) =>        (a -> Key f)     -> (a -> m (Fold m a b))     -> Fold m a (m (f b), Maybe (Key f, b))-demuxGenericIO getKey getFold = fmap extract $ foldlM' step initial+demuxGenericIO getKey getFold =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where      initial = return $ Tuple' IsMap.mapEmpty Nothing      {-# INLINE initFold #-}-    initFold kv (Fold step1 initial1 extract1) (k, a) = do+    initFold kv (Fold step1 initial1 extract1 final1) (k, a) = do          res <- initial1          case res of             Partial s -> do                 res1 <- step1 s a                 case res1 of                     Partial _ -> do-                        let fld = Fold step1 (return res1) extract1+                        let fld = Fold step1 (return res1) extract1 final1                         ref <- liftIO $ newIORef fld                         return $ Tuple' (IsMap.mapInsert k ref kv) Nothing                     Done b -> return $ Tuple' kv (Just (k, b))             Done b -> return $ Tuple' kv (Just (k, b))      {-# INLINE runFold #-}-    runFold kv ref (Fold step1 initial1 extract1) (k, a) = do+    runFold kv ref (Fold step1 initial1 extract1 final1) (k, a) = do          res <- initial1          case res of             Partial s -> do                 res1 <- step1 s a                 case res1 of                         Partial _ -> do-                            let fld = Fold step1 (return res1) extract1+                            let fld = Fold step1 (return res1) extract1 final1                             liftIO $ writeIORef ref fld                             return $ Tuple' kv Nothing                         Done b ->@@ -363,20 +406,34 @@                 f <- liftIO $ readIORef ref                 runFold kv ref f (k, a) -    extract (Tuple' kv x) = (Prelude.mapM f kv, x)+    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)          where          f ref = do-            (Fold _ i e) <- liftIO $ readIORef ref+            Fold _ i e _ <- liftIO $ readIORef ref             r <- i             case r of                 Partial s -> e s-                Done b -> return b+                _ -> error "demuxGenericIO: unreachable code" +    final (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f ref = do+            Fold _ i _ fin <- liftIO $ readIORef ref+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxGenericIO: unreachable code"+ -- | This is specialized version of 'demux' that uses mutable IO cells as -- fold accumulators for better performance. --+-- Keep in mind that the values in the returned Map may be changed by the+-- ongoing fold if you are using those concurrently in another thread.+-- {-# INLINE demuxIO #-} demuxIO :: (MonadIO m, Ord k) =>        (a -> k)@@ -384,6 +441,13 @@     -> Fold m a (m (Map k b), Maybe (k, b)) demuxIO = demuxGenericIO +-- | Fold a key value stream to a key-value Map. If the same key appears+-- multiple times, only the last value is retained.+{-# INLINE kvToMapOverwriteGeneric #-}+kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)+kvToMapOverwriteGeneric =+    foldl' (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty+ {-# INLINE demuxToContainer #-} demuxToContainer :: (Monad m, IsMap f, Traversable f) =>     (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)@@ -471,8 +535,8 @@     -- for that use case. We return an action because we want it to be lazy so     -- that the downstream consumers can choose to process or discard it.     (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))-classifyGeneric f (Fold step1 initial1 extract1) =-    fmap extract $ foldlM' step initial+classifyGeneric f (Fold step1 initial1 extract1 final1) =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where @@ -509,8 +573,17 @@                             let kv1 = IsMap.mapDelete k kv                              in Tuple3' kv1 (Set.insert k set) (Just (k, b)) -    extract (Tuple3' kv _ x) = (Prelude.mapM extract1 kv, x)+    extract (Tuple3' kv _ x) = return (Prelude.mapM extract1 kv, x) +    final (Tuple3' kv set x) = return (IsMap.mapTraverseWithKey f1 kv, x)++        where++        f1 k s = do+            if Set.member k set+            then extract1 s+            else final1 s+ -- | Folds the values for each key using the supplied fold. When scanning, as -- soon as the fold is complete, its result is available in the second -- component of the tuple.  The first component of the tuple is a snapshot of@@ -534,8 +607,8 @@ {-# INLINE classifyGenericIO #-} classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>     (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))-classifyGenericIO f (Fold step1 initial1 extract1) =-    fmap extract $ foldlM' step initial+classifyGenericIO f (Fold step1 initial1 extract1 final1) =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where @@ -574,9 +647,22 @@                          in return                                 $ Tuple3' kv1 (Set.insert k set) (Just (k, b)) -    extract (Tuple3' kv _ x) =-        (Prelude.mapM (\ref -> liftIO (readIORef ref) >>= extract1) kv, x)+    extract (Tuple3' kv _ x) = return (Prelude.mapM g kv, x) +        where++        g ref = liftIO (readIORef ref) >>= extract1++    final (Tuple3' kv set x) = return (IsMap.mapTraverseWithKey g kv, x)++        where++        g k ref = do+            s <- liftIO $ readIORef ref+            if Set.member k set+            then extract1 s+            else final1 s+ -- | Same as classify except that it uses mutable IORef cells in the -- Map providing better performance. Be aware that if this is used as a scan, -- the values in the intermediate Maps would be mutable.@@ -589,13 +675,6 @@ classifyIO :: (MonadIO m, Ord k) =>     (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b)) classifyIO = classifyGenericIO---- | Fold a key value stream to a key-value Map. If the same key appears--- multiple times, only the last value is retained.-{-# INLINE kvToMapOverwriteGeneric #-}-kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)-kvToMapOverwriteGeneric =-    foldl' (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty  {-# INLINE toContainer #-} toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>
src/Streamly/Internal/Data/Fold/Step.hs view
@@ -8,7 +8,7 @@ -- module Streamly.Internal.Data.Fold.Step     (-    -- * Types+    -- * Step Type       Step (..)      , mapMStep@@ -40,7 +40,7 @@     = Partial !s     | Done !b --- | 'first' maps over 'Partial' and 'second' maps over 'Done'.+-- | 'first' maps over the fold state and 'second' maps over the fold result. -- instance Bifunctor Step where     {-# INLINE bimap #-}
src/Streamly/Internal/Data/Fold/Tee.hs view
@@ -16,7 +16,9 @@     ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Streamly.Internal.Data.Fold.Type (Fold)  import qualified Streamly.Internal.Data.Fold.Type as Fold@@ -77,7 +79,7 @@ -- | '<>' distributes the input to both the argument 'Tee's and combines their -- outputs using the 'Monoid' instance of the output type. ---instance (Semigroup b, Monoid b, Monad m) => Monoid (Tee m a b) where+instance (Monoid b, Monad m) => Monoid (Tee m a b) where     {-# INLINE mempty #-}     mempty = pure mempty
src/Streamly/Internal/Data/Fold/Type.hs view
@@ -126,6 +126,25 @@ -- or to not be able to use `take 0` if we have it. Also, applicative and -- monadic composition of folds would not be possible. --+-- == Cleanup Action+--+-- Fold may use other folds in the downstream pipeline. When a fold is done and+-- it wants to terminate it needs to wait for the downstream folds before it+-- returns. For example, if the downstream fold is an async fold we need to+-- wait for the async fold to finish and return the final result.+--+-- To be able to support this use case we need a cleanup action in the fold.+-- The fold gets finalized once the cleanup is called and we can use extract to+-- get the final state/result of the fold.+--+-- Similar to folds we may have a cleanup action in streams as well. Currently,+-- we rely on GC to cleanup the streams, if we use a cleanup action then we can+-- perform cleanup quickly. Also, similar to folds we can also have an+-- "initial" action in streams as well to generate the initial state. It could+-- decouple the initialization of the stream from the first element being+-- pulled. For example, you may want to start a timer at initialization rather+-- than at the first element pull of the stream.+-- -- == Terminating Folds with backtracking -- -- Consider the example of @takeWhile@ operation, it needs to inspect an@@ -325,11 +344,9 @@ -- module Streamly.Internal.Data.Fold.Type     (-    -- * Imports-    -- $setup+      module Streamly.Internal.Data.Fold.Step -    -- * Types-      Step (..)+    -- * Fold Type     , Fold (..)      -- * Constructors@@ -425,21 +442,25 @@  #include "inline.hs" +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)-import Control.Monad ((>=>))+#endif+import Control.Monad ((>=>), void) import Data.Bifunctor (Bifunctor(..)) import Data.Either (fromLeft, fromRight, isLeft, isRight) import Data.Functor.Identity (Identity(..)) import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep, chainStepM) import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import Streamly.Internal.Data.Refold.Type (Refold(..)) -import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.StreamK.Type as K -import Prelude hiding (concatMap, filter, foldr, map, take)+import Prelude hiding (Foldable(..), concatMap, filter, map, take) +-- Entire module is exported, do not import selectively+import Streamly.Internal.Data.Fold.Step+ #include "DocTestDataFold.hs"  ------------------------------------------------------------------------------@@ -450,23 +471,64 @@ -- The type @b@ is the accumulator of the writer. That's the reason the -- default folds in various modules are called "write". --- | The type @Fold m a b@ having constructor @Fold step initial extract@--- represents a fold over an input stream of values of type @a@ to a final--- value of type @b@ in 'Monad' @m@.+-- An alternative to using an "extract" function is to use "Partial s b" style+-- partial value so that we always emit the output value and there is no need+-- to extract. Then extract can be used for cleanup purposes. But in this case+-- in some cases we may need a "Continue" constructor where an output value is+-- not available, this was implicit earlier. Also, "b" should be lazy here so+-- that we do not always compute it even if we do not need it. ----- The fold uses an intermediate state @s@ as accumulator, the type @s@ is--- internal to the specific fold definition. The initial value of the fold--- state @s@ is returned by @initial@. The @step@ function consumes an input--- and either returns the final result @b@ if the fold is done or the next--- intermediate state (see 'Step'). At any point the fold driver can extract--- the result from the intermediate state using the @extract@ function.+-- Partial s b  --> extract :: s -> b+-- Continue     --> extract :: s -> Maybe b --+-- But keeping 'b' lazy does not let the fold optimize well. It leads to+-- significant regressions in the key-value folds.+--+-- The "final" function complicates combinators that take other folds as+-- argument because we need to call their finalizers at right places. An+-- alternative to reduce this complexity where it is not required is to use a+-- separate type for bracketed folds but then we need to manage the complexity+-- of two different fold types.++-- The "final" function could be (s -> m (Step s b)), like in parsers so that+-- it can be called in a loop to drain the fold.++-- | The type @Fold m a b@ represents a consumer of an input stream of values+-- of type @a@ and returning a final value of type @b@ in 'Monad' @m@. The+-- constructor of a fold is @Fold step initial extract final@.+--+-- The fold uses an internal state of type @s@. The initial value of the state+-- @s@ is created by @initial@. This function is called once and only once+-- before the fold starts consuming input. Any resource allocation can be done+-- in this function.+--+-- The @step@ function is called on each input, it consumes an input and+-- returns the next intermediate state (see 'Step') or the final result @b@ if+-- the fold terminates.+--+-- If the fold is used as a scan, the @extract@ function is used by the scan+-- driver to map the current state @s@ of the fold to the fold result. Thus+-- @extract@ can be called multiple times. In some folds, where scanning does+-- not make sense, this function is left unimplemented; such folds cannot be+-- used as scans.+--+-- Before a fold terminates, @final@ is called once and only once (unless the+-- fold terminated in @initial@ itself). Any resources allocated by @initial@+-- can be released in @final@. In folds that do not require any cleanup+-- @extract@ and @final@ are typically the same.+--+-- When implementing fold combinators, care should be taken to cleanup any+-- state of the argument folds held by the fold by calling the respective+-- @final@ at all exit points of the fold. Also, @final@ should not be called+-- more than once. Note that if a fold terminates by 'Done' constructor, there+-- is no state to cleanup.+-- -- NOTE: The constructor is not yet released, smart constructors are provided -- to create folds. -- data Fold m a b =-  -- | @Fold @ @ step @ @ initial @ @ extract@-  forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b)+  -- | @Fold@ @step@ @initial@ @extract@ @final@+  forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b) (s -> m b)  ------------------------------------------------------------------------------ -- Mapping on the output@@ -476,7 +538,8 @@ -- {-# INLINE rmapM #-} rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-rmapM f (Fold step initial extract) = Fold step1 initial1 (extract >=> f)+rmapM f (Fold step initial extract final) =+    Fold step1 initial1 (extract >=> f) (final >=> f)      where @@ -507,6 +570,7 @@         (\s a -> return $ Partial $ step s a)         (return (Partial initial))         return+        return  -- | Make a fold from a left fold style monadic step function and initial value -- of the accumulator.@@ -521,7 +585,7 @@ {-# INLINE foldlM' #-} foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b foldlM' step initial =-    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) return+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) return return  -- | Make a strict left fold, for non-empty streams, using first element as the -- starting value. Returns Nothing if the stream is empty.@@ -619,7 +683,11 @@ {-# INLINE foldt' #-} foldt' :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b foldt' step initial extract =-    Fold (\s a -> return $ step s a) (return initial) (return . extract)+    Fold+        (\s a -> return $ step s a)+        (return initial)+        (return . extract)+        (return . extract)  -- | Make a terminating fold with an effectful step function and initial state, -- and a state extraction function.@@ -632,7 +700,7 @@ -- {-# INLINE foldtM' #-} foldtM' :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b-foldtM' = Fold+foldtM' step initial extract = Fold step initial extract extract  ------------------------------------------------------------------------------ -- Refold@@ -646,7 +714,7 @@ -- /Internal/ fromRefold :: Refold m c a b -> c -> Fold m a b fromRefold (Refold step inject extract) c =-    Fold step (inject c) extract+    Fold step (inject c) extract extract  ------------------------------------------------------------------------------ -- Basic Folds@@ -706,7 +774,8 @@ -- | Maps a function on the output of the fold (the type @b@). instance Functor m => Functor (Fold m a) where     {-# INLINE fmap #-}-    fmap f (Fold step1 initial1 extract) = Fold step initial (fmap2 f extract)+    fmap f (Fold step1 initial1 extract final) =+        Fold step initial (fmap2 f extract) (fmap2 f final)          where @@ -741,7 +810,7 @@ -- {-# INLINE fromPure #-} fromPure :: Applicative m => b -> Fold m a b-fromPure b = Fold undefined (pure $ Done b) pure+fromPure b = Fold undefined (pure $ Done b) pure pure  -- | Make a fold that yields the result of the supplied effectful action -- without consuming any further input.@@ -750,7 +819,7 @@ -- {-# INLINE fromEffect #-} fromEffect :: Applicative m => m b -> Fold m a b-fromEffect b = Fold undefined (Done <$> b) pure+fromEffect b = Fold undefined (Done <$> b) pure pure  {-# ANN type SeqFoldState Fuse #-} data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr@@ -775,16 +844,20 @@ -- complexity, because each composition adds a new branch that each subsequent -- fold's input element has to traverse, therefore, it cannot scale to a large -- number of compositions. After around 100 compositions the performance starts--- dipping rapidly compared to a CPS style implementation. When you need--- scaling use parser monad instead.+-- dipping rapidly compared to a CPS style implementation. --+-- For larger number of compositions you can convert the fold to a parser and+-- use ParserK.+-- -- /Time: O(n^2) where n is the number of compositions./ -- {-# INLINE splitWith #-} splitWith :: Monad m =>     (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-splitWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+splitWith func+    (Fold stepL initialL _ finalL)+    (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -801,13 +874,18 @@     step (SeqFoldL st) a = runL (stepL st a)     step (SeqFoldR f st) a = runR (stepR st a) f -    extract (SeqFoldR f sR) = fmap f (extractR sR)-    extract (SeqFoldL sL) = do-        rL <- extractL sL+    -- XXX splitWith should not be used for scanning+    -- It would rarely make sense and resource tracking and cleanup would be+    -- expensive. especially when multiple splitWith are chained.+    extract _ = error "splitWith: cannot be used for scanning"++    final (SeqFoldR f sR) = fmap f (finalR sR)+    final (SeqFoldL sL) = do+        rL <- finalL sL         res <- initialR         fmap (func rL)             $ case res of-                Partial sR -> extractR sR+                Partial sR -> finalR sR                 Done rR -> return rR  {-# DEPRECATED serialWith "Please use \"splitWith\" instead" #-}@@ -827,8 +905,8 @@ -- {-# INLINE split_ #-} split_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b-split_ (Fold stepL initialL _) (Fold stepR initialR extractR) =-    Fold step initial extract+split_ (Fold stepL initialL _ finalL) (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -851,11 +929,16 @@         resR <- stepR st a         return $ first SeqFoldR_ resR -    extract (SeqFoldR_ sR) = extractR sR-    extract (SeqFoldL_ _) = do+    -- XXX split_ should not be used for scanning+    -- See splitWith for more details.+    extract _ = error "split_: cannot be used for scanning"++    final (SeqFoldR_ sR) = finalR sR+    final (SeqFoldL_ sL) = do+        _ <- finalL sL         res <- initialR         case res of-            Partial sR -> extractR sR+            Partial sR -> finalR sR             Done rR -> return rR  -- | 'Applicative' form of 'splitWith'. Split the input serially over two@@ -903,8 +986,10 @@ -- {-# INLINE teeWith #-} teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-teeWith f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+teeWith f+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -931,6 +1016,10 @@     extract (TeeLeft bR sL) = (`f` bR) <$> extractL sL     extract (TeeRight bL sR) = f bL <$> extractR sR +    final (TeeBoth sL sR) = f <$> finalL sL <*> finalR sR+    final (TeeLeft bR sL) = (`f` bR) <$> finalL sL+    final (TeeRight bL sR) = f bL <$> finalR sR+ {-# ANN type TeeFstState Fuse #-} data TeeFstState sL sR b     = TeeFstBoth !sL !sR@@ -943,8 +1032,10 @@ {-# INLINE teeWithFst #-} teeWithFst :: Monad m =>     (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d-teeWithFst f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+teeWithFst f+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -963,7 +1054,7 @@             Done bl -> do                 Done . f bl <$>                     case resR of-                        Partial sr -> extractR sr+                        Partial sr -> finalR sr                         Done br -> return br      initial = runBoth initialL initialR@@ -974,6 +1065,9 @@     extract (TeeFstBoth sL sR) = f <$> extractL sL <*> extractR sR     extract (TeeFstLeft bR sL) = (`f` bR) <$> extractL sL +    final (TeeFstBoth sL sR) = f <$> finalL sL <*> finalR sR+    final (TeeFstLeft bR sL) = (`f` bR) <$> finalL sL+ -- | Like 'teeWith' but terminates as soon as any one of the two folds -- terminates. --@@ -982,8 +1076,10 @@ {-# INLINE teeWithMin #-} teeWithMin :: Monad m =>     (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d-teeWithMin f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+teeWithMin f+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -995,12 +1091,12 @@             Partial sl -> do                 case resR of                     Partial sr -> return $ Partial $ Tuple' sl sr-                    Done br -> Done . (`f` br) <$> extractL sl+                    Done br -> Done . (`f` br) <$> finalL sl              Done bl -> do                 Done . f bl <$>                     case resR of-                        Partial sr -> extractR sr+                        Partial sr -> finalR sr                         Done br -> return br      initial = runBoth initialL initialR@@ -1009,6 +1105,8 @@      extract (Tuple' sL sR) = f <$> extractL sL <*> extractR sR +    final (Tuple' sL sR) = f <$> finalL sL <*> finalR sR+ -- | Shortest alternative. Apply both folds in parallel but choose the result -- from the one which consumed least input i.e. take the shortest succeeding -- fold.@@ -1020,8 +1118,8 @@ -- {-# INLINE shortest #-} shortest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)-shortest (Fold stepL initialL extractL) (Fold stepR initialR _) =-    Fold step initial extract+shortest (Fold stepL initialL extractL finalL) (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -1029,10 +1127,16 @@     runBoth actionL actionR = do         resL <- actionL         resR <- actionR-        return $-            case resL of-                Partial sL -> bimap (Tuple' sL) Right resR-                Done bL -> Done $ Left bL+        case resL of+            Partial sL ->+                case resR of+                    Partial sR -> return $ Partial $ Tuple' sL sR+                    Done bR -> finalL sL >> return (Done (Right bR))+            Done bL -> do+                case resR of+                    Partial sR -> void (finalR sR)+                    Done _ -> return ()+                return (Done (Left bL))      initial = runBoth initialL initialR @@ -1040,6 +1144,8 @@      extract (Tuple' sL _) = Left <$> extractL sL +    final (Tuple' sL sR) = Left <$> finalL sL <* finalR sR+ {-# ANN type LongestState Fuse #-} data LongestState sL sR     = LongestBoth !sL !sR@@ -1057,8 +1163,10 @@ -- {-# INLINE longest #-} longest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)-longest (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+longest+    (Fold stepL initialL _ finalL)+    (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -1081,15 +1189,19 @@     step (LongestLeft sL) a = bimap LongestLeft Left <$> stepL sL a     step (LongestRight sR) a = bimap LongestRight Right <$> stepR sR a -    left sL = Left <$> extractL sL-    extract (LongestLeft sL) = left sL-    extract (LongestRight sR) = Right <$> extractR sR-    extract (LongestBoth sL _) = left sL+    -- XXX Scan with this may not make sense as we cannot determine the longest+    -- until one of them have exhausted.+    extract _ = error $ "longest: scan is not allowed as longest cannot be "+        ++ "determined until one fold has exhausted." -data ConcatMapState m sa a c-    = B !sa-    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c)+    final (LongestLeft sL) = Left <$> finalL sL+    final (LongestRight sR) = Right <$> finalR sR+    final (LongestBoth sL sR) = Left <$> finalL sL <* finalR sR +data ConcatMapState m sa a b c+    = B !sa (sa -> m b)+    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c) (s -> m c)+ -- | Map a 'Fold' returning function on the result of a 'Fold' and run the -- returned fold. This operation can be used to express data dependencies -- between fold operations.@@ -1111,43 +1223,47 @@ -- {-# INLINE concatMap #-} concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c-concatMap f (Fold stepa initiala extracta) = Fold stepc initialc extractc+concatMap f (Fold stepa initiala _ finala) =+    Fold stepc initialc extractc finalc   where     initialc = do         r <- initiala         case r of-            Partial s -> return $ Partial (B s)+            Partial s -> return $ Partial (B s finala)             Done b -> initInnerFold (f b) -    stepc (B s) a = do+    stepc (B s fin) a = do         r <- stepa s a         case r of-            Partial s1 -> return $ Partial (B s1)+            Partial s1 -> return $ Partial (B s1 fin)             Done b -> initInnerFold (f b) -    stepc (C stepInner s extractInner) a = do+    stepc (C stepInner s extractInner fin) a = do         r <- stepInner s a         return $ case r of-            Partial sc -> Partial (C stepInner sc extractInner)+            Partial sc -> Partial (C stepInner sc extractInner fin)             Done c -> Done c -    extractc (B s) = do-        r <- extracta s-        initExtract (f r)-    extractc (C _ sInner extractInner) = extractInner sInner+    -- XXX Cannot use for scanning+    extractc _ = error "concatMap: cannot be used for scanning" -    initInnerFold (Fold step i e) = do+    initInnerFold (Fold step i e fin) = do         r <- i         return $ case r of-            Partial s -> Partial (C step s e)+            Partial s -> Partial (C step s e fin)             Done c -> Done c -    initExtract (Fold _ i e) = do+    initFinalize (Fold _ i _ fin) = do         r <- i         case r of-            Partial s -> e s+            Partial s -> fin s             Done c -> return c +    finalc (B s fin) = do+        r <- fin s+        initFinalize (f r)+    finalc (C _ sInner _ fin) = fin sInner+ ------------------------------------------------------------------------------ -- Mapping on input ------------------------------------------------------------------------------@@ -1166,7 +1282,7 @@ -- {-# INLINE lmap #-} lmap :: (a -> b) -> Fold m b r -> Fold m a r-lmap f (Fold step begin done) = Fold step' begin done+lmap f (Fold step begin done final) = Fold step' begin done final     where     step' x a = step x (f a) @@ -1174,7 +1290,7 @@ -- {-# INLINE lmapM #-} lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r-lmapM f (Fold step begin done) = Fold step' begin done+lmapM f (Fold step begin done final) = Fold step' begin done final     where     step' x a = f a >>= step x @@ -1186,8 +1302,10 @@ -- /Pre-release/ {-# INLINE postscan #-} postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-postscan (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+postscan+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -1198,30 +1316,32 @@             Done bL -> do                 rR <- stepR sR bL                 case rR of-                    Partial sR1 -> Done <$> extractR sR1+                    Partial sR1 -> Done <$> finalR sR1                     Done bR -> return $ Done bR             Partial sL -> do                 !b <- extractL sL                 rR <- stepR sR b-                return-                    $ case rR of-                        Partial sR1 -> Partial (sL, sR1)-                        Done bR -> Done bR+                case rR of+                    Partial sR1 -> return $ Partial (sL, sR1)+                    Done bR -> finalL sL >> return (Done bR)      initial = do-        r <- initialR-        rL <- initialL-        case r of-            Partial sR ->+        rR <- initialR+        case rR of+            Partial sR -> do+                rL <- initialL                 case rL of-                    Done _ -> Done <$> extractR sR+                    Done _ -> Done <$> finalR sR                     Partial sL -> return $ Partial (sL, sR)             Done b -> return $ Done b +    -- XXX should use Tuple'     step (sL, sR) x = runStep (stepL sL x) sR      extract = extractR . snd +    final (sL, sR) = finalL sL *> finalR sR+ ------------------------------------------------------------------------------ -- Filtering ------------------------------------------------------------------------------@@ -1234,7 +1354,7 @@ -- {-# INLINE_NORMAL catMaybes #-} catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-catMaybes (Fold step initial extract) = Fold step1 initial extract+catMaybes (Fold step initial extract final) = Fold step1 initial extract final      where @@ -1274,7 +1394,7 @@ {-# INLINE filter #-} filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r -- filter p = scanMaybe (filtering p)-filter f (Fold step begin done) = Fold step' begin done+filter f (Fold step begin extract final) = Fold step' begin extract final     where     step' x a = if f a then step x a else return $ Partial x @@ -1285,7 +1405,7 @@ -- {-# INLINE filterM #-} filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r-filterM f (Fold step begin done) = Fold step' begin done+filterM f (Fold step begin extract final) = Fold step' begin extract final     where     step' x a = do       use <- f a@@ -1374,7 +1494,7 @@ {-# INLINE take #-} take :: Monad m => Int -> Fold m a b -> Fold m a b -- take n = scanMaybe (taking n)-take n (Fold fstep finitial fextract) = Fold step initial extract+take n (Fold fstep finitial fextract ffinal) = Fold step initial extract final      where @@ -1386,7 +1506,7 @@                     s1 = Tuple'Fused i1 s                 if i1 < n                 then return $ Partial s1-                else Done <$> fextract s+                else Done <$> ffinal s             Done b -> return $ Done b      initial = finitial >>= next (-1)@@ -1395,6 +1515,8 @@      extract (Tuple'Fused _ r) = fextract r +    final (Tuple'Fused _ r) = ffinal r+ ------------------------------------------------------------------------------ -- Nesting ------------------------------------------------------------------------------@@ -1412,8 +1534,8 @@ -- /Pre-release/ {-# INLINE duplicate #-} duplicate :: Monad m => Fold m a b -> Fold m a (Fold m a b)-duplicate (Fold step1 initial1 extract1) =-    Fold step initial (\s -> pure $ Fold step1 (pure $ Partial s) extract1)+duplicate (Fold step1 initial1 extract1 final1) =+    Fold step initial extract final      where @@ -1421,6 +1543,11 @@      step s a = second fromPure <$> step1 s a +    -- Scanning may be problematic due to multiple finalizations.+    extract = error "duplicate: scanning may be problematic"++    final s = pure $ Fold step1 (pure $ Partial s) extract1 final1+ -- If there were a finalize/flushing action in the stream type that would be -- equivalent to running initialize in Fold. But we do not have a flushing -- action in streams.@@ -1432,9 +1559,9 @@ -- /Pre-release/ {-# INLINE reduce #-} reduce :: Monad m => Fold m a b -> m (Fold m a b)-reduce (Fold step initial extract) = do+reduce (Fold step initial extract final) = do     i <- initial-    return $ Fold step (return i) extract+    return $ Fold step (return i) extract final  -- This is the dual of Stream @cons@. @@ -1444,7 +1571,8 @@ -- /Pre-release/ {-# INLINE snoclM #-} snoclM :: Monad m => Fold m a b -> m a -> Fold m a b-snoclM (Fold fstep finitial fextract) action = Fold fstep initial fextract+snoclM (Fold fstep finitial fextract ffinal) action =+    Fold fstep initial fextract ffinal      where @@ -1471,7 +1599,8 @@ {-# INLINE snocl #-} snocl :: Monad m => Fold m a b -> a -> Fold m a b -- snocl f = snoclM f . return-snocl (Fold fstep finitial fextract) a = Fold fstep initial fextract+snocl (Fold fstep finitial fextract ffinal) a =+    Fold fstep initial fextract ffinal      where @@ -1491,12 +1620,12 @@ -- /Pre-release/ {-# INLINE snocM #-} snocM :: Monad m => Fold m a b -> m a -> m (Fold m a b)-snocM (Fold step initial extract) action = do+snocM (Fold step initial extract final) action = do     res <- initial     r <- case res of           Partial fs -> action >>= step fs           Done _ -> return res-    return $ Fold step (return r) extract+    return $ Fold step (return r) extract final  -- Definitions: --@@ -1515,12 +1644,12 @@ -- /Pre-release/ {-# INLINE snoc #-} snoc :: Monad m => Fold m a b -> a -> m (Fold m a b)-snoc (Fold step initial extract) a = do+snoc (Fold step initial extract final) a = do     res <- initial     r <- case res of           Partial fs -> step fs a           Done _ -> return res-    return $ Fold step (return r) extract+    return $ Fold step (return r) extract final  -- | Append a singleton value to the fold. --@@ -1548,7 +1677,7 @@ -- /Pre-release/ {-# INLINE extractM #-} extractM :: Monad m => Fold m a b -> m b-extractM (Fold _ initial extract) = do+extractM (Fold _ initial extract _) = do     res <- initial     case res of           Partial fs -> extract fs@@ -1557,14 +1686,15 @@ -- | Close a fold so that it does not accept any more input. {-# INLINE close #-} close :: Monad m => Fold m a b -> Fold m a b-close (Fold _ initial1 extract1) = Fold undefined initial undefined+close (Fold _ initial1 _ final1) =+    Fold undefined initial undefined undefined      where      initial = do         res <- initial1         case res of-              Partial s -> Done <$> extract1 s+              Partial s -> Done <$> final1 s               Done b -> return $ Done b  -- Corresponds to the null check for streams.@@ -1574,7 +1704,7 @@ -- /Pre-release/ {-# INLINE isClosed #-} isClosed :: Monad m => Fold m a b -> m Bool-isClosed (Fold _ initial _) = do+isClosed (Fold _ initial _ _) = do     res <- initial     return $ case res of           Partial _ -> False@@ -1608,8 +1738,10 @@ -- {-# INLINE many #-} many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-many (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =-    Fold step initial extract+many+    (Fold sstep sinitial sextract sfinal)+    (Fold cstep cinitial cextract cfinal) =+    Fold step initial extract final      where @@ -1658,6 +1790,13 @@             Partial s -> cextract s             Done b -> return b +    final (ManyFirst ss cs) = sfinal ss *> cfinal cs+    final (ManyLoop ss cs) = do+        cres <- sfinal ss >>= cstep cs+        case cres of+            Partial s -> cfinal s+            Done b -> return b+ -- | Like many, but the "first" fold emits an output at the end even if no -- input is received. --@@ -1667,8 +1806,10 @@ -- {-# INLINE manyPost #-} manyPost :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-manyPost (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =-    Fold step initial extract+manyPost+    (Fold sstep sinitial sextract sfinal)+    (Fold cstep cinitial cextract cfinal) =+    Fold step initial extract final      where @@ -1704,6 +1845,12 @@             Partial s -> cextract s             Done b -> return b +    final (Tuple' ss cs) = do+        cres <- sfinal ss >>= cstep cs+        case cres of+            Partial s -> cfinal s+            Done b -> return b+ -- | @groupsOf n split collect@ repeatedly applies the @split@ fold to chunks -- of @n@ items in the input stream and supplies the result to the @collect@ -- fold.@@ -1732,7 +1879,10 @@ -- {-# INLINE refoldMany #-} refoldMany :: Monad m => Fold m a b -> Refold m x b c -> Refold m x a c-refoldMany (Fold sstep sinitial sextract) (Refold cstep cinject cextract) =+refoldMany+    (Fold sstep sinitial sextract _sfinal)+    -- XXX We will need a "final" in refold as well+    (Refold cstep cinject cextract) =     Refold step inject extract      where@@ -1783,7 +1933,9 @@ -- /Internal/ {-# INLINE refoldMany1 #-} refoldMany1 :: Monad m => Refold m x a b -> Fold m b c -> Refold m x a c-refoldMany1 (Refold sstep sinject sextract) (Fold cstep cinitial cextract) =+refoldMany1+    (Refold sstep sinject sextract)+    (Fold cstep cinitial cextract _cfinal) =     Refold step inject extract      where@@ -1834,7 +1986,7 @@ {-# INLINE refold #-} refold :: Monad m => Refold m b a c -> Fold m a b -> Fold m a c refold (Refold step inject extract) f =-    Fold step (extractM f >>= inject) extract+    Fold step (extractM f >>= inject) extract extract  ------------------------------------------------------------------------------ -- morphInner@@ -1844,8 +1996,8 @@ -- -- /Pre-release/ morphInner :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b-morphInner f (Fold step initial extract) =-    Fold (\x a -> f $ step x a) (f initial) (f . extract)+morphInner f (Fold step initial extract final) =+    Fold (\x a -> f $ step x a) (f initial) (f . extract) (f . final)  -- | Adapt a pure fold to any monad. --
src/Streamly/Internal/Data/Fold/Window.hs view
@@ -36,24 +36,24 @@     -- window folds by keeping the second element of the input tuple as     -- @Nothing@.     ---      lmap+      windowLmap     , cumulative -    , rollingMap-    , rollingMapM+    , windowRollingMap+    , windowRollingMapM      -- ** Sums-    , length-    , sum-    , sumInt-    , powerSum-    , powerSumFrac+    , windowLength+    , windowSum+    , windowSumInt+    , windowPowerSum+    , windowPowerSumFrac      -- ** Location-    , minimum-    , maximum-    , range-    , mean+    , windowMinimum+    , windowMaximum+    , windowRange+    , windowMean     ) where @@ -65,16 +65,18 @@ import Streamly.Internal.Data.Tuple.Strict     (Tuple'(..), Tuple3Fused' (Tuple3Fused')) +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+ import qualified Streamly.Internal.Data.Fold.Type as Fold-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring+import qualified Streamly.Internal.Data.Ring as Ring  import Prelude hiding (length, sum, minimum, maximum)  -- $setup -- >>> import Data.Bifunctor(bimap) -- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold.Window as FoldW--- >>> import qualified Streamly.Internal.Data.Ring.Unboxed as Ring+-- >>> import qualified Streamly.Internal.Data.Fold.Window as Fold+-- >>> import qualified Streamly.Internal.Data.Ring as Ring -- >>> import qualified Streamly.Data.Stream as Stream -- >>> import Prelude hiding (length, sum, minimum, maximum) @@ -87,9 +89,9 @@ -- -- >>> lmap f = Fold.lmap (bimap f (f <$>)) ---{-# INLINE lmap #-}-lmap :: (c -> a) -> Fold m (a, Maybe a) b -> Fold m (c, Maybe c) b-lmap f = Fold.lmap (bimap f (f <$>))+{-# INLINE windowLmap #-}+windowLmap :: (c -> a) -> Fold m (a, Maybe a) b -> Fold m (c, Maybe c) b+windowLmap f = Fold.lmap (bimap f (f <$>))  -- | Convert an incremental fold to a cumulative fold using the entire input -- stream as a single window.@@ -105,10 +107,10 @@  -- | Apply an effectful function on the latest and the oldest element of the -- window.-{-# INLINE rollingMapM #-}-rollingMapM :: Monad m =>+{-# INLINE windowRollingMapM #-}+windowRollingMapM :: Monad m =>     (Maybe a -> a -> m (Maybe b)) -> Fold m (a, Maybe a) (Maybe b)-rollingMapM f = Fold.foldlM' f1 initial+windowRollingMapM f = Fold.foldlM' f1 initial      where @@ -118,12 +120,12 @@  -- | Apply a pure function on the latest and the oldest element of the window. ----- >>> rollingMap f = FoldW.rollingMapM (\x y -> return $ f x y)+-- >>> windowRollingMap f = Fold.windowRollingMapM (\x y -> return $ f x y) ---{-# INLINE rollingMap #-}-rollingMap :: Monad m =>+{-# INLINE windowRollingMap #-}+windowRollingMap :: Monad m =>     (Maybe a -> a -> Maybe b) -> Fold m (a, Maybe a) (Maybe b)-rollingMap f = Fold.foldl' f1 initial+windowRollingMap f = Fold.foldl' f1 initial      where @@ -146,9 +148,9 @@ -- -- /Internal/ ---{-# INLINE sumInt #-}-sumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a-sumInt = Fold step initial extract+{-# INLINE windowSumInt #-}+windowSumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a+windowSumInt = Fold step initial extract extract      where @@ -180,9 +182,9 @@ -- -- /Time/: \(\mathcal{O}(n)\) ---{-# INLINE sum #-}-sum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a-sum = Fold step initial extract+{-# INLINE windowSum #-}+windowSum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a+windowSum = Fold step initial extract extract      where @@ -219,9 +221,9 @@ -- -- >>> length = powerSum 0 ---{-# INLINE length #-}-length :: (Monad m, Num b) => Fold m (a, Maybe a) b-length = Fold.foldl' step 0+{-# INLINE windowLength #-}+windowLength :: (Monad m, Num b) => Fold m (a, Maybe a) b+windowLength = Fold.foldl' step 0      where @@ -237,18 +239,18 @@ -- /Space/: \(\mathcal{O}(1)\) -- -- /Time/: \(\mathcal{O}(n)\)-{-# INLINE powerSum #-}-powerSum :: (Monad m, Num a) => Int -> Fold m (a, Maybe a) a-powerSum k = lmap (^ k) sum+{-# INLINE windowPowerSum #-}+windowPowerSum :: (Monad m, Num a) => Int -> Fold m (a, Maybe a) a+windowPowerSum k = windowLmap (^ k) windowSum  -- | Like 'powerSum' but powers can be negative or fractional. This is slower -- than 'powerSum' for positive intergal powers. -- -- >>> powerSumFrac p = lmap (** p) sum ---{-# INLINE powerSumFrac #-}-powerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a-powerSumFrac p = lmap (** p) sum+{-# INLINE windowPowerSumFrac #-}+windowPowerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a+windowPowerSumFrac p = windowLmap (** p) windowSum  ------------------------------------------------------------------------------- -- Location@@ -265,9 +267,9 @@ -- -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. ---{-# INLINE range #-}-range :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))-range n = Fold step initial extract+{-# INLINE windowRange #-}+windowRange :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))+windowRange n = Fold step initial extract extract      where @@ -300,7 +302,11 @@         if i == 0         then return Nothing         else do-            x <- liftIO $ peek rh+            -- Here we use "ringStart" over "ringHead" as "ringHead" will be+            -- uninitialized if the ring is not full.+            -- Using "unsafeForeignPtrToPtr" here is safe as we touch the ring+            -- again in "foldFunc".+            x <- liftIO $ peek (unsafeForeignPtrToPtr (Ring.ringStart rb))             let accum (mn, mx) a = return (min mn a, max mx a)             fmap Just $ foldFunc i rh accum (x, x) rb @@ -316,9 +322,9 @@ -- -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. ---{-# INLINE minimum #-}-minimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)-minimum n = fmap (fmap fst) $ range n+{-# INLINE windowMinimum #-}+windowMinimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+windowMinimum n = fmap (fmap fst) $ windowRange n  -- | The maximum element in a rolling window. --@@ -329,9 +335,9 @@ -- -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. ---{-# INLINE maximum #-}-maximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)-maximum n = fmap (fmap snd) $ range n+{-# INLINE windowMaximum #-}+windowMaximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+windowMaximum n = fmap (fmap snd) $ windowRange n  -- | Arithmetic mean of elements in a sliding window: --@@ -346,6 +352,6 @@ -- /Space/: \(\mathcal{O}(1)\) -- -- /Time/: \(\mathcal{O}(n)\)-{-# INLINE mean #-}-mean :: forall m a. (Monad m, Fractional a) => Fold m (a, Maybe a) a-mean = Fold.teeWith (/) sum length+{-# INLINE windowMean #-}+windowMean :: forall m a. (Monad m, Fractional a) => Fold m (a, Maybe a) a+windowMean = Fold.teeWith (/) windowSum windowLength
src/Streamly/Internal/Data/IOFinalizer.hs view
@@ -66,6 +66,9 @@ -- never runs again.  Note, the finalizing action runs with async exceptions -- masked. --+-- If this function is called multiple times, the action is guaranteed to run+-- once and only once.+-- -- /Pre-release/ runIOFinalizer :: MonadIO m => IOFinalizer -> m () runIOFinalizer (IOFinalizer ref) = liftIO $ do@@ -83,9 +86,16 @@ -- | Run an action clearing the finalizer atomically wrt async exceptions. The -- action is run with async exceptions masked. --+-- This function can be called at most once after setting the finalizer. If the+-- finalizer is not set it is considered a bug.+-- -- /Pre-release/ clearingIOFinalizer :: MonadIO m => IOFinalizer -> IO a -> m a clearingIOFinalizer (IOFinalizer ref) action = do     liftIO $ mask_ $ do-        writeIORef ref Nothing-        action+        res <- readIORef ref+        case res of+            Just _ -> do+                writeIORef ref Nothing+                action+            Nothing -> error "clearingIOFinalizer: finalizer not set"
src/Streamly/Internal/Data/IORef/Unboxed.hs view
@@ -23,36 +23,31 @@     (       IORef -    -- * Construction+    -- Construction     , newIORef -    -- * Write+    -- Write     , writeIORef     , modifyIORef' -    -- * Read+    -- Read     , readIORef-    , toStreamD+    , pollIntIORef     ) where  #include "inline.hs" -import Data.Proxy (Proxy(..)) import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Data.Unboxed-    ( MutableByteArray(..)-    , Unbox-    , sizeOf-    , peekWith-    , pokeWith-    , newUnpinnedBytes-    )+import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)+import Streamly.Internal.Data.Unbox (Unbox(..), sizeOf) -import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.MutByteArray.Type as MBA+import qualified Streamly.Internal.Data.Stream.Type as D  -- | An 'IORef' holds a single 'Unbox'-able value.-newtype IORef a = IORef MutableByteArray+newtype IORef a = IORef MutByteArray  -- | Create a new 'IORef'. --@@ -60,8 +55,8 @@ {-# INLINE newIORef #-} newIORef :: forall a. Unbox a => a -> IO (IORef a) newIORef x = do-    var <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))-    pokeWith var 0 x+    var <- MBA.new (sizeOf (Proxy :: Proxy a))+    pokeAt 0 var x     return $ IORef var  -- | Write a value to an 'IORef'.@@ -69,14 +64,14 @@ -- /Pre-release/ {-# INLINE writeIORef #-} writeIORef :: Unbox a => IORef a -> a -> IO ()-writeIORef (IORef var) = pokeWith var 0+writeIORef (IORef var) = pokeAt 0 var  -- | Read a value from an 'IORef'. -- -- /Pre-release/ {-# INLINE readIORef #-} readIORef :: Unbox a => IORef a -> IO a-readIORef (IORef var) = peekWith var 0+readIORef (IORef var) = peekAt 0 var  -- | Modify the value of an 'IORef' using a function with strict application. --@@ -89,10 +84,16 @@  -- | Generate a stream by continuously reading the IORef. --+-- This operation reads the IORef without any synchronization. It can be+-- assumed to be atomic because the IORef (MutableByteArray) is always aligned+-- to Int boundaries, we are assuming that compiler uses single instructions to+-- access the memory. It may read stale values though until caches are+-- synchronised in a multiprocessor architecture.+-- -- /Pre-release/-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: (MonadIO m, Unbox a) => IORef a -> D.Stream m a-toStreamD var = D.Stream step ()+{-# INLINE_NORMAL pollIntIORef #-}+pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> D.Stream m a+pollIntIORef var = D.Stream step ()      where
src/Streamly/Internal/Data/IsMap.hs view
@@ -28,6 +28,8 @@     mapDelete :: Key f -> f a -> f a     mapUnion :: f a -> f a -> f a     mapNull :: f a -> Bool+    mapTraverseWithKey ::+        Applicative t => (Key f -> a -> t b) -> f a -> t (f b)  instance Ord k => IsMap (Map k) where     type Key (Map k) = k@@ -39,6 +41,7 @@     mapDelete = Map.delete     mapUnion = Map.union     mapNull = Map.null+    mapTraverseWithKey = Map.traverseWithKey  instance IsMap IntMap.IntMap where     type Key IntMap.IntMap = Int@@ -50,3 +53,4 @@     mapDelete = IntMap.delete     mapUnion = IntMap.union     mapNull = IntMap.null+    mapTraverseWithKey = IntMap.traverseWithKey
− src/Streamly/Internal/Data/List.hs 
@@ -1,169 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.List--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Lists are just a special case of monadic streams. The stream type @Stream--- Identity a@ can be used as a replacement for @[a]@.  The 'List' type in this--- module is just a newtype wrapper around @Stream Identity@ for better type--- inference when using the 'OverloadedLists' GHC extension. @List a@ provides--- better performance compared to @[a]@. Standard list, string and list--- comprehension syntax can be used with the 'List' type by enabling--- 'OverloadedLists', 'OverloadedStrings' and 'MonadComprehensions' GHC--- extensions.  There would be a slight difference in the 'Show' and 'Read'--- strings of streamly list as compared to regular lists.------ Conversion to stream types is free, any stream combinator can be used on--- lists by converting them to streams.  However, for convenience, this module--- provides combinators that work directly on the 'List' type.--------- @--- List $ S.map (+ 1) $ toStream (1 \`Cons\` Nil)--- @------ To convert a 'List' to regular lists, you can use any of the following:------ * @toList . toStream@ and @toStream . fromList@--- * 'Data.Foldable.toList' from "Data.Foldable"--- * 'GHC.Exts.toList' and 'GHC.Exts.fromList' from 'IsList' in "GHC.Exts"------ If you have made use of 'Nil' and 'Cons' constructors in the code and you--- want to replace streamly lists with standard lists, all you need to do is--- import these definitions:------ @--- type List = []--- pattern Nil <- [] where Nil = []--- pattern Cons x xs = x : xs--- infixr 5 `Cons`--- {-\# COMPLETE Cons, Nil #-}--- @------ See <src/docs/streamly-vs-lists.md> for more details and--- <src/test/PureStreams.hs> for comprehensive usage examples.----module Streamly.Internal.Data.List-    (-    List (Nil, Cons)--    , toStream-    , fromStream--    -- XXX we may want to use rebindable syntax for variants instead of using-    -- different types (applicative do and apWith).-    , ZipList (..)-    , fromZipList-    , toZipList-    )-where--import Control.Arrow (second)-import Data.Functor.Identity (Identity, runIdentity)-import GHC.Exts (IsList(..), IsString(..))-import Streamly.Internal.Data.Stream.Cross (CrossStream(..))-import Streamly.Internal.Data.Stream.Type (Stream)-import Streamly.Internal.Data.Stream.Zip (ZipStream(..))-import Text.Read (readPrec)--import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.Type as Stream---- XXX Rename to PureStream.---- | @List a@ is a replacement for @[a]@.------ /Pre-release/-newtype List a = List { toCrossStream :: CrossStream Identity a }-    deriving-    ( Eq, Ord-    , Semigroup, Monoid, Functor, Foldable-    , Applicative, Traversable, Monad, IsList)--toStream :: List a -> Stream Identity a-toStream = unCrossStream . toCrossStream--fromStream :: Stream Identity a -> List a-fromStream xs = List (CrossStream xs)--instance (a ~ Char) => IsString (List a) where-    {-# INLINE fromString #-}-    fromString = List . fromList--instance Show a => Show (List a) where-    show (List x) = show $ unCrossStream x--instance Read a => Read (List a) where-    readPrec = fromStream <$> readPrec----------------------------------------------------------------------------------- Patterns----------------------------------------------------------------------------------- Note: When using the OverloadedLists extension we should be able to pattern--- match using the regular list contructors. OverloadedLists uses 'toList' to--- perform the pattern match, it should not be too bad as it works lazily in--- the Identity monad. We need these patterns only when not using that--- extension.---- | An empty list constructor and pattern that matches an empty 'List'.--- Corresponds to '[]' for Haskell lists.----pattern Nil :: List a-pattern Nil <- (runIdentity . K.null . Stream.toStreamK . toStream -> True)--    where--    Nil = List $ CrossStream (Stream.fromStreamK K.nil)--infixr 5 `Cons`---- | A list constructor and pattern that deconstructs a 'List' into its head--- and tail. Corresponds to ':' for Haskell lists.----pattern Cons :: a -> List a -> List a-pattern Cons x xs <--    (fmap (second (List . CrossStream . Stream.fromStreamK))-        . runIdentity . K.uncons . Stream.toStreamK . toStream-            -> Just (x, xs)-    )--    where--    Cons x xs = List $ CrossStream $ Stream.cons x (toStream xs)--{-# COMPLETE Nil, Cons #-}----------------------------------------------------------------------------------- ZipList----------------------------------------------------------------------------------- | Just like 'List' except that it has a zipping 'Applicative' instance--- and no 'Monad' instance.----newtype ZipList a = ZipList { toZipStream :: ZipStream Identity a }-    deriving-    ( Show, Read, Eq, Ord-    , Semigroup, Monoid, Functor, Foldable-    , Applicative, Traversable, IsList-    )--instance (a ~ Char) => IsString (ZipList a) where-    {-# INLINE fromString #-}-    fromString = ZipList . fromList---- | Convert a 'ZipList' to a regular 'List'----fromZipList :: ZipList a -> List a-fromZipList (ZipList zs) = List $ CrossStream (unZipStream zs)---- | Convert a regular 'List' to a 'ZipList'----toZipList :: List a -> ZipList a-toZipList = ZipList . ZipStream . toStream
+ src/Streamly/Internal/Data/MutArray.hs view
@@ -0,0 +1,91 @@+-- |+-- Module      : Streamly.Internal.Data.MutArray+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.MutArray+    (+    -- * MutArray.Type module+      module Streamly.Internal.Data.MutArray.Type+    -- * MutArray module+    , splitOn+    , genSlicesFromLen+    , getSlicesFromLen+    , fromStream+    -- * Unboxed IORef+    , module Streamly.Internal.Data.IORef.Unboxed+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.Unfold as Unfold++import Prelude hiding (foldr, length, read, splitAt)+import Streamly.Internal.Data.MutArray.Type+import Streamly.Internal.Data.IORef.Unboxed++-- | Split the array into a stream of slices using a predicate. The element+-- matching the predicate is dropped.+--+-- /Pre-release/+{-# INLINE splitOn #-}+splitOn :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> Stream m (MutArray a)+splitOn predicate arr =+    fmap (\(i, len) -> getSliceUnsafe i len arr)+        $ D.sliceOnSuffix predicate (read arr)++-- | Generate a stream of array slice descriptors ((index, len)) of specified+-- length from an array, starting from the supplied array index. The last slice+-- may be shorter than the requested length depending on the array length.+--+-- /Pre-release/+{-# INLINE genSlicesFromLen #-}+genSlicesFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (MutArray a) (Int, Int)+genSlicesFromLen from len =+    let fromThenTo n = (from, from + len, n - 1)+        mkSlice n i = return (i, min len (n - i))+     in Unfold.lmap length+        $ Unfold.mapM2 mkSlice+        $ Unfold.lmap fromThenTo Unfold.enumerateFromThenTo++-- | Generate a stream of slices of specified length from an array, starting+-- from the supplied array index. The last slice may be shorter than the+-- requested length depending on the array length.+--+-- /Pre-release/+{-# INLINE getSlicesFromLen #-}+getSlicesFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (MutArray a) (MutArray a)+getSlicesFromLen from len =+    let mkSlice arr (i, n) = return $ getSliceUnsafe i n arr+     in Unfold.mapM2 mkSlice (genSlicesFromLen from len)++-- | Create an 'Array' from a stream. This is useful when we want to create a+-- single array from a stream of unknown size. 'writeN' is at least twice+-- as efficient when the size is already known.+--+-- Note that if the input stream is too large memory allocation for the array+-- may fail.  When the stream size is not known, `chunksOf` followed by+-- processing of indvidual arrays in the resulting stream should be preferred.+--+-- /Pre-release/+{-# INLINE fromStream #-}+fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+fromStream = fromStreamD+-- fromStream (Stream m) = P.fold write m
+ src/Streamly/Internal/Data/MutArray/Generic.hs view
@@ -0,0 +1,912 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module      : Streamly.Internal.Data.MutArray.Generic+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.MutArray.Generic+(+    -- * Type+    -- $arrayNotes+      MutArray (..)++    -- * Constructing and Writing+    -- ** Construction+    , nil++    -- *** Uninitialized Arrays+    , new+    -- , newArrayWith++    -- *** From streams+    , writeNUnsafe+    , writeN+    , writeWith+    , write+    , fromStreamN+    , fromStream+    , fromPureStream++    -- , writeRevN+    -- , writeRev++    -- ** From containers+    , fromListN+    , fromList++    -- * Random writes+    , putIndex+    , putIndexUnsafe+    , putIndices+    -- , putFromThenTo+    -- , putFrom -- start writing at the given position+    -- , putUpto -- write from beginning up to the given position+    -- , putFromTo+    -- , putFromRev+    -- , putUptoRev+    , modifyIndexUnsafe+    , modifyIndex+    -- , modifyIndices+    -- , modify+    -- , swapIndices++    -- * Growing and Shrinking+    -- Arrays grow only at the end, though it is possible to grow on both sides+    -- and therefore have a cons as well as snoc. But that will require two+    -- bounds in the array representation.++    -- ** Reallocation+    , realloc+    , uninit++    -- ** Appending elements+    , snocWith+    , snoc+    -- , snocLinear+    -- , snocMay+    , snocUnsafe++    -- ** Appending streams+    -- , writeAppendNUnsafe+    -- , writeAppendN+    -- , writeAppendWith+    -- , writeAppend++    -- ** Truncation+    -- These are not the same as slicing the array at the beginning, they may+    -- reduce the length as well as the capacity of the array.+    -- , truncateWith+    -- , truncate+    -- , truncateExp++    -- * Eliminating and Reading++    -- ** Unfolds+    , reader+    -- , readerRev+    , producerWith -- experimental+    , producer -- experimental++    -- ** To containers+    , read+    , readRev+    , toStreamK+    -- , toStreamKRev+    , toList++    -- ** Random reads+    , getIndex+    , getIndexUnsafe+    , getIndexUnsafeWith+    -- , getIndices+    -- , getFromThenTo+    -- , getIndexRev++    -- * Size+    , length++    -- * In-place Mutation Algorithms+    , strip+    -- , reverse+    -- , permute+    -- , partitionBy+    -- , shuffleBy+    -- , divideBy+    -- , mergeBy++    -- * Folding+    -- , foldl'+    -- , foldr+    , cmp+    , eq++    -- * Arrays of arrays+    --  We can add dimensionality parameter to the array type to get+    --  multidimensional arrays. Multidimensional arrays would just be a+    --  convenience wrapper on top of single dimensional arrays.++    -- | Operations dealing with multiple arrays, streams of arrays or+    -- multidimensional array representations.++    -- ** Construct from streams+    , chunksOf+    -- , arrayStreamKFromStreamD+    -- , writeChunks++    -- ** Eliminate to streams+    -- , flattenArrays+    -- , flattenArraysRev+    -- , fromArrayStreamK++    -- ** Construct from arrays+    -- get chunks without copying+    , getSliceUnsafe+    , getSlice+    -- , getSlicesFromLenN+    -- , splitAt -- XXX should be able to express using getSlice+    -- , breakOn++    -- ** Appending arrays+    -- , spliceCopy+    -- , spliceWith+    -- , splice+    -- , spliceExp+    , putSliceUnsafe+    -- , appendSlice+    -- , appendSliceFrom++    , clone+    )+where++#include "inline.hs"+#include "assert.hs"++import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import GHC.Base+    ( MutableArray#+    , RealWorld+    , copyMutableArray#+    , newArray#+    , readArray#+    , writeArray#+    )+import GHC.IO (IO(..))+import GHC.Int (Int(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Producer.Type (Producer (..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.SVar.Type (adaptState)++import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Generate as D+import qualified Streamly.Internal.Data.Stream.Lift as D+import qualified Streamly.Internal.Data.StreamK.Type as K++import Prelude hiding (read, length)++#include "DocTestDataMutArrayGeneric.hs"++-------------------------------------------------------------------------------+-- MutArray Data Type+-------------------------------------------------------------------------------++data MutArray a =+    MutArray+        { arrContents# :: MutableArray# RealWorld a+          -- ^ The internal contents of the array representing the entire array.++        , arrStart :: {-# UNPACK #-}!Int+          -- ^ The starting index of this slice.++        , arrLen :: {-# UNPACK #-}!Int+          -- ^ The length of this slice.++        , arrTrueLen :: {-# UNPACK #-}!Int+          -- ^ This is the true length of the array. Coincidentally, this also+          -- represents the first index beyond the maximum acceptable index of+          -- the array. This is specific to the array contents itself and not+          -- dependent on the slice. This value should not change and is shared+          -- across all the slices.+        }++{-# INLINE bottomElement #-}+bottomElement :: a+bottomElement =+    error+        $ unwords+              [ funcName+              , "This is the bottom element of the array."+              , "This is a place holder and should never be reached!"+              ]++    where++    funcName = "Streamly.Internal.Data.MutArray.Generic.bottomElement:"++-- XXX Would be nice if GHC can provide something like newUninitializedArray# so+-- that we do not have to write undefined or error in the whole array.++-- | @new count@ allocates a zero length array that can be extended to hold+-- up to 'count' items without reallocating.+--+-- /Pre-release/+{-# INLINE new #-}+new :: MonadIO m => Int -> m (MutArray a)+new n@(I# n#) =+    liftIO+        $ IO+        $ \s# ->+              case newArray# n# bottomElement s# of+                  (# s1#, arr# #) ->+                      let ma = MutArray arr# 0 0 n+                       in (# s1#, ma #)++-- XXX This could be pure?++-- |+-- Definition:+--+-- >>> nil = MutArray.new 0+{-# INLINE nil #-}+nil :: MonadIO m => m (MutArray a)+nil = new 0++-------------------------------------------------------------------------------+-- Random writes+-------------------------------------------------------------------------------++-- | Write the given element to the given index of the 'MutableArray#'. Does not+-- check if the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE putIndexUnsafeWith #-}+putIndexUnsafeWith :: MonadIO m => Int -> MutableArray# RealWorld a -> a -> m ()+putIndexUnsafeWith n _arrContents# x =+    liftIO+        $ IO+        $ \s# ->+              case n of+                  I# n# ->+                      let s1# = writeArray# _arrContents# n# x s#+                       in (# s1#, () #)++-- | Write the given element to the given index of the array. Does not check if+-- the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE putIndexUnsafe #-}+putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+putIndexUnsafe i MutArray {..} x =+    assert (i >= 0 && i < arrLen)+    putIndexUnsafeWith (i + arrStart) arrContents# x++invalidIndex :: String -> Int -> a+invalidIndex label i =+    error $ label ++ ": invalid array index " ++ show i++-- | /O(1)/ Write the given element at the given index in the array.+-- Performs in-place mutation of the array.+--+-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))+--+-- /Pre-release/+{-# INLINE putIndex #-}+putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()+putIndex i arr@MutArray {..} x =+    if i >= 0 && i < arrLen+    then putIndexUnsafe i arr x+    else invalidIndex "putIndex" i++-- | Write an input stream of (index, value) pairs to an array. Throws an+-- error if any index is out of bounds.+--+-- /Pre-release/+{-# INLINE putIndices #-}+putIndices :: MonadIO m+    => MutArray a -> Fold m (Int, a) ()+putIndices arr = FL.foldlM' step (return ())++    where++    step () (i, x) = liftIO (putIndex i arr x)++-- | Modify a given index of an array using a modifier function without checking+-- the bounds.+--+-- Unsafe because it does not check the bounds of the array.+--+-- /Pre-release/+modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndexUnsafe i MutArray {..} f = do+    liftIO+        $ IO+        $ \s# ->+              case i + arrStart of+                  I# n# ->+                      case readArray# arrContents# n# s# of+                          (# s1#, a #) ->+                              let (a1, b) = f a+                                  s2# = writeArray# arrContents# n# a1 s1#+                               in (# s2#, b #)++-- | Modify a given index of an array using a modifier function.+--+-- /Pre-release/+modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndex i arr@MutArray {..} f = do+    if i >= 0 && i < arrLen+    then modifyIndexUnsafe i arr f+    else invalidIndex "modifyIndex" i++-------------------------------------------------------------------------------+-- Resizing+-------------------------------------------------------------------------------++-- | Reallocates the array according to the new size. This is a safe function+-- that always creates a new array and copies the old array into the new one.+-- If the reallocated size is less than the original array it results in a+-- truncated version of the original array.+--+realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)+realloc n arr = do+    arr1 <- new n+    let !newLen@(I# newLen#) = min n (arrLen arr)+        !(I# arrS#) = arrStart arr+        !(I# arr1S#) = arrStart arr1+        arrC# = arrContents# arr+        arr1C# = arrContents# arr1+    liftIO+        $ IO+        $ \s# ->+              let s1# = copyMutableArray# arrC# arrS# arr1C# arr1S# newLen# s#+               in (# s1#, arr1 {arrLen = newLen, arrTrueLen = n} #)++reallocWith ::+       MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)+reallocWith label sizer reqSize arr = do+    let oldSize = arrLen arr+        newSize = sizer oldSize+        safeSize = max newSize (oldSize + reqSize)+    assert (newSize >= oldSize + reqSize || error badSize) (return ())+    realloc safeSize arr++    where++    badSize = concat+        [ label+        , ": new array size is less than required size "+        , show reqSize+        , ". Please check the sizing function passed."+        ]++-------------------------------------------------------------------------------+-- Snoc+-------------------------------------------------------------------------------++-- XXX Not sure of the behavior of writeArray# if we specify an index which is+-- out of bounds. This comment should be rewritten based on that.+-- | Really really unsafe, appends the element into the first array, may+-- cause silent data corruption or if you are lucky a segfault if the index+-- is out of bounds.+--+-- /Internal/+{-# INLINE snocUnsafe #-}+snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)+snocUnsafe arr@MutArray {..} a = do+    assert (arrStart + arrLen < arrTrueLen) (return ())+    let arr1 = arr {arrLen = arrLen + 1}+    putIndexUnsafe arrLen arr1 a+    return arr1++-- NOINLINE to move it out of the way and not pollute the instruction cache.+{-# NOINLINE snocWithRealloc #-}+snocWithRealloc :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+snocWithRealloc sizer arr x = do+    arr1 <- reallocWith "snocWithRealloc" sizer 1 arr+    snocUnsafe arr1 x++-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of+-- the array increases by 1.+--+-- If there is no reserved space available in @arr@ it is reallocated to a size+-- in bytes determined by the @sizer oldSize@ function, where @oldSize@ is the+-- original size of the array.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- /Pre-release/+{-# INLINE snocWith #-}+snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+snocWith sizer arr@MutArray {..} x = do+    if arrStart + arrLen < arrTrueLen+    then snocUnsafe arr x+    else snocWithRealloc sizer arr x++-- XXX round it to next power of 2.++-- | The array is mutated to append an additional element to it. If there is no+-- reserved space available in the array then it is reallocated to double the+-- original size.+--+-- This is useful to reduce allocations when appending unknown number of+-- elements.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- >>> snoc = MutArray.snocWith (* 2)+--+-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.+--+-- /Pre-release/+{-# INLINE snoc #-}+snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+snoc = snocWith (* 2)++-- | Make the uninitialized memory in the array available for use extending it+-- by the supplied length beyond the current length of the array. The array may+-- be reallocated.+--+{-# INLINE uninit #-}+uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)+uninit arr@MutArray{..} len =+    if arrStart + arrLen + len <= arrTrueLen+    then return $ arr {arrLen = arrLen + len}+    else realloc (arrLen + len) arr++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- | Return the element at the specified index without checking the bounds from+-- a @MutableArray# RealWorld@.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE getIndexUnsafeWith #-}+getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+getIndexUnsafeWith _arrContents# n =+    liftIO+        $ IO+        $ \s# ->+              let !(I# i#) = n+               in readArray# _arrContents# i# s#++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE_NORMAL getIndexUnsafe #-}+getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+getIndexUnsafe n MutArray {..} = getIndexUnsafeWith arrContents# (n + arrStart)++-- | /O(1)/ Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: MonadIO m => Int -> MutArray a -> m (Maybe a)+getIndex i arr@MutArray {..} =+    if i >= 0 && i < arrLen+    then Just <$> getIndexUnsafe i arr+    else return Nothing++-------------------------------------------------------------------------------+-- Subarrays+-------------------------------------------------------------------------------++-- XXX We can also get immutable slices.++-- | /O(1)/ Slice an array in constant time.+--+-- Unsafe: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE getSliceUnsafe #-}+getSliceUnsafe+    :: Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSliceUnsafe index len arr@MutArray {..} =+    assert (index >= 0 && len >= 0 && index + len <= arrLen)+        $ arr {arrStart = arrStart + index, arrLen = len}++-- | /O(1)/ Slice an array in constant time. Throws an error if the slice+-- extends out of the array bounds.+--+-- /Pre-release/+{-# INLINE getSlice #-}+getSlice+    :: Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSlice index len arr@MutArray{..} =+    if index >= 0 && len >= 0 && index + len <= arrLen+    then arr {arrStart = arrStart + index, arrLen = len}+    else error+             $ "getSlice: invalid slice, index "+             ++ show index ++ " length " ++ show len++-------------------------------------------------------------------------------+-- to Lists and streams+-------------------------------------------------------------------------------++-- XXX Maybe faster to create a list explicitly instead of mapM, if list fusion+-- does not work well.++-- | Convert an 'Array' into a list.+--+-- /Pre-release/+{-# INLINE toList #-}+toList :: MonadIO m => MutArray a -> m [a]+toList arr@MutArray{..} = mapM (`getIndexUnsafe` arr) [0 .. (arrLen - 1)]++-- | Generates a stream from the elements of a @MutArray@.+--+-- >>> read = Stream.unfold MutArray.reader+--+{-# INLINE_NORMAL read #-}+read :: MonadIO m => MutArray a -> D.Stream m a+read arr@MutArray{..} =+    D.mapM (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)++-- Check equivalence with StreamK.fromStream . toStreamD and remove+{-# INLINE toStreamK #-}+toStreamK :: MonadIO m => MutArray a -> K.StreamK m a+toStreamK arr@MutArray{..} = K.unfoldrM step 0++    where++    step i+        | i == arrLen = return Nothing+        | otherwise = do+            x <- getIndexUnsafe i arr+            return $ Just (x, i + 1)++{-# INLINE_NORMAL readRev #-}+readRev :: MonadIO m => MutArray a -> D.Stream m a+readRev arr@MutArray{..} =+    D.mapM (`getIndexUnsafe` arr)+        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- XXX deduplicate this across unboxed array and this module?++-- | The default chunk size by which the array creation routines increase the+-- size of the array when the array is grown linearly.+arrayChunkSize :: Int+arrayChunkSize = 1024++-- | Like 'writeN' but does not check the array bounds when writing. The fold+-- driver must not call the step function more than 'n' times otherwise it will+-- corrupt the memory and crash. This function exists mainly because any+-- conditional in the step function blocks fusion causing 10x performance+-- slowdown.+--+-- /Pre-release/+{-# INLINE_NORMAL writeNUnsafe #-}+writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+writeNUnsafe n = Fold step initial return return++    where++    initial = FL.Partial <$> new (max n 0)++    step arr x = FL.Partial <$> snocUnsafe arr x++-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an+-- 'Array'.+--+-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)+--+-- /Pre-release/+{-# INLINE_NORMAL writeN #-}+writeN :: MonadIO m => Int -> Fold m a (MutArray a)+writeN n = FL.take n $ writeNUnsafe n++-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.pinnedNew n)+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)++-- | @writeWith minCount@ folds the whole input to a single array. The array+-- starts at a size big enough to hold minCount elements, the size is doubled+-- every time the array needs to be grown.+--+-- /Caution! Do not use this on infinite streams./+--+-- /Pre-release/+{-# INLINE_NORMAL writeWith #-}+writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (pinnedNew n)+writeWith elemCount = FL.rmapM extract $ FL.foldlM' step initial++    where++    initial = do+        when (elemCount < 0) $ error "writeWith: elemCount is negative"+        liftIO $ new elemCount++    step arr@(MutArray _ start end bound) x+        | end == bound = do+        let oldSize = end - start+            newSize = max (oldSize * 2) 1+        arr1 <- liftIO $ realloc newSize arr+        snocUnsafe arr1 x+    step arr x = snocUnsafe arr x++    -- extract = liftIO . rightSize+    extract = return++-- | Fold the whole input to a single array.+--+-- Same as 'writeWith' using an initial array size of 'arrayChunkSize' bytes+-- rounded up to the element size.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE write #-}+write :: MonadIO m => Fold m a (MutArray a)+write = writeWith arrayChunkSize++-- | Create a 'MutArray' from the first @n@ elements of a stream. The+-- array is allocated to size @n@, if the stream terminates before @n@+-- elements then the array may hold less than @n@ elements.+--+{-# INLINE fromStreamN #-}+fromStreamN :: MonadIO m => Int -> Stream m a -> m (MutArray a)+fromStreamN n = D.fold (writeN n)++{-# INLINE fromStream #-}+fromStream :: MonadIO m => Stream m a -> m (MutArray a)+fromStream = D.fold write++{-# INLINABLE fromListN #-}+fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)+fromListN n xs = fromStreamN n $ D.fromList xs++{-# INLINABLE fromList #-}+fromList :: MonadIO m => [a] -> m (MutArray a)+fromList xs = fromStream $ D.fromList xs++{-# INLINABLE fromPureStream #-}+fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a)+fromPureStream xs =+    liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs++-------------------------------------------------------------------------------+-- Chunking+-------------------------------------------------------------------------------++data GroupState s a start end bound+    = GroupStart s+    | GroupBuffer s (MutableArray# RealWorld a) start end bound+    | GroupYield+          (MutableArray# RealWorld a)+          start+          end+          bound+          (GroupState s a start end bound)+    | GroupFinish++-- | @chunksOf n stream@ groups the input stream into a stream of+-- arrays of size n.+--+-- @chunksOf n = foldMany (MutArray.writeN n)@+--+-- /Pre-release/+{-# INLINE_NORMAL chunksOf #-}+chunksOf :: forall m a. MonadIO m+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- XXX the idiomatic implementation leads to large regression in the D.reverse'+-- benchmark. It seems it has difficulty producing optimized code when+-- converting to StreamK. Investigate GHC optimizations.+-- chunksOf n = D.foldMany (writeN n)+chunksOf n (D.Stream step state) =+    D.Stream step' (GroupStart state)++    where++    -- start is always 0+    -- end and len are always equal++    {-# INLINE_LATE step' #-}+    step' _ (GroupStart st) = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ "Streamly.Internal.Data.Array.Generic.Mut.Type.chunksOf: "+                    ++ "the size of arrays [" ++ show n+                    ++ "] must be a natural number"+        (MutArray contents start end bound :: MutArray a) <- new n+        return $ D.Skip (GroupBuffer st contents start end bound)++    step' gst (GroupBuffer st contents start end bound) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                putIndexUnsafeWith end contents x+                let end1 = end + 1+                return $+                    if end1 >= bound+                    then D.Skip+                            (GroupYield+                                contents start end1 bound (GroupStart s))+                    else D.Skip (GroupBuffer s contents start end1 bound)+            D.Skip s ->+                return $ D.Skip (GroupBuffer s contents start end bound)+            D.Stop ->+                return+                    $ D.Skip (GroupYield contents start end bound GroupFinish)++    step' _ (GroupYield contents start end bound next) =+         return $ D.Yield (MutArray contents start end bound) next++    step' _ GroupFinish = return D.Stop++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producerWith #-}+producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a+producerWith liftio = Producer step inject extract++    where++    {-# INLINE inject #-}+    inject arr = return (arr, 0)++    {-# INLINE extract #-}+    extract (arr, i) =+        return $ arr {arrStart = arrStart arr + i, arrLen = arrLen arr - i}++    {-# INLINE_LATE step #-}+    step (arr, i)+        | assert (arrLen arr >= 0) (i == arrLen arr) = return D.Stop+    step (arr, i) = do+        x <- liftio $ getIndexUnsafe i arr+        return $ D.Yield x (arr, i + 1)++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producer #-}+producer :: MonadIO m => Producer m (MutArray a) a+producer = producerWith liftIO++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: MonadIO m => Unfold m (MutArray a) a+reader = Producer.simplify producer++--------------------------------------------------------------------------------+-- Appending arrays+--------------------------------------------------------------------------------++-- | Put a sub range of a source array into a subrange of a destination array.+-- This is not safe as it does not check the bounds.+{-# INLINE putSliceUnsafe #-}+putSliceUnsafe :: MonadIO m =>+    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+putSliceUnsafe src srcStart dst dstStart len = liftIO $ do+    assertM(len <= arrLen dst)+    assertM(len <= arrLen src)+    let !(I# srcStart#) = srcStart + arrStart src+        !(I# dstStart#) = dstStart + arrStart dst+        !(I# len#) = len+    let arrS# = arrContents# src+        arrD# = arrContents# dst+    IO $ \s# -> (# copyMutableArray#+                    arrS# srcStart# arrD# dstStart# len# s#+                , () #)++{-# INLINE clone #-}+clone :: MonadIO m => MutArray a -> m (MutArray a)+clone src = liftIO $ do+    let len = arrLen src+    dst <- new len+    putSliceUnsafe src 0 dst 0 len+    return dst++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++{-# INLINE length #-}+length :: MutArray a -> Int+length = arrLen++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Compare the length of the arrays. If the length is equal, compare the+-- lexicographical ordering of two underlying byte arrays otherwise return the+-- result of length comparison.+--+-- /Pre-release/+{-# INLINE cmp #-}+cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering+cmp a1 a2 =+    case compare lenA1 lenA2 of+        EQ -> loop (lenA1 - 1)+        x -> return x++    where++    lenA1 = length a1+    lenA2 = length a2++    loop i+        | i < 0 = return EQ+        | otherwise = do+            v1 <- getIndexUnsafe i a1+            v2 <- getIndexUnsafe i a2+            case compare v1 v2 of+                EQ -> loop (i - 1)+                x -> return x++{-# INLINE eq #-}+eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool+eq a1 a2 =+    if lenA1 == lenA2+    then loop (lenA1 - 1)+    else return False++    where++    lenA1 = length a1+    lenA2 = length a2++    loop i+        | i < 0 = return True+        | otherwise = do+            v1 <- getIndexUnsafe i a1+            v2 <- getIndexUnsafe i a2+            if v1 == v2+            then loop (i - 1)+            else return False++{-# INLINE strip #-}+strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+strip p arr = liftIO $ do+    let lastIndex = length arr - 1+    indexR <- getIndexR lastIndex -- last predicate failing index+    if indexR < 0+    then nil+    else do+        indexL <- getIndexL 0 -- first predicate failing index+        if indexL == 0 && indexR == lastIndex+        then return arr+        else+           let newLen = indexR - indexL + 1+            in return $ getSliceUnsafe indexL newLen arr++    where++    getIndexR idx+        | idx < 0 = return idx+        | otherwise = do+            r <- getIndexUnsafe idx arr+            if p r+            then getIndexR (idx - 1)+            else return idx++    getIndexL idx = do+        r <- getIndexUnsafe idx arr+        if p r+        then getIndexL (idx + 1)+        else return idx
+ src/Streamly/Internal/Data/MutArray/Stream.hs view
@@ -0,0 +1,329 @@+-- |+-- Module      : Streamly.Internal.Data.MutArray.Stream+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Combinators to efficiently manipulate streams of mutable arrays.+--+-- We can either push these in the MutArray module with a "chunks" prefix or+-- keep this as a separate module and release it.+--+module Streamly.Internal.Data.MutArray.Stream+    (+    -- * Generation+      MArray.chunksOf+    , MArray.pinnedChunksOf+    , MArray.writeChunks -- chunksWrite?+    , MArray.splitOn -- chunksSplitOn++    -- * Compaction+    , packArraysChunksOf+    , SpliceState (..)+    , lpackArraysChunksOf+    , compact -- chunksCompact+    , compactLE+    , compactEQ+    , compactGE++    -- * Elimination+    , MArray.flattenArrays -- chunksConcat+    , MArray.flattenArraysRev -- chunksConcatRev+    , MArray.fromArrayStreamK -- chunksCoalesce+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad (when)+import Data.Bifunctor (first)+import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.Unbox (Unbox, sizeOf)+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Parser (ParseError)+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))++import qualified Streamly.Internal.Data.MutArray as MArray+import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Parser as ParserD+import qualified Streamly.Internal.Data.Stream as D++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++data SpliceState s arr+    = SpliceInitial s+    | SpliceBuffering s arr+    | SpliceYielding arr (SpliceState s arr)+    | SpliceFinish++-- XXX This can be removed once compactLEFold/compactLE are implemented.+--+-- | This mutates the first array (if it has space) to append values from the+-- second one. This would work for immutable arrays as well because an+-- immutable array never has space so a new array is allocated instead of+-- mutating it.+--+-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size. Note that if a single array is bigger than the+-- specified size we do not split it to fit. When we coalesce multiple arrays+-- if the size would exceed the specified size we do not coalesce therefore the+-- actual array size may be less than the specified chunk size.+--+-- @since 0.7.0+{-# INLINE_NORMAL packArraysChunksOf #-}+packArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)+packArraysChunksOf n (D.Stream step state) =+    D.Stream step' (SpliceInitial state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (SpliceInitial st) = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ "Streamly.Internal.Data.MutArray.Type.packArraysChunksOf: the size of "+                 ++ "arrays [" ++ show n ++ "] must be a natural number"+        r <- step gst st+        case r of+            D.Yield arr s -> return $+                let len = MArray.byteLength arr+                 in if len >= n+                    then D.Skip (SpliceYielding arr (SpliceInitial s))+                    else D.Skip (SpliceBuffering s arr)+            D.Skip s -> return $ D.Skip (SpliceInitial s)+            D.Stop -> return D.Stop++    step' gst (SpliceBuffering st buf) = do+        r <- step gst st+        case r of+            D.Yield arr s -> do+                let len = MArray.byteLength buf + MArray.byteLength arr+                if len > n+                then return $+                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))+                else do+                    buf' <- if MArray.byteCapacity buf < n+                            then liftIO $ MArray.realloc n buf+                            else return buf+                    buf'' <- MArray.splice buf' arr+                    return $ D.Skip (SpliceBuffering s buf'')+            D.Skip s -> return $ D.Skip (SpliceBuffering s buf)+            D.Stop -> return $ D.Skip (SpliceYielding buf SpliceFinish)++    step' _ SpliceFinish = return D.Stop++    step' _ (SpliceYielding arr next) = return $ D.Yield arr next++-- XXX Remove this once compactLEFold is implemented+-- lpackArraysChunksOf = Fold.many compactLEFold+--+{-# INLINE_NORMAL lpackArraysChunksOf #-}+lpackArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+lpackArraysChunksOf n (Fold step1 initial1 _ final1) =+    Fold step initial extract final++    where++    initial = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ "Streamly.Internal.Data.MutArray.Type.packArraysChunksOf: the size of "+                 ++ "arrays [" ++ show n ++ "] must be a natural number"++        r <- initial1+        return $ first (Tuple' Nothing) r++    step (Tuple' Nothing r1) arr =+            let len = MArray.byteLength arr+             in if len >= n+                then do+                    r <- step1 r1 arr+                    case r of+                        FL.Done _ -> return $ FL.Done ()+                        FL.Partial s -> do+                            _ <- final1 s+                            res <- initial1+                            return $ first (Tuple' Nothing) res+                else return $ FL.Partial $ Tuple' (Just arr) r1++    step (Tuple' (Just buf) r1) arr = do+            let len = MArray.byteLength buf + MArray.byteLength arr+            buf' <- if MArray.byteCapacity buf < len+                    then liftIO $ MArray.realloc (max n len) buf+                    else return buf+            buf'' <- MArray.splice buf' arr++            -- XXX this is common in both the equations of step+            if len >= n+            then do+                r <- step1 r1 buf''+                case r of+                    FL.Done _ -> return $ FL.Done ()+                    FL.Partial s -> do+                        _ <- final1 s+                        res <- initial1+                        return $ first (Tuple' Nothing) res+            else return $ FL.Partial $ Tuple' (Just buf'') r1++    -- XXX Several folds do extract >=> final, therefore, we need to make final+    -- return  "m b" rather than using extract post it if we want extract to be+    -- partial.+    --+    -- extract forces the pending buffer to be sent to the fold which is not+    -- what we want.+    extract _ = error "lpackArraysChunksOf: not designed for scanning"++    final (Tuple' Nothing r1) = final1 r1+    final (Tuple' (Just buf) r1) = do+        r <- step1 r1 buf+        case r of+            FL.Partial rr -> final1 rr+            FL.Done _ -> return ()++-- XXX Same as compactLE, to be removed once that is implemented.+--+-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size in bytes.+--+-- /Internal/+{-# INLINE compact #-}+compact :: (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compact = packArraysChunksOf++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size. Note that if a single array is bigger than the+-- specified size we do not split it to fit. When we coalesce multiple arrays+-- if the size would exceed the specified size we do not coalesce therefore the+-- actual array size may be less than the specified chunk size.+--+-- /Internal/+{-# INLINE_NORMAL compactLEParserD #-}+compactLEParserD ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> ParserD.Parser (MutArray a) m (MutArray a)+compactLEParserD n = ParserD.Parser step initial extract++    where++    nBytes = n * SIZE_OF(a)++    initial =+        return+            $ if n <= 0+              then error+                       $ functionPath+                       ++ ": the size of arrays ["+                       ++ show n ++ "] must be a natural number"+              else ParserD.IPartial Nothing++    step Nothing arr =+        return+            $ let len = MArray.byteLength arr+               in if len >= nBytes+                  then ParserD.Done 0 arr+                  else ParserD.Partial 0 (Just arr)+    step (Just buf) arr =+        let len = MArray.byteLength buf + MArray.byteLength arr+         in if len > nBytes+            then return $ ParserD.Done 1 buf+            else do+                buf1 <-+                    if MArray.byteCapacity buf < nBytes+                    then liftIO $ MArray.realloc nBytes buf+                    else return buf+                buf2 <- MArray.splice buf1 arr+                return $ ParserD.Partial 0 (Just buf2)++    extract Nothing = return $ ParserD.Done 0 MArray.nil+    extract (Just buf) = return $ ParserD.Done 0 buf++    functionPath =+        "Streamly.Internal.Data.Stream.MutChunked.compactLEParserD"++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- minimum specified size. Note that if all the arrays in the stream together+-- are smaller than the specified size the resulting array will be smaller than+-- the specified size. When we coalesce multiple arrays if the size would exceed+-- the specified size we stop coalescing further.+--+-- /Internal/+{-# INLINE_NORMAL compactGEFold #-}+compactGEFold ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> FL.Fold m (MutArray a) (MutArray a)+compactGEFold n = Fold step initial extract extract++    where++    nBytes = n * SIZE_OF(a)++    initial =+        return+            $ if n < 0+              then error+                       $ functionPath+                       ++ ": the size of arrays ["+                       ++ show n ++ "] must be a natural number"+              else FL.Partial Nothing++    step Nothing arr =+        return+            $ let len = MArray.byteLength arr+               in if len >= nBytes+                  then FL.Done arr+                  else FL.Partial (Just arr)+    step (Just buf) arr = do+        let len = MArray.byteLength buf + MArray.byteLength arr+        buf1 <-+            if MArray.byteCapacity buf < len+            then liftIO $ MArray.realloc (max len nBytes) buf+            else return buf+        buf2 <- MArray.splice buf1 arr+        if len >= n+        then return $ FL.Done buf2+        else return $ FL.Partial (Just buf2)++    extract Nothing = return MArray.nil+    extract (Just buf) = return buf++    functionPath =+        "Streamly.Internal.Data.Stream.MutChunked.compactGEFold"++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size in bytes.+--+-- /Internal/+compactLE :: (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (Either ParseError (MutArray a))+compactLE n = D.parseManyD (compactLEParserD n)++-- | Like 'compactLE' but generates arrays of exactly equal to the size+-- specified except for the last array in the stream which could be shorter.+--+-- /Unimplemented/+{-# INLINE compactEQ #-}+compactEQ :: -- (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactEQ _n _xs = undefined+    -- IsStream.fromStreamD $ D.foldMany (compactEQFold n) (IsStream.toStreamD xs)++-- | Like 'compactLE' but generates arrays of size greater than or equal to the+-- specified except for the last array in the stream which could be shorter.+--+-- /Internal/+{-# INLINE compactGE #-}+compactGE ::+       (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactGE n = D.foldMany (compactGEFold n)
+ src/Streamly/Internal/Data/MutArray/Type.hs view
@@ -0,0 +1,2479 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module      : Streamly.Internal.Data.MutArray.Type+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Pinned and unpinned mutable array for 'Unboxed' types. Fulfils the following+-- goals:+--+-- * Random access (array)+-- * Efficient storage (unboxed)+-- * Performance (unboxed access)+-- * Performance - in-place operations (mutable)+-- * Performance - GC (pinned, mutable)+-- * interfacing with OS (pinned)+--+-- Stream and Fold APIs allow easy, efficient and convenient operations on+-- arrays.+--+-- Mutable arrays and file system files are quite similar, they can grow and+-- their content is mutable. Therefore, both have similar APIs as well. We+-- strive to keep the API consistent for both. Ideally, you should be able to+-- replace one with another with little changes to the code.++module Streamly.Internal.Data.MutArray.Type+    (+    -- ** Type+    -- $arrayNotes+      MutArray (..)+    , MutByteArray+    , MutableByteArray+    , pin+    , unpin+    , isPinned++    -- -- * Constructing and Writing+    -- ** Construction+    , nil++    -- *** Uninitialized Arrays+    , pinnedNew+    , pinnedNewBytes+    , pinnedNewAligned+    , new+    , newArrayWith++    -- *** From streams+    , ArrayUnsafe (..)+    , writeNWithUnsafe+    , writeNWith+    , writeNUnsafe+    , pinnedWriteNUnsafe+    , writeN+    , pinnedWriteN+    , pinnedWriteNAligned++    , writeWith+    , write+    , pinnedWrite++    , writeRevN+    -- , writeRev++    -- *** From containers+    , fromListN+    , pinnedFromListN+    , fromList+    , pinnedFromList+    , fromListRevN+    , fromListRev+    , fromStreamDN+    , fromStreamD+    , fromPureStream++    -- ** Random writes+    , putIndex+    , putIndexUnsafe+    , putIndices+    -- , putFromThenTo+    -- , putFrom -- start writing at the given position+    -- , putUpto -- write from beginning up to the given position+    -- , putFromTo+    -- , putFromRev+    -- , putUptoRev+    , modifyIndexUnsafe+    , modifyIndex+    , modifyIndices+    , modify+    , swapIndices+    , unsafeSwapIndices++    -- ** Growing and Shrinking+    -- | Arrays grow only at the end, though it is possible to grow on both sides+    -- and therefore have a cons as well as snoc. But that will require two+    -- bounds in the array representation.++    -- *** Appending elements+    , snocWith+    , snoc+    , snocLinear+    , snocMay+    , snocUnsafe++    -- *** Appending streams+    , writeAppendNUnsafe+    , writeAppendN+    , writeAppendWith+    , writeAppend++    -- ** Eliminating and Reading++    -- *** To streams+    , reader+    , readerRevWith+    , readerRev++    -- *** To containers+    , toStreamDWith+    , toStreamDRevWith+    , toStreamKWith+    , toStreamKRevWith+    , read+    , readRev+    , toStreamK+    , toStreamKRev+    , toList++    -- experimental+    , producerWith+    , producer++    -- *** Random reads+    , getIndex+    , getIndexUnsafe+    , getIndices+    , getIndicesD+    -- , getFromThenTo+    , getIndexRev++    -- ** Memory Management+    , blockSize+    , arrayChunkBytes+    , allocBytesToElemCount+    , realloc+    , resize+    , resizeExp+    , rightSize++    -- ** Size+    , length+    , byteLength+    -- , capacity+    , byteCapacity+    , bytesFree++    -- ** In-place Mutation Algorithms+    , strip+    , reverse+    , permute+    , partitionBy+    , shuffleBy+    , divideBy+    , mergeBy+    , bubble++    -- ** Casting+    , cast+    , castUnsafe+    , asBytes+    , asPtrUnsafe++    -- ** Folding+    , foldl'+    , foldr+    , cmp++    -- ** Arrays of arrays+    --  We can add dimensionality parameter to the array type to get+    --  multidimensional arrays. Multidimensional arrays would just be a+    --  convenience wrapper on top of single dimensional arrays.++    -- | Operations dealing with multiple arrays, streams of arrays or+    -- multidimensional array representations.++    -- *** Construct from streams+    , chunksOf+    , pinnedChunksOf+    , writeChunks++    -- *** Eliminate to streams+    , flattenArrays+    , flattenArraysRev+    , fromArrayStreamK++    -- *** Construct from arrays+    -- get chunks without copying+    , getSliceUnsafe+    , getSlice+    -- , getSlicesFromLenN+    , splitAt -- XXX should be able to express using getSlice+    , breakOn++    -- ** Cloning arrays+    , clone+    , pinnedClone++    -- ** Appending arrays+    , spliceCopy+    , spliceWith+    , splice+    , spliceExp+    , spliceUnsafe+    -- , putSlice+    -- , appendSlice+    -- , appendSliceFrom++    -- ** Utilities+    , roundUpToPower2+    , memcpy+    , memcmp+    , c_memchr+    )+where++#include "assert.hs"+#include "inline.hs"+#include "ArrayMacros.h"+#include "MachDeps.h"++import Control.Monad (when, void)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bits (shiftR, (.|.), (.&.))+import Data.Functor.Identity (Identity(..))+import Data.Proxy (Proxy(..))+import Data.Word (Word8)+import Foreign.C.Types (CSize(..), CInt(..))+import Foreign.Ptr (plusPtr, minusPtr, nullPtr)+import Streamly.Internal.Data.MutByteArray.Type+    ( MutByteArray(..)+    , MutableByteArray+    , PinnedState(..)+    , getMutableByteArray#+    , putSliceUnsafe+    )+import Streamly.Internal.Data.Unbox (Unbox(..))+import GHC.Base+    ( IO(..)+    , Int(..)+    , compareByteArrays#+    , copyMutableByteArray#+    )+import GHC.Base (noinline)+import GHC.Exts (unsafeCoerce#)+import GHC.Ptr (Ptr(..))++import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Producer.Type (Producer (..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.StreamK.Type (StreamK)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)++import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Lift as D+import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Prelude++import Prelude hiding+    (Foldable(..), read, unlines, splitAt, reverse, truncate)++#include "DocTestDataMutArray.hs"++-------------------------------------------------------------------------------+-- Foreign helpers+-------------------------------------------------------------------------------++foreign import ccall unsafe "string.h memcpy" c_memcpy+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)++foreign import ccall unsafe "string.h memchr" c_memchr+    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)++foreign import ccall unsafe "string.h memcmp" c_memcmp+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt++-- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return+-- how many elements of that type will completely fit in those bytes.+--+{-# INLINE bytesToElemCount #-}+bytesToElemCount :: forall a. Unbox a => a -> Int -> Int+bytesToElemCount _ n = n `div` SIZE_OF(a)++-- XXX we are converting Int to CSize+memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+memcpy dst src len = void (c_memcpy dst src (fromIntegral len))++-- XXX we are converting Int to CSize+-- return True if the memory locations have identical contents+{-# INLINE memcmp #-}+memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool+memcmp p1 p2 len = do+    r <- c_memcmp p1 p2 (fromIntegral len)+    return $ r == 0++-------------------------------------------------------------------------------+-- MutArray Data Type+-------------------------------------------------------------------------------++-- $arrayNotes+--+-- We can use an 'Unboxed' constraint in the MutArray type and the constraint+-- can be automatically provided to a function that pattern matches on the+-- MutArray type. However, it has huge performance cost, so we do not use it.+-- Investigate a GHC improvement possiblity.++-- | An unboxed mutable array. An array is created with a given length+-- and capacity. Length is the number of valid elements in the array.  Capacity+-- is the maximum number of elements that the array can be expanded to without+-- having to reallocate the memory.+--+-- The elements in the array can be mutated in-place without changing the+-- reference (constructor). However, the length of the array cannot be mutated+-- in-place.  A new array reference is generated when the length changes.  When+-- the length is increased (upto the maximum reserved capacity of the array),+-- the array is not reallocated and the new reference uses the same underlying+-- memory as the old one.+--+-- Several routines in this module allow the programmer to control the capacity+-- of the array. The programmer can control the trade-off between memory usage+-- and performance impact due to reallocations when growing or shrinking the+-- array.+--+data MutArray a =+#ifdef DEVBUILD+    Unbox a =>+#endif+    -- The array is a range into arrContents. arrContents may be a superset of+    -- the slice represented by the array. All offsets are in bytes.+    MutArray+    { arrContents :: {-# UNPACK #-} !MutByteArray+    , arrStart :: {-# UNPACK #-} !Int  -- ^ index into arrContents+    , arrEnd   :: {-# UNPACK #-} !Int    -- ^ index into arrContents+                                       -- Represents the first invalid index of+                                       -- the array.+    , arrBound :: {-# UNPACK #-} !Int    -- ^ first invalid index of arrContents.+    }++-------------------------------------------------------------------------------+-- Pinning & Unpinning+-------------------------------------------------------------------------------++-- | Return a copy of the array in pinned memory if unpinned, else return the+-- original array.+{-# INLINE pin #-}+pin :: MutArray a -> IO (MutArray a)+pin arr@MutArray{..} =+    if Unboxed.isPinned arrContents+    then pure arr+    else pinnedClone arr++-- | Return a copy of the array in unpinned memory if pinned, else return the+-- original array.+{-# INLINE unpin #-}+unpin :: MutArray a -> IO (MutArray a)+unpin arr@MutArray{..} =+    if Unboxed.isPinned arrContents+    then clone arr+    else pure arr++-- | Return 'True' if the array is allocated in pinned memory.+{-# INLINE isPinned #-}+isPinned :: MutArray a -> Bool+isPinned MutArray{..} = Unboxed.isPinned arrContents++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- XXX Change the names to use "new" instead of "newArray". That way we can use+-- the same names for managed file system objects as well. For unmanaged ones+-- we can use open/create etc as usual.+--+-- A new array is similar to "touch" creating a zero length file. An mmapped+-- array would be similar to a sparse file with holes. TBD: support mmapped+-- files and arrays.++-- GHC always guarantees word-aligned memory, alignment is important only when+-- we need more than that.  See stg_pinnedNewAlignedByteArrayzh and+-- allocatePinned in GHC source.++-- | @newArrayWith allocator alignment count@ allocates a new array of zero+-- length and with a capacity to hold @count@ elements, using @allocator+-- size alignment@ as the memory allocator function.+--+-- Alignment must be greater than or equal to machine word size and a power of+-- 2.+--+-- Alignment is ignored if the allocator allocates unpinned memory.+--+-- /Pre-release/+{-# INLINE newArrayWith #-}+newArrayWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)+newArrayWith alloc alignSize count = do+    let size = max (count * SIZE_OF(a)) 0+    contents <- alloc size alignSize+    return $ MutArray+        { arrContents = contents+        , arrStart = 0+        , arrEnd   = 0+        , arrBound = size+        }++nil ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a+nil = MutArray Unboxed.nil 0 0 0++{-# INLINE newBytesAs #-}+newBytesAs :: MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    PinnedState -> Int -> m (MutArray a)+newBytesAs ps bytes = do+    contents <- liftIO $ Unboxed.newBytesAs ps bytes+    return $ MutArray+        { arrContents = contents+        , arrStart = 0+        , arrEnd   = 0+        , arrBound = bytes+        }++-- | Allocates a pinned empty array that can hold 'count' items.  The memory of+-- the array is uninitialized and the allocation is aligned as per the+-- 'Unboxed' instance of the type.+--+-- /Pre-release/+{-# INLINE pinnedNewBytes #-}+pinnedNewBytes :: MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    Int -> m (MutArray a)+pinnedNewBytes = newBytesAs Pinned++-- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and+-- the alignment is dictated by the 'Unboxed' instance of the type.+--+-- /Internal/+{-# INLINE pinnedNewAligned #-}+pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)+pinnedNewAligned =+    newArrayWith (\s a -> liftIO $ Unboxed.pinnedNewAlignedBytes s a)++{-# INLINE newAs #-}+newAs :: (MonadIO m, Unbox a) => PinnedState -> Int -> m (MutArray a)+newAs ps =+    newArrayWith+        (\s _ -> liftIO $ Unboxed.newBytesAs ps s)+        (error "new: alignment is not used in unpinned arrays.")++-- XXX can unaligned allocation be more efficient when alignment is not needed?+--+-- | Allocates an empty pinned array that can hold 'count' items.  The memory of+-- the array is uninitialized and the allocation is aligned as per the 'Unboxed'+-- instance of the type.+--+{-# INLINE pinnedNew #-}+pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+pinnedNew = newAs Pinned++-- | Allocates an empty unpinned array that can hold 'count' items.  The memory+-- of the array is uninitialized.+--+{-# INLINE new #-}+new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+new = newAs Unpinned++-------------------------------------------------------------------------------+-- Random writes+-------------------------------------------------------------------------------++-- | Write the given element to the given index of the array. Does not check if+-- the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE putIndexUnsafe #-}+putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> MutArray a -> a -> m ()+putIndexUnsafe i MutArray{..} x = do+    let index = INDEX_OF(arrStart, i, a)+    assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())+    liftIO $ pokeAt index arrContents  x++invalidIndex :: String -> Int -> a+invalidIndex label i =+    error $ label ++ ": invalid array index " ++ show i++-- | /O(1)/ Write the given element at the given index in the array.+-- Performs in-place mutation of the array.+--+-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))+-- >>> f = MutArray.putIndices+-- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))+--+{-# INLINE putIndex #-}+putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+putIndex i MutArray{..} x = do+    let index = INDEX_OF(arrStart,i,a)+    if i >= 0 && INDEX_VALID(index,arrEnd,a)+    then liftIO $ pokeAt index arrContents  x+    else invalidIndex "putIndex" i++-- | Write an input stream of (index, value) pairs to an array. Throws an+-- error if any index is out of bounds.+--+-- /Pre-release/+{-# INLINE putIndices #-}+putIndices :: forall m a. (MonadIO m, Unbox a)+    => MutArray a -> Fold m (Int, a) ()+putIndices arr = FL.foldlM' step (return ())++    where++    step () (i, x) = liftIO (putIndex i arr x)++-- | Modify a given index of an array using a modifier function.+--+-- Unsafe because it does not check the bounds of the array.+--+-- /Pre-release/+modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndexUnsafe i MutArray{..} f = liftIO $ do+        let index = INDEX_OF(arrStart,i,a)+        assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())+        r <- peekAt index arrContents+        let (x, res) = f r+        pokeAt index arrContents  x+        return res++-- | Modify a given index of an array using a modifier function.+--+-- /Pre-release/+modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndex i MutArray{..} f = do+    let index = INDEX_OF(arrStart,i,a)+    if i >= 0 && INDEX_VALID(index,arrEnd,a)+    then liftIO $ do+        r <- peekAt index arrContents+        let (x, res) = f r+        pokeAt index arrContents  x+        return res+    else invalidIndex "modifyIndex" i++-- | Modify the array indices generated by the supplied stream.+--+-- /Pre-release/+{-# INLINE modifyIndices #-}+modifyIndices :: forall m a . (MonadIO m, Unbox a)+    => MutArray a -> (Int -> a -> a) -> Fold m Int ()+modifyIndices arr f = FL.foldlM' step initial++    where++    initial = return ()++    step () i =+        let f1 x = (f i x, ())+         in modifyIndex i arr f1++-- | Modify each element of an array using the supplied modifier function.+--+-- This is an in-place equivalent of an immutable map operation.+--+-- /Pre-release/+modify :: forall m a. (MonadIO m, Unbox a)+    => MutArray a -> (a -> a) -> m ()+modify MutArray{..} f = liftIO $+    go arrStart++    where++    go i =+        when (INDEX_VALID(i,arrEnd,a)) $ do+            r <- peekAt i arrContents+            pokeAt i arrContents (f r)+            go (INDEX_NEXT(i,a))++-- XXX We could specify the number of bytes to swap instead of Proxy. Need+-- to ensure that the memory does not overlap.+{-# INLINE swapArrayByteIndices #-}+swapArrayByteIndices ::+       forall a. Unbox a+    => Proxy a+    -> MutByteArray+    -> Int+    -> Int+    -> IO ()+swapArrayByteIndices _ arrContents i1 i2 = do+    r1 <- peekAt i1 arrContents+    r2 <- peekAt i2 arrContents+    pokeAt i1 arrContents (r2 :: a)+    pokeAt i2 arrContents (r1 :: a)++-- | Swap the elements at two indices without validating the indices.+--+-- /Unsafe/: This could result in memory corruption if indices are not valid.+--+-- /Pre-release/+{-# INLINE unsafeSwapIndices #-}+unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> MutArray a -> m ()+unsafeSwapIndices i1 i2 MutArray{..} = liftIO $ do+        let t1 = INDEX_OF(arrStart,i1,a)+            t2 = INDEX_OF(arrStart,i2,a)+        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2++-- | Swap the elements at two indices.+--+-- /Pre-release/+swapIndices :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> MutArray a -> m ()+swapIndices i1 i2 MutArray{..} = liftIO $ do+        let t1 = INDEX_OF(arrStart,i1,a)+            t2 = INDEX_OF(arrStart,i2,a)+        when (i1 < 0 || INDEX_INVALID(t1,arrEnd,a))+            $ invalidIndex "swapIndices" i1+        when (i2 < 0 || INDEX_INVALID(t2,arrEnd,a))+            $ invalidIndex "swapIndices" i2+        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2++-------------------------------------------------------------------------------+-- Rounding+-------------------------------------------------------------------------------++-- XXX Should we use bitshifts in calculations or it gets optimized by the+-- compiler/processor itself?+--+-- | The page or block size used by the GHC allocator. Allocator allocates at+-- least a block and then allocates smaller allocations from within a block.+blockSize :: Int+blockSize = 4 * 1024++-- | Allocations larger than 'largeObjectThreshold' are in multiples of block+-- size and are always pinned. The space beyond the end of a large object up to+-- the end of the block is unused.+largeObjectThreshold :: Int+largeObjectThreshold = (blockSize * 8) `div` 10++-- XXX Should be done only when we are using the GHC allocator.+-- | Round up an array larger than 'largeObjectThreshold' to use the whole+-- block.+{-# INLINE roundUpLargeArray #-}+roundUpLargeArray :: Int -> Int+roundUpLargeArray size =+    if size >= largeObjectThreshold+    then+        assert+            (blockSize /= 0 && ((blockSize .&. (blockSize - 1)) == 0))+            ((size + blockSize - 1) .&. negate blockSize)+    else size++{-# INLINE isPower2 #-}+isPower2 :: Int -> Bool+isPower2 n = n .&. (n - 1) == 0++{-# INLINE roundUpToPower2 #-}+roundUpToPower2 :: Int -> Int+roundUpToPower2 n =+#if WORD_SIZE_IN_BITS == 64+    1 + z6+#else+    1 + z5+#endif++    where++    z0 = n - 1+    z1 = z0 .|. z0 `shiftR` 1+    z2 = z1 .|. z1 `shiftR` 2+    z3 = z2 .|. z2 `shiftR` 4+    z4 = z3 .|. z3 `shiftR` 8+    z5 = z4 .|. z4 `shiftR` 16+    z6 = z5 .|. z5 `shiftR` 32++-- | @allocBytesToBytes elem allocatedBytes@ returns the array size in bytes+-- such that the real allocation is less than or equal to @allocatedBytes@,+-- unless @allocatedBytes@ is less than the size of one array element in which+-- case it returns one element's size.+--+{-# INLINE allocBytesToBytes #-}+allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int+allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))++-- | Given an 'Unboxed' type (unused first arg) and real allocation size+-- (including overhead), return how many elements of that type will completely+-- fit in it, returns at least 1.+--+{-# INLINE allocBytesToElemCount #-}+allocBytesToElemCount :: Unbox a => a -> Int -> Int+allocBytesToElemCount x bytes =+    let n = bytesToElemCount x (allocBytesToBytes x bytes)+     in assert (n >= 1) n++-- | The default chunk size by which the array creation routines increase the+-- size of the array when the array is grown linearly.+arrayChunkBytes :: Int+arrayChunkBytes = 1024++-------------------------------------------------------------------------------+-- Resizing+-------------------------------------------------------------------------------++-- | Round the second argument down to multiples of the first argument.+{-# INLINE roundDownTo #-}+roundDownTo :: Int -> Int -> Int+roundDownTo elemSize size = size - (size `mod` elemSize)++-- XXX See if resizing can be implemented by reading the old array as a stream+-- and then using writeN to the new array.+--+-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.+-- Since this is not inlined Unboxed consrraint leads to dictionary passing+-- which complicates some inspection tests.+--+{-# NOINLINE reallocExplicit #-}+reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)+reallocExplicit elemSize newCapacityInBytes MutArray{..} = do+    assertM(arrEnd <= arrBound)++    -- Allocate new array+    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes+    contents <-+        if Unboxed.isPinned arrContents+        then Unboxed.pinnedNew newCapMaxInBytes+        else Unboxed.new newCapMaxInBytes+    let !(MutByteArray mbarrFrom#) = arrContents+        !(MutByteArray mbarrTo#) = contents++    -- Copy old data+    let oldStart = arrStart+        !(I# oldStartInBytes#) = oldStart+        oldSizeInBytes = arrEnd - oldStart+        newCapInBytes = roundDownTo elemSize newCapMaxInBytes+        !newLenInBytes@(I# newLenInBytes#) = min oldSizeInBytes newCapInBytes+    assert (oldSizeInBytes `mod` elemSize == 0) (return ())+    assert (newLenInBytes >= 0) (return ())+    assert (newLenInBytes `mod` elemSize == 0) (return ())+    IO $ \s# -> (# copyMutableByteArray# mbarrFrom# oldStartInBytes#+                        mbarrTo# 0# newLenInBytes# s#, () #)++    return $ MutArray+        { arrStart = 0+        , arrContents = contents+        , arrEnd   = newLenInBytes+        , arrBound = newCapInBytes+        }++-- | @realloc newCapacity array@ reallocates the array to the specified+-- capacity in bytes.+--+-- If the new size is less than the original array the array gets truncated.+-- If the new size is not a multiple of array element size then it is rounded+-- down to multiples of array size.  If the new size is more than+-- 'largeObjectThreshold' then it is rounded up to the block size (4K).+--+-- If the original array is pinned, the newly allocated array is also pinned.+{-# INLINABLE realloc #-}+realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr++-- | @reallocWith label capSizer minIncrBytes array@. The label is used+-- in error messages and the capSizer is used to determine the capacity of the+-- new array in bytes given the current byte length of the array.+reallocWith :: forall m a. (MonadIO m , Unbox a) =>+       String+    -> (Int -> Int)+    -> Int+    -> MutArray a+    -> m (MutArray a)+reallocWith label capSizer minIncrBytes arr = do+    let oldSizeBytes = arrEnd arr - arrStart arr+        newCapBytes = capSizer oldSizeBytes+        newSizeBytes = oldSizeBytes + minIncrBytes+        safeCapBytes = max newCapBytes newSizeBytes+    assertM(safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))++    realloc safeCapBytes arr++    where++    badSize newSize =+        concat+            [ label+            , ": new array size (in bytes) is less than required size "+            , show newSize+            , ". Please check the sizing function passed."+            ]++-- | @resize newCapacity array@ changes the total capacity of the array so that+-- it is enough to hold the specified number of elements.  Nothing is done if+-- the specified capacity is less than the length of the array.+--+-- If the capacity is more than 'largeObjectThreshold' then it is rounded up to+-- the block size (4K).+--+-- /Pre-release/+{-# INLINE resize #-}+resize :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+resize nElems arr@MutArray{..} = do+    let req = SIZE_OF(a) * nElems+        len = arrEnd - arrStart+    if req < len+    then return arr+    else realloc req arr++-- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'+-- then it is rounded up to the closest power of 2.+--+-- /Pre-release/+{-# INLINE resizeExp #-}+resizeExp :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+resizeExp nElems arr@MutArray{..} = do+    let req = roundUpLargeArray (SIZE_OF(a) * nElems)+        req1 =+            if req > largeObjectThreshold+            then roundUpToPower2 req+            else req+        len = arrEnd - arrStart+    if req1 < len+    then return arr+    else realloc req1 arr++-- | Resize the allocated memory to drop any reserved free space at the end of+-- the array and reallocate it to reduce wastage.+--+-- Up to 25% wastage is allowed to avoid reallocations.  If the capacity is+-- more than 'largeObjectThreshold' then free space up to the 'blockSize' is+-- retained.+--+-- /Pre-release/+{-# INLINE rightSize #-}+rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)+rightSize arr@MutArray{..} = do+    assert (arrEnd <= arrBound) (return ())+    let start = arrStart+        len = arrEnd - start+        capacity = arrBound - start+        target = roundUpLargeArray len+        waste = arrBound - arrEnd+    assert (target >= len) (return ())+    assert (len `mod` SIZE_OF(a) == 0) (return ())+    -- We trade off some wastage (25%) to avoid reallocations and copying.+    if target < capacity && len < 3 * waste+    then realloc target arr+    else return arr++-------------------------------------------------------------------------------+-- Snoc+-------------------------------------------------------------------------------++-- XXX We can possibly use a smallMutableByteArray to hold the start, end,+-- bound pointers.  Using fully mutable handle will ensure that we do not have+-- multiple references to the same array of different lengths lying around and+-- potentially misused. In that case "snoc" need not return a new array (snoc+-- :: MutArray a -> a -> m ()), it will just modify the old reference.  The array+-- length will be mutable.  This means the length function would also be+-- monadic.  Mutable arrays would behave more like files that grow in that+-- case.++-- | Snoc using a 'Ptr'. Low level reusable function.+--+-- /Internal/+{-# INLINE snocNewEnd #-}+snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)+snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do+    assert (newEnd <= arrBound) (return ())+    pokeAt arrEnd arrContents x+    return $ arr {arrEnd = newEnd}++-- | Really really unsafe, appends the element into the first array, may+-- cause silent data corruption or if you are lucky a segfault if the first+-- array does not have enough space to append the element.+--+-- /Internal/+{-# INLINE snocUnsafe #-}+snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>+    MutArray a -> a -> m (MutArray a)+snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr++-- | Like 'snoc' but does not reallocate when pre-allocated array capacity+-- becomes full.+--+-- /Internal/+{-# INLINE snocMay #-}+snocMay :: forall m a. (MonadIO m, Unbox a) =>+    MutArray a -> a -> m (Maybe (MutArray a))+snocMay arr@MutArray{..} x = liftIO $ do+    let newEnd = INDEX_NEXT(arrEnd,a)+    if newEnd <= arrBound+    then Just <$> snocNewEnd newEnd arr x+    else return Nothing++-- NOINLINE to move it out of the way and not pollute the instruction cache.+{-# NOINLINE snocWithRealloc #-}+snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray a+    -> a+    -> m (MutArray a)+snocWithRealloc sizer arr x = do+    arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr+    snocUnsafe arr1 x++-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of+-- the array increases by 1.+--+-- If there is no reserved space available in @arr@ it is reallocated to a size+-- in bytes determined by the @sizer oldSizeBytes@ function, where+-- @oldSizeBytes@ is the original size of the array in bytes.+--+-- If the new array size is more than 'largeObjectThreshold' we automatically+-- round it up to 'blockSize'.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- /Pre-release/+{-# INLINE snocWith #-}+snocWith :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray a+    -> a+    -> m (MutArray a)+snocWith allocSize arr x = liftIO $ do+    let newEnd = INDEX_NEXT(arrEnd arr,a)+    if newEnd <= arrBound arr+    then snocNewEnd newEnd arr x+    else snocWithRealloc allocSize arr x++-- | The array is mutated to append an additional element to it. If there+-- is no reserved space available in the array then it is reallocated to grow+-- it by 'arrayChunkBytes' rounded up to 'blockSize' when the size becomes more+-- than 'largeObjectThreshold'.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- Performs O(n^2) copies to grow but is thrifty on memory.+--+-- /Pre-release/+{-# INLINE snocLinear #-}+snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+snocLinear = snocWith (+ allocBytesToBytes (undefined :: a) arrayChunkBytes)++-- | The array is mutated to append an additional element to it. If there is no+-- reserved space available in the array then it is reallocated to double the+-- original size.+--+-- This is useful to reduce allocations when appending unknown number of+-- elements.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- >>> snoc = MutArray.snocWith (* 2)+--+-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.+--+{-# INLINE snoc #-}+snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+snoc = snocWith f++    where++    f oldSize =+        if isPower2 oldSize+        then oldSize * 2+        else roundUpToPower2 oldSize * 2++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- XXX Can this be deduplicated with array/foreign++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE_NORMAL getIndexUnsafe #-}+getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+getIndexUnsafe i MutArray{..} = do+    let index = INDEX_OF(arrStart,i,a)+    assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())+    liftIO $ peekAt index arrContents++-- | /O(1)/ Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)+getIndex i MutArray{..} = do+    let index = INDEX_OF(arrStart,i,a)+    if i >= 0 && INDEX_VALID(index,arrEnd,a)+    then liftIO $ Just <$> peekAt index arrContents+    else return Nothing++-- | /O(1)/ Lookup the element at the given index from the end of the array.+-- Index starts from 0.+--+-- Slightly faster than computing the forward index and using getIndex.+--+{-# INLINE getIndexRev #-}+getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+getIndexRev i MutArray{..} = do+    let index = RINDEX_OF(arrEnd,i,a)+    if i >= 0 && index >= arrStart+    then liftIO $ peekAt index arrContents+    else invalidIndex "getIndexRev" i++data GetIndicesState contents start end st =+    GetIndicesState contents start end st++-- | Given an unfold that generates array indices, read the elements on those+-- indices from the supplied MutArray. An error is thrown if an index is out of+-- bounds.+--+-- /Pre-release/+{-# INLINE getIndicesD #-}+getIndicesD :: (Monad m, Unbox a) =>+    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a+getIndicesD liftio (D.Stream stepi sti) = Unfold step inject++    where++    inject (MutArray contents start end _) =+        return $ GetIndicesState contents start end sti++    {-# INLINE_LATE step #-}+    step (GetIndicesState contents start end st) = do+        r <- stepi defState st+        case r of+            D.Yield i s -> do+                x <- liftio $ getIndex i (MutArray contents start end undefined)+                case x of+                    Just v -> return $ D.Yield v (GetIndicesState contents start end s)+                    Nothing -> error "Invalid Index"+            D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)+            D.Stop -> return D.Stop++{-# INLINE getIndices #-}+getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+getIndices = getIndicesD liftIO++-------------------------------------------------------------------------------+-- Subarrays+-------------------------------------------------------------------------------++-- XXX We can also get immutable slices.++-- | /O(1)/ Slice an array in constant time.+--+-- Unsafe: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE getSliceUnsafe #-}+getSliceUnsafe :: forall a. Unbox a+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSliceUnsafe index len (MutArray contents start e _) =+    let fp1 = INDEX_OF(start,index,a)+        end = fp1 + (len * SIZE_OF(a))+     in assert+            (index >= 0 && len >= 0 && end <= e)+            -- Note: In a slice we always use bound = end so that the slice+            -- user cannot overwrite elements beyond the end of the slice.+            (MutArray contents fp1 end end)++-- | /O(1)/ Slice an array in constant time. Throws an error if the slice+-- extends out of the array bounds.+--+-- /Pre-release/+{-# INLINE getSlice #-}+getSlice :: forall a. Unbox a =>+       Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSlice index len (MutArray contents start e _) =+    let fp1 = INDEX_OF(start,index,a)+        end = fp1 + (len * SIZE_OF(a))+     in if index >= 0 && len >= 0 && end <= e+        -- Note: In a slice we always use bound = end so that the slice user+        -- cannot overwrite elements beyond the end of the slice.+        then MutArray contents fp1 end end+        else error+                $ "getSlice: invalid slice, index "+                ++ show index ++ " length " ++ show len++-------------------------------------------------------------------------------+-- In-place mutation algorithms+-------------------------------------------------------------------------------++-- XXX consider the bulk update/accumulation/permutation APIs from vector.++-- | You may not need to reverse an array because you can consume it in reverse+-- using 'readerRev'. To reverse large arrays you can read in reverse and write+-- to another array. However, in-place reverse can be useful to take adavantage+-- of cache locality and when you do not want to allocate additional memory.+--+{-# INLINE reverse #-}+reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()+reverse MutArray{..} = liftIO $ do+    let l = arrStart+        h = INDEX_PREV(arrEnd,a)+     in swap l h++    where++    swap l h = do+        when (l < h) $ do+            swapArrayByteIndices (Proxy :: Proxy a) arrContents l h+            swap (INDEX_NEXT(l,a)) (INDEX_PREV(h,a))++-- | Generate the next permutation of the sequence, returns False if this is+-- the last permutation.+--+-- /Unimplemented/+{-# INLINE permute #-}+permute :: MutArray a -> m Bool+permute = undefined++-- | Partition an array into two halves using a partitioning predicate. The+-- first half retains values where the predicate is 'False' and the second half+-- retains values where the predicate is 'True'.+--+-- /Pre-release/+{-# INLINE partitionBy #-}+partitionBy :: forall m a. (MonadIO m, Unbox a)+    => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+partitionBy f arr@MutArray{..} = liftIO $ do+    if arrStart >= arrEnd+    then return (arr, arr)+    else do+        ptr <- go arrStart (INDEX_PREV(arrEnd,a))+        let pl = MutArray arrContents arrStart ptr ptr+            pr = MutArray arrContents ptr arrEnd arrEnd+        return (pl, pr)++    where++    -- Invariant low < high on entry, and on return as well+    moveHigh low high = do+        h <- peekAt high arrContents+        if f h+        then+            -- Correctly classified, continue the loop+            let high1 = INDEX_PREV(high,a)+             in if low == high1+                then return Nothing+                else moveHigh low high1+        else return (Just (high, h)) -- incorrectly classified++    -- Keep a low pointer starting at the start of the array (first partition)+    -- and a high pointer starting at the end of the array (second partition).+    -- Keep incrementing the low ptr and decrementing the high ptr until both+    -- are wrongly classified, at that point swap the two and continue until+    -- the two pointer cross each other.+    --+    -- Invariants when entering this loop:+    -- low <= high+    -- Both low and high are valid locations within the array+    go low high = do+        l <- peekAt low arrContents+        if f l+        then+            -- low is wrongly classified+            if low == high+            then return low+            else do -- low < high+                r <- moveHigh low high+                case r of+                    Nothing -> return low+                    Just (high1, h) -> do -- low < high1+                        pokeAt low arrContents h+                        pokeAt high1 arrContents l+                        let low1 = INDEX_NEXT(low,a)+                            high2 = INDEX_PREV(high1,a)+                        if low1 <= high2+                        then go low1 high2+                        else return low1 -- low1 > high2++        else do+            -- low is correctly classified+            let low1 = INDEX_NEXT(low,a)+            if low == high+            then return low1+            else go low1 high++-- | Shuffle corresponding elements from two arrays using a shuffle function.+-- If the shuffle function returns 'False' then do nothing otherwise swap the+-- elements. This can be used in a bottom up fold to shuffle or reorder the+-- elements.+--+-- /Unimplemented/+{-# INLINE shuffleBy #-}+shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()+shuffleBy = undefined++-- XXX we can also make the folds partial by stopping at a certain level.+--+-- | @divideBy level partition array@  performs a top down hierarchical+-- recursive partitioning fold of items in the container using the given+-- function as the partition function.  Level indicates the level in the tree+-- where the fold would stop.+--+-- This performs a quick sort if the partition function is+-- 'partitionBy (< pivot)'.+--+-- /Unimplemented/+{-# INLINABLE divideBy #-}+divideBy ::+    Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()+divideBy = undefined++-- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively+-- merging the pairs using the supplied merge function. Level indicates the+-- level in the tree where the fold would stop.+--+-- This performs a random shuffle if the merge function is random.  If we+-- stop at level 0 and repeatedly apply the function then we can do a bubble+-- sort.+--+-- /Unimplemented/+mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()+mergeBy = undefined++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++-- | /O(1)/ Get the byte length of the array.+--+{-# INLINE byteLength #-}+byteLength :: MutArray a -> Int+byteLength MutArray{..} =+    let len = arrEnd - arrStart+    in assert (len >= 0) len++-- Note: try to avoid the use of length in performance sensitive internal+-- routines as it involves a costly 'div' operation. Instead use the end ptr+-- in the array to check the bounds etc.+--+-- | /O(1)/ Get the length of the array i.e. the number of elements in the+-- array.+--+-- Note that 'byteLength' is less expensive than this operation, as 'length'+-- involves a costly division operation.+--+{-# INLINE length #-}+length :: forall a. Unbox a => MutArray a -> Int+length arr =+    let elemSize = SIZE_OF(a)+        blen = byteLength arr+     in assert (blen `mod` elemSize == 0) (blen `div` elemSize)++-- | Get the total capacity of an array. An array may have space reserved+-- beyond the current used length of the array.+--+-- /Pre-release/+{-# INLINE byteCapacity #-}+byteCapacity :: MutArray a -> Int+byteCapacity MutArray{..} =+    let len = arrBound - arrStart+    in assert (len >= 0) len++-- | The remaining capacity in the array for appending more elements without+-- reallocation.+--+-- /Pre-release/+{-# INLINE bytesFree #-}+bytesFree :: MutArray a -> Int+bytesFree MutArray{..} =+    let n = arrBound - arrEnd+    in assert (n >= 0) n++-------------------------------------------------------------------------------+-- Streams of arrays - Creation+-------------------------------------------------------------------------------++data GroupState s contents start end bound+    = GroupStart s+    | GroupBuffer s contents start end bound+    | GroupYield+        contents start end bound (GroupState s contents start end bound)+    | GroupFinish++{-# INLINE_NORMAL chunksOfAs #-}+chunksOfAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> D.Stream m a -> D.Stream m (MutArray a)+chunksOfAs ps n (D.Stream step state) =+    D.Stream step' (GroupStart state)++    where++    {-# INLINE_LATE step' #-}+    step' _ (GroupStart st) = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ "Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "+                    ++ "the size of arrays [" ++ show n+                    ++ "] must be a natural number"+        (MutArray contents start end bound :: MutArray a) <- newAs ps n+        return $ D.Skip (GroupBuffer st contents start end bound)++    step' gst (GroupBuffer st contents start end bound) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                liftIO $ pokeAt end contents  x+                let end1 = INDEX_NEXT(end,a)+                return $+                    if end1 >= bound+                    then D.Skip+                            (GroupYield+                                contents start end1 bound (GroupStart s))+                    else D.Skip (GroupBuffer s contents start end1 bound)+            D.Skip s ->+                return $ D.Skip (GroupBuffer s contents start end bound)+            D.Stop ->+                return+                    $ D.Skip (GroupYield contents start end bound GroupFinish)++    step' _ (GroupYield contents start end bound next) =+        return $ D.Yield (MutArray contents start end bound) next++    step' _ GroupFinish = return D.Stop++-- | @chunksOf n stream@ groups the elements in the input stream into arrays of+-- @n@ elements each.+--+-- Same as the following but may be more efficient:+--+-- >>> chunksOf n = Stream.foldMany (MutArray.writeN n)+--+-- /Pre-release/+{-# INLINE_NORMAL chunksOf #-}+chunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- XXX the idiomatic implementation leads to large regression in the D.reverse'+-- benchmark. It seems it has difficulty producing optimized code when+-- converting to StreamK. Investigate GHC optimizations.+-- chunksOf n = D.foldMany (writeN n)+chunksOf = chunksOfAs Unpinned++-- | Like 'chunksOf' but creates pinned arrays.+{-# INLINE_NORMAL pinnedChunksOf #-}+pinnedChunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- pinnedChunksOf n = D.foldMany (pinnedWriteN n)+pinnedChunksOf = chunksOfAs Pinned++-- XXX This should take a PinnedState+-- XXX buffer to a list instead?+-- | Buffer the stream into arrays in memory.+{-# INLINE arrayStreamKFromStreamDAs #-}+arrayStreamKFromStreamDAs :: forall m a. (MonadIO m, Unbox a) =>+    PinnedState -> D.Stream m a -> m (StreamK m (MutArray a))+arrayStreamKFromStreamDAs ps =+    let n = allocBytesToElemCount (undefined :: a) defaultChunkSize+     in D.foldr K.cons K.nil . chunksOfAs ps n++-------------------------------------------------------------------------------+-- Streams of arrays - Flattening+-------------------------------------------------------------------------------++data FlattenState s contents a =+      OuterLoop s+    | InnerLoop s contents !Int !Int++-- | Use the "reader" unfold instead.+--+-- @flattenArrays = unfoldMany reader@+--+-- We can try this if there are any fusion issues in the unfold.+--+{-# INLINE_NORMAL flattenArrays #-}+flattenArrays :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield MutArray{..} s ->+                D.Skip (InnerLoop s arrContents arrStart arrEnd)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =+        return $ D.Skip $ OuterLoop st++    step' _ (InnerLoop st contents p end) = do+        x <- liftIO $ peekAt p contents+        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)++-- | Use the "readerRev" unfold instead.+--+-- @flattenArrays = unfoldMany readerRev@+--+-- We can try this if there are any fusion issues in the unfold.+--+{-# INLINE_NORMAL flattenArraysRev #-}+flattenArraysRev :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield MutArray{..} s ->+                let p = INDEX_PREV(arrEnd,a)+                 in D.Skip (InnerLoop s arrContents p arrStart)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p start) | p < start =+        return $ D.Skip $ OuterLoop st++    step' _ (InnerLoop st contents p start) = do+        x <- liftIO $ peekAt p contents+        let cur = INDEX_PREV(p,a)+        return $ D.Yield x (InnerLoop st contents cur start)++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++data ArrayUnsafe a = ArrayUnsafe+    {-# UNPACK #-} !MutByteArray   -- contents+    {-# UNPACK #-} !Int                -- index 1+    {-# UNPACK #-} !Int                -- index 2++toArrayUnsafe :: MutArray a -> ArrayUnsafe a+toArrayUnsafe (MutArray contents start end _) = ArrayUnsafe contents start end++fromArrayUnsafe ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    ArrayUnsafe a -> MutArray a+fromArrayUnsafe (ArrayUnsafe contents start end) =+         MutArray contents start end end++{-# INLINE_NORMAL producerWith #-}+producerWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> Producer m (MutArray a) a+producerWith liftio = Producer step (return . toArrayUnsafe) extract+    where++    {-# INLINE_LATE step #-}+    step (ArrayUnsafe _ cur end)+        | assert (cur <= end) (cur == end) = return D.Stop+    step (ArrayUnsafe contents cur end) = do+            -- When we use a purely lazy Monad like Identity, we need to force a+            -- few actions for correctness and execution order sanity. We want+            -- the peek to occur right here and not lazily at some later point+            -- because we want the peek to be ordered with respect to the touch.+            !x <- liftio $ peekAt cur contents+            return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)++    extract = return . fromArrayUnsafe++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producer #-}+producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a+producer = producerWith liftIO++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+reader = Producer.simplify producer++{-# INLINE_NORMAL readerRevWith #-}+readerRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> Unfold m (MutArray a) a+readerRevWith liftio = Unfold step inject+    where++    inject (MutArray contents start end _) =+        let p = INDEX_PREV(end,a)+         in return $ ArrayUnsafe contents start p++    {-# INLINE_LATE step #-}+    step (ArrayUnsafe _ start p) | p < start = return D.Stop+    step (ArrayUnsafe contents start p) = do+        !x <- liftio $ peekAt p contents+        return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))++-- | Unfold an array into a stream in reverse order.+--+{-# INLINE_NORMAL readerRev #-}+readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+readerRev = readerRevWith liftIO++-------------------------------------------------------------------------------+-- to Lists and streams+-------------------------------------------------------------------------------++{-+-- Use foldr/build fusion to fuse with list consumers+-- This can be useful when using the IsList instance+{-# INLINE_LATE toListFB #-}+toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b+toListFB c n MutArray{..} = go arrStart+    where++    go p | assert (p <= arrEnd) (p == arrEnd) = n+    go p =+        -- unsafeInlineIO allows us to run this in Identity monad for pure+        -- toList/foldr case which makes them much faster due to not+        -- accumulating the list and fusing better with the pure consumers.+        --+        -- This should be safe as the array contents are guaranteed to be+        -- evaluated/written to before we peek at them.+        -- XXX+        let !x = unsafeInlineIO $ do+                    r <- peekAt arrContents p+                    return r+        in c x (go (PTR_NEXT(p,a)))+-}++-- XXX Monadic foldr/build fusion?+-- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion++-- | Convert a 'MutArray' into a list.+--+{-# INLINE toList #-}+toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]+toList MutArray{..} = liftIO $ go arrStart+    where++    go p | assert (p <= arrEnd) (p == arrEnd) = return []+    go p = do+        x <- peekAt p arrContents+        (:) x <$> go (INDEX_NEXT(p,a))++{-# INLINE_NORMAL toStreamDWith #-}+toStreamDWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a+toStreamDWith liftio MutArray{..} = D.Stream step arrStart++    where++    {-# INLINE_LATE step #-}+    step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop+    step _ p = liftio $ do+        r <- peekAt p arrContents+        return $ D.Yield r (INDEX_NEXT(p,a))++-- | Convert a 'MutArray' into a stream.+--+-- >>> read = Stream.unfold MutArray.reader+--+{-# INLINE_NORMAL read #-}+read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a+read = toStreamDWith liftIO++{-# INLINE toStreamKWith #-}+toStreamKWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+toStreamKWith liftio MutArray{..} = go arrStart++    where++    go p | assert (p <= arrEnd) (p == arrEnd) = K.nil+         | otherwise =+        let elemM = peekAt p arrContents+        in liftio elemM `K.consM` go (INDEX_NEXT(p,a))++{-# INLINE toStreamK #-}+toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+toStreamK = toStreamKWith liftIO++{-# INLINE_NORMAL toStreamDRevWith #-}+toStreamDRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a+toStreamDRevWith liftio MutArray{..} =+    let p = INDEX_PREV(arrEnd,a)+    in D.Stream step p++    where++    {-# INLINE_LATE step #-}+    step _ p | p < arrStart = return D.Stop+    step _ p = liftio $ do+        r <- peekAt p arrContents+        return $ D.Yield r (INDEX_PREV(p,a))++-- | Convert a 'MutArray' into a stream in reverse order.+--+-- >>> readRev = Stream.unfold MutArray.readerRev+--+{-# INLINE_NORMAL readRev #-}+readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a+readRev = toStreamDRevWith liftIO++{-# INLINE toStreamKRevWith #-}+toStreamKRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+toStreamKRevWith liftio MutArray {..} =+    let p = INDEX_PREV(arrEnd,a)+    in go p++    where++    go p | p < arrStart = K.nil+         | otherwise =+        let elemM = peekAt p arrContents+        in liftio elemM `K.consM` go (INDEX_PREV(p,a))++{-# INLINE toStreamKRev #-}+toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+toStreamKRev = toStreamKRevWith liftIO++-------------------------------------------------------------------------------+-- Folding+-------------------------------------------------------------------------------++-- XXX Need something like "MutArray m a" enforcing monadic action to avoid the+-- possibility of such APIs.+--+-- | Strict left fold of an array.+{-# INLINE_NORMAL foldl' #-}+foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b+foldl' f z arr = D.foldl' f z $ read arr++-- | Right fold of an array.+{-# INLINE_NORMAL foldr #-}+foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b+foldr f z arr = D.foldr f z $ read arr++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- Note: Arrays may be allocated with a specific alignment at the beginning of+-- the array. If you need to maintain that alignment on reallocations then you+-- can resize the array manually before append, using an aligned resize+-- operation.++-- XXX Keep the bound intact to not lose any free space? Perf impact?++-- | @writeAppendNUnsafe n arr@ appends up to @n@ input items to the supplied+-- array.+--+-- Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory+-- corruption or segfault.+--+-- Any free space left in the array after appending @n@ elements is lost.+--+-- /Internal/+{-# INLINE_NORMAL writeAppendNUnsafe #-}+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>+       Int+    -> m (MutArray a)+    -> Fold m a (MutArray a)+writeAppendNUnsafe n action =+    fmap fromArrayUnsafe $ FL.foldlM' step initial++    where++    initial = do+        assert (n >= 0) (return ())+        arr@(MutArray _ _ end bound) <- action+        let free = bound - end+            needed = n * SIZE_OF(a)+        -- XXX We can also reallocate if the array has too much free space,+        -- otherwise we lose that space.+        arr1 <-+            if free < needed+            then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr+            else return arr+        return $ toArrayUnsafe arr1++    step (ArrayUnsafe contents start end) x = do+        liftIO $ pokeAt end contents x+        return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))++-- | Append @n@ elements to an existing array. Any free space left in the array+-- after appending @n@ elements is lost.+--+-- >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)+--+{-# INLINE_NORMAL writeAppendN #-}+writeAppendN :: forall m a. (MonadIO m, Unbox a) =>+    Int -> m (MutArray a) -> Fold m a (MutArray a)+writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)++-- | @writeAppendWith realloc action@ mutates the array generated by @action@ to+-- append the input stream. If there is no reserved space available in the+-- array it is reallocated to a size in bytes  determined by @realloc oldSize@,+-- where @oldSize@ is the current size of the array in bytes.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)+--+-- /Pre-release/+{-# INLINE writeAppendWith #-}+writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+writeAppendWith sizer = FL.foldlM' (snocWith sizer)++-- | @append action@ mutates the array generated by @action@ to append the+-- input stream. If there is no reserved space available in the array it is+-- reallocated to double the size.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> writeAppend = MutArray.writeAppendWith (* 2)+--+{-# INLINE writeAppend #-}+writeAppend :: forall m a. (MonadIO m, Unbox a) =>+    m (MutArray a) -> Fold m a (MutArray a)+writeAppend = writeAppendWith (* 2)++-- XXX We can carry bound as well in the state to make sure we do not lose the+-- remaining capacity. Need to check perf impact.+--+-- | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function+-- as argument.+--+-- >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n+--+-- /Pre-release/+{-# INLINE_NORMAL writeNWithUnsafe #-}+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial++    where++    initial = toArrayUnsafe <$> alloc (max n 0)++    step (ArrayUnsafe contents start end) x = do+        liftIO $ pokeAt end contents x+        return+          $ ArrayUnsafe contents start (INDEX_NEXT(end,a))++{-# INLINE_NORMAL writeNUnsafeAs #-}+writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m a (MutArray a)+writeNUnsafeAs ps = writeNWithUnsafe (newAs ps)++-- | Like 'writeN' but does not check the array bounds when writing. The fold+-- driver must not call the step function more than 'n' times otherwise it will+-- corrupt the memory and crash. This function exists mainly because any+-- conditional in the step function blocks fusion causing 10x performance+-- slowdown.+--+-- >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.new+--+{-# INLINE_NORMAL writeNUnsafe #-}+writeNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+writeNUnsafe = writeNUnsafeAs Unpinned++-- | Like 'writeNUnsafe' but creates a pinned array.+{-# INLINE_NORMAL pinnedWriteNUnsafe #-}+pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+pinnedWriteNUnsafe = writeNUnsafeAs Pinned++-- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array+-- allocated using the @alloc@ function.+--+-- >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)+-- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n+--+{-# INLINE_NORMAL writeNWith #-}+writeNWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)++{-# INLINE_NORMAL writeNAs #-}+writeNAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState+    -> Int+    -> Fold m a (MutArray a)+writeNAs ps = writeNWith (newAs ps)++-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an+-- 'MutArray'.+--+-- >>> writeN = MutArray.writeNWith MutArray.new+-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)+-- >>> writeN n = MutArray.writeAppendN n (MutArray.new n)+--+{-# INLINE_NORMAL writeN #-}+writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+writeN = writeNAs Unpinned++-- | Like 'writeN' but creates a pinned array.+{-# INLINE_NORMAL pinnedWriteN #-}+pinnedWriteN ::+       forall m a. (MonadIO m, Unbox a)+    => Int+    -> Fold m a (MutArray a)+pinnedWriteN = writeNAs Pinned++-- | Like writeNWithUnsafe but writes the array in reverse order.+--+-- /Internal/+{-# INLINE_NORMAL writeRevNWithUnsafe #-}+writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial++    where++    toArrayUnsafeRev (MutArray contents _ _ bound) =+         ArrayUnsafe contents bound bound++    initial = toArrayUnsafeRev <$> alloc (max n 0)++    step (ArrayUnsafe contents start end) x = do+        let ptr = INDEX_PREV(start,a)+        liftIO $ pokeAt ptr contents x+        return+          $ ArrayUnsafe contents ptr end++-- | Like writeNWith but writes the array in reverse order.+--+-- /Internal/+{-# INLINE_NORMAL writeRevNWith #-}+writeRevNWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)++-- | Like writeN but writes the array in reverse order.+--+-- /Pre-release/+{-# INLINE_NORMAL writeRevN #-}+writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+writeRevN = writeRevNWith new++-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the+-- input stream to a 'MutArray' aligned to the given size.+--+-- >>> pinnedWriteNAligned align = MutArray.writeNWith (MutArray.pinnedNewAligned align)+-- >>> pinnedWriteNAligned align n = MutArray.writeAppendN n (MutArray.pinnedNewAligned align n)+--+-- /Pre-release/+--+{-# INLINE_NORMAL pinnedWriteNAligned #-}+pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> Fold m a (MutArray a)+pinnedWriteNAligned align = writeNWith (pinnedNewAligned align)++-- XXX Buffer to a list instead?++-- | Buffer a stream into a stream of arrays.+--+-- >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK+--+-- Breaking an array into an array stream  can be useful to consume a large+-- array sequentially such that memory of the array is released incrementatlly.+--+-- See also: 'arrayStreamKFromStreamD'.+--+-- /Unimplemented/+--+{-# INLINE_NORMAL writeChunks #-}+writeChunks :: (MonadIO m, Unbox a) =>+    Int -> Fold m a (StreamK n (MutArray a))+writeChunks n = FL.many (writeN n) FL.toStreamK++{-# INLINE_NORMAL writeWithAs #-}+writeWithAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m a (MutArray a)+-- writeWithAs ps n = FL.rmapM rightSize $ writeAppendWith (* 2) (newAs ps n)+writeWithAs ps elemCount =+    FL.rmapM extract $ FL.foldlM' step initial++    where++    initial = do+        when (elemCount < 0) $ error "writeWith: elemCount is negative"+        liftIO $ newAs ps elemCount++    step arr@(MutArray _ start end bound) x+        | INDEX_NEXT(end,a) > bound = do+        let oldSize = end - start+            newSize = max (oldSize * 2) 1+        arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr+        snocUnsafe arr1 x+    step arr x = snocUnsafe arr x++    extract = liftIO . rightSize++-- XXX Compare writeWith with fromStreamD which uses an array of streams+-- implementation. We can write this using writeChunks above if that is faster.+-- If writeWith is faster then we should use that to implement+-- fromStreamD.+--+-- XXX The realloc based implementation needs to make one extra copy if we use+-- shrinkToFit.  On the other hand, the stream of arrays implementation may+-- buffer the array chunk pointers in memory but it does not have to shrink as+-- we know the exact size in the end. However, memory copying does not seem to+-- be as expensive as the allocations. Therefore, we need to reduce the number+-- of allocations instead. Also, the size of allocations matters, right sizing+-- an allocation even at the cost of copying sems to help.  Should be measured+-- on a big stream with heavy calls to toArray to see the effect.+--+-- XXX check if GHC's memory allocator is efficient enough. We can try the C+-- malloc to compare against.++-- | @writeWith minCount@ folds the whole input to a single array. The array+-- starts at a size big enough to hold minCount elements, the size is doubled+-- every time the array needs to be grown.+--+-- /Caution! Do not use this on infinite streams./+--+-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.new n)+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)+--+-- /Pre-release/+{-# INLINE_NORMAL writeWith #-}+writeWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (new n)+writeWith = writeWithAs Unpinned++-- | Fold the whole input to a single array.+--+-- Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes+-- rounded up to the element size.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE write #-}+write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)++-- | Like 'write' but creates a pinned array.+{-# INLINE pinnedWrite #-}+pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+pinnedWrite =+    writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)++-------------------------------------------------------------------------------+-- construct from streams, known size+-------------------------------------------------------------------------------++{-# INLINE_NORMAL fromStreamDNAs #-}+fromStreamDNAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> D.Stream m a -> m (MutArray a)+fromStreamDNAs ps limit str = do+    (arr :: MutArray a) <- liftIO $ newAs ps limit+    end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str+    return $ arr {arrEnd = end}++    where++    fwrite arrContents ptr x = do+        liftIO $ pokeAt ptr arrContents  x+        return $ INDEX_NEXT(ptr,a)++-- | Use the 'writeN' fold instead.+--+-- >>> fromStreamDN n = Stream.fold (MutArray.writeN n)+--+{-# INLINE_NORMAL fromStreamDN #-}+fromStreamDN :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> m (MutArray a)+-- fromStreamDN n = D.fold (writeN n)+fromStreamDN = fromStreamDNAs Unpinned++-- | Create a 'MutArray' from the first N elements of a list. The array is+-- allocated to size N, if the list terminates before N elements then the+-- array may hold less than N elements.+--+{-# INLINABLE fromListN #-}+fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+fromListN n xs = fromStreamDN n $ D.fromList xs++-- | Like 'fromListN' but creates a pinned array.+{-# INLINABLE pinnedFromListN #-}+pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+pinnedFromListN n xs = fromStreamDNAs Pinned n $ D.fromList xs++-- | Like fromListN but writes the array in reverse order.+--+-- /Pre-release/+{-# INLINE fromListRevN #-}+fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs++-- | Convert a pure stream in Identity monad to a mutable array.+{-# INLINABLE fromPureStream #-}+fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)+fromPureStream xs =+    liftIO $ D.fold write $ D.morphInner (return . runIdentity) xs++-------------------------------------------------------------------------------+-- convert stream to a single array+-------------------------------------------------------------------------------++{-# INLINE arrayStreamKLength #-}+arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int+arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)++-- | Convert an array stream to an array. Note that this requires peak memory+-- that is double the size of the array stream.+--+{-# INLINE fromArrayStreamK #-}+fromArrayStreamK :: (Unbox a, MonadIO m) =>+    StreamK m (MutArray a) -> m (MutArray a)+fromArrayStreamK as = do+    len <- arrayStreamKLength as+    fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as++{-# INLINE fromStreamDAs #-}+fromStreamDAs ::+       (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)+fromStreamDAs ps m = arrayStreamKFromStreamDAs ps m >>= fromArrayStreamK++-- CAUTION: a very large number (millions) of arrays can degrade performance+-- due to GC overhead because we need to buffer the arrays before we flatten+-- all the arrays.+--+-- XXX Compare if this is faster or "fold write".+--+-- | We could take the approach of doubling the memory allocation on each+-- overflow. This would result in more or less the same amount of copying as in+-- the chunking approach. However, if we have to shrink in the end then it may+-- result in an extra copy of the entire data.+--+-- >>> fromStreamD = StreamD.fold MutArray.write+--+{-# INLINE fromStreamD #-}+fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)+fromStreamD = fromStreamDAs Unpinned++-- | Create a 'MutArray' from a list. The list must be of finite size.+--+{-# INLINE fromList #-}+fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+fromList xs = fromStreamD $ D.fromList xs++-- | Like 'fromList' but creates a pinned array.+{-# INLINE pinnedFromList #-}+pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+pinnedFromList xs = fromStreamDAs Pinned $ D.fromList xs++-- XXX We are materializing the whole list first for getting the length. Check+-- if the 'fromList' like chunked implementation would fare better.++-- | Like 'fromList' but writes the contents of the list in reverse order.+{-# INLINE fromListRev #-}+fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+fromListRev xs = fromListRevN (Prelude.length xs) xs++-------------------------------------------------------------------------------+-- Cloning+-------------------------------------------------------------------------------++{-# INLINE cloneAs #-}+cloneAs ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => PinnedState -> MutArray a -> m (MutArray a)+cloneAs ps src =+    liftIO $ do+        let startSrc = arrStart src+            srcLen = arrEnd src - startSrc+        newArrContents <-+            Unboxed.cloneSliceUnsafeAs ps startSrc srcLen (arrContents src)+        return $ MutArray newArrContents 0 srcLen srcLen++{-# INLINE clone #-}+clone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => MutArray a -> m (MutArray a)+clone = cloneAs Unpinned++{-# INLINE pinnedClone #-}+pinnedClone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => MutArray a -> m (MutArray a)+pinnedClone = cloneAs Pinned++-------------------------------------------------------------------------------+-- Combining+-------------------------------------------------------------------------------++-- | Copy two arrays into a newly allocated array. If the first array is pinned+-- the spliced array is also pinned.+{-# INLINE spliceCopy #-}+spliceCopy :: forall m a. MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a -> MutArray a -> m (MutArray a)+spliceCopy arr1 arr2 = liftIO $ do+    let start1 = arrStart arr1+        start2 = arrStart arr2+        len1 = arrEnd arr1 - start1+        len2 = arrEnd arr2 - start2+    let newLen = len1 + len2+    newArrContents <-+        if Unboxed.isPinned (arrContents arr1)+        then Unboxed.pinnedNew newLen+        else Unboxed.new newLen+    let len = len1 + len2+    putSliceUnsafe (arrContents arr1) start1 newArrContents 0 len1+    putSliceUnsafe (arrContents arr2) start2 newArrContents len1 len2+    return $ MutArray newArrContents 0 len len++-- | Really really unsafe, appends the second array into the first array. If+-- the first array does not have enough space it may cause silent data+-- corruption or if you are lucky a segfault.+{-# INLINE spliceUnsafe #-}+spliceUnsafe :: MonadIO m =>+    MutArray a -> MutArray a -> m (MutArray a)+spliceUnsafe dst src =+    liftIO $ do+         let startSrc = arrStart src+             srcLen = arrEnd src - startSrc+             endDst = arrEnd dst+         assertM(endDst + srcLen <= arrBound dst)+         putSliceUnsafe+             (arrContents src) startSrc (arrContents dst) endDst srcLen+         return $ dst {arrEnd = endDst + srcLen}++-- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no+-- reserved space available in @dst@ it is reallocated to a size determined by+-- the @sizer dstBytes srcBytes@ function, where @dstBytes@ is the size of the+-- first array and @srcBytes@ is the size of the second array, in bytes.+--+-- Note that the returned array may be a mutated version of first array.+--+-- /Pre-release/+{-# INLINE spliceWith #-}+spliceWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)+spliceWith sizer dst@(MutArray _ start end bound) src = do+{-+    let f = writeAppendWith (`sizer` byteLength src) (return dst)+     in D.fold f (toStreamD src)+-}+    assert (end <= bound) (return ())+    let srcBytes = arrEnd src - arrStart src++    dst1 <-+        if end + srcBytes >= bound+        then do+            let dstBytes = end - start+                newSizeInBytes = sizer dstBytes srcBytes+            when (newSizeInBytes < dstBytes + srcBytes)+                $ error+                    $ "splice: newSize is less than the total size "+                    ++ "of arrays being appended. Please check the "+                    ++ "sizer function passed."+            liftIO $ realloc newSizeInBytes dst+        else return dst+    spliceUnsafe dst1 src++-- | The first array is mutated to append the second array. If there is no+-- reserved space available in the first array a new allocation of exact+-- required size is done.+--+-- Note that the returned array may be a mutated version of first array.+--+-- >>> splice = MutArray.spliceWith (+)+--+-- If the original array is pinned the spliced array is also pinned.+--+-- /Pre-release/+{-# INLINE splice #-}+splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+splice = spliceWith (+)++-- | Like 'append' but the growth of the array is exponential. Whenever a new+-- allocation is required the previous array size is at least doubled.+--+-- This is useful to reduce allocations when folding many arrays together.+--+-- Note that the returned array may be a mutated version of first array.+--+-- >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))+--+-- /Pre-release/+{-# INLINE spliceExp #-}+spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))++-------------------------------------------------------------------------------+-- Splitting+-------------------------------------------------------------------------------++-- | Drops the separator byte+{-# INLINE breakOn #-}+breakOn :: MonadIO m+    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do+    -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted+    -- Addr# to memchr and it should be safe (from ghc 8.4).+    -- XXX We do not need memchr here, we can use a Haskell equivalent.+    loc <- c_memchr p sep (fromIntegral $ byteLength arr)+    let sepIndex = loc `minusPtr` p+    return $+        if loc == nullPtr+        then (arr, Nothing)+        else+            ( MutArray+                { arrContents = arrContents+                , arrStart = arrStart+                , arrEnd = arrStart + sepIndex -- exclude the separator+                , arrBound = arrStart + sepIndex+                }+            , Just $ MutArray+                    { arrContents = arrContents+                    , arrStart = arrStart + (sepIndex + 1)+                    , arrEnd = arrEnd+                    , arrBound = arrBound+                    }+            )++-- | Create two slices of an array without copying the original array. The+-- specified index @i@ is the first index of the second slice.+--+splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+splitAt i arr@MutArray{..} =+    let maxIndex = length arr - 1+    in  if i < 0+        then error "sliceAt: negative array index"+        else if i > maxIndex+             then error $ "sliceAt: specified array index " ++ show i+                        ++ " is beyond the maximum index " ++ show maxIndex+             else let off = i * SIZE_OF(a)+                      p = arrStart + off+                in ( MutArray+                  { arrContents = arrContents+                  , arrStart = arrStart+                  , arrEnd = p+                  , arrBound = p+                  }+                , MutArray+                  { arrContents = arrContents+                  , arrStart = p+                  , arrEnd = arrEnd+                  , arrBound = arrBound+                  }+                )++-------------------------------------------------------------------------------+-- Casting+-------------------------------------------------------------------------------++-- | Cast an array having elements of type @a@ into an array having elements of+-- type @b@. The array size must be a multiple of the size of type @b@+-- otherwise accessing the last element of the array may result into a crash or+-- a random value.+--+-- /Pre-release/+--+castUnsafe ::+#ifdef DEVBUILD+    Unbox b =>+#endif+    MutArray a -> MutArray b+castUnsafe (MutArray contents start end bound) =+    MutArray contents start end bound++-- | Cast an @MutArray a@ into an @MutArray Word8@.+--+asBytes :: MutArray a -> MutArray Word8+asBytes = castUnsafe++-- | Cast an array having elements of type @a@ into an array having elements of+-- type @b@. The length of the array should be a multiple of the size of the+-- target element otherwise 'Nothing' is returned.+--+cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)+cast arr =+    let len = byteLength arr+        r = len `mod` SIZE_OF(b)+     in if r /= 0+        then Nothing+        else Just $ castUnsafe arr++-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted+-- pointer to the FFI call. For unsafe calls we do not need to pin the array.+-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in+-- before the pointer is wrapped.+--+-- From the GHC manual:+--+-- GHC, since version 8.4, guarantees that garbage collection will never occur+-- during an unsafe call, even in the bytecode interpreter, and further+-- guarantees that unsafe calls will be performed in the calling thread. Making+-- it safe to pass heap-allocated objects to unsafe functions.++-- Should we just name it asPtr, the unsafety is implicit for any pointer+-- operations. And we are safe from Haskell perspective because we will be+-- pinning the memory.++-- | Use a @MutArray a@ as @Ptr a@. This is useful when we want to pass an+-- array as a pointer to some operating system call or to a "safe" FFI call.+--+-- If the array is not pinned it is copied to pinned memory before passing it+-- to the monadic action.+--+-- /Performance Notes:/ Forces a copy if the array is not pinned. It is advised+-- that the programmer keeps this in mind and creates a pinned array+-- opportunistically before this operation occurs, to avoid the cost of a copy+-- if possible.+--+-- /Unsafe/ because of direct pointer operations. The user must ensure that+-- they are writing within the legal bounds of the array.+--+-- /Pre-release/+--+{-# INLINE asPtrUnsafe #-}+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+asPtrUnsafe arr f =+    Unboxed.asPtrUnsafe+        (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Compare the length of the arrays. If the length is equal, compare the+-- lexicographical ordering of two underlying byte arrays otherwise return the+-- result of length comparison.+--+-- /Pre-release/+{-# INLINE cmp #-}+cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+cmp arr1 arr2 =+    liftIO+        $ do+            let marr1 = getMutableByteArray# (arrContents arr1)+                marr2 = getMutableByteArray# (arrContents arr2)+                !(I# st1#) = arrStart arr1+                !(I# st2#) = arrStart arr2+                !(I# len#) = byteLength arr1+            case compare (byteLength arr1) (byteLength arr2) of+                EQ -> do+                    r <- liftIO $ IO $ \s# ->+                             let res =+                                     I#+                                         (compareByteArrays#+                                              (unsafeCoerce# marr1)+                                              st1#+                                              (unsafeCoerce# marr2)+                                              st2#+                                              len#)+                              in (# s#, res #)+                    return $ compare r 0+                x -> return x++-------------------------------------------------------------------------------+-- NFData+-------------------------------------------------------------------------------++-- | Strip elements which match with predicate from both ends.+--+-- /Pre-release/+{-# INLINE strip #-}+strip :: forall a m. (Unbox a, MonadIO m) =>+    (a -> Bool) -> MutArray a -> m (MutArray a)+strip eq arr@MutArray{..} = liftIO $ do+    st <- getStart arrStart+    end <- getLast arrEnd st+    return arr {arrStart = st, arrEnd = end, arrBound = end}++    where++    {-+    -- XXX This should have the same perf but it does not, investigate.+    getStart = do+        r <- liftIO $ D.head $ D.findIndices (not . eq) $ toStreamD arr+        pure $+            case r of+                Nothing -> arrEnd+                Just i -> PTR_INDEX(arrStart,i,a)+    -}++    getStart cur = do+        if cur < arrEnd+        then do+            r <- peekAt cur arrContents+            if eq r+            then getStart (INDEX_NEXT(cur,a))+            else return cur+        else return cur++    getLast cur low = do+        if cur > low+        then do+            let prev = INDEX_PREV(cur,a)+            r <- peekAt prev arrContents+            if eq r+            then getLast prev low+            else return cur+        else return cur++-- | Given an array sorted in ascending order except the last element being out+-- of order, use bubble sort to place the last element at the right place such+-- that the array remains sorted in ascending order.+--+-- /Pre-release/+{-# INLINE bubble #-}+bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()+bubble cmp0 arr =+    when (l > 1) $ do+        x <- getIndexUnsafe (l - 1) arr+        go x (l - 2)++        where++        l = length arr++        go x i =+            if i >= 0+            then do+                x1 <- getIndexUnsafe i arr+                case x `cmp0` x1 of+                    LT -> do+                        putIndexUnsafe (i + 1) arr x1+                        go x (i - 1)+                    _ -> putIndexUnsafe (i + 1) arr x+            else putIndexUnsafe (i + 1) arr x
+ src/Streamly/Internal/Data/MutByteArray.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE TemplateHaskell #-}++-- This is required as all the instances in this module are orphan instances.+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Streamly.Internal.Data.MutByteArray+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--++module Streamly.Internal.Data.MutByteArray+    (+    -- * MutByteArray+      module Streamly.Internal.Data.MutByteArray.Type+    -- * Unbox+    , module Streamly.Internal.Data.Unbox+    , module Streamly.Internal.Data.Unbox.TH+    -- * Serialize+    , module Streamly.Internal.Data.Serialize.Type+    -- * Serialize TH+    , module Streamly.Internal.Data.Serialize.TH+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.Array (Array(..))+import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)+import GHC.Word (Word8)++#if __GLASGOW_HASKELL__ >= 900+import GHC.Num.Integer (Integer(..))+#else+import GHC.Integer.GMP.Internals (Integer(..), BigNat(..))+#endif++import Streamly.Internal.Data.MutByteArray.Type+import Streamly.Internal.Data.Serialize.TH+import Streamly.Internal.Data.Serialize.Type+import Streamly.Internal.Data.Unbox+import Streamly.Internal.Data.Unbox.TH++--------------------------------------------------------------------------------+-- Common instances+--------------------------------------------------------------------------------++-- Note+-- ====+--+-- Even a non-functional change such as changing the order of constructors will+-- change the instance derivation.+--+-- This will not pose a problem if both, encode, and decode are done by the same+-- version of the application. There *might* be a problem if version that+-- encodes differs from the version that decodes.+--+-- We need to add some compatibility tests using different versions of+-- dependencies.+--+-- Although such chages for the most basic types won't happen we need to detect+-- if it ever happens.+--+-- Should we worry about these kind of changes and this kind of compatibility?+-- This is a problem for all types of derivations that depend on the order of+-- constructors, for example, Enum.++-- Note on Windows build+-- =====================+--+-- On Windows, having template haskell splices here fail the build with the+-- following error:+--+-- @+-- addLibrarySearchPath: C:\...  (Win32 error 3): The system cannot find the path specified.+-- @+--+-- The error might be irrelavant but having these splices triggers it. We should+-- either fix the problem or avoid the use to template haskell splices in this+-- file.+--+-- Similar issue: https://github.com/haskell/cabal/issues/4741++-- $(Serialize.deriveSerialize ''Maybe)+instance Serialize a => Serialize (Maybe a) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc x =+        case x of+            Nothing -> (acc + 1)+            Just field0 -> (addSizeTo (acc + 1)) field0++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset arr endOffset = do+        (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset+        case tag :: Word8 of+            0 -> pure (i0, Nothing)+            1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+                    pure (i1, Just a0)+            _ -> error "Found invalid tag while peeking (Maybe a)"++    {-# INLINE serializeAt #-}+    serializeAt initialOffset arr val =+        case val of+            Nothing -> do+                i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)+                pure i0+            Just field0 -> do+                i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)+                i1 <- ((serializeAt i0) arr) field0+                pure i1++-- $(Serialize.deriveSerialize ''Either)+instance (Serialize a, Serialize b) => Serialize (Either a b) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc x =+        case x of+            Left field0 -> (addSizeTo (acc + 1)) field0+            Right field0 -> (addSizeTo (acc + 1)) field0++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset arr endOffset = do+        (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset+        case tag :: Word8 of+            0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+                    pure (i1, Left a0)+            1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+                    pure (i1, Right a0)+            _ -> error "Found invalid tag while peeking (Either a b)"++    {-# INLINE serializeAt #-}+    serializeAt initialOffset arr val =+        case val of+            Left field0 -> do+                i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)+                i1 <- ((serializeAt i0) arr) field0+                pure i1+            Right field0 -> do+                i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)+                i1 <- ((serializeAt i0) arr) field0+                pure i1++instance Serialize (Proxy a) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc _ = (acc + 1)++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset _ _ = pure ((initialOffset + 1), Proxy)++    {-# INLINE serializeAt #-}+    serializeAt initialOffset _ _ = pure (initialOffset + 1)++--------------------------------------------------------------------------------+-- Integer+--------------------------------------------------------------------------------++data LiftedInteger+    = LIS Int+    | LIP (Array Word)+    | LIN (Array Word)++-- $(Serialize.deriveSerialize ''LiftedInteger)+instance Serialize LiftedInteger where++    {-# INLINE addSizeTo #-}+    addSizeTo acc x =+        case x of+            LIS field0 -> (addSizeTo (acc + 1)) field0+            LIP field0 -> (addSizeTo (acc + 1)) field0+            LIN field0 -> (addSizeTo (acc + 1)) field0++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset arr endOffset = do+        (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset+        case tag :: Word8 of+            0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+                    pure (i1, LIS a0)+            1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+                    pure (i1, LIP a0)+            2 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+                    pure (i1, LIN a0)+            _ -> error "Found invalid tag while peeking (LiftedInteger)"++    {-# INLINE serializeAt #-}+    serializeAt initialOffset arr val =+        case val of+            LIS field0 -> do+                i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)+                i1 <- ((serializeAt i0) arr) field0+                pure i1+            LIP field0 -> do+                i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)+                i1 <- ((serializeAt i0) arr) field0+                pure i1+            LIN field0 -> do+                i0 <- ((serializeAt initialOffset) arr) (2 :: Word8)+                i1 <- ((serializeAt i0) arr) field0+                pure i1++#if __GLASGOW_HASKELL__ >= 900++{-# INLINE liftInteger #-}+liftInteger :: Integer -> LiftedInteger+liftInteger (IS x) = LIS (I# x)+liftInteger (IP x) =+    LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))+liftInteger (IN x) =+    LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))++{-# INLINE unliftInteger #-}+unliftInteger :: LiftedInteger -> Integer+unliftInteger (LIS (I# x)) = IS x+unliftInteger (LIP (Array (MutByteArray x) _ _)) = IP (unsafeCoerce# x)+unliftInteger (LIN (Array (MutByteArray x) _ _)) = IN (unsafeCoerce# x)++#else++{-# INLINE liftInteger #-}+liftInteger :: Integer -> LiftedInteger+liftInteger (S# x) = LIS (I# x)+liftInteger (Jp# (BN# x)) =+    LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))+liftInteger (Jn# (BN# x)) =+    LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))++{-# INLINE unliftInteger #-}+unliftInteger :: LiftedInteger -> Integer+unliftInteger (LIS (I# x)) = S# x+unliftInteger (LIP (Array (MutByteArray x) _ _)) =+    Jp# (BN# (unsafeCoerce# x))+unliftInteger (LIN (Array (MutByteArray x) _ _)) =+    Jn# (BN# (unsafeCoerce# x))++#endif++instance Serialize Integer where+    {-# INLINE addSizeTo #-}+    addSizeTo i a = addSizeTo i (liftInteger a)++    {-# INLINE deserializeAt #-}+    deserializeAt off arr end =+        fmap unliftInteger <$> deserializeAt off arr end++    {-# INLINE serializeAt #-}+    serializeAt off arr val = serializeAt off arr (liftInteger val)
+ src/Streamly/Internal/Data/MutByteArray/Type.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module      : Streamly.Internal.Data.MutByteArray.Type+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.MutByteArray.Type+    (+    -- ** MutByteArray+      MutByteArray(..)+    , MutableByteArray+    , getMutableByteArray#++    -- ** Pinning+    , PinnedState(..)+    , isPinned+    , pin+    , unpin++    -- ** Allocation+    , nil+    , newBytesAs+    , new+    , pinnedNew+    , pinnedNewAlignedBytes++    -- ** Access+    , sizeOfMutableByteArray+    , putSliceUnsafe+    , cloneSliceUnsafeAs+    , cloneSliceUnsafe+    , pinnedCloneSliceUnsafe+    , asPtrUnsafe+    ) where++import Control.Monad.IO.Class (MonadIO(..))+#ifdef DEBUG+import Control.Monad (when)+import Debug.Trace (trace)+#endif+import GHC.Base (IO(..))+import System.IO.Unsafe (unsafePerformIO)++import GHC.Exts++--------------------------------------------------------------------------------+-- The ArrayContents type+--------------------------------------------------------------------------------++data PinnedState+    = Pinned+    | Unpinned++-- XXX can use UnliftedNewtypes++-- | A lifted mutable byte array type wrapping @MutableByteArray# RealWorld@.+-- This is a low level array used to back high level unboxed arrays and+-- serialized data.+data MutByteArray = MutByteArray (MutableByteArray# RealWorld)++{-# DEPRECATED MutableByteArray "Please use MutByteArray instead" #-}+type MutableByteArray = MutByteArray++{-# INLINE getMutableByteArray# #-}+getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld+getMutableByteArray# (MutByteArray mbarr) = mbarr++-- | Return the size of the array in bytes.+{-# INLINE sizeOfMutableByteArray #-}+sizeOfMutableByteArray :: MutByteArray -> IO Int+sizeOfMutableByteArray (MutByteArray arr) =+    IO $ \s ->+        case getSizeofMutableByteArray# arr s of+            (# s1, i #) -> (# s1, I# i #)++{-# INLINE touch #-}+touch :: MutByteArray -> IO ()+touch (MutByteArray contents) =+    IO $ \s -> case touch# contents s of s' -> (# s', () #)++-- XXX We can provide another API for "unsafe" FFI calls passing an unlifted+-- pointer to the FFI call. For unsafe calls we do not need to pin the array.+-- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in+-- before the pointer is wrapped.+--+-- From the GHC manual:+--+-- GHC, since version 8.4, guarantees that garbage collection will never occur+-- during an unsafe call, even in the bytecode interpreter, and further+-- guarantees that unsafe calls will be performed in the calling thread. Making+-- it safe to pass heap-allocated objects to unsafe functions.++-- | Use a @MutByteArray@ as @Ptr a@. This is useful when we want to pass+-- an array as a pointer to some operating system call or to a "safe" FFI call.+--+-- If the array is not pinned it is copied to pinned memory before passing it+-- to the monadic action.+--+-- /Performance Notes:/ Forces a copy if the array is not pinned. It is advised+-- that the programmer keeps this in mind and creates a pinned array+-- opportunistically before this operation occurs, to avoid the cost of a copy+-- if possible.+--+-- /Unsafe/ because of direct pointer operations. The user must ensure that+-- they are writing within the legal bounds of the array.+--+-- /Pre-release/+--+{-# INLINE asPtrUnsafe #-}+asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+asPtrUnsafe arr f = do+  contents <- liftIO $ pin arr+  let !ptr = Ptr (byteArrayContents#+                     (unsafeCoerce# (getMutableByteArray# contents)))+  r <- f ptr+  liftIO $ touch contents+  return r++--------------------------------------------------------------------------------+-- Creation+--------------------------------------------------------------------------------++{-# NOINLINE nil #-}+nil :: MutByteArray+nil = unsafePerformIO $ new 0++{-# INLINE new #-}+new :: Int -> IO MutByteArray+new nbytes | nbytes < 0 =+  errorWithoutStackTrace "newByteArray: size must be >= 0"+new (I# nbytes) = IO $ \s ->+    case newByteArray# nbytes s of+        (# s', mbarr# #) ->+           let c = MutByteArray mbarr#+            in (# s', c #)++{-# INLINE pinnedNew #-}+pinnedNew :: Int -> IO MutByteArray+pinnedNew nbytes | nbytes < 0 =+  errorWithoutStackTrace "pinnedNewByteArray: size must be >= 0"+pinnedNew (I# nbytes) = IO $ \s ->+    case newPinnedByteArray# nbytes s of+        (# s', mbarr# #) ->+           let c = MutByteArray mbarr#+            in (# s', c #)++{-# INLINE pinnedNewAlignedBytes #-}+pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray+pinnedNewAlignedBytes nbytes _align | nbytes < 0 =+  errorWithoutStackTrace "pinnedNewAlignedBytes: size must be >= 0"+pinnedNewAlignedBytes (I# nbytes) (I# align) = IO $ \s ->+    case newAlignedPinnedByteArray# nbytes align s of+        (# s', mbarr# #) ->+           let c = MutByteArray mbarr#+            in (# s', c #)++{-# INLINE newBytesAs #-}+newBytesAs :: PinnedState -> Int -> IO MutByteArray+newBytesAs Unpinned = new+newBytesAs Pinned = pinnedNew++-------------------------------------------------------------------------------+-- Copying+-------------------------------------------------------------------------------++-- | Put a sub range of a source array into a subrange of a destination array.+-- This is not safe as it does not check the bounds of neither the src array+-- nor the destination array.+{-# INLINE putSliceUnsafe #-}+putSliceUnsafe ::+       MonadIO m+    => MutByteArray+    -> Int+    -> MutByteArray+    -> Int+    -> Int+    -> m ()+putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do+#ifdef DEBUG+    srcLen <- sizeOfMutableByteArray src+    dstLen <- sizeOfMutableByteArray dst+    when (srcLen - srcStartBytes < lenBytes)+        $ error $ "putSliceUnsafe: src overflow: start" ++ show srcStartBytes+            ++ " end " ++ show srcLen ++ " len " ++ show lenBytes+    when (dstLen - dstStartBytes < lenBytes)+        $ error $ "putSliceUnsafe: dst overflow: start" ++ show dstStartBytes+            ++ " end " ++ show dstLen ++ " len " ++ show lenBytes+#endif+    let !(I# srcStartBytes#) = srcStartBytes+        !(I# dstStartBytes#) = dstStartBytes+        !(I# lenBytes#) = lenBytes+    let arrS# = getMutableByteArray# src+        arrD# = getMutableByteArray# dst+    IO $ \s# -> (# copyMutableByteArray#+                    arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#+                , () #)++-- | Unsafe as it does not check whether the start offset and length supplied+-- are valid inside the array.+{-# INLINE cloneSliceUnsafeAs #-}+cloneSliceUnsafeAs :: MonadIO m =>+    PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray+cloneSliceUnsafeAs ps srcOff srcLen src =+    liftIO $ do+        mba <- newBytesAs ps srcLen+        putSliceUnsafe src srcOff mba 0 srcLen+        return mba++-- | @cloneSliceUnsafe offset len arr@ clones a slice of the supplied array+-- starting at the given offset and equal to the given length.+{-# INLINE cloneSliceUnsafe #-}+cloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+cloneSliceUnsafe = cloneSliceUnsafeAs Unpinned++-- | @pinnedCloneSliceUnsafe offset len arr@+{-# INLINE pinnedCloneSliceUnsafe #-}+pinnedCloneSliceUnsafe :: MonadIO m =>+    Int -> Int -> MutByteArray -> m MutByteArray+pinnedCloneSliceUnsafe = cloneSliceUnsafeAs Pinned++-------------------------------------------------------------------------------+-- Pinning & Unpinning+-------------------------------------------------------------------------------++-- | Return 'True' if the array is allocated in pinned memory.+{-# INLINE isPinned #-}+isPinned :: MutByteArray -> Bool+isPinned (MutByteArray arr#) =+    let pinnedInt = I# (isMutableByteArrayPinned# arr#)+     in pinnedInt /= 0+++{-# INLINE cloneMutableArrayWith# #-}+cloneMutableArrayWith#+    :: (Int# -> State# RealWorld -> (# State# RealWorld+                                     , MutableByteArray# RealWorld #))+    -> MutableByteArray# RealWorld+    -> State# RealWorld+    -> (# State# RealWorld, MutableByteArray# RealWorld #)+cloneMutableArrayWith# alloc# arr# s# =+    case getSizeofMutableByteArray# arr# s# of+        (# s1#, i# #) ->+            case alloc# i# s1# of+                (# s2#, arr1# #) ->+                    case copyMutableByteArray# arr# 0# arr1# 0# i# s2# of+                        s3# -> (# s3#, arr1# #)++-- | Return a copy of the array in pinned memory if unpinned, else return the+-- original array.+{-# INLINE pin #-}+pin :: MutByteArray -> IO MutByteArray+pin arr@(MutByteArray marr#) =+    if isPinned arr+    then return arr+    else+#ifdef DEBUG+      do+        -- XXX dump stack trace+        trace ("pin: Copying array") (return ())+#endif+        IO+             $ \s# ->+                   case cloneMutableArrayWith# newPinnedByteArray# marr# s# of+                       (# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)++-- | Return a copy of the array in unpinned memory if pinned, else return the+-- original array.+{-# INLINE unpin #-}+unpin :: MutByteArray -> IO MutByteArray+unpin arr@(MutByteArray marr#) =+    if not (isPinned arr)+    then return arr+    else+#ifdef DEBUG+      do+        -- XXX dump stack trace+        trace ("unpin: Copying array") (return ())+#endif+        IO+             $ \s# ->+                   case cloneMutableArrayWith# newByteArray# marr# s# of+                       (# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)
src/Streamly/Internal/Data/Parser.hs view
@@ -1,14 +1,3621 @@--- |--- Module      : Streamly.Internal.Data.Parser--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Parser-    ( module Streamly.Internal.Data.Parser.ParserD-    )-where--import Streamly.Internal.Data.Parser.ParserD+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Parser+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Parser+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++      module Streamly.Internal.Data.Parser.Type+    --, module Streamly.Internal.Data.Parser.Tee++    -- * Types+    , Parser (..)+    , ParseError (..)+    , Step (..)+    , Initial (..)++    -- * Downgrade to Fold+    , toFold++    -- First order parsers+    -- * Accumulators+    , fromFold+    , fromFoldMaybe++    -- * Map on input+    , postscan++    -- * Element parsers+    , peek++    -- All of these can be expressed in terms of either+    , one+    , oneEq+    , oneNotEq+    , oneOf+    , noneOf+    , eof+    , satisfy+    , maybe+    , either++    -- * Sequence parsers (tokenizers)+    --+    -- | Parsers chained in series, if one parser terminates the composition+    -- terminates. Currently we are using folds to collect the output of the+    -- parsers but we can use Parsers instead of folds to make the composition+    -- more powerful. For example, we can do:+    --+    -- takeEndByOrMax cond n p = takeEndBy cond (take n p)+    -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)+    -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)+    , lookAhead++    -- ** By length+    -- | Grab a sequence of input elements without inspecting them+    , takeBetween+    -- , take -- takeBetween 0 n+    , takeEQ -- takeBetween n n+    , takeGE -- takeBetween n maxBound+    -- , takeGE1 -- take1 -- takeBetween 1 n+    , takeP++    -- Grab a sequence of input elements by inspecting them+    -- ** Exact match+    , listEq+    , listEqBy+    , streamEqBy+    , subsequenceBy++    -- ** By predicate+    , takeWhile+    , takeWhileP+    , takeWhile1+    , dropWhile++    -- ** Separated by elements+    -- | Separator could be in prefix postion ('takeStartBy'), or suffix+    -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix+    -- separator parsing, also see 'intersperseQuotedBy' fold.++    -- These can be implemented modularly with refolds, using takeWhile and+    -- satisfy.+    , takeEndBy+    , takeEndBy_+    , takeEndByEsc+    -- , takeEndByEsc_+    , takeStartBy+    , takeStartBy_+    , takeEitherSepBy+    , wordBy++    -- ** Grouped by element comparison+    , groupBy+    , groupByRolling+    , groupByRollingEither++    -- ** Framed by elements+    -- | Also see 'intersperseQuotedBy' fold.+    -- Framed by a one or more ocurrences of a separator around a word like+    -- spaces or quotes. No nesting.+    , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?+    , wordWithQuotes+    , wordKeepQuotes+    , wordProcessQuotes++    -- Framed by separate start and end characters, potentially nested.+    -- blockWithQuotes allows quotes inside a block. However,+    -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and+    -- block with escaping.+    -- , takeFramedBy+    , takeFramedBy_+    , takeFramedByEsc_+    , takeFramedByGeneric+    , blockWithQuotes++    -- Matching strings+    -- , prefixOf -- match any prefix of a given string+    -- , suffixOf -- match any suffix of a given string+    -- , infixOf -- match any substring of a given string++    -- ** Spanning+    , span+    , spanBy+    , spanByRolling++    -- Second order parsers (parsers using parsers)+    -- * Binary Combinators+    {-+    -- ** Parallel Applicatives+    , teeWith+    , teeWithFst+    , teeWithMin+    -- , teeTill -- like manyTill but parallel+    -}++    {-+    -- ** Parallel Alternatives+    , shortest+    , longest+    -- , fastest+    -}++    -- * N-ary Combinators+    -- ** Sequential Collection+    , sequence++    -- ** Sequential Repetition+    , count+    , countBetween+    -- , countBetweenTill+    , manyP+    , many+    , some++    -- ** Interleaved Repetition+    -- Use two folds, run a primary parser, its rejected values go to the+    -- secondary parser.+    , deintercalate+    , deintercalate1+    , deintercalateAll+    -- , deintercalatePrefix+    -- , deintercalateSuffix++    -- *** Special cases+    -- | TODO: traditional implmentations of these may be of limited use. For+    -- example, consider parsing lines separated by @\\r\\n@. The main parser+    -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we+    -- can apply the "sep" parser.+    --+    -- We can instead implement these as special cases of deintercalate.+    --+    -- @+    -- , endBy+    -- , sepEndBy+    -- , beginBy+    -- , sepBeginBy+    -- , sepAroundBy+    -- @+    , sepBy1+    , sepBy+    , sepByAll++    , manyTillP+    , manyTill+    , manyThen++    -- -- * Distribution+    --+    -- A simple and stupid impl would be to just convert the stream to an array+    -- and give the array reference to all consumers. The array can be grown on+    -- demand by any consumer and truncated when nonbody needs it.+    --+    -- -- ** Distribute to collection+    -- -- ** Distribute to repetition++    -- ** Interleaved collection+    -- |+    --+    -- 1. Round robin+    -- 2. Priority based+    , roundRobin++    -- -- ** Interleaved repetition+    -- repeat one parser and when it fails run an error recovery parser+    -- e.g. to find a key frame in the stream after an error++    -- ** Collection of Alternatives+    -- | Unimplemented+    --+    -- @+    -- , shortestN+    -- , longestN+    -- , fastestN -- first N successful in time+    -- , choiceN  -- first N successful in position+    -- @+    -- , choice   -- first successful in position++    -- ** Repeated Alternatives+    , retryMaxTotal+    , retryMaxSuccessive+    , retry++    -- ** Zipping Input+    , zipWithM+    , zip+    , indexed+    , makeIndexFilter+    , sampleFromthen++     -- * Deprecated+    , next+    )+where++#include "inline.hs"+#include "assert.hs"++import Control.Monad (when)+import Data.Bifunctor (first)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.SVar.Type (defState)+import Streamly.Internal.Data.Either.Strict (Either'(..))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Stream.Type (Stream)++import qualified Data.Foldable as Foldable+import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Generate as D++import Streamly.Internal.Data.Parser.Type+--import Streamly.Internal.Data.Parser.Tee -- It's empty++import Prelude hiding+       (any, all, take, takeWhile, sequence, concatMap, maybe, either, span+       , zip, filter, dropWhile)++#include "DocTestDataParser.hs"++-------------------------------------------------------------------------------+-- Downgrade a parser to a Fold+-------------------------------------------------------------------------------++-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the+-- parser fails or tries to backtrack.+--+-- This can be useful in combinators that accept a Fold and we know that a+-- Parser cannot fail or failure exception is acceptable as there is no way to+-- recover.+--+-- /Pre-release/+--+{-# INLINE toFold #-}+toFold :: Monad m => Parser a m b -> Fold m a b+toFold (Parser pstep pinitial pextract) = Fold step initial extract final++    where++    initial = do+        r <- pinitial+        case r of+            IPartial s -> return $ FL.Partial s+            IDone b -> return $ FL.Done b+            IError err ->+                error $ "toFold: parser throws error in initial" ++ err++    perror n = error $ "toFold: parser backtracks in Partial: " ++ show n+    cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n+    derror n = error $ "toFold: parser backtracks in Done: " ++ show n+    eerror err = error $ "toFold: parser throws error: " ++ err++    step st a = do+        r <- pstep st a+        case r of+            Partial 0 s -> return $ FL.Partial s+            Continue 0 s -> return $ FL.Partial s+            Done 0 b -> return $ FL.Done b+            Partial n _ -> perror n+            Continue n _ -> cerror n+            Done n _ -> derror n+            Error err -> eerror err++    extract = error "toFold: parser cannot be used for scanning"++    final st = do+        r <- pextract st+        case r of+            Done 0 b -> return b+            Partial n _ -> perror n+            Continue n _ -> cerror n+            Done n _ -> derror n+            Error err -> eerror err++-------------------------------------------------------------------------------+-- Upgrade folds to parses+-------------------------------------------------------------------------------++-- | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the+-- fold.+--+{-# INLINE fromFold #-}+fromFold :: Monad m => Fold m a b -> Parser a m b+fromFold (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    initial = do+        res <- finitial+        return+            $ case res of+                  FL.Partial s1 -> IPartial s1+                  FL.Done b -> IDone b++    step s a = do+        res <- fstep s a+        return+            $ case res of+                  FL.Partial s1 -> Partial 0 s1+                  FL.Done b -> Done 0 b++    extract = fmap (Done 0) . ffinal++-- | Convert a Maybe returning fold to an error returning parser. The first+-- argument is the error message that the parser would return when the fold+-- returns Nothing.+--+-- /Pre-release/+--+{-# INLINE fromFoldMaybe #-}+fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b+fromFoldMaybe errMsg (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return+            $ case res of+                  FL.Partial s1 -> IPartial s1+                  FL.Done b ->+                        case b of+                            Just x -> IDone x+                            Nothing -> IError errMsg++    step s a = do+        res <- fstep s a+        return+            $ case res of+                  FL.Partial s1 -> Partial 0 s1+                  FL.Done b ->+                        case b of+                            Just x -> Done 0 x+                            Nothing -> Error errMsg++    extract s = do+        res <- ffinal s+        case res of+            Just x -> return $ Done 0 x+            Nothing -> return $ Error errMsg++-------------------------------------------------------------------------------+-- Failing Parsers+-------------------------------------------------------------------------------++-- | Peek the head element of a stream, without consuming it. Fails if it+-- encounters end of input.+--+-- >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]+-- Right (1,1)+--+-- @+-- peek = lookAhead (satisfy True)+-- @+--+{-# INLINE peek #-}+peek :: Monad m => Parser a m a+peek = Parser step initial extract++    where++    initial = return $ IPartial ()++    step () a = return $ Done 1 a++    extract () = return $ Error "peek: end of input"++-- | Succeeds if we are at the end of input, fails otherwise.+--+-- >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]+-- Right (1,())+--+{-# INLINE eof #-}+eof :: Monad m => Parser a m ()+eof = Parser step initial extract++    where++    initial = return $ IPartial ()++    step () _ = return $ Error "eof: not at end of input"++    extract () = return $ Done 0 ()++-- | Return the next element of the input. Returns 'Nothing'+-- on end of input. Also known as 'head'.+--+-- /Pre-release/+--+{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}+{-# INLINE next #-}+next :: Monad m => Parser a m (Maybe a)+next = Parser step initial extract++  where++  initial = pure $ IPartial ()++  step () a = pure $ Done 0 (Just a)++  extract () = pure $ Done 0 Nothing++-- | Map an 'Either' returning function on the next element in the stream.  If+-- the function returns 'Left err', the parser fails with the error message+-- @err@ otherwise returns the 'Right' value.+--+-- /Pre-release/+--+{-# INLINE either #-}+either :: Monad m => (a -> Either String b) -> Parser a m b+either f = Parser step initial extract++    where++    initial = return $ IPartial ()++    step () a = return $+        case f a of+            Right b -> Done 0 b+            Left err -> Error err++    extract () = return $ Error "end of input"++-- | Map a 'Maybe' returning function on the next element in the stream. The+-- parser fails if the function returns 'Nothing' otherwise returns the 'Just'+-- value.+--+-- >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right+-- >>> maybe f = Parser.either (toEither . f)+--+-- >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)+--+-- /Pre-release/+--+{-# INLINE maybe #-}+maybe :: Monad m => (a -> Maybe b) -> Parser a m b+-- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)+maybe parserF = Parser step initial extract++    where++    initial = return $ IPartial ()++    step () a = return $+        case parserF a of+            Just b -> Done 0 b+            Nothing -> Error "maybe: predicate failed"++    extract () = return $ Error "maybe: end of input"++-- | Returns the next element if it passes the predicate, fails otherwise.+--+-- >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]+-- Right 1+--+-- >>> toMaybe f x = if f x then Just x else Nothing+-- >>> satisfy f = Parser.maybe (toMaybe f)+--+{-# INLINE satisfy #-}+satisfy :: Monad m => (a -> Bool) -> Parser a m a+-- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)+satisfy predicate = Parser step initial extract++    where++    initial = return $ IPartial ()++    step () a = return $+        if predicate a+        then Done 0 a+        else Error "satisfy: predicate failed"++    extract () = return $ Error "satisfy: end of input"++-- | Consume one element from the head of the stream.  Fails if it encounters+-- end of input.+--+-- >>> one = Parser.satisfy $ const True+--+{-# INLINE one #-}+one :: Monad m => Parser a m a+one = satisfy $ const True++-- Alternate names: "only", "onlyThis".++-- | Match a specific element.+--+-- >>> oneEq x = Parser.satisfy (== x)+--+{-# INLINE oneEq #-}+oneEq :: (Monad m, Eq a) => a -> Parser a m a+oneEq x = satisfy (== x)++-- Alternate names: "exclude", "notThis".++-- | Match anything other than the supplied element.+--+-- >>> oneNotEq x = Parser.satisfy (/= x)+--+{-# INLINE oneNotEq #-}+oneNotEq :: (Monad m, Eq a) => a -> Parser a m a+oneNotEq x = satisfy (/= x)++-- | Match any one of the elements in the supplied list.+--+-- >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)+--+-- When performance matters a pattern matching predicate could be more+-- efficient than a 'Foldable' datatype:+--+-- @+-- let p x =+--    case x of+--       'a' -> True+--       'e' -> True+--        _  -> False+-- in satisfy p+-- @+--+-- GHC may use a binary search instead of linear search in the list.+-- Alternatively, you can also use an array instead of list for storage and+-- search.+--+{-# INLINE oneOf #-}+oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+oneOf xs = satisfy (`Foldable.elem` xs)++-- | See performance notes in 'oneOf'.+--+-- >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)+--+{-# INLINE noneOf #-}+noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+noneOf xs = satisfy (`Foldable.notElem` xs)++-------------------------------------------------------------------------------+-- Taking elements+-------------------------------------------------------------------------------++-- Required to fuse "take" with "many" in "chunksOf", for ghc-9.x+{-# ANN type Tuple'Fused Fuse #-}+data Tuple'Fused a b = Tuple'Fused !a !b deriving Show++-- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input+-- elements and folds them using the supplied fold.+--+-- Stops after @n@ elements.+-- Fails if the stream ends before @m@ elements could be taken.+--+-- Examples: -+--+-- @+-- >>> :{+--   takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)+--     where prsr = Parser.takeBetween low high Fold.toList+-- :}+--+-- @+--+-- >>> takeBetween' 2 4 [1, 2, 3, 4, 5]+-- Right [1,2,3,4]+--+-- >>> takeBetween' 2 4 [1, 2]+-- Right [1,2]+--+-- >>> takeBetween' 2 4 [1]+-- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")+--+-- >>> takeBetween' 0 0 [1, 2]+-- Right []+--+-- >>> takeBetween' 0 1 []+-- Right []+--+-- @takeBetween@ is the most general take operation, other take operations can+-- be defined in terms of takeBetween. For example:+--+-- >>> take n = Parser.takeBetween 0 n+-- >>> takeEQ n = Parser.takeBetween n n+-- >>> takeGE n = Parser.takeBetween n maxBound+--+-- /Pre-release/+--+{-# INLINE takeBetween #-}+takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b+takeBetween low high (Fold fstep finitial _ ffinal) =++    Parser step initial (extract streamErr)++    where++    streamErr i =+           "takeBetween: Expecting alteast " ++ show low+        ++ " elements, got " ++ show i++    invalidRange =+        "takeBetween: lower bound - " ++ show low+            ++ " is greater than higher bound - " ++ show high++    foldErr :: Int -> String+    foldErr i =+        "takeBetween: the collecting fold terminated after"+            ++ " consuming" ++ show i ++ " elements"+            ++ " minimum" ++ show low ++ " elements needed"++    -- Exactly the same as snext except different constructors, we can possibly+    -- deduplicate the two.+    {-# INLINE inext #-}+    inext i res =+        let i1 = i + 1+        in case res of+            FL.Partial s -> do+                let s1 = Tuple'Fused i1 s+                if i1 < high+                -- XXX ideally this should be a Continue instead+                then return $ IPartial s1+                else iextract foldErr s1+            FL.Done b ->+                return+                    $ if i1 >= low+                      then IDone b+                      else IError (foldErr i1)++    initial = do+        when (low >= 0 && high >= 0 && low > high)+            $ error invalidRange++        finitial >>= inext (-1)++    -- Keep the impl same as inext+    {-# INLINE snext #-}+    snext i res =+        let i1 = i + 1+        in case res of+            FL.Partial s -> do+                let s1 = Tuple'Fused i1 s+                if i1 < low+                then return $ Continue 0 s1+                else if i1 < high+                then return $ Partial 0 s1+                else fmap (Done 0) (ffinal s)+            FL.Done b ->+                return+                    $ if i1 >= low+                      then Done 0 b+                      else Error (foldErr i1)++    step (Tuple'Fused i s) a = fstep s a >>= snext i++    extract f (Tuple'Fused i s)+        | i >= low && i <= high = fmap (Done 0) (ffinal s)+        | otherwise = return $ Error (f i)++    -- XXX Need to make Initial return type Step to deduplicate this+    iextract f (Tuple'Fused i s)+        | i >= low && i <= high = fmap IDone (ffinal s)+        | otherwise = return $ IError (f i)++-- | Stops after taking exactly @n@ input elements.+--+-- * Stops - after consuming @n@ elements.+-- * Fails - if the stream or the collecting fold ends before it can collect+--           exactly @n@ elements.+--+-- >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]+-- Right [1,0]+--+-- >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]+-- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")+--+{-# INLINE takeEQ #-}+takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b+takeEQ n (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    initial = do+        res <- finitial+        case res of+            FL.Partial s ->+                if n > 0+                then return $ IPartial $ Tuple'Fused 1 s+                else fmap IDone (ffinal s)+            FL.Done b -> return $+                if n > 0+                then IError+                         $ "takeEQ: Expecting exactly " ++ show n+                             ++ " elements, fold terminated without"+                             ++ " consuming any elements"+                else IDone b++    step (Tuple'Fused i1 r) a = do+        res <- fstep r a+        if n > i1+        then+            return+                $ case res of+                    FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s+                    FL.Done _ ->+                        Error+                            $ "takeEQ: Expecting exactly " ++ show n+                                ++ " elements, fold terminated on " ++ show i1+        else+            -- assert (n == i1)+            Done 0+                <$> case res of+                        FL.Partial s -> ffinal s+                        FL.Done b -> return b++    extract (Tuple'Fused i _) =+        -- Using the count "i" in the message below causes large performance+        -- regression unless we use Fuse annotation on Tuple.+        return+            $ Error+            $ "takeEQ: Expecting exactly " ++ show n+                ++ " elements, input terminated on " ++ show (i - 1)++{-# ANN type TakeGEState Fuse #-}+data TakeGEState s =+      TakeGELT !Int !s+    | TakeGEGE !s++-- | Take at least @n@ input elements, but can collect more.+--+-- * Stops - when the collecting fold stops.+-- * Fails - if the stream or the collecting fold ends before producing @n@+--           elements.+--+-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]+-- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")+--+-- >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]+-- Right [1,0,1,0,1]+--+-- /Pre-release/+--+{-# INLINE takeGE #-}+takeGE :: Monad m => Int -> Fold m a b -> Parser a m b+takeGE n (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    initial = do+        res <- finitial+        case res of+            FL.Partial s ->+                if n > 0+                then return $ IPartial $ TakeGELT 1 s+                else return $ IPartial $ TakeGEGE s+            FL.Done b -> return $+                if n > 0+                then IError+                         $ "takeGE: Expecting at least " ++ show n+                             ++ " elements, fold terminated without"+                             ++ " consuming any elements"+                else IDone b++    step (TakeGELT i1 r) a = do+        res <- fstep r a+        if n > i1+        then+            return+                $ case res of+                      FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s+                      FL.Done _ ->+                        Error+                            $ "takeGE: Expecting at least " ++ show n+                                ++ " elements, fold terminated on " ++ show i1+        else+            -- assert (n <= i1)+            return+                $ case res of+                      FL.Partial s -> Partial 0 $ TakeGEGE s+                      FL.Done b -> Done 0 b+    step (TakeGEGE r) a = do+        res <- fstep r a+        return+            $ case res of+                  FL.Partial s -> Partial 0 $ TakeGEGE s+                  FL.Done b -> Done 0 b++    extract (TakeGELT i _) =+        return+            $ Error+            $ "takeGE: Expecting at least " ++ show n+                ++ " elements, input terminated on " ++ show (i - 1)+    extract (TakeGEGE r) = fmap (Done 0) $ ffinal r++-------------------------------------------------------------------------------+-- Conditional splitting+-------------------------------------------------------------------------------++-- XXX We should perhaps use only takeWhileP and rename it to takeWhile.++-- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the+-- input. The combinator stops when the condition fails or if the collecting+-- parser stops.+--+-- Other interesting parsers can be implemented in terms of this parser:+--+-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)+-- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)+--+-- Stops: when the condition fails or the collecting parser stops.+-- Fails: when the collecting parser fails.+--+-- /Pre-release/+--+{-# INLINE takeWhileP #-}+takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+takeWhileP predicate (Parser pstep pinitial pextract) =+    Parser step pinitial pextract++    where++    step s a =+        if predicate a+        then pstep s a+        else do+            r <- pextract s+            -- XXX need a map on count+            case r of+                Error err -> return $ Error err+                Done n s1 -> return $ Done (n + 1) s1+                Partial _ _ -> error "Bug: takeWhileP: Partial in extract"+                Continue n s1 -> return $ Continue (n + 1) s1++-- | Collect stream elements until an element fails the predicate. The element+-- on which the predicate fails is returned back to the input stream.+--+-- * Stops - when the predicate fails or the collecting fold stops.+-- * Fails - never.+--+-- >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]+-- Right [0,0]+--+-- >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)+--+-- We can implement a @breakOn@ using 'takeWhile':+--+-- @+-- breakOn p = takeWhile (not p)+-- @+--+{-# INLINE takeWhile #-}+takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+-- takeWhile cond f = takeWhileP cond (fromFold f)+takeWhile predicate (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return $ case res of+            FL.Partial s -> IPartial s+            FL.Done b -> IDone b++    step s a =+        if predicate a+        then do+            fres <- fstep s a+            return+                $ case fres of+                      FL.Partial s1 -> Partial 0 s1+                      FL.Done b -> Done 0 b+        else Done 1 <$> ffinal s++    extract s = fmap (Done 0) (ffinal s)++{-+-- XXX This may not be composable because of the b argument. We can instead+-- return a "Reparse b a m b" so that those can be composed.+{-# INLINE takeWhile1X #-}+takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b+-- We can implement this using satisfy and takeWhile. We can use "satisfy+-- p", fold the result with the refold and then use the "takeWhile p" and+-- fold that using the refold.+takeWhile1 acc cond f = undefined+-}++-- | Like 'takeWhile' but takes at least one element otherwise fails.+--+-- >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)+--+{-# INLINE takeWhile1 #-}+takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)+takeWhile1 predicate (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return $ case res of+            FL.Partial s -> IPartial (Left' s)+            FL.Done _ ->+                IError+                    $ "takeWhile1: fold terminated without consuming:"+                          ++ " any element"++    {-# INLINE process #-}+    process s a = do+        res <- fstep s a+        return+            $ case res of+                  FL.Partial s1 -> Partial 0 (Right' s1)+                  FL.Done b -> Done 0 b++    step (Left' s) a =+        if predicate a+        then process s a+        else return $ Error "takeWhile1: predicate failed on first element"+    step (Right' s) a =+        if predicate a+        then process s a+        else do+            b <- ffinal s+            return $ Done 1 b++    extract (Left' _) = return $ Error "takeWhile1: end of input"+    extract (Right' s) = fmap (Done 0) (ffinal s)++-- | Drain the input as long as the predicate succeeds, running the effects and+-- discarding the results.+--+-- This is also called @skipWhile@ in some parsing libraries.+--+-- >>> dropWhile p = Parser.takeWhile p Fold.drain+--+{-# INLINE dropWhile #-}+dropWhile :: Monad m => (a -> Bool) -> Parser a m ()+dropWhile p = takeWhile p FL.drain++-------------------------------------------------------------------------------+-- Separators+-------------------------------------------------------------------------------++{-# ANN type FramedEscState Fuse #-}+data FramedEscState s =+    FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int++-- XXX We can remove Maybe from esc+{-# INLINE takeFramedByGeneric #-}+takeFramedByGeneric :: Monad m =>+       Maybe (a -> Bool) -- is escape char?+    -> Maybe (a -> Bool) -- is frame begin?+    -> Maybe (a -> Bool) -- is frame end?+    -> Fold m a b+    -> Parser a m b+takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) =++    Parser step initial extract++    where++    initial =  do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (FrameEscInit s)+                FL.Done _ ->+                    error "takeFramedByGeneric: fold done without input"++    {-# INLINE process #-}+    process s a n = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)+                FL.Done b -> Done 0 b++    {-# INLINE processNoEsc #-}+    processNoEsc s a n =+        case end of+            Just isEnd ->+                case begin of+                    Just isBegin ->+                        -- takeFramedBy case+                        if isEnd a+                        then+                            if n == 0+                            then Done 0 <$> ffinal s+                            else process s a (n - 1)+                        else+                            let n1 = if isBegin a then n + 1 else n+                             in process s a n1+                    Nothing -> -- takeEndBy case+                        if isEnd a+                        then Done 0 <$> ffinal s+                        else process s a n+            Nothing -> -- takeStartBy case+                case begin of+                    Just isBegin ->+                        if isBegin a+                        then Done 0 <$> ffinal s+                        else process s a n+                    Nothing ->+                        error $ "takeFramedByGeneric: "+                            ++ "Both begin and end frame predicate missing"++    {-# INLINE processCheckEsc #-}+    processCheckEsc s a n =+        case esc of+            Just isEsc ->+                if isEsc a+                then return $ Partial 0 $ FrameEscEsc s n+                else processNoEsc s a n+            Nothing -> processNoEsc s a n++    step (FrameEscInit s) a =+        case begin of+            Just isBegin ->+                if isBegin a+                then return $ Partial 0 (FrameEscGo s 0)+                else return $ Error "takeFramedByGeneric: missing frame start"+            Nothing ->+                case end of+                    Just isEnd ->+                        if isEnd a+                        then Done 0 <$> ffinal s+                        else processCheckEsc s a 0+                    Nothing ->+                        error "Both begin and end frame predicate missing"+    step (FrameEscGo s n) a = processCheckEsc s a n+    step (FrameEscEsc s n) a = process s a n++    err = return . Error++    extract (FrameEscInit _) =+        err "takeFramedByGeneric: empty token"+    extract (FrameEscGo s _) =+        case begin of+            Just _ ->+                case end of+                    Nothing -> fmap (Done 0) $ ffinal s+                    Just _ -> err "takeFramedByGeneric: missing frame end"+            Nothing -> err "takeFramedByGeneric: missing closing frame"+    extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"++data BlockParseState s =+      BlockInit !s+    | BlockUnquoted !Int !s+    | BlockQuoted !Int !s+    | BlockQuotedEsc !Int !s++-- Blocks can be of different types e.g. {} or (). We only parse from the+-- perspective of the outermost block type. The nesting of that block are+-- checked. Any other block types nested inside it are opaque to us and can be+-- parsed when the contents of the block are parsed.++-- XXX Put a limit on nest level to keep the API safe.++-- | Parse a block enclosed within open, close brackets. Block contents may be+-- quoted, brackets inside quotes are ignored. Quoting characters can be used+-- within quotes if escaped. A block can have a nested block inside it.+--+-- Quote begin and end chars are the same. Block brackets and quote chars must+-- not overlap. Block start and end brackets must be different for nesting+-- blocks within blocks.+--+-- >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList+-- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"+-- Right "msg: \"hello world\""+--+{-# INLINE blockWithQuotes #-}+blockWithQuotes :: (Monad m, Eq a) =>+       (a -> Bool)  -- ^ escape char+    -> (a -> Bool)  -- ^ quote char, to quote inside brackets+    -> a  -- ^ Block opening bracket+    -> a  -- ^ Block closing bracket+    -> Fold m a b+    -> Parser a m b+blockWithQuotes isEsc isQuote bopen bclose+    (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (BlockInit s)+                FL.Done _ ->+                    error "blockWithQuotes: fold finished without input"++    {-# INLINE process #-}+    process s a nextState = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (nextState s1)+                FL.Done b -> Done 0 b++    step (BlockInit s) a =+        return+            $ if a == bopen+              then Continue 0 $ BlockUnquoted 1 s+              else Error "blockWithQuotes: missing block start"+    step (BlockUnquoted level s) a+        | a == bopen = process s a (BlockUnquoted (level + 1))+        | a == bclose =+            if level == 1+            then fmap (Done 0) (ffinal s)+            else process s a (BlockUnquoted (level - 1))+        | isQuote a = process s a (BlockQuoted level)+        | otherwise = process s a (BlockUnquoted level)+    step (BlockQuoted level s) a+        | isEsc a = process s a (BlockQuotedEsc level)+        | otherwise =+            if isQuote a+            then process s a (BlockUnquoted level)+            else process s a (BlockQuoted level)+    step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)++    err = return . Error++    extract (BlockInit s) = fmap (Done 0) $ ffinal s+    extract (BlockUnquoted level _) =+        err $ "blockWithQuotes: finished at block nest level " ++ show level+    extract (BlockQuoted level _) =+        err $ "blockWithQuotes: finished, inside an unfinished quote, "+            ++ "at block nest level " ++ show level+    extract (BlockQuotedEsc level _) =+        err $ "blockWithQuotes: finished, inside an unfinished quote, "+            ++ "after an escape char, at block nest level " ++ show level++-- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by+-- the supplied predicate. The separator is also taken with the token.+--+-- This can be combined with other parsers to implement other interesting+-- parsers as follows:+--+-- >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)+-- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)+--+-- >>> takeEndBy = Parser.takeEndByEsc (const False)+--+-- See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting+-- parser in the takeEndBy parser can decide whether to fail or not if the+-- stream does not end with separator.+--+-- /Pre-release/+--+{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+-- takeEndBy = takeEndByEsc (const False)+takeEndBy cond (Parser pstep pinitial pextract) =++    Parser step initial pextract++    where++    initial = pinitial++    step s a = do+        res <- pstep s a+        if not (cond a)+        then return res+        else extractStep pextract res++-- | Like 'takeEndBy' but the separator elements can be escaped using an+-- escape char determined by the first predicate. The escape characters are+-- removed.+--+-- /pre-release/+{-# INLINE takeEndByEsc #-}+takeEndByEsc :: Monad m =>+    (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b+takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =++    Parser step initial extract++    where++    initial = first Left' <$> pinitial++    step (Left' s) a = do+        if isEsc a+        then return $ Partial 0 $ Right' s+        else do+            res <- pstep s a+            if not (isSep a)+            then return $ first Left' res+            else fmap (first Left') $ extractStep pextract res++    step (Right' s) a = do+        res <- pstep s a+        return $ first Left' res++    extract (Left' s) = fmap (first Left') $ pextract s+    extract (Right' _) =+        return $ Error "takeEndByEsc: trailing escape"++-- | Like 'takeEndBy' but the separator is dropped.+--+-- See also "Streamly.Data.Fold.takeEndBy_".+--+-- /Pre-release/+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b+{-+takeEndBy_ isEnd p =+    takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)+-}+takeEndBy_ cond (Parser pstep pinitial pextract) =++    Parser step pinitial pextract++    where++    step s a =+        if cond a+        then pextract s+        else pstep s a++-- | Take either the separator or the token. Separator is a Left value and+-- token is Right value.+--+-- /Unimplemented/+{-# INLINE takeEitherSepBy #-}+takeEitherSepBy :: -- Monad m =>+    (a -> Bool) -> Fold m (Either a b) c -> Parser a m c+takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond++-- | Parse a token that starts with an element chosen by the predicate.  The+-- parser fails if the input does not start with the selected element.+--+-- * Stops - when the predicate succeeds in non-leading position.+-- * Fails - when the predicate fails in the leading position.+--+-- >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)+--+-- Examples: -+--+-- >>> p = Parser.takeStartBy (== ',') Fold.toList+-- >>> leadingComma = Stream.parse p . Stream.fromList+-- >>> leadingComma "a,b"+-- Left (ParseError "takeStartBy: missing frame start")+-- ...+-- >>> leadingComma ",,"+-- Right ","+-- >>> leadingComma ",a,b"+-- Right ",a"+-- >>> leadingComma ""+-- Right ""+--+-- /Pre-release/+--+{-# INLINE takeStartBy #-}+takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+takeStartBy cond (Fold fstep finitial _ ffinal) =++    Parser step initial extract++    where++    initial =  do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (Left' s)+                FL.Done _ -> IError "takeStartBy: fold done without input"++    {-# INLINE process #-}+    process s a = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Partial 0 (Right' s1)+                FL.Done b -> Done 0 b++    step (Left' s) a =+        if cond a+        then process s a+        else return $ Error "takeStartBy: missing frame start"+    step (Right' s) a =+        if not (cond a)+        then process s a+        else Done 1 <$> ffinal s++    extract (Left' s) = fmap (Done 0) $ ffinal s+    extract (Right' s) = fmap (Done 0) $ ffinal s++-- | Like 'takeStartBy' but drops the separator.+--+-- >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing+--+{-# INLINE takeStartBy_ #-}+takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing++-- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a+-- begin and end predicate, and an escape character. The frame begin and end+-- characters lose their special meaning if preceded by the escape character.+--+-- Nested frames are allowed if begin and end markers are different, nested+-- frames must be balanced unless escaped, nested frame markers are emitted as+-- it is.+--+-- For example,+--+-- >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList+-- >>> Stream.parse p $ Stream.fromList "{hello}"+-- Right "hello"+-- >>> Stream.parse p $ Stream.fromList "{hello {world}}"+-- Right "hello {world}"+-- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"+-- Right "hello {world"+-- >>> Stream.parse p $ Stream.fromList "{hello {world}"+-- Left (ParseError "takeFramedByEsc_: missing frame end")+--+-- /Pre-release/+{-# INLINE takeFramedByEsc_ #-}+takeFramedByEsc_ :: Monad m =>+    (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+-- takeFramedByEsc_ isEsc isEnd p =+--    takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)+takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial _ ffinal ) =++    Parser step initial extract++    where++    initial =  do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (FrameEscInit s)+                FL.Done _ ->+                    error "takeFramedByEsc_: fold done without input"++    {-# INLINE process #-}+    process s a n = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)+                FL.Done b -> Done 0 b++    step (FrameEscInit s) a =+        if isBegin a+        then return $ Partial 0 (FrameEscGo s 0)+        else return $ Error "takeFramedByEsc_: missing frame start"+    step (FrameEscGo s n) a =+        if isEsc a+        then return $ Partial 0 $ FrameEscEsc s n+        else do+            if not (isEnd a)+            then+                let n1 = if isBegin a then n + 1 else n+                 in process s a n1+            else+                if n == 0+                then Done 0 <$> ffinal s+                else process s a (n - 1)+    step (FrameEscEsc s n) a = process s a n++    err = return . Error++    extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"+    extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"+    extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"++data FramedState s = FrameInit !s | FrameGo !s Int++-- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an+-- end predicate.+--+-- >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)+--+{-# INLINE takeFramedBy_ #-}+takeFramedBy_ :: Monad m =>+    (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+-- takeFramedBy_ isBegin isEnd =+--    takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)+takeFramedBy_ isBegin isEnd (Fold fstep finitial _ ffinal) =++    Parser step initial extract++    where++    initial =  do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (FrameInit s)+                FL.Done _ ->+                    error "takeFramedBy_: fold done without input"++    {-# INLINE process #-}+    process s a n = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (FrameGo s1 n)+                FL.Done b -> Done 0 b++    step (FrameInit s) a =+        if isBegin a+        then return $ Continue 0 (FrameGo s 0)+        else return $ Error "takeFramedBy_: missing frame start"+    step (FrameGo s n) a+        | not (isEnd a) =+            let n1 = if isBegin a then n + 1 else n+             in process s a n1+        | n == 0 = Done 0 <$> ffinal s+        | otherwise = process s a (n - 1)++    err = return . Error++    extract (FrameInit _) = err "takeFramedBy_: empty token"+    extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"++-------------------------------------------------------------------------------+-- Grouping and words+-------------------------------------------------------------------------------++data WordByState s b = WBLeft !s | WBWord !s | WBRight !b++-- Note we can also get words using something like:+-- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)+--+-- But that won't be as efficient and ergonomic.++-- | Like 'splitOn' but strips leading, trailing, and repeated separators.+-- Therefore, @".a..b."@ having '.' as the separator would be parsed as+-- @["a","b"]@.  In other words, its like parsing words from whitespace+-- separated text.+--+-- * Stops - when it finds a word separator after a non-word element+-- * Fails - never.+--+-- >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)+--+-- @+-- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)+-- @+--+{-# INLINE wordBy #-}+wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+wordBy predicate (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    {-# INLINE worder #-}+    worder s a = do+        res <- fstep s a+        return+            $ case res of+                  FL.Partial s1 -> Partial 0 $ WBWord s1+                  FL.Done b -> Done 0 b++    initial = do+        res <- finitial+        return+            $ case res of+                  FL.Partial s -> IPartial $ WBLeft s+                  FL.Done b -> IDone b++    step (WBLeft s) a =+        if not (predicate a)+        then worder s a+        else return $ Partial 0 $ WBLeft s+    step (WBWord s) a =+        if not (predicate a)+        then worder s a+        else do+            b <- ffinal s+            return $ Partial 0 $ WBRight b+    step (WBRight b) a =+        return+            $ if not (predicate a)+              then Done 1 b+              else Partial 0 $ WBRight b++    extract (WBLeft s) = fmap (Done 0) $ ffinal s+    extract (WBWord s) = fmap (Done 0) $ ffinal s+    extract (WBRight b) = return (Done 0 b)++data WordFramedState s b =+      WordFramedSkipPre !s+    | WordFramedWord !s !Int+    | WordFramedEsc !s !Int+    | WordFramedSkipPost !b++-- | Like 'wordBy' but treats anything inside a pair of quotes as a single+-- word, the quotes can be escaped by an escape character.  Recursive quotes+-- are possible if quote begin and end characters are different, quotes must be+-- balanced. Outermost quotes are stripped.+--+-- >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList+-- >>> Stream.parse braces $ Stream.fromList "{ab} cd"+-- Right "ab"+-- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"+-- Right "abcd"+-- >>> Stream.parse braces $ Stream.fromList "a{b} cd"+-- Right "ab"+-- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"+-- Right "a{b}"+--+-- >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList+-- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""+-- Right "ab"+--+{-# INLINE wordFramedBy #-}+wordFramedBy :: Monad m =>+       (a -> Bool)  -- ^ Matches escape elem?+    -> (a -> Bool)  -- ^ Matches left quote?+    -> (a -> Bool)  -- ^ matches right quote?+    -> (a -> Bool)  -- ^ matches word separator?+    -> Fold m a b+    -> Parser a m b+wordFramedBy isEsc isBegin isEnd isSep+    (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial =  do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (WordFramedSkipPre s)+                FL.Done _ ->+                    error "wordFramedBy: fold done without input"++    {-# INLINE process #-}+    process s a n = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)+                FL.Done b -> Done 0 b++    step (WordFramedSkipPre s) a+        | isEsc a = return $ Continue 0 $ WordFramedEsc s 0+        | isSep a = return $ Partial 0 $ WordFramedSkipPre s+        | isBegin a = return $ Continue 0 $ WordFramedWord s 1+        | isEnd a =+            return $ Error "wordFramedBy: missing frame start"+        | otherwise = process s a 0+    step (WordFramedWord s n) a+        | isEsc a = return $ Continue 0 $ WordFramedEsc s n+        | n == 0 && isSep a = do+            b <- ffinal s+            return $ Partial 0 $ WordFramedSkipPost b+        | otherwise = do+            -- We need to use different order for checking begin and end for+            -- the n == 0 and n == 1 case so that when the begin and end+            -- character is the same we treat the one after begin as end.+            if n == 0+            then+               -- Need to check isBegin first+               if isBegin a+               then return $ Continue 0 $ WordFramedWord s 1+               else if isEnd a+                    then return $ Error "wordFramedBy: missing frame start"+                    else process s a n+            else+               -- Need to check isEnd first+                if isEnd a+                then+                   if n == 1+                   then return $ Continue 0 $ WordFramedWord s 0+                   else process s a (n - 1)+                else if isBegin a+                     then process s a (n + 1)+                     else process s a n+    step (WordFramedEsc s n) a = process s a n+    step (WordFramedSkipPost b) a =+        return+            $ if not (isSep a)+              then Done 1 b+              else Partial 0 $ WordFramedSkipPost b++    err = return . Error++    extract (WordFramedSkipPre s) = fmap (Done 0) $ ffinal s+    extract (WordFramedWord s n) =+        if n == 0+        then fmap (Done 0) $ ffinal s+        else err "wordFramedBy: missing frame end"+    extract (WordFramedEsc _ _) =+        err "wordFramedBy: trailing escape"+    extract (WordFramedSkipPost b) = return (Done 0 b)++data WordQuotedState s b a =+      WordQuotedSkipPre !s+    | WordUnquotedWord !s+    | WordQuotedWord !s !Int !a !a+    | WordUnquotedEsc !s+    | WordQuotedEsc !s !Int !a !a+    | WordQuotedSkipPost !b++-- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but+-- word separators within specified quotes or brackets are ignored. Quotes and+-- escape characters can be processed. If the end quote is different from the+-- start quote it is called a bracket. The following quoting rules apply:+--+-- * In an unquoted string a character may be preceded by an escape character.+-- The escape character is removed and the character following it is treated+-- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,+-- \n is same as n.+-- * Any part of the word can be placed within quotes. Inside quotes all+-- characters are treated literally with no special meaning. Quoting character+-- itself cannot be used within quotes unless escape processing within quotes+-- is applied to allow it.+-- * Optionally escape processing for quoted part can be specified. Escape+-- character has no special meaning inside quotes unless it is followed by a+-- character that has a escape translation specified, in that case the escape+-- character is removed, and the specified translation is applied to the+-- character following it. This can be used to escape the quoting character+-- itself within quotes.+-- * There can be multiple quoting characters, when a quote starts, all other+-- quoting characters within that quote lose any special meaning until the+-- quote is closed.+-- * A starting quote char without an ending char generates a parse error. An+-- ending bracket char without a corresponding bracket begin is ignored.+-- * Brackets can be nested.+--+-- We should note that unquoted and quoted escape processing are different. In+-- unquoted part escape character is always removed. In quoted part it is+-- removed only if followed by a special meaning character. This is consistent+-- with how shell performs escape processing.++-- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},+-- ((nested) brackets).+--+-- Example:+--+-- >>> :{+-- >>> q x =+-- >>>     case x of+-- >>>         '"' -> Just x+-- >>>         '\'' -> Just x+-- >>>         _ -> Nothing+-- >>> :}+--+-- >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList+-- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"+-- Right "a\"b'c\";'d\"e'f"+--+-- Note that outer quotes and backslashes from the input string are consumed by+-- Haskell, therefore, the actual input string passed to the parser is:+-- a"b'c";'d"e'f ghi+--+-- Similarly, when printing, double quotes are escaped by Haskell.+--+-- Limitations:+--+-- Shell like quote processing can be performed by using quote char specific+-- escape processing, single quotes with no escapes, and double quotes with+-- escapes.+--+-- JSON string processing can also be achieved except the "\uXXXX" style+-- escaping for Unicode characters.+--+{-# INLINE wordWithQuotes #-}+wordWithQuotes :: (Monad m, Eq a) =>+       Bool            -- ^ Retain the quotes and escape chars in the output+    -> (a -> a -> Maybe a)  -- ^ quote char -> escaped char -> translated char+    -> a               -- ^ Matches an escape elem?+    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.+    -> (a -> Bool)     -- ^ Matches a word separator?+    -> Fold m a b+    -> Parser a m b+wordWithQuotes keepQuotes tr escChar toRight isSep+    (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Can be used to generate parse error for a bracket end without a bracket+    -- begin.+    isInvalid = const False++    isEsc = (== escChar)++    initial =  do+        res <- finitial+        return $+            case res of+                FL.Partial s -> IPartial (WordQuotedSkipPre s)+                FL.Done _ ->+                    error "wordKeepQuotes: fold done without input"++    {-# INLINE processQuoted #-}+    processQuoted s a n ql qr = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)+                FL.Done b -> Done 0 b++    {-# INLINE processUnquoted #-}+    processUnquoted s a = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)+                FL.Done b -> Done 0 b++    step (WordQuotedSkipPre s) a+        | isEsc a = return $ Continue 0 $ WordUnquotedEsc s+        | isSep a = return $ Partial 0 $ WordQuotedSkipPre s+        | otherwise =+            case toRight a of+                Just qr ->+                  if keepQuotes+                  then processQuoted s a 1 a qr+                  else return $ Continue 0 $ WordQuotedWord s 1 a qr+                Nothing+                    | isInvalid a ->+                        return $ Error "wordKeepQuotes: invalid unquoted char"+                    | otherwise -> processUnquoted s a+    step (WordUnquotedWord s) a+        | isEsc a = return $ Continue 0 $ WordUnquotedEsc s+        | isSep a = do+            b <- ffinal s+            return $ Partial 0 $ WordQuotedSkipPost b+        | otherwise = do+            case toRight a of+                Just qr ->+                    if keepQuotes+                    then processQuoted s a 1 a qr+                    else return $ Continue 0 $ WordQuotedWord s 1 a qr+                Nothing ->+                    if isInvalid a+                    then return $ Error "wordKeepQuotes: invalid unquoted char"+                    else processUnquoted s a+    step (WordQuotedWord s n ql qr) a+        | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr+        {-+        -- XXX Will this ever occur? Will n ever be 0?+        | n == 0 && isSep a = do+            b <- fextract s+            return $ Partial 0 $ WordQuotedSkipPost b+        -}+        | otherwise = do+                if a == qr+                then+                   if n == 1+                   then if keepQuotes+                        then processUnquoted s a+                        else return $ Continue 0 $ WordUnquotedWord s+                   else processQuoted s a (n - 1) ql qr+                else if a == ql+                     then processQuoted s a (n + 1) ql qr+                     else processQuoted s a n ql qr+    step (WordUnquotedEsc s) a = processUnquoted s a+    step (WordQuotedEsc s n ql qr) a =+        case tr ql a of+            Nothing -> do+                res <- fstep s escChar+                case res of+                    FL.Partial s1 -> processQuoted s1 a n ql qr+                    FL.Done b -> return $ Done 0 b+            Just x -> processQuoted s x n ql qr+    step (WordQuotedSkipPost b) a =+        return+            $ if not (isSep a)+              then Done 1 b+              else Partial 0 $ WordQuotedSkipPost b++    err = return . Error++    extract (WordQuotedSkipPre s) = fmap (Done 0) $ ffinal s+    extract (WordUnquotedWord s) = fmap (Done 0) $ ffinal s+    extract (WordQuotedWord s n _ _) =+        if n == 0+        then fmap (Done 0) $ ffinal s+        else err "wordWithQuotes: missing frame end"+    extract WordQuotedEsc {} =+        err "wordWithQuotes: trailing escape"+    extract (WordUnquotedEsc _) =+        err "wordWithQuotes: trailing escape"+    extract (WordQuotedSkipPost b) = return (Done 0 b)++-- | 'wordWithQuotes' without processing the quotes and escape function+-- supplied to escape the quote char within a quote. Can be used to parse words+-- keeping the quotes and escapes intact.+--+-- >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)+--+{-# INLINE wordKeepQuotes #-}+wordKeepQuotes :: (Monad m, Eq a) =>+       a               -- ^ Escape char+    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.+    -> (a -> Bool)     -- ^ Matches a word separator?+    -> Fold m a b+    -> Parser a m b+wordKeepQuotes =+    -- Escape the quote char itself+    wordWithQuotes True (\q x -> if q == x then Just x else Nothing)++-- See the "Quoting Rules" section in the "bash" manual page for a primer on+-- how quotes are used by shells.++-- | 'wordWithQuotes' with quote processing applied and escape function+-- supplied to escape the quote char within a quote. Can be ysed to parse words+-- and processing the quoting and escaping at the same time.+--+-- >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)+--+{-# INLINE wordProcessQuotes #-}+wordProcessQuotes :: (Monad m, Eq a) =>+        a              -- ^ Escape char+    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.+    -> (a -> Bool)     -- ^ Matches a word separator?+    -> Fold m a b+    -> Parser a m b+wordProcessQuotes =+    -- Escape the quote char itself+    wordWithQuotes False (\q x -> if q == x then Just x else Nothing)++{-# ANN type GroupByState Fuse #-}+data GroupByState a s+    = GroupByInit !s+    | GroupByGrouping !a !s++-- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the+-- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is+-- 'True' @b@ is also assigned to the same group.  If @a \`cmp` c@ is 'True'+-- then @c@ is also assigned to the same group and so on. When the comparison+-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and+-- the result of the fold is the result of the parser.+--+-- * Stops - when the comparison fails.+-- * Fails - never.+--+-- >>> :{+--  runGroupsBy eq =+--      Stream.fold Fold.toList+--          . Stream.parseMany (Parser.groupBy eq Fold.toList)+--          . Stream.fromList+-- :}+--+-- >>> runGroupsBy (<) []+-- []+--+-- >>> runGroupsBy (<) [1]+-- [Right [1]]+--+-- >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]+-- [Right [3,5,4],Right [1,2],Right [0]]+--+{-# INLINE groupBy #-}+groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+groupBy eq (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    {-# INLINE grouper #-}+    grouper s a0 a = do+        res <- fstep s a+        return+            $ case res of+                  FL.Done b -> Done 0 b+                  FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)++    initial = do+        res <- finitial+        return+            $ case res of+                  FL.Partial s -> IPartial $ GroupByInit s+                  FL.Done b -> IDone b++    step (GroupByInit s) a = grouper s a a+    step (GroupByGrouping a0 s) a =+        if eq a0 a+        then grouper s a0 a+        else Done 1 <$> ffinal s++    extract (GroupByInit s) = fmap (Done 0) $ ffinal s+    extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s++-- | Unlike 'groupBy' this combinator performs a rolling comparison of two+-- successive elements in the input stream.  Assuming the input stream+-- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser+-- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is+-- 'True' @b@ is also assigned to the same group.  If @b \`cmp` c@ is 'True'+-- then @c@ is also assigned to the same group and so on. When the comparison+-- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and+-- the result of the fold is the result of the parser.+--+-- * Stops - when the comparison fails.+-- * Fails - never.+--+-- >>> :{+--  runGroupsByRolling eq =+--      Stream.fold Fold.toList+--          . Stream.parseMany (Parser.groupByRolling eq Fold.toList)+--          . Stream.fromList+-- :}+--+-- >>> runGroupsByRolling (<) []+-- []+--+-- >>> runGroupsByRolling (<) [1]+-- [Right [1]]+--+-- >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]+-- [Right [3,5],Right [4],Right [1,2],Right [0]]+--+-- /Pre-release/+--+{-# INLINE groupByRolling #-}+groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+groupByRolling eq (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    {-# INLINE grouper #-}+    grouper s a = do+        res <- fstep s a+        return+            $ case res of+                  FL.Done b -> Done 0 b+                  FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)++    initial = do+        res <- finitial+        return+            $ case res of+                  FL.Partial s -> IPartial $ GroupByInit s+                  FL.Done b -> IDone b++    step (GroupByInit s) a = grouper s a+    step (GroupByGrouping a0 s) a =+        if eq a0 a+        then grouper s a+        else Done 1 <$> ffinal s++    extract (GroupByInit s) = fmap (Done 0) $ ffinal s+    extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s++{-# ANN type GroupByStatePair Fuse #-}+data GroupByStatePair a s1 s2+    = GroupByInitPair !s1 !s2+    | GroupByGroupingPair !a !s1 !s2+    | GroupByGroupingPairL !a !s1 !s2+    | GroupByGroupingPairR !a !s1 !s2++-- | Like 'groupByRolling', but if the predicate is 'True' then collects using+-- the first fold as long as the predicate holds 'True', if the predicate is+-- 'False' collects using the second fold as long as it remains 'False'.+-- Returns 'Left' for the first case and 'Right' for the second case.+--+-- For example, if we want to detect sorted sequences in a stream, both+-- ascending and descending cases we can use 'groupByRollingEither (<=)+-- Fold.toList Fold.toList'.+--+-- /Pre-release/+{-# INLINE groupByRollingEither #-}+groupByRollingEither :: Monad m =>+    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)+groupByRollingEither+    eq+    (Fold fstep1 finitial1 _ ffinal1)+    (Fold fstep2 finitial2 _ ffinal2) = Parser step initial extract++    where++    {-# INLINE grouper #-}+    grouper s1 s2 a = do+        return $ Continue 0 (GroupByGroupingPair a s1 s2)++    {-# INLINE grouperL2 #-}+    grouperL2 s1 s2 a = do+        res <- fstep1 s1 a+        return+            $ case res of+                FL.Done b -> Done 0 (Left b)+                FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)++    {-# INLINE grouperL #-}+    grouperL s1 s2 a0 a = do+        res <- fstep1 s1 a0+        case res of+            FL.Done b -> return $ Done 0 (Left b)+            FL.Partial s11 -> grouperL2 s11 s2 a++    {-# INLINE grouperR2 #-}+    grouperR2 s1 s2 a = do+        res <- fstep2 s2 a+        return+            $ case res of+                FL.Done b -> Done 0 (Right b)+                FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)++    {-# INLINE grouperR #-}+    grouperR s1 s2 a0 a = do+        res <- fstep2 s2 a0+        case res of+            FL.Done b -> return $ Done 0 (Right b)+            FL.Partial s21 -> grouperR2 s1 s21 a++    initial = do+        res1 <- finitial1+        res2 <- finitial2+        return+            $ case res1 of+                FL.Partial s1 ->+                    case res2 of+                        FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2+                        FL.Done b -> IDone (Right b)+                FL.Done b -> IDone (Left b)++    step (GroupByInitPair s1 s2) a = grouper s1 s2 a++    step (GroupByGroupingPair a0 s1 s2) a =+        if not (eq a0 a)+        then grouperL s1 s2 a0 a+        else grouperR s1 s2 a0 a++    step (GroupByGroupingPairL a0 s1 s2) a =+        if not (eq a0 a)+        then grouperL2 s1 s2 a+        else Done 1 . Left <$> ffinal1 s1++    step (GroupByGroupingPairR a0 s1 s2) a =+        if eq a0 a+        then grouperR2 s1 s2 a+        else Done 1 . Right <$> ffinal2 s2++    extract (GroupByInitPair s1 _) = Done 0 . Left <$> ffinal1 s1+    extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> ffinal1 s1+    extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> ffinal2 s2+    extract (GroupByGroupingPair a s1 _) = do+                res <- fstep1 s1 a+                case res of+                    FL.Done b -> return $ Done 0 (Left b)+                    FL.Partial s11 -> Done 0 . Left <$> ffinal1 s11++-- XXX use an Unfold instead of a list?+-- XXX custom combinators for matching list, array and stream?+-- XXX rename to listBy?++-- | Match the given sequence of elements using the given comparison function.+-- Returns the original sequence if successful.+--+-- Definition:+--+-- >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs+--+-- Examples:+--+-- >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"+-- Right "string"+--+-- >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"+-- Left (ParseError "streamEqBy: mismtach occurred")+--+{-# INLINE listEqBy #-}+listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]+listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs+{-+listEqBy cmp str = Parser step initial extract++    where++    -- XXX Should return IDone in initial for [] case+    initial = return $ IPartial str++    step [] _ = return $ Done 0 str+    step [x] a =+        return+            $ if x `cmp` a+              then Done 0 str+              else Error "listEqBy: failed, yet to match the last element"+    step (x:xs) a =+        return+            $ if x `cmp` a+              then Continue 0 xs+              else Error+                       $ "listEqBy: failed, yet to match "+                       ++ show (length xs + 1) ++ " elements"++    extract xs =+        return+            $ Error+            $ "listEqBy: end of input, yet to match "+            ++ show (length xs) ++ " elements"+-}++{-# INLINE streamEqByInternal #-}+streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()+streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract++    where++    initial = do+        r <- sstep defState state+        case r of+            D.Yield x s -> return $ IPartial (Just' x, s)+            D.Stop -> return $ IDone ()+            -- Need Skip/Continue in initial to loop right here+            D.Skip s -> return $ IPartial (Nothing', s)++    step (Just' x, st) a =+        if x `cmp` a+          then do+            r <- sstep defState st+            return+                $ case r of+                    D.Yield x1 s -> Continue 0 (Just' x1, s)+                    D.Stop -> Done 0 ()+                    D.Skip s -> Continue 1 (Nothing', s)+          else return $ Error "streamEqBy: mismtach occurred"+    step (Nothing', st) a = do+        r <- sstep defState st+        return+            $ case r of+                D.Yield x s -> do+                    if x `cmp` a+                    then Continue 0 (Nothing', s)+                    else Error "streamEqBy: mismatch occurred"+                D.Stop -> Done 1 ()+                D.Skip s -> Continue 1 (Nothing', s)++    extract _ = return $ Error "streamEqBy: end of input"++-- | Like 'listEqBy' but uses a stream instead of a list and does not return+-- the stream.+--+{-# INLINE streamEqBy #-}+streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()+-- XXX Somehow composing this with "*>" is much faster on the microbenchmark.+-- Need to investigate why.+streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()++-- Rename to "list".+-- | Match the input sequence with the supplied list and return it if+-- successful.+--+-- >>> listEq = Parser.listEqBy (==)+--+{-# INLINE listEq #-}+listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]+listEq = listEqBy (==)++-- | Match if the input stream is a subsequence of the argument stream i.e. all+-- the elements of the input stream occur, in order, in the argument stream.+-- The elements do not have to occur consecutively. A sequence is considered a+-- subsequence of itself.+{-# INLINE subsequenceBy #-}+subsequenceBy :: -- Monad m =>+    (a -> a -> Bool) -> Stream m a -> Parser a m ()+subsequenceBy = undefined++{-+-- Should go in Data.Parser.Regex in streamly package so that it can depend on+-- regex backends.+{-# INLINE regexPosix #-}+regexPosix :: -- Monad m =>+    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))+regexPosix = undefined++{-# INLINE regexPCRE #-}+regexPCRE :: -- Monad m =>+    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))+regexPCRE = undefined+-}++-------------------------------------------------------------------------------+-- Transformations on input+-------------------------------------------------------------------------------++-- Initial needs a "Continue" constructor to implement scans on parsers. As a+-- parser can always return a Continue in initial when we feed the fold's+-- initial result to it. We can work this around for postscan by introducing an+-- initial state and calling "initial" only on the first input.++-- | Stateful scan on the input of a parser using a Fold.+--+-- /Unimplemented/+--+{-# INLINE postscan #-}+postscan :: -- Monad m =>+    Fold m a b -> Parser b m c -> Parser a m c+postscan = undefined++{-# INLINE zipWithM #-}+zipWithM :: Monad m =>+    (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x+zipWithM zf (D.Stream sstep state) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        fres <- finitial+        case fres of+            FL.Partial fs -> do+                r <- sstep defState state+                case r of+                    D.Yield x s -> return $ IPartial (Just' x, s, fs)+                    D.Stop -> do+                        x <- ffinal fs+                        return $ IDone x+                    -- Need Skip/Continue in initial to loop right here+                    D.Skip s -> return $ IPartial (Nothing', s, fs)+            FL.Done x -> return $ IDone x++    step (Just' a, st, fs) b = do+        c <- zf a b+        fres <- fstep fs c+        case fres of+            FL.Partial fs1 -> do+                r <- sstep defState st+                case r of+                    D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)+                    D.Stop -> do+                        x <- ffinal fs1+                        return $ Done 0 x+                    D.Skip s -> return $ Continue 1 (Nothing', s, fs1)+            FL.Done x -> return $ Done 0 x+    step (Nothing', st, fs) b = do+        r <- sstep defState st+        case r of+                D.Yield a s -> do+                    c <- zf a b+                    fres <- fstep fs c+                    case fres of+                        FL.Partial fs1 ->+                            return $ Continue 0 (Nothing', s, fs1)+                        FL.Done x -> return $ Done 0 x+                D.Stop -> do+                    x <- ffinal fs+                    return $ Done 1 x+                D.Skip s -> return $ Continue 1 (Nothing', s, fs)++    extract _ = return $ Error "zipWithM: end of input"++-- | Zip the input of a fold with a stream.+--+-- /Pre-release/+--+{-# INLINE zip #-}+zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x+zip = zipWithM (curry return)++-- | Pair each element of a fold input with its index, starting from index 0.+--+-- /Pre-release/+{-# INLINE indexed #-}+indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b+indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)++-- | @makeIndexFilter indexer filter predicate@ generates a fold filtering+-- function using a fold indexing function that attaches an index to each input+-- element and a filtering function that filters using @(index, element) ->+-- Bool) as predicate.+--+-- For example:+--+-- @+-- filterWithIndex = makeIndexFilter indexed filter+-- filterWithAbsTime = makeIndexFilter timestamped filter+-- filterWithRelTime = makeIndexFilter timeIndexed filter+-- @+--+-- /Pre-release/+{-# INLINE makeIndexFilter #-}+makeIndexFilter ::+       (Fold m (s, a) b -> Parser a m b)+    -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)+    -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)+makeIndexFilter f comb g = f . comb g . FL.lmap snd++-- | @sampleFromthen offset stride@ samples the element at @offset@ index and+-- then every element at strides of @stride@.+--+-- /Pre-release/+{-# INLINE sampleFromthen #-}+sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b+sampleFromthen offset size =+    makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)++--------------------------------------------------------------------------------+--- Spanning+--------------------------------------------------------------------------------++-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the+-- input as long as the predicate @p@ is 'True'.  @f2@ consumes the rest of the+-- input.+--+-- @+-- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs+--+-- > span_ (< 1) [1,2,3]+-- ([],[1,2,3])+--+-- > span_ (< 2) [1,2,3]+-- ([1],[2,3])+--+-- > span_ (< 4) [1,2,3]+-- ([1,2,3],[])+--+-- @+--+-- /Pre-release/+{-# INLINE span #-}+span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)++-- | Break the input stream into two groups, the first group takes the input as+-- long as the predicate applied to the first element of the stream and next+-- input element holds 'True', the second group takes the rest of the input.+--+-- /Pre-release/+--+{-# INLINE spanBy #-}+spanBy ::+       Monad m+    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)++-- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.+-- predicate is applied to the previous and the next input elements.+--+-- /Pre-release/+{-# INLINE spanByRolling #-}+spanByRolling ::+       Monad m+    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+spanByRolling eq f1 f2 =+    noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)++-------------------------------------------------------------------------------+-- nested parsers+-------------------------------------------------------------------------------++-- | Takes at-most @n@ input elements.+--+-- * Stops - when the collecting parser stops.+-- * Fails - when the collecting parser fails.+--+-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]+-- Right [1,2]+--+-- >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]+-- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")+--+-- /Internal/+{-# INLINE takeP #-}+takeP :: Monad m => Int -> Parser a m b -> Parser a m b+takeP lim (Parser pstep pinitial pextract) = Parser step initial extract++    where++    initial = do+        res <- pinitial+        case res of+            IPartial s ->+                if lim > 0+                then return $ IPartial $ Tuple' 0 s+                else iextract s+            IDone b -> return $ IDone b+            IError e -> return $ IError e++    step (Tuple' cnt r) a = do+        assertM(cnt < lim)+        res <- pstep r a+        let cnt1 = cnt + 1+        case res of+            Partial 0 s -> do+                assertM(cnt1 >= 0)+                if cnt1 < lim+                then return $ Partial 0 $ Tuple' cnt1 s+                else do+                    r1 <- pextract s+                    return $ case r1 of+                        Done n b -> Done n b+                        Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)+                        Error err -> Error err+                        Partial _ _ -> error "takeP: Partial in extract"++            Continue 0 s -> do+                assertM(cnt1 >= 0)+                if cnt1 < lim+                then return $ Continue 0 $ Tuple' cnt1 s+                else do+                    r1 <- pextract s+                    return $ case r1 of+                        Done n b -> Done n b+                        Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)+                        Error err -> Error err+                        Partial _ _ -> error "takeP: Partial in extract"+            Partial n s -> do+                let taken = cnt1 - n+                assertM(taken >= 0)+                return $ Partial n $ Tuple' taken s+            Continue n s -> do+                let taken = cnt1 - n+                assertM(taken >= 0)+                return $ Continue n $ Tuple' taken s+            Done n b -> return $ Done n b+            Error str -> return $ Error str++    extract (Tuple' cnt r) = do+        r1 <- pextract r+        return $ case r1 of+            Done n b -> Done n b+            Continue n s1 -> Continue n (Tuple' (cnt - n) s1)+            Error err -> Error err+            Partial _ _ -> error "takeP: Partial in extract"++    -- XXX Need to make the Initial type Step to remove this+    iextract s = do+        r <- pextract s+        return $ case r of+            Done _ b -> IDone b+            Error err -> IError err+            _ -> error "Bug: takeP invalid state in initial"++-- | Run a parser without consuming the input.+--+{-# INLINE lookAhead #-}+lookAhead :: Monad m => Parser a m b -> Parser a m b+lookAhead (Parser step1 initial1 _) = Parser step initial extract++    where++    initial = do+        res <- initial1+        return $ case res of+            IPartial s -> IPartial (Tuple'Fused 0 s)+            IDone b -> IDone b+            IError e -> IError e++    step (Tuple'Fused cnt st) a = do+        r <- step1 st a+        let cnt1 = cnt + 1+        return+            $ case r of+                  Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)+                  Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)+                  Done _ b -> Done cnt1 b+                  Error err -> Error err++    -- XXX returning an error let's us backtrack.  To implement it in a way so+    -- that it terminates on eof without an error then we need a way to+    -- backtrack on eof, that will require extract to return 'Step' type.+    extract (Tuple'Fused n _) =+        return+            $ Error+            $ "lookAhead: end of input after consuming "+            ++ show n ++ " elements"++-------------------------------------------------------------------------------+-- Interleaving+-------------------------------------------------------------------------------+--+-- To deinterleave we can chain two parsers one behind the other. The input is+-- given to the first parser and the input definitively rejected by the first+-- parser is given to the second parser.+--+-- We can either have the parsers themselves buffer the input or use the shared+-- global buffer to hold it until none of the parsers need it. When the first+-- parser returns Skip (i.e. rewind) we let the second parser consume the+-- rejected input and when it is done we move the cursor forward to the first+-- parser again. This will require a "move forward" command as well.+--+-- To implement grep we can use three parsers, one to find the pattern, one+-- to store the context behind the pattern and one to store the context in+-- front of the pattern. When a match occurs we need to emit the accumulator of+-- all the three parsers. One parser can count the line numbers to provide the+-- line number info.++{-# ANN type DeintercalateAllState Fuse #-}+data DeintercalateAllState fs sp ss =+      DeintercalateAllInitL !fs+    | DeintercalateAllL !fs !sp+    | DeintercalateAllInitR !fs+    | DeintercalateAllR !fs !ss++-- XXX rename this to intercalate++-- Having deintercalateAll for accepting or rejecting entire input could be+-- useful. For example, in case of JSON parsing we get an entire block of+-- key-value pairs which we need to verify. This version may be simpler, more+-- efficient. We could implement this as a stream operation like parseMany.+--+-- XXX Also, it may be a good idea to provide a parse driver for a fold. For+-- example, in case of csv parsing as we are feeding a line to a fold we can+-- parse it.++-- | Like 'deintercalate' but the entire input must satisfy the pattern+-- otherwise the parser fails. This is many times faster than deintercalate.+--+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList+-- >>> p2 = Parser.satisfy (== '+')+-- >>> p = Parser.deintercalateAll p1 p2 Fold.toList+-- >>> Stream.parse p $ Stream.fromList ""+-- Right []+-- >>> Stream.parse p $ Stream.fromList "1"+-- Right [Left "1"]+-- >>> Stream.parse p $ Stream.fromList "1+"+-- Left (ParseError "takeWhile1: end of input")+-- >>> Stream.parse p $ Stream.fromList "1+2+3"+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]+--+{-# INLINE deintercalateAll #-}+deintercalateAll :: Monad m =>+       Parser a m x+    -> Parser a m y+    -> Fold m (Either x y) z+    -> Parser a m z+deintercalateAll+    (Parser stepL initialL extractL)+    (Parser stepR initialR _)+    (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    errMsg p status =+        error $ "deintercalate: " ++ p ++ " parser cannot "+                ++ status ++ " without input"++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs+            FL.Done c -> return $ IDone c++    {-# INLINE processL #-}+    processL foldAction n nextState = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> return $ Partial n (nextState fs1)+            FL.Done c -> return $ Done n c++    {-# INLINE runStepL #-}+    runStepL fs sL a = do+        r <- stepL sL a+        case r of+            Partial n s -> return $ Partial n (DeintercalateAllL fs s)+            Continue n s -> return $ Continue n (DeintercalateAllL fs s)+            Done n b ->+                processL (fstep fs (Left b)) n DeintercalateAllInitR+            Error err -> return $ Error err++    {-# INLINE processR #-}+    processR foldAction n = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> do+                res <- initialL+                case res of+                    IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)+                    IDone _ -> errMsg "left" "succeed"+                    IError _ -> errMsg "left" "fail"+            FL.Done c -> return $ Done n c++    {-# INLINE runStepR #-}+    runStepR fs sR a = do+        r <- stepR sR a+        case r of+            Partial n s -> return $ Partial n (DeintercalateAllR fs s)+            Continue n s -> return $ Continue n (DeintercalateAllR fs s)+            Done n b -> processR (fstep fs (Right b)) n+            Error err -> return $ Error err++    step (DeintercalateAllInitL fs) a = do+        res <- initialL+        case res of+            IPartial s -> runStepL fs s a+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"+    step (DeintercalateAllL fs sL) a = runStepL fs sL a+    step (DeintercalateAllInitR fs) a = do+        res <- initialR+        case res of+            IPartial s -> runStepR fs s a+            IDone _ -> errMsg "right" "succeed"+            IError _ -> errMsg "right" "fail"+    step (DeintercalateAllR fs sR) a = runStepR fs sR a++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+            FL.Done c -> return (Done n c)+    extract (DeintercalateAllInitL fs) = fmap (Done 0) $ ffinal fs+    extract (DeintercalateAllL fs sL) = do+        r <- extractL sL+        case r of+            Done n b -> extractResult n fs (Left b)+            Error err -> return $ Error err+            Continue n s -> return $ Continue n (DeintercalateAllL fs s)+            Partial _ _ -> error "Partial in extract"+    extract (DeintercalateAllInitR fs) = fmap (Done 0) $ ffinal fs+    extract (DeintercalateAllR _ _) =+        return $ Error "deintercalateAll: input ended at 'Right' value"++{-# ANN type DeintercalateState Fuse #-}+data DeintercalateState b fs sp ss =+      DeintercalateInitL !fs+    | DeintercalateL !Int !fs !sp+    | DeintercalateInitR !fs+    | DeintercalateR !Int !fs !ss+    | DeintercalateRL !Int !b !fs !sp++-- XXX Add tests that the next character that we take after running a parser is+-- correct. Especially for the parsers that maintain a count. In the stream+-- finished case (extract) as well as not finished case.++-- | Apply two parsers alternately to an input stream. The input stream is+-- considered an interleaving of two patterns. The two parsers represent the+-- two patterns. Parsing starts at the first parser and stops at the first+-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty+-- input or single parse of the first parser is accepted.+--+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList+-- >>> p2 = Parser.satisfy (== '+')+-- >>> p = Parser.deintercalate p1 p2 Fold.toList+-- >>> Stream.parse p $ Stream.fromList ""+-- Right []+-- >>> Stream.parse p $ Stream.fromList "1"+-- Right [Left "1"]+-- >>> Stream.parse p $ Stream.fromList "1+"+-- Right [Left "1"]+-- >>> Stream.parse p $ Stream.fromList "1+2+3"+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]+--+{-# INLINE deintercalate #-}+deintercalate :: Monad m =>+       Parser a m x+    -> Parser a m y+    -> Fold m (Either x y) z+    -> Parser a m z+deintercalate+    (Parser stepL initialL extractL)+    (Parser stepR initialR _)+    (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    errMsg p status =+        error $ "deintercalate: " ++ p ++ " parser cannot "+                ++ status ++ " without input"++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs+            FL.Done c -> return $ IDone c++    {-# INLINE processL #-}+    processL foldAction n nextState = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> return $ Partial n (nextState fs1)+            FL.Done c -> return $ Done n c++    {-# INLINE runStepL #-}+    runStepL cnt fs sL a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)+            Done n b ->+                processL (fstep fs (Left b)) n DeintercalateInitR+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    {-# INLINE processR #-}+    processR cnt b fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        let cnt1 = cnt + 1+        r <- stepR sR a+        case r of+            Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)+            Done n b -> processR (cnt1 - n) b fs n+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    step (DeintercalateInitL fs) a = do+        res <- initialL+        case res of+            IPartial s -> runStepL 0 fs s a+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"+    step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a+    step (DeintercalateInitR fs) a = do+        res <- initialR+        case res of+            IPartial s -> runStepR 0 fs s a+            IDone _ -> errMsg "right" "succeed"+            IError _ -> errMsg "right" "fail"+    step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a+    step (DeintercalateRL cnt bR fs sL) a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)+            Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)+            Done n bL -> do+                res <- fstep fs (Right bR)+                case res of+                    FL.Partial fs1 -> do+                        fres <- fstep fs1 (Left bL)+                        case fres of+                            FL.Partial fs2 ->+                                return $ Partial n (DeintercalateInitR fs2)+                            FL.Done c -> return $ Done n c+                    -- XXX We could have the fold accept pairs of (bR, bL)+                    FL.Done _ -> error "Fold terminated consuming partial input"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+            FL.Done c -> return (Done n c)++    extract (DeintercalateInitL fs) = fmap (Done 0) $ ffinal fs+    extract (DeintercalateL cnt fs sL) = do+        r <- extractL sL+        case r of+            Done n b -> extractResult n fs (Left b)+            Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)+            Partial _ _ -> error "Partial in extract"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt xs+    extract (DeintercalateInitR fs) = fmap (Done 0) $ ffinal fs+    extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ ffinal fs+    extract (DeintercalateRL cnt bR fs sL) = do+        r <- extractL sL+        case r of+            Done n bL -> do+                res <- fstep fs (Right bR)+                case res of+                    FL.Partial fs1 -> extractResult n fs1 (Left bL)+                    FL.Done _ -> error "Fold terminated consuming partial input"+            Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)+            Partial _ _ -> error "Partial in extract"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt xs++{-# ANN type Deintercalate1State Fuse #-}+data Deintercalate1State b fs sp ss =+      Deintercalate1InitL !Int !fs !sp+    | Deintercalate1InitR !fs+    | Deintercalate1R !Int !fs !ss+    | Deintercalate1RL !Int !b !fs !sp++-- | Apply two parsers alternately to an input stream. The input stream is+-- considered an interleaving of two patterns. The two parsers represent the+-- two patterns. Parsing starts at the first parser and stops at the first+-- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty+-- input or single parse of the first parser is accepted.+--+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList+-- >>> p2 = Parser.satisfy (== '+')+-- >>> p = Parser.deintercalate1 p1 p2 Fold.toList+-- >>> Stream.parse p $ Stream.fromList ""+-- Left (ParseError "takeWhile1: end of input")+-- >>> Stream.parse p $ Stream.fromList "1"+-- Right [Left "1"]+-- >>> Stream.parse p $ Stream.fromList "1+"+-- Right [Left "1"]+-- >>> Stream.parse p $ Stream.fromList "1+2+3"+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]+--+{-# INLINE deintercalate1 #-}+deintercalate1 :: Monad m =>+       Parser a m x+    -> Parser a m y+    -> Fold m (Either x y) z+    -> Parser a m z+deintercalate1+    (Parser stepL initialL extractL)+    (Parser stepR initialR _)+    (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    errMsg p status =+        error $ "deintercalate: " ++ p ++ " parser cannot "+                ++ status ++ " without input"++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> do+                pres <- initialL+                case pres of+                    IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s+                    IDone _ -> errMsg "left" "succeed"+                    IError _ -> errMsg "left" "fail"+            FL.Done c -> return $ IDone c++    {-# INLINE processL #-}+    processL foldAction n nextState = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> return $ Partial n (nextState fs1)+            FL.Done c -> return $ Done n c++    {-# INLINE runStepInitL #-}+    runStepInitL cnt fs sL a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)+            Done n b ->+                processL (fstep fs (Left b)) n Deintercalate1InitR+            Error err -> return $ Error err++    {-# INLINE processR #-}+    processR cnt b fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        let cnt1 = cnt + 1+        r <- stepR sR a+        case r of+            Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)+            Done n b -> processR (cnt1 - n) b fs n+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a+    step (Deintercalate1InitR fs) a = do+        res <- initialR+        case res of+            IPartial s -> runStepR 0 fs s a+            IDone _ -> errMsg "right" "succeed"+            IError _ -> errMsg "right" "fail"+    step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a+    step (Deintercalate1RL cnt bR fs sL) a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)+            Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)+            Done n bL -> do+                res <- fstep fs (Right bR)+                case res of+                    FL.Partial fs1 -> do+                        fres <- fstep fs1 (Left bL)+                        case fres of+                            FL.Partial fs2 ->+                                return $ Partial n (Deintercalate1InitR fs2)+                            FL.Done c -> return $ Done n c+                    -- XXX We could have the fold accept pairs of (bR, bL)+                    FL.Done _ -> error "Fold terminated consuming partial input"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+            FL.Done c -> return (Done n c)++    extract (Deintercalate1InitL cnt fs sL) = do+        r <- extractL sL+        case r of+            Done n b -> extractResult n fs (Left b)+            Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)+            Partial _ _ -> error "Partial in extract"+            Error err -> return $ Error err+    extract (Deintercalate1InitR fs) = fmap (Done 0) $ ffinal fs+    extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ ffinal fs+    extract (Deintercalate1RL cnt bR fs sL) = do+        r <- extractL sL+        case r of+            Done n bL -> do+                res <- fstep fs (Right bR)+                case res of+                    FL.Partial fs1 -> extractResult n fs1 (Left bL)+                    FL.Done _ -> error "Fold terminated consuming partial input"+            Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)+            Partial _ _ -> error "Partial in extract"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt xs++{-# ANN type SepByState Fuse #-}+data SepByState fs sp ss =+      SepByInitL !fs+    | SepByL !Int !fs !sp+    | SepByInitR !fs+    | SepByR !Int !fs !ss++-- | Apply two parsers alternately to an input stream. Parsing starts at the+-- first parser and stops at the first parser. The output of the first parser+-- is emiited and the output of the second parser is discarded. It can be used+-- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse+-- of the first parser is accepted.+--+-- Definitions:+--+-- >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)+-- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)+--+-- Examples:+--+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList+-- >>> p2 = Parser.satisfy (== '+')+-- >>> p = Parser.sepBy p1 p2 Fold.toList+-- >>> Stream.parse p $ Stream.fromList ""+-- Right []+-- >>> Stream.parse p $ Stream.fromList "1"+-- Right ["1"]+-- >>> Stream.parse p $ Stream.fromList "1+"+-- Right ["1"]+-- >>> Stream.parse p $ Stream.fromList "1+2+3"+-- Right ["1","2","3"]+--+{-# INLINE sepBy #-}+sepBy :: Monad m =>+    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+-- This has similar performance as the custom impl below.+-- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)+sepBy+    (Parser stepL initialL extractL)+    (Parser stepR initialR _)+    (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    errMsg p status =+        error $ "sepBy: " ++ p ++ " parser cannot "+                ++ status ++ " without input"++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> return $ IPartial $ SepByInitL fs+            FL.Done c -> return $ IDone c++    {-# INLINE processL #-}+    processL foldAction n nextState = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> return $ Partial n (nextState fs1)+            FL.Done c -> return $ Done n c++    {-# INLINE runStepL #-}+    runStepL cnt fs sL a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)+            Done n b ->+                processL (fstep fs b) n SepByInitR+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    {-# INLINE processR #-}+    processR cnt fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ Continue n (SepByL cnt fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        let cnt1 = cnt + 1+        r <- stepR sR a+        case r of+            Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)+            Done n _ -> processR (cnt1 - n) fs n+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    step (SepByInitL fs) a = do+        res <- initialL+        case res of+            IPartial s -> runStepL 0 fs s a+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"+    step (SepByL cnt fs sL) a = runStepL cnt fs sL a+    step (SepByInitR fs) a = do+        res <- initialR+        case res of+            IPartial s -> runStepR 0 fs s a+            IDone _ -> errMsg "right" "succeed"+            IError _ -> errMsg "right" "fail"+    step (SepByR cnt fs sR) a = runStepR cnt fs sR a++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+            FL.Done c -> return (Done n c)++    extract (SepByInitL fs) = fmap (Done 0) $ ffinal fs+    extract (SepByL cnt fs sL) = do+        r <- extractL sL+        case r of+            Done n b -> extractResult n fs b+            Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)+            Partial _ _ -> error "Partial in extract"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt xs+    extract (SepByInitR fs) = fmap (Done 0) $ ffinal fs+    extract (SepByR cnt fs _) = fmap (Done cnt) $ ffinal fs++-- | Non-backtracking version of sepBy. Several times faster.+{-# INLINE sepByAll #-}+sepByAll :: Monad m =>+    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)++-- XXX This can be implemented using refold, parse one and then continue+-- collecting the rest in that.++{-# ANN type SepBy1State Fuse #-}+data SepBy1State fs sp ss =+      SepBy1InitL !Int !fs sp+    | SepBy1L !Int !fs !sp+    | SepBy1InitR !fs+    | SepBy1R !Int !fs !ss++{-+{-# INLINE sepBy1 #-}+sepBy1 :: Monad m =>+    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+sepBy1 p sep sink = do+    x <- p+    f <- fromEffect $ FL.reduce sink+    f1 <- fromEffect $ FL.snoc f x+    many (sep >> p) f1+-}++-- | Like 'sepBy' but requires at least one successful parse.+--+-- Definition:+--+-- >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)+--+-- Examples:+--+-- >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList+-- >>> p2 = Parser.satisfy (== '+')+-- >>> p = Parser.sepBy1 p1 p2 Fold.toList+-- >>> Stream.parse p $ Stream.fromList ""+-- Left (ParseError "takeWhile1: end of input")+-- >>> Stream.parse p $ Stream.fromList "1"+-- Right ["1"]+-- >>> Stream.parse p $ Stream.fromList "1+"+-- Right ["1"]+-- >>> Stream.parse p $ Stream.fromList "1+2+3"+-- Right ["1","2","3"]+--+{-# INLINE sepBy1 #-}+sepBy1 :: Monad m =>+    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+sepBy1+    (Parser stepL initialL extractL)+    (Parser stepR initialR _)+    (Fold fstep finitial _ ffinal) = Parser step initial extract++    where++    errMsg p status =+        error $ "sepBy: " ++ p ++ " parser cannot "+                ++ status ++ " without input"++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> do+                pres <- initialL+                case pres of+                    IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s+                    IDone _ -> errMsg "left" "succeed"+                    IError _ -> errMsg "left" "fail"+            FL.Done c -> return $ IDone c++    {-# INLINE processL #-}+    processL foldAction n nextState = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> return $ Partial n (nextState fs1)+            FL.Done c -> return $ Done n c++    {-# INLINE runStepInitL #-}+    runStepInitL cnt fs sL a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)+            Done n b ->+                processL (fstep fs b) n SepBy1InitR+            Error err -> return $ Error err++    {-# INLINE runStepL #-}+    runStepL cnt fs sL a = do+        let cnt1 = cnt + 1+        r <- stepL sL a+        case r of+            Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)+            Done n b ->+                processL (fstep fs b) n SepBy1InitR+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    {-# INLINE processR #-}+    processR cnt fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        let cnt1 = cnt + 1+        r <- stepR sR a+        case r of+            Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)+            Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)+            Done n _ -> processR (cnt1 - n) fs n+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a+    step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a+    step (SepBy1InitR fs) a = do+        res <- initialR+        case res of+            IPartial s -> runStepR 0 fs s a+            IDone _ -> errMsg "right" "succeed"+            IError _ -> errMsg "right" "fail"+    step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+            FL.Done c -> return (Done n c)++    extract (SepBy1InitL cnt fs sL) = do+        r <- extractL sL+        case r of+            Done n b -> extractResult n fs b+            Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)+            Partial _ _ -> error "Partial in extract"+            Error err -> return $ Error err+    extract (SepBy1L cnt fs sL) = do+        r <- extractL sL+        case r of+            Done n b -> extractResult n fs b+            Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)+            Partial _ _ -> error "Partial in extract"+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt xs+    extract (SepBy1InitR fs) = fmap (Done 0) $ ffinal fs+    extract (SepBy1R cnt fs _) = fmap (Done cnt) $ ffinal fs++-------------------------------------------------------------------------------+-- Interleaving a collection of parsers+-------------------------------------------------------------------------------+--+-- | Apply a collection of parsers to an input stream in a round robin fashion.+-- Each parser is applied until it stops and then we repeat starting with the+-- the first parser again.+--+-- /Unimplemented/+--+{-# INLINE roundRobin #-}+roundRobin :: -- (Foldable t, Monad m) =>+    t (Parser a m b) -> Fold m b c -> Parser a m c+roundRobin _ps _f = undefined++-------------------------------------------------------------------------------+-- Sequential Collection+-------------------------------------------------------------------------------++-- | @sequence f p@ collects sequential parses of parsers in a+-- serial stream @p@ using the fold @f@. Fails if the input ends or any+-- of the parsers fail.+--+-- /Pre-release/+--+{-# INLINE sequence #-}+sequence :: Monad m =>+    D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c+sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    initial = do+        fres <- finitial+        case fres of+            FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)+            FL.Done c -> return $ IDone c++    -- state does not contain any parser+    -- yield a new parser from the stream+    step (Nothing', ss, fs) _ = do+        sres <- sstep defState ss+        case sres of+            D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)+            D.Stop -> do+                c <- ffinal fs+                return $ Done 1 c+            D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)++    -- state holds a parser that may or may not have been+    -- initialized. pinit holds the initial parser state+    -- or modified parser state respectively+    step (Just' (Parser pstep pinit pextr), ss, fs) a = do+        ps <- pinit+        case ps of+            IPartial ps1 -> do+                pres <- pstep ps1 a+                case pres of+                    Partial n ps2 ->+                        let newP =+                              Just' $ Parser pstep (return $ IPartial ps2) pextr+                        in return $ Partial n (newP, ss, fs)+                    Continue n ps2 ->+                        let newP =+                              Just' $ Parser pstep (return $ IPartial ps2) pextr+                        in return $ Continue n (newP, ss, fs)+                    Done n b -> do+                        fres <- fstep fs b+                        case fres of+                            FL.Partial fs1 ->+                                return $ Partial n (Nothing', ss, fs1)+                            FL.Done c -> return $ Done n c+                    Error msg -> return $ Error msg+            IDone b -> do+                fres <- fstep fs b+                case fres of+                    FL.Partial fs1 ->+                        return $ Partial 1 (Nothing', ss, fs1)+                    FL.Done c -> return $ Done 1 c+            IError err -> return $ Error err++    extract (Nothing', _, fs) = fmap (Done 0) $ ffinal fs+    extract (Just' (Parser pstep pinit pextr), ss, fs) = do+        ps <- pinit+        case ps of+            IPartial ps1 ->  do+                r <- pextr ps1+                case r of+                    Done n b -> do+                        res <- fstep fs b+                        case res of+                            FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+                            FL.Done c -> return (Done n c)+                    Error err -> return $ Error err+                    Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)+                    Partial _ _ -> error "Partial in extract"+            IDone b -> do+                fres <- fstep fs b+                case fres of+                    FL.Partial fs1 -> fmap (Done 0) $ ffinal fs1+                    FL.Done c -> return (Done 0 c)+            IError err -> return $ Error err++-------------------------------------------------------------------------------+-- Alternative Collection+-------------------------------------------------------------------------------++{-+-- | @choice parsers@ applies the @parsers@ in order and returns the first+-- successful parse.+--+-- This is same as 'asum' but more efficient.+--+-- /Broken/+--+{-# INLINE choice #-}+choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b+choice = foldl1 shortest+-}++-------------------------------------------------------------------------------+-- Sequential Repetition+-------------------------------------------------------------------------------++-- | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the+-- results. Parsing stops or fails if the collecting parser stops or fails.+--+-- /Unimplemented/+--+{-# INLINE manyP #-}+manyP :: -- MonadCatch m =>+    Parser a m b -> Parser b m c -> Parser a m c+manyP _p _f = undefined++-- | Collect zero or more parses. Apply the supplied parser repeatedly on the+-- input stream and push the parse results to a downstream fold.+--+--  Stops: when the downstream fold stops or the parser fails.+--  Fails: never, produces zero or more results.+--+-- >>> many = Parser.countBetween 0 maxBound+--+-- Compare with 'Control.Applicative.many'.+--+{-# INLINE many #-}+many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+many = splitMany+-- many = countBetween 0 maxBound++-- Note: many1 would perhaps be a better name for this and consistent with+-- other names like takeWhile1. But we retain the name "some" for+-- compatibility.++-- | Collect one or more parses. Apply the supplied parser repeatedly on the+-- input stream and push the parse results to a downstream fold.+--+--  Stops: when the downstream fold stops or the parser fails.+--  Fails: if it stops without producing a single result.+--+-- >>> some p f = Parser.manyP p (Parser.takeGE 1 f)+-- >>> some = Parser.countBetween 1 maxBound+--+-- Compare with 'Control.Applicative.some'.+--+{-# INLINE some #-}+some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+some = splitSome+-- some p f = manyP p (takeGE 1 f)+-- some = countBetween 1 maxBound++-- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of+-- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if+-- the input ends or the parser fails before @m@ results are collected.+--+-- >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)+--+-- /Unimplemented/+--+{-# INLINE countBetween #-}+countBetween :: -- MonadCatch m =>+    Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c+countBetween _m _n _p = undefined+-- countBetween m n p f = manyP p (takeBetween m n f)++-- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using+-- the fold @f@.  Fails if the input ends or the parser fails before @n@+-- results are collected.+--+-- >>> count n = Parser.countBetween n n+-- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)+--+-- /Unimplemented/+--+{-# INLINE count #-}+count :: -- MonadCatch m =>+    Int -> Parser a m b -> Fold m b c -> Parser a m c+count n = countBetween n n+-- count n p f = manyP p (takeEQ n f)++-- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a+-- 'Fold'.  Parsing stops or fails if the collecting parser stops or fails.+--+-- We can implemnent parsers like the following using 'manyTillP':+--+-- @+-- countBetweenTill m n f p = manyTillP (takeBetween m n f) p+-- @+--+-- /Unimplemented/+--+{-# INLINE manyTillP #-}+manyTillP :: -- Monad m =>+    Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c+manyTillP _p1 _p2 _f = undefined+    -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f++{-# ANN type ManyTillState Fuse #-}+data ManyTillState fs sr sl+    = ManyTillR !Int !fs !sr+    | ManyTillL !fs !sl++-- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@+-- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is+-- tried again and so on. The parser stops when @test@ succeeds.  The output of+-- @test@ is discarded and the output of @chunking@ is accumulated by the+-- supplied fold. The parser fails if @chunking@ fails.+--+-- Stops when the fold @f@ stops.+--+{-# INLINE manyTill #-}+manyTill :: Monad m+    => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+manyTill (Parser stepL initialL extractL)+         (Parser stepR initialR _)+         (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution: Mutual recursion++    scrutL fs p c d e = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ c (ManyTillL fs sl)+            IDone bl -> do+                fr <- fstep fs bl+                case fr of+                    FL.Partial fs1 -> scrutR fs1 p c d e+                    FL.Done fb -> return $ d fb+            IError err -> return $ e err++    scrutR fs p c d e = do+        resR <- initialR+        case resR of+            IPartial sr -> return $ p (ManyTillR 0 fs sr)+            IDone _ -> d <$> ffinal fs+            IError _ -> scrutL fs p c d e++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> scrutR fs IPartial IPartial IDone IError+            FL.Done b -> return $ IDone b++    step (ManyTillR cnt fs st) a = do+        r <- stepR st a+        case r of+            Partial n s -> return $ Partial n (ManyTillR 0 fs s)+            Continue n s -> do+                assertM(cnt + 1 - n >= 0)+                return $ Continue n (ManyTillR (cnt + 1 - n) fs s)+            Done n _ -> do+                b <- ffinal fs+                return $ Done n b+            Error _ -> do+                resL <- initialL+                case resL of+                    IPartial sl ->+                        return $ Continue (cnt + 1) (ManyTillL fs sl)+                    IDone bl -> do+                        fr <- fstep fs bl+                        let cnt1 = cnt + 1+                        case fr of+                            FL.Partial fs1 ->+                                scrutR+                                    fs1+                                    (Partial cnt1)+                                    (Continue cnt1)+                                    (Done cnt1)+                                    Error+                            FL.Done fb -> return $ Done cnt1 fb+                    IError err -> return $ Error err+    step (ManyTillL fs st) a = do+        r <- stepL st a+        case r of+            Partial n s -> return $ Partial n (ManyTillL fs s)+            Continue n s -> return $ Continue n (ManyTillL fs s)+            Done n b -> do+                fs1 <- fstep fs b+                case fs1 of+                    FL.Partial s ->+                        scrutR s (Partial n) (Continue n) (Done n) Error+                    FL.Done b1 -> return $ Done n b1+            Error err -> return $ Error err++    extract (ManyTillL fs sR) = do+        res <- extractL sR+        case res of+            Done n b -> do+                r <- fstep fs b+                case r of+                    FL.Partial fs1 -> fmap (Done n) $ ffinal fs1+                    FL.Done c -> return (Done n c)+            Error err -> return $ Error err+            Continue n s -> return $ Continue n (ManyTillL fs s)+            Partial _ _ -> error "Partial in extract"+    extract (ManyTillR _ fs _) = fmap (Done 0) $ ffinal fs++-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and+-- collects the output in the supplied fold. If the the parser @collect@ fails,+-- parser @recover@ is run until it stops and then we start repeating the+-- parser @collect@ again. The parser fails if the recovery parser fails.+--+-- For example, this can be used to find a key frame in a video stream after an+-- error.+--+-- /Unimplemented/+--+{-# INLINE manyThen #-}+manyThen :: -- (Foldable t, Monad m) =>+    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+manyThen _parser _recover _f = undefined++-------------------------------------------------------------------------------+-- Repeated Alternatives+-------------------------------------------------------------------------------++-- | Keep trying a parser up to a maximum of @n@ failures.  When the parser+-- fails the input consumed till now is dropped and the new instance is tried+-- on the fresh input.+--+-- /Unimplemented/+--+{-# INLINE retryMaxTotal #-}+retryMaxTotal :: -- (Monad m) =>+    Int -> Parser a m b -> Fold m b c -> Parser a m c+retryMaxTotal _n _p _f  = undefined++-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.+--+-- /Unimplemented/+--+{-# INLINE retryMaxSuccessive #-}+retryMaxSuccessive :: -- (Monad m) =>+    Int -> Parser a m b -> Fold m b c -> Parser a m c+retryMaxSuccessive _n _p _f = undefined++-- | Keep trying a parser until it succeeds.  When the parser fails the input+-- consumed till now is dropped and the new instance is tried on the fresh+-- input.+--+-- /Unimplemented/+--+{-# INLINE retry #-}+retry :: -- (Monad m) =>+    Parser a m b -> Parser a m b+retry _p = undefined
− src/Streamly/Internal/Data/Parser/ParserD.hs 
@@ -1,3629 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Parser.ParserD--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Parser.ParserD-    (-    -- * Setup-    -- $setup--    -- * Types-      Parser (..)-    , ParseError (..)-    , Step (..)-    , Initial (..)--    -- * Downgrade to Fold-    , toFold--    -- First order parsers-    -- * Accumulators-    , fromFold-    , fromFoldMaybe-    , fromPure-    , fromEffect-    , die-    , dieM--    -- * Map on input-    , lmap-    , lmapM-    , postscan-    , filter--    -- * Map on output-    , rmapM--    -- * Element parsers-    , peek--    -- All of these can be expressed in terms of either-    , one-    , oneEq-    , oneNotEq-    , oneOf-    , noneOf-    , eof-    , satisfy-    , maybe-    , either--    -- * Sequence parsers (tokenizers)-    ---    -- | Parsers chained in series, if one parser terminates the composition-    -- terminates. Currently we are using folds to collect the output of the-    -- parsers but we can use Parsers instead of folds to make the composition-    -- more powerful. For example, we can do:-    ---    -- takeEndByOrMax cond n p = takeEndBy cond (take n p)-    -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)-    -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)-    , lookAhead--    -- ** By length-    -- | Grab a sequence of input elements without inspecting them-    , takeBetween-    -- , take -- takeBetween 0 n-    , takeEQ -- takeBetween n n-    , takeGE -- takeBetween n maxBound-    -- , takeGE1 -- take1 -- takeBetween 1 n-    , takeP--    -- Grab a sequence of input elements by inspecting them-    -- ** Exact match-    , listEq-    , listEqBy-    , streamEqBy-    , subsequenceBy--    -- ** By predicate-    , takeWhile-    , takeWhileP-    , takeWhile1-    , dropWhile--    -- ** Separated by elements-    -- | Separator could be in prefix postion ('takeStartBy'), or suffix-    -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix-    -- separator parsing, also see 'intersperseQuotedBy' fold.--    -- These can be implemented modularly with refolds, using takeWhile and-    -- satisfy.-    , takeEndBy-    , takeEndBy_-    , takeEndByEsc-    -- , takeEndByEsc_-    , takeStartBy-    , takeStartBy_-    , takeEitherSepBy-    , wordBy--    -- ** Grouped by element comparison-    , groupBy-    , groupByRolling-    , groupByRollingEither--    -- ** Framed by elements-    -- | Also see 'intersperseQuotedBy' fold.-    -- Framed by a one or more ocurrences of a separator around a word like-    -- spaces or quotes. No nesting.-    , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?-    , wordWithQuotes-    , wordKeepQuotes-    , wordProcessQuotes--    -- Framed by separate start and end characters, potentially nested.-    -- blockWithQuotes allows quotes inside a block. However,-    -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and-    -- block with escaping.-    -- , takeFramedBy-    , takeFramedBy_-    , takeFramedByEsc_-    , takeFramedByGeneric-    , blockWithQuotes--    -- Matching strings-    -- , prefixOf -- match any prefix of a given string-    -- , suffixOf -- match any suffix of a given string-    -- , infixOf -- match any substring of a given string--    -- ** Spanning-    , span-    , spanBy-    , spanByRolling--    -- Second order parsers (parsers using parsers)-    -- * Binary Combinators--    -- ** Sequential Applicative-    , splitWith-    , split_--    {--    -- ** Parallel Applicatives-    , teeWith-    , teeWithFst-    , teeWithMin-    -- , teeTill -- like manyTill but parallel-    -}--    -- ** Sequential Alternative-    , alt--    {--    -- ** Parallel Alternatives-    , shortest-    , longest-    -- , fastest-    -}--    -- * N-ary Combinators-    -- ** Sequential Collection-    , sequence-    , concatMap--    -- ** Sequential Repetition-    , count-    , countBetween-    -- , countBetweenTill-    , manyP-    , many-    , some--    -- ** Interleaved Repetition-    -- Use two folds, run a primary parser, its rejected values go to the-    -- secondary parser.-    , deintercalate-    , deintercalate1-    , deintercalateAll-    -- , deintercalatePrefix-    -- , deintercalateSuffix--    -- *** Special cases-    -- | TODO: traditional implmentations of these may be of limited use. For-    -- example, consider parsing lines separated by @\\r\\n@. The main parser-    -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we-    -- can apply the "sep" parser.-    ---    -- We can instead implement these as special cases of deintercalate.-    ---    -- @-    -- , endBy-    -- , sepEndBy-    -- , beginBy-    -- , sepBeginBy-    -- , sepAroundBy-    -- @-    , sepBy1-    , sepBy-    , sepByAll--    , manyTillP-    , manyTill-    , manyThen--    -- -- * Distribution-    ---    -- A simple and stupid impl would be to just convert the stream to an array-    -- and give the array reference to all consumers. The array can be grown on-    -- demand by any consumer and truncated when nonbody needs it.-    ---    -- -- ** Distribute to collection-    -- -- ** Distribute to repetition--    -- ** Interleaved collection-    -- |-    ---    -- 1. Round robin-    -- 2. Priority based-    , roundRobin--    -- -- ** Interleaved repetition-    -- repeat one parser and when it fails run an error recovery parser-    -- e.g. to find a key frame in the stream after an error--    -- ** Collection of Alternatives-    -- | Unimplemented-    ---    -- @-    -- , shortestN-    -- , longestN-    -- , fastestN -- first N successful in time-    -- , choiceN  -- first N successful in position-    -- @-    -- , choice   -- first successful in position--    -- ** Repeated Alternatives-    , retryMaxTotal-    , retryMaxSuccessive-    , retry--    -- ** Zipping Input-    , zipWithM-    , zip-    , indexed-    , makeIndexFilter-    , sampleFromthen--     -- * Deprecated-    , next-    )-where--#include "inline.hs"-#include "assert.hs"--import Control.Monad (when)-import Data.Bifunctor (first)-import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.SVar.Type (defState)-import Streamly.Internal.Data.Either.Strict (Either'(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)--import qualified Data.Foldable as Foldable-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D--import Prelude hiding-       (any, all, take, takeWhile, sequence, concatMap, maybe, either, span-       , zip, filter, dropWhile)--- import Streamly.Internal.Data.Parser.ParserD.Tee-import Streamly.Internal.Data.Parser.ParserD.Type--#include "DocTestDataParser.hs"------------------------------------------------------------------------------------ Downgrade a parser to a Fold------------------------------------------------------------------------------------ | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the--- parser fails or tries to backtrack.------ This can be useful in combinators that accept a Fold and we know that a--- Parser cannot fail or failure exception is acceptable as there is no way to--- recover.------ /Pre-release/----{-# INLINE toFold #-}-toFold :: Monad m => Parser a m b -> Fold m a b-toFold (Parser pstep pinitial pextract) = Fold step initial extract--    where--    initial = do-        r <- pinitial-        case r of-            IPartial s -> return $ FL.Partial s-            IDone b -> return $ FL.Done b-            IError err ->-                error $ "toFold: parser throws error in initial" ++ err--    perror n = error $ "toFold: parser backtracks in Partial: " ++ show n-    cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n-    derror n = error $ "toFold: parser backtracks in Done: " ++ show n-    eerror err = error $ "toFold: parser throws error: " ++ err--    step st a = do-        r <- pstep st a-        case r of-            Partial 0 s -> return $ FL.Partial s-            Continue 0 s -> return $ FL.Partial s-            Done 0 b -> return $ FL.Done b-            Partial n _ -> perror n-            Continue n _ -> cerror n-            Done n _ -> derror n-            Error err -> eerror err--    extract st = do-        r <- pextract st-        case r of-            Done 0 b -> return b-            Partial n _ -> perror n-            Continue n _ -> cerror n-            Done n _ -> derror n-            Error err -> eerror err------------------------------------------------------------------------------------ Upgrade folds to parses------------------------------------------------------------------------------------ | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the--- fold.----{-# INLINE fromFold #-}-fromFold :: Monad m => Fold m a b -> Parser a m b-fromFold (Fold fstep finitial fextract) = Parser step initial extract--    where--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s1 -> IPartial s1-                  FL.Done b -> IDone b--    step s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 s1-                  FL.Done b -> Done 0 b--    extract = fmap (Done 0) . fextract---- | Convert a Maybe returning fold to an error returning parser. The first--- argument is the error message that the parser would return when the fold--- returns Nothing.------ /Pre-release/----{-# INLINE fromFoldMaybe #-}-fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b-fromFoldMaybe errMsg (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s1 -> IPartial s1-                  FL.Done b ->-                        case b of-                            Just x -> IDone x-                            Nothing -> IError errMsg--    step s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 s1-                  FL.Done b ->-                        case b of-                            Just x -> Done 0 x-                            Nothing -> Error errMsg--    extract s = do-        res <- fextract s-        case res of-            Just x -> return $ Done 0 x-            Nothing -> return $ Error errMsg------------------------------------------------------------------------------------ Failing Parsers------------------------------------------------------------------------------------ | Peek the head element of a stream, without consuming it. Fails if it--- encounters end of input.------ >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]--- Right (1,1)------ @--- peek = lookAhead (satisfy True)--- @----{-# INLINE peek #-}-peek :: Monad m => Parser a m a-peek = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $ Done 1 a--    extract () = return $ Error "peek: end of input"---- | Succeeds if we are at the end of input, fails otherwise.------ >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]--- Right (1,())----{-# INLINE eof #-}-eof :: Monad m => Parser a m ()-eof = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () _ = return $ Error "eof: not at end of input"--    extract () = return $ Done 0 ()---- | Return the next element of the input. Returns 'Nothing'--- on end of input. Also known as 'head'.------ /Pre-release/----{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}-{-# INLINE next #-}-next :: Monad m => Parser a m (Maybe a)-next = Parser step initial extract--  where--  initial = pure $ IPartial ()--  step () a = pure $ Done 0 (Just a)--  extract () = pure $ Done 0 Nothing---- | Map an 'Either' returning function on the next element in the stream.  If--- the function returns 'Left err', the parser fails with the error message--- @err@ otherwise returns the 'Right' value.------ /Pre-release/----{-# INLINE either #-}-either :: Monad m => (a -> Either String b) -> Parser a m b-either f = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        case f a of-            Right b -> Done 0 b-            Left err -> Error err--    extract () = return $ Error "end of input"---- | Map a 'Maybe' returning function on the next element in the stream. The--- parser fails if the function returns 'Nothing' otherwise returns the 'Just'--- value.------ >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right--- >>> maybe f = Parser.either (toEither . f)------ >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)------ /Pre-release/----{-# INLINE maybe #-}-maybe :: Monad m => (a -> Maybe b) -> Parser a m b--- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)-maybe parserF = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        case parserF a of-            Just b -> Done 0 b-            Nothing -> Error "maybe: predicate failed"--    extract () = return $ Error "maybe: end of input"---- | Returns the next element if it passes the predicate, fails otherwise.------ >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]--- Right 1------ >>> toMaybe f x = if f x then Just x else Nothing--- >>> satisfy f = Parser.maybe (toMaybe f)----{-# INLINE satisfy #-}-satisfy :: Monad m => (a -> Bool) -> Parser a m a--- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)-satisfy predicate = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        if predicate a-        then Done 0 a-        else Error "satisfy: predicate failed"--    extract () = return $ Error "satisfy: end of input"---- | Consume one element from the head of the stream.  Fails if it encounters--- end of input.------ >>> one = Parser.satisfy $ const True----{-# INLINE one #-}-one :: Monad m => Parser a m a-one = satisfy $ const True---- Alternate names: "only", "onlyThis".---- | Match a specific element.------ >>> oneEq x = Parser.satisfy (== x)----{-# INLINE oneEq #-}-oneEq :: (Monad m, Eq a) => a -> Parser a m a-oneEq x = satisfy (== x)---- Alternate names: "exclude", "notThis".---- | Match anything other than the supplied element.------ >>> oneNotEq x = Parser.satisfy (/= x)----{-# INLINE oneNotEq #-}-oneNotEq :: (Monad m, Eq a) => a -> Parser a m a-oneNotEq x = satisfy (/= x)---- | Match any one of the elements in the supplied list.------ >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)------ When performance matters a pattern matching predicate could be more--- efficient than a 'Foldable' datatype:------ @--- let p x =---    case x of---       'a' -> True---       'e' -> True---        _  -> False--- in satisfy p--- @------ GHC may use a binary search instead of linear search in the list.--- Alternatively, you can also use an array instead of list for storage and--- search.----{-# INLINE oneOf #-}-oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a-oneOf xs = satisfy (`Foldable.elem` xs)---- | See performance notes in 'oneOf'.------ >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)----{-# INLINE noneOf #-}-noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a-noneOf xs = satisfy (`Foldable.notElem` xs)------------------------------------------------------------------------------------ Taking elements------------------------------------------------------------------------------------ Required to fuse "take" with "many" in "chunksOf", for ghc-9.x-{-# ANN type Tuple'Fused Fuse #-}-data Tuple'Fused a b = Tuple'Fused !a !b deriving Show---- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input--- elements and folds them using the supplied fold.------ Stops after @n@ elements.--- Fails if the stream ends before @m@ elements could be taken.------ Examples: ------- @--- >>> :{---   takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)---     where prsr = Parser.takeBetween low high Fold.toList--- :}------ @------ >>> takeBetween' 2 4 [1, 2, 3, 4, 5]--- Right [1,2,3,4]------ >>> takeBetween' 2 4 [1, 2]--- Right [1,2]------ >>> takeBetween' 2 4 [1]--- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")------ >>> takeBetween' 0 0 [1, 2]--- Right []------ >>> takeBetween' 0 1 []--- Right []------ @takeBetween@ is the most general take operation, other take operations can--- be defined in terms of takeBetween. For example:------ >>> take n = Parser.takeBetween 0 n--- >>> takeEQ n = Parser.takeBetween n n--- >>> takeGE n = Parser.takeBetween n maxBound------ /Pre-release/----{-# INLINE takeBetween #-}-takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b-takeBetween low high (Fold fstep finitial fextract) =--    Parser step initial (extract streamErr)--    where--    streamErr i =-           "takeBetween: Expecting alteast " ++ show low-        ++ " elements, got " ++ show i--    invalidRange =-        "takeBetween: lower bound - " ++ show low-            ++ " is greater than higher bound - " ++ show high--    foldErr :: Int -> String-    foldErr i =-        "takeBetween: the collecting fold terminated after"-            ++ " consuming" ++ show i ++ " elements"-            ++ " minimum" ++ show low ++ " elements needed"--    -- Exactly the same as snext except different constructors, we can possibly-    -- deduplicate the two.-    {-# INLINE inext #-}-    inext i res =-        let i1 = i + 1-        in case res of-            FL.Partial s -> do-                let s1 = Tuple'Fused i1 s-                if i1 < high-                -- XXX ideally this should be a Continue instead-                then return $ IPartial s1-                else iextract foldErr s1-            FL.Done b ->-                return-                    $ if i1 >= low-                      then IDone b-                      else IError (foldErr i1)--    initial = do-        when (low >= 0 && high >= 0 && low > high)-            $ error invalidRange--        finitial >>= inext (-1)--    -- Keep the impl same as inext-    {-# INLINE snext #-}-    snext i res =-        let i1 = i + 1-        in case res of-            FL.Partial s -> do-                let s1 = Tuple'Fused i1 s-                if i1 < high-                then return $ Continue 0 s1-                else extract foldErr s1-            FL.Done b ->-                return-                    $ if i1 >= low-                      then Done 0 b-                      else Error (foldErr i1)--    step (Tuple'Fused i s) a = fstep s a >>= snext i--    extract f (Tuple'Fused i s)-        | i >= low && i <= high = fmap (Done 0) (fextract s)-        | otherwise = return $ Error (f i)--    -- XXX Need to make Initial return type Step to deduplicate this-    iextract f (Tuple'Fused i s)-        | i >= low && i <= high = fmap IDone (fextract s)-        | otherwise = return $ IError (f i)---- | Stops after taking exactly @n@ input elements.------ * Stops - after consuming @n@ elements.--- * Fails - if the stream or the collecting fold ends before it can collect---           exactly @n@ elements.------ >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]--- Right [1,0]------ >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]--- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")----{-# INLINE takeEQ #-}-takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b-takeEQ n (Fold fstep finitial fextract) = Parser step initial extract--    where--    initial = do-        res <- finitial-        case res of-            FL.Partial s ->-                if n > 0-                then return $ IPartial $ Tuple'Fused 1 s-                else fmap IDone (fextract s)-            FL.Done b -> return $-                if n > 0-                then IError-                         $ "takeEQ: Expecting exactly " ++ show n-                             ++ " elements, fold terminated without"-                             ++ " consuming any elements"-                else IDone b--    step (Tuple'Fused i1 r) a = do-        res <- fstep r a-        if n > i1-        then-            return-                $ case res of-                    FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s-                    FL.Done _ ->-                        Error-                            $ "takeEQ: Expecting exactly " ++ show n-                                ++ " elements, fold terminated on " ++ show i1-        else-            -- assert (n == i1)-            Done 0-                <$> case res of-                        FL.Partial s -> fextract s-                        FL.Done b -> return b--    extract (Tuple'Fused i _) =-        -- Using the count "i" in the message below causes large performance-        -- regression unless we use Fuse annotation on Tuple.-        return-            $ Error-            $ "takeEQ: Expecting exactly " ++ show n-                ++ " elements, input terminated on " ++ show (i - 1)--{-# ANN type TakeGEState Fuse #-}-data TakeGEState s =-      TakeGELT !Int !s-    | TakeGEGE !s---- | Take at least @n@ input elements, but can collect more.------ * Stops - when the collecting fold stops.--- * Fails - if the stream or the collecting fold ends before producing @n@---           elements.------ >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]--- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")------ >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]--- Right [1,0,1,0,1]------ /Pre-release/----{-# INLINE takeGE #-}-takeGE :: Monad m => Int -> Fold m a b -> Parser a m b-takeGE n (Fold fstep finitial fextract) = Parser step initial extract--    where--    initial = do-        res <- finitial-        case res of-            FL.Partial s ->-                if n > 0-                then return $ IPartial $ TakeGELT 1 s-                else return $ IPartial $ TakeGEGE s-            FL.Done b -> return $-                if n > 0-                then IError-                         $ "takeGE: Expecting at least " ++ show n-                             ++ " elements, fold terminated without"-                             ++ " consuming any elements"-                else IDone b--    step (TakeGELT i1 r) a = do-        res <- fstep r a-        if n > i1-        then-            return-                $ case res of-                      FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s-                      FL.Done _ ->-                        Error-                            $ "takeGE: Expecting at least " ++ show n-                                ++ " elements, fold terminated on " ++ show i1-        else-            -- assert (n <= i1)-            return-                $ case res of-                      FL.Partial s -> Partial 0 $ TakeGEGE s-                      FL.Done b -> Done 0 b-    step (TakeGEGE r) a = do-        res <- fstep r a-        return-            $ case res of-                  FL.Partial s -> Partial 0 $ TakeGEGE s-                  FL.Done b -> Done 0 b--    extract (TakeGELT i _) =-        return-            $ Error-            $ "takeGE: Expecting at least " ++ show n-                ++ " elements, input terminated on " ++ show (i - 1)-    extract (TakeGEGE r) = fmap (Done 0) $ fextract r------------------------------------------------------------------------------------ Conditional splitting------------------------------------------------------------------------------------ XXX We should perhaps use only takeWhileP and rename it to takeWhile.---- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the--- input. The combinator stops when the condition fails or if the collecting--- parser stops.------ Other interesting parsers can be implemented in terms of this parser:------ >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)--- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)------ Stops: when the condition fails or the collecting parser stops.--- Fails: when the collecting parser fails.------ /Pre-release/----{-# INLINE takeWhileP #-}-takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b-takeWhileP predicate (Parser pstep pinitial pextract) =-    Parser step pinitial pextract--    where--    step s a =-        if predicate a-        then pstep s a-        else do-            r <- pextract s-            -- XXX need a map on count-            case r of-                Error err -> return $ Error err-                Done n s1 -> return $ Done (n + 1) s1-                Partial _ _ -> error "Bug: takeWhileP: Partial in extract"-                Continue n s1 -> return $ Continue (n + 1) s1---- | Collect stream elements until an element fails the predicate. The element--- on which the predicate fails is returned back to the input stream.------ * Stops - when the predicate fails or the collecting fold stops.--- * Fails - never.------ >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]--- Right [0,0]------ >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)------ We can implement a @breakOn@ using 'takeWhile':------ @--- breakOn p = takeWhile (not p)--- @----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b--- takeWhile cond f = takeWhileP cond (fromFold f)-takeWhile predicate (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return $ case res of-            FL.Partial s -> IPartial s-            FL.Done b -> IDone b--    step s a =-        if predicate a-        then do-            fres <- fstep s a-            return-                $ case fres of-                      FL.Partial s1 -> Partial 0 s1-                      FL.Done b -> Done 0 b-        else Done 1 <$> fextract s--    extract s = fmap (Done 0) (fextract s)--{---- XXX This may not be composable because of the b argument. We can instead--- return a "Reparse b a m b" so that those can be composed.-{-# INLINE takeWhile1X #-}-takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b--- We can implement this using satisfy and takeWhile. We can use "satisfy--- p", fold the result with the refold and then use the "takeWhile p" and--- fold that using the refold.-takeWhile1 acc cond f = undefined--}---- | Like 'takeWhile' but takes at least one element otherwise fails.------ >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)----{-# INLINE takeWhile1 #-}-takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b--- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)-takeWhile1 predicate (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return $ case res of-            FL.Partial s -> IPartial (Left' s)-            FL.Done _ ->-                IError-                    $ "takeWhile1: fold terminated without consuming:"-                          ++ " any element"--    {-# INLINE process #-}-    process s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 (Right' s1)-                  FL.Done b -> Done 0 b--    step (Left' s) a =-        if predicate a-        then process s a-        else return $ Error "takeWhile1: predicate failed on first element"-    step (Right' s) a =-        if predicate a-        then process s a-        else do-            b <- fextract s-            return $ Done 1 b--    extract (Left' _) = return $ Error "takeWhile1: end of input"-    extract (Right' s) = fmap (Done 0) (fextract s)---- | Drain the input as long as the predicate succeeds, running the effects and--- discarding the results.------ This is also called @skipWhile@ in some parsing libraries.------ >>> dropWhile p = Parser.takeWhile p Fold.drain----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Parser a m ()-dropWhile p = takeWhile p FL.drain------------------------------------------------------------------------------------ Separators----------------------------------------------------------------------------------{-# ANN type FramedEscState Fuse #-}-data FramedEscState s =-    FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int---- XXX We can remove Maybe from esc-{-# INLINE takeFramedByGeneric #-}-takeFramedByGeneric :: Monad m =>-       Maybe (a -> Bool) -- is escape char?-    -> Maybe (a -> Bool) -- is frame begin?-    -> Maybe (a -> Bool) -- is frame end?-    -> Fold m a b-    -> Parser a m b-takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (FrameEscInit s)-                FL.Done _ ->-                    error "takeFramedByGeneric: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)-                FL.Done b -> Done 0 b--    {-# INLINE processNoEsc #-}-    processNoEsc s a n =-        case end of-            Just isEnd ->-                case begin of-                    Just isBegin ->-                        -- takeFramedBy case-                        if isEnd a-                        then-                            if n == 0-                            then Done 0 <$> fextract s-                            else process s a (n - 1)-                        else-                            let n1 = if isBegin a then n + 1 else n-                             in process s a n1-                    Nothing -> -- takeEndBy case-                        if isEnd a-                        then Done 0 <$> fextract s-                        else process s a n-            Nothing -> -- takeStartBy case-                case begin of-                    Just isBegin ->-                        if isBegin a-                        then Done 0 <$> fextract s-                        else process s a n-                    Nothing ->-                        error $ "takeFramedByGeneric: "-                            ++ "Both begin and end frame predicate missing"--    {-# INLINE processCheckEsc #-}-    processCheckEsc s a n =-        case esc of-            Just isEsc ->-                if isEsc a-                then return $ Partial 0 $ FrameEscEsc s n-                else processNoEsc s a n-            Nothing -> processNoEsc s a n--    step (FrameEscInit s) a =-        case begin of-            Just isBegin ->-                if isBegin a-                then return $ Partial 0 (FrameEscGo s 0)-                else return $ Error "takeFramedByGeneric: missing frame start"-            Nothing ->-                case end of-                    Just isEnd ->-                        if isEnd a-                        then Done 0 <$> fextract s-                        else processCheckEsc s a 0-                    Nothing ->-                        error "Both begin and end frame predicate missing"-    step (FrameEscGo s n) a = processCheckEsc s a n-    step (FrameEscEsc s n) a = process s a n--    err = return . Error--    extract (FrameEscInit _) =-        err "takeFramedByGeneric: empty token"-    extract (FrameEscGo s _) =-        case begin of-            Just _ ->-                case end of-                    Nothing -> fmap (Done 0) $ fextract s-                    Just _ -> err "takeFramedByGeneric: missing frame end"-            Nothing -> err "takeFramedByGeneric: missing closing frame"-    extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"--data BlockParseState s =-      BlockInit !s-    | BlockUnquoted !Int !s-    | BlockQuoted !Int !s-    | BlockQuotedEsc !Int !s---- Blocks can be of different types e.g. {} or (). We only parse from the--- perspective of the outermost block type. The nesting of that block are--- checked. Any other block types nested inside it are opaque to us and can be--- parsed when the contents of the block are parsed.---- XXX Put a limit on nest level to keep the API safe.---- | Parse a block enclosed within open, close brackets. Block contents may be--- quoted, brackets inside quotes are ignored. Quoting characters can be used--- within quotes if escaped. A block can have a nested block inside it.------ Quote begin and end chars are the same. Block brackets and quote chars must--- not overlap. Block start and end brackets must be different for nesting--- blocks within blocks.------ >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList--- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"--- Right "msg: \"hello world\""----{-# INLINE blockWithQuotes #-}-blockWithQuotes :: (Monad m, Eq a) =>-       (a -> Bool)  -- ^ escape char-    -> (a -> Bool)  -- ^ quote char, to quote inside brackets-    -> a  -- ^ Block opening bracket-    -> a  -- ^ Block closing bracket-    -> Fold m a b-    -> Parser a m b-blockWithQuotes isEsc isQuote bopen bclose-    (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (BlockInit s)-                FL.Done _ ->-                    error "blockWithQuotes: fold finished without input"--    {-# INLINE process #-}-    process s a nextState = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (nextState s1)-                FL.Done b -> Done 0 b--    step (BlockInit s) a =-        return-            $ if a == bopen-              then Continue 0 $ BlockUnquoted 1 s-              else Error "blockWithQuotes: missing block start"-    step (BlockUnquoted level s) a-        | a == bopen = process s a (BlockUnquoted (level + 1))-        | a == bclose =-            if level == 1-            then fmap (Done 0) (fextract s)-            else process s a (BlockUnquoted (level - 1))-        | isQuote a = process s a (BlockQuoted level)-        | otherwise = process s a (BlockUnquoted level)-    step (BlockQuoted level s) a-        | isEsc a = process s a (BlockQuotedEsc level)-        | otherwise =-            if isQuote a-            then process s a (BlockUnquoted level)-            else process s a (BlockQuoted level)-    step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)--    err = return . Error--    extract (BlockInit s) = fmap (Done 0) $ fextract s-    extract (BlockUnquoted level _) =-        err $ "blockWithQuotes: finished at block nest level " ++ show level-    extract (BlockQuoted level _) =-        err $ "blockWithQuotes: finished, inside an unfinished quote, "-            ++ "at block nest level " ++ show level-    extract (BlockQuotedEsc level _) =-        err $ "blockWithQuotes: finished, inside an unfinished quote, "-            ++ "after an escape char, at block nest level " ++ show level---- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by--- the supplied predicate. The separator is also taken with the token.------ This can be combined with other parsers to implement other interesting--- parsers as follows:------ >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)--- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)------ >>> takeEndBy = Parser.takeEndByEsc (const False)------ See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting--- parser in the takeEndBy parser can decide whether to fail or not if the--- stream does not end with separator.------ /Pre-release/----{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b--- takeEndBy = takeEndByEsc (const False)-takeEndBy cond (Parser pstep pinitial pextract) =--    Parser step initial pextract--    where--    initial = pinitial--    step s a = do-        res <- pstep s a-        if not (cond a)-        then return res-        else extractStep pextract res---- | Like 'takeEndBy' but the separator elements can be escaped using an--- escape char determined by the first predicate. The escape characters are--- removed.------ /pre-release/-{-# INLINE takeEndByEsc #-}-takeEndByEsc :: Monad m =>-    (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b-takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =--    Parser step initial extract--    where--    initial = first Left' <$> pinitial--    step (Left' s) a = do-        if isEsc a-        then return $ Partial 0 $ Right' s-        else do-            res <- pstep s a-            if not (isSep a)-            then return $ first Left' res-            else fmap (first Left') $ extractStep pextract res--    step (Right' s) a = do-        res <- pstep s a-        return $ first Left' res--    extract (Left' s) = fmap (first Left') $ pextract s-    extract (Right' _) =-        return $ Error "takeEndByEsc: trailing escape"---- | Like 'takeEndBy' but the separator is dropped.------ See also "Streamly.Data.Fold.takeEndBy_".------ /Pre-release/----{-# INLINE takeEndBy_ #-}-takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b-{--takeEndBy_ isEnd p =-    takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)--}-takeEndBy_ cond (Parser pstep pinitial pextract) =--    Parser step pinitial pextract--    where--    step s a =-        if cond a-        then pextract s-        else pstep s a---- | Take either the separator or the token. Separator is a Left value and--- token is Right value.------ /Unimplemented/-{-# INLINE takeEitherSepBy #-}-takeEitherSepBy :: -- Monad m =>-    (a -> Bool) -> Fold m (Either a b) c -> Parser a m c-takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond---- | Parse a token that starts with an element chosen by the predicate.  The--- parser fails if the input does not start with the selected element.------ * Stops - when the predicate succeeds in non-leading position.--- * Fails - when the predicate fails in the leading position.------ >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)------ Examples: ------- >>> p = Parser.takeStartBy (== ',') Fold.toList--- >>> leadingComma = Stream.parse p . Stream.fromList--- >>> leadingComma "a,b"--- Left (ParseError "takeStartBy: missing frame start")--- ...--- >>> leadingComma ",,"--- Right ","--- >>> leadingComma ",a,b"--- Right ",a"--- >>> leadingComma ""--- Right ""------ /Pre-release/----{-# INLINE takeStartBy #-}-takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b-takeStartBy cond (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (Left' s)-                FL.Done _ -> IError "takeStartBy: fold done without input"--    {-# INLINE process #-}-    process s a = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Partial 0 (Right' s1)-                FL.Done b -> Done 0 b--    step (Left' s) a =-        if cond a-        then process s a-        else return $ Error "takeStartBy: missing frame start"-    step (Right' s) a =-        if not (cond a)-        then process s a-        else Done 1 <$> fextract s--    extract (Left' s) = fmap (Done 0) $ fextract s-    extract (Right' s) = fmap (Done 0) $ fextract s---- | Like 'takeStartBy' but drops the separator.------ >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing----{-# INLINE takeStartBy_ #-}-takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b-takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing---- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a--- begin and end predicate, and an escape character. The frame begin and end--- characters lose their special meaning if preceded by the escape character.------ Nested frames are allowed if begin and end markers are different, nested--- frames must be balanced unless escaped, nested frame markers are emitted as--- it is.------ For example,------ >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList--- >>> Stream.parse p $ Stream.fromList "{hello}"--- Right "hello"--- >>> Stream.parse p $ Stream.fromList "{hello {world}}"--- Right "hello {world}"--- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"--- Right "hello {world"--- >>> Stream.parse p $ Stream.fromList "{hello {world}"--- Left (ParseError "takeFramedByEsc_: missing frame end")------ /Pre-release/-{-# INLINE takeFramedByEsc_ #-}-takeFramedByEsc_ :: Monad m =>-    (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b--- takeFramedByEsc_ isEsc isEnd p =---    takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)-takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (FrameEscInit s)-                FL.Done _ ->-                    error "takeFramedByEsc_: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)-                FL.Done b -> Done 0 b--    step (FrameEscInit s) a =-        if isBegin a-        then return $ Partial 0 (FrameEscGo s 0)-        else return $ Error "takeFramedByEsc_: missing frame start"-    step (FrameEscGo s n) a =-        if isEsc a-        then return $ Partial 0 $ FrameEscEsc s n-        else do-            if not (isEnd a)-            then-                let n1 = if isBegin a then n + 1 else n-                 in process s a n1-            else-                if n == 0-                then Done 0 <$> fextract s-                else process s a (n - 1)-    step (FrameEscEsc s n) a = process s a n--    err = return . Error--    extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"-    extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"-    extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"--data FramedState s = FrameInit !s | FrameGo !s Int---- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an--- end predicate.------ >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)----{-# INLINE takeFramedBy_ #-}-takeFramedBy_ :: Monad m =>-    (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b--- takeFramedBy_ isBegin isEnd =---    takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)-takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (FrameInit s)-                FL.Done _ ->-                    error "takeFramedBy_: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (FrameGo s1 n)-                FL.Done b -> Done 0 b--    step (FrameInit s) a =-        if isBegin a-        then return $ Continue 0 (FrameGo s 0)-        else return $ Error "takeFramedBy_: missing frame start"-    step (FrameGo s n) a-        | not (isEnd a) =-            let n1 = if isBegin a then n + 1 else n-             in process s a n1-        | n == 0 = Done 0 <$> fextract s-        | otherwise = process s a (n - 1)--    err = return . Error--    extract (FrameInit _) = err "takeFramedBy_: empty token"-    extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"------------------------------------------------------------------------------------ Grouping and words----------------------------------------------------------------------------------data WordByState s b = WBLeft !s | WBWord !s | WBRight !b---- Note we can also get words using something like:--- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)------ But that won't be as efficient and ergonomic.---- | Like 'splitOn' but strips leading, trailing, and repeated separators.--- Therefore, @".a..b."@ having '.' as the separator would be parsed as--- @["a","b"]@.  In other words, its like parsing words from whitespace--- separated text.------ * Stops - when it finds a word separator after a non-word element--- * Fails - never.------ >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)------ @--- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)--- @----{-# INLINE wordBy #-}-wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b-wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract--    where--    {-# INLINE worder #-}-    worder s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 $ WBWord s1-                  FL.Done b -> Done 0 b--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s -> IPartial $ WBLeft s-                  FL.Done b -> IDone b--    step (WBLeft s) a =-        if not (predicate a)-        then worder s a-        else return $ Partial 0 $ WBLeft s-    step (WBWord s) a =-        if not (predicate a)-        then worder s a-        else do-            b <- fextract s-            return $ Partial 0 $ WBRight b-    step (WBRight b) a =-        return-            $ if not (predicate a)-              then Done 1 b-              else Partial 0 $ WBRight b--    extract (WBLeft s) = fmap (Done 0) $ fextract s-    extract (WBWord s) = fmap (Done 0) $ fextract s-    extract (WBRight b) = return (Done 0 b)--data WordFramedState s b =-      WordFramedSkipPre !s-    | WordFramedWord !s !Int-    | WordFramedEsc !s !Int-    | WordFramedSkipPost !b---- | Like 'wordBy' but treats anything inside a pair of quotes as a single--- word, the quotes can be escaped by an escape character.  Recursive quotes--- are possible if quote begin and end characters are different, quotes must be--- balanced. Outermost quotes are stripped.------ >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList--- >>> Stream.parse braces $ Stream.fromList "{ab} cd"--- Right "ab"--- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"--- Right "abcd"--- >>> Stream.parse braces $ Stream.fromList "a{b} cd"--- Right "ab"--- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"--- Right "a{b}"------ >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList--- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""--- Right "ab"----{-# INLINE wordFramedBy #-}-wordFramedBy :: Monad m =>-       (a -> Bool)  -- ^ Matches escape elem?-    -> (a -> Bool)  -- ^ Matches left quote?-    -> (a -> Bool)  -- ^ matches right quote?-    -> (a -> Bool)  -- ^ matches word separator?-    -> Fold m a b-    -> Parser a m b-wordFramedBy isEsc isBegin isEnd isSep-    (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (WordFramedSkipPre s)-                FL.Done _ ->-                    error "wordFramedBy: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)-                FL.Done b -> Done 0 b--    step (WordFramedSkipPre s) a-        | isEsc a = return $ Continue 0 $ WordFramedEsc s 0-        | isSep a = return $ Partial 0 $ WordFramedSkipPre s-        | isBegin a = return $ Continue 0 $ WordFramedWord s 1-        | isEnd a =-            return $ Error "wordFramedBy: missing frame start"-        | otherwise = process s a 0-    step (WordFramedWord s n) a-        | isEsc a = return $ Continue 0 $ WordFramedEsc s n-        | n == 0 && isSep a = do-            b <- fextract s-            return $ Partial 0 $ WordFramedSkipPost b-        | otherwise = do-            -- We need to use different order for checking begin and end for-            -- the n == 0 and n == 1 case so that when the begin and end-            -- character is the same we treat the one after begin as end.-            if n == 0-            then-               -- Need to check isBegin first-               if isBegin a-               then return $ Continue 0 $ WordFramedWord s 1-               else if isEnd a-                    then return $ Error "wordFramedBy: missing frame start"-                    else process s a n-            else-               -- Need to check isEnd first-                if isEnd a-                then-                   if n == 1-                   then return $ Continue 0 $ WordFramedWord s 0-                   else process s a (n - 1)-                else if isBegin a-                     then process s a (n + 1)-                     else process s a n-    step (WordFramedEsc s n) a = process s a n-    step (WordFramedSkipPost b) a =-        return-            $ if not (isSep a)-              then Done 1 b-              else Partial 0 $ WordFramedSkipPost b--    err = return . Error--    extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s-    extract (WordFramedWord s n) =-        if n == 0-        then fmap (Done 0) $ fextract s-        else err "wordFramedBy: missing frame end"-    extract (WordFramedEsc _ _) =-        err "wordFramedBy: trailing escape"-    extract (WordFramedSkipPost b) = return (Done 0 b)--data WordQuotedState s b a =-      WordQuotedSkipPre !s-    | WordUnquotedWord !s-    | WordQuotedWord !s !Int !a !a-    | WordUnquotedEsc !s-    | WordQuotedEsc !s !Int !a !a-    | WordQuotedSkipPost !b---- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but--- word separators within specified quotes or brackets are ignored. Quotes and--- escape characters can be processed. If the end quote is different from the--- start quote it is called a bracket. The following quoting rules apply:------ * In an unquoted string a character may be preceded by an escape character.--- The escape character is removed and the character following it is treated--- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,--- \n is same as n.--- * Any part of the word can be placed within quotes. Inside quotes all--- characters are treated literally with no special meaning. Quoting character--- itself cannot be used within quotes unless escape processing within quotes--- is applied to allow it.--- * Optionally escape processing for quoted part can be specified. Escape--- character has no special meaning inside quotes unless it is followed by a--- character that has a escape translation specified, in that case the escape--- character is removed, and the specified translation is applied to the--- character following it. This can be used to escape the quoting character--- itself within quotes.--- * There can be multiple quoting characters, when a quote starts, all other--- quoting characters within that quote lose any special meaning until the--- quote is closed.--- * A starting quote char without an ending char generates a parse error. An--- ending bracket char without a corresponding bracket begin is ignored.--- * Brackets can be nested.------ We should note that unquoted and quoted escape processing are different. In--- unquoted part escape character is always removed. In quoted part it is--- removed only if followed by a special meaning character. This is consistent--- with how shell performs escape processing.---- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},--- ((nested) brackets).------ Example:------ >>> :{--- >>> q x =--- >>>     case x of--- >>>         '"' -> Just x--- >>>         '\'' -> Just x--- >>>         _ -> Nothing--- >>> :}------ >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList--- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"--- Right "a\"b'c\";'d\"e'f"------ Note that outer quotes and backslashes from the input string are consumed by--- Haskell, therefore, the actual input string passed to the parser is:--- a"b'c";'d"e'f ghi------ Similarly, when printing, double quotes are escaped by Haskell.------ Limitations:------ Shell like quote processing can be performed by using quote char specific--- escape processing, single quotes with no escapes, and double quotes with--- escapes.------ JSON string processing can also be achieved except the "\uXXXX" style--- escaping for Unicode characters.----{-# INLINE wordWithQuotes #-}-wordWithQuotes :: (Monad m, Eq a) =>-       Bool            -- ^ Retain the quotes and escape chars in the output-    -> (a -> a -> Maybe a)  -- ^ quote char -> escaped char -> translated char-    -> a               -- ^ Matches an escape elem?-    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.-    -> (a -> Bool)     -- ^ Matches a word separator?-    -> Fold m a b-    -> Parser a m b-wordWithQuotes keepQuotes tr escChar toRight isSep-    (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Can be used to generate parse error for a bracket end without a bracket-    -- begin.-    isInvalid = const False--    isEsc = (== escChar)--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (WordQuotedSkipPre s)-                FL.Done _ ->-                    error "wordKeepQuotes: fold done without input"--    {-# INLINE processQuoted #-}-    processQuoted s a n ql qr = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)-                FL.Done b -> Done 0 b--    {-# INLINE processUnquoted #-}-    processUnquoted s a = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)-                FL.Done b -> Done 0 b--    step (WordQuotedSkipPre s) a-        | isEsc a = return $ Continue 0 $ WordUnquotedEsc s-        | isSep a = return $ Partial 0 $ WordQuotedSkipPre s-        | otherwise =-            case toRight a of-                Just qr ->-                  if keepQuotes-                  then processQuoted s a 1 a qr-                  else return $ Continue 0 $ WordQuotedWord s 1 a qr-                Nothing-                    | isInvalid a ->-                        return $ Error "wordKeepQuotes: invalid unquoted char"-                    | otherwise -> processUnquoted s a-    step (WordUnquotedWord s) a-        | isEsc a = return $ Continue 0 $ WordUnquotedEsc s-        | isSep a = do-            b <- fextract s-            return $ Partial 0 $ WordQuotedSkipPost b-        | otherwise = do-            case toRight a of-                Just qr ->-                    if keepQuotes-                    then processQuoted s a 1 a qr-                    else return $ Continue 0 $ WordQuotedWord s 1 a qr-                Nothing ->-                    if isInvalid a-                    then return $ Error "wordKeepQuotes: invalid unquoted char"-                    else processUnquoted s a-    step (WordQuotedWord s n ql qr) a-        | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr-        {--        -- XXX Will this ever occur? Will n ever be 0?-        | n == 0 && isSep a = do-            b <- fextract s-            return $ Partial 0 $ WordQuotedSkipPost b-        -}-        | otherwise = do-                if a == qr-                then-                   if n == 1-                   then if keepQuotes-                        then processUnquoted s a-                        else return $ Continue 0 $ WordUnquotedWord s-                   else processQuoted s a (n - 1) ql qr-                else if a == ql-                     then processQuoted s a (n + 1) ql qr-                     else processQuoted s a n ql qr-    step (WordUnquotedEsc s) a = processUnquoted s a-    step (WordQuotedEsc s n ql qr) a =-        case tr ql a of-            Nothing -> do-                res <- fstep s escChar-                case res of-                    FL.Partial s1 -> processQuoted s1 a n ql qr-                    FL.Done b -> return $ Done 0 b-            Just x -> processQuoted s x n ql qr-    step (WordQuotedSkipPost b) a =-        return-            $ if not (isSep a)-              then Done 1 b-              else Partial 0 $ WordQuotedSkipPost b--    err = return . Error--    extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s-    extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s-    extract (WordQuotedWord s n _ _) =-        if n == 0-        then fmap (Done 0) $ fextract s-        else err "wordWithQuotes: missing frame end"-    extract WordQuotedEsc {} =-        err "wordWithQuotes: trailing escape"-    extract (WordUnquotedEsc _) =-        err "wordWithQuotes: trailing escape"-    extract (WordQuotedSkipPost b) = return (Done 0 b)---- | 'wordWithQuotes' without processing the quotes and escape function--- supplied to escape the quote char within a quote. Can be used to parse words--- keeping the quotes and escapes intact.------ >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)----{-# INLINE wordKeepQuotes #-}-wordKeepQuotes :: (Monad m, Eq a) =>-       a               -- ^ Escape char-    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.-    -> (a -> Bool)     -- ^ Matches a word separator?-    -> Fold m a b-    -> Parser a m b-wordKeepQuotes =-    -- Escape the quote char itself-    wordWithQuotes True (\q x -> if q == x then Just x else Nothing)---- See the "Quoting Rules" section in the "bash" manual page for a primer on--- how quotes are used by shells.---- | 'wordWithQuotes' with quote processing applied and escape function--- supplied to escape the quote char within a quote. Can be ysed to parse words--- and processing the quoting and escaping at the same time.------ >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)----{-# INLINE wordProcessQuotes #-}-wordProcessQuotes :: (Monad m, Eq a) =>-        a              -- ^ Escape char-    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.-    -> (a -> Bool)     -- ^ Matches a word separator?-    -> Fold m a b-    -> Parser a m b-wordProcessQuotes =-    -- Escape the quote char itself-    wordWithQuotes False (\q x -> if q == x then Just x else Nothing)--{-# ANN type GroupByState Fuse #-}-data GroupByState a s-    = GroupByInit !s-    | GroupByGrouping !a !s---- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the--- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is--- 'True' @b@ is also assigned to the same group.  If @a \`cmp` c@ is 'True'--- then @c@ is also assigned to the same group and so on. When the comparison--- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and--- the result of the fold is the result of the parser.------ * Stops - when the comparison fails.--- * Fails - never.------ >>> :{---  runGroupsBy eq =---      Stream.fold Fold.toList---          . Stream.parseMany (Parser.groupBy eq Fold.toList)---          . Stream.fromList--- :}------ >>> runGroupsBy (<) []--- []------ >>> runGroupsBy (<) [1]--- [Right [1]]------ >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]--- [Right [3,5,4],Right [1,2],Right [0]]----{-# INLINE groupBy #-}-groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b-groupBy eq (Fold fstep finitial fextract) = Parser step initial extract--    where--    {-# INLINE grouper #-}-    grouper s a0 a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Done b -> Done 0 b-                  FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s -> IPartial $ GroupByInit s-                  FL.Done b -> IDone b--    step (GroupByInit s) a = grouper s a a-    step (GroupByGrouping a0 s) a =-        if eq a0 a-        then grouper s a0 a-        else Done 1 <$> fextract s--    extract (GroupByInit s) = fmap (Done 0) $ fextract s-    extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s---- | Unlike 'groupBy' this combinator performs a rolling comparison of two--- successive elements in the input stream.  Assuming the input stream--- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser--- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is--- 'True' @b@ is also assigned to the same group.  If @b \`cmp` c@ is 'True'--- then @c@ is also assigned to the same group and so on. When the comparison--- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and--- the result of the fold is the result of the parser.------ * Stops - when the comparison fails.--- * Fails - never.------ >>> :{---  runGroupsByRolling eq =---      Stream.fold Fold.toList---          . Stream.parseMany (Parser.groupByRolling eq Fold.toList)---          . Stream.fromList--- :}------ >>> runGroupsByRolling (<) []--- []------ >>> runGroupsByRolling (<) [1]--- [Right [1]]------ >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]--- [Right [3,5],Right [4],Right [1,2],Right [0]]------ /Pre-release/----{-# INLINE groupByRolling #-}-groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b-groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract--    where--    {-# INLINE grouper #-}-    grouper s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Done b -> Done 0 b-                  FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s -> IPartial $ GroupByInit s-                  FL.Done b -> IDone b--    step (GroupByInit s) a = grouper s a-    step (GroupByGrouping a0 s) a =-        if eq a0 a-        then grouper s a-        else Done 1 <$> fextract s--    extract (GroupByInit s) = fmap (Done 0) $ fextract s-    extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s--{-# ANN type GroupByStatePair Fuse #-}-data GroupByStatePair a s1 s2-    = GroupByInitPair !s1 !s2-    | GroupByGroupingPair !a !s1 !s2-    | GroupByGroupingPairL !a !s1 !s2-    | GroupByGroupingPairR !a !s1 !s2---- | Like 'groupByRolling', but if the predicate is 'True' then collects using--- the first fold as long as the predicate holds 'True', if the predicate is--- 'False' collects using the second fold as long as it remains 'False'.--- Returns 'Left' for the first case and 'Right' for the second case.------ For example, if we want to detect sorted sequences in a stream, both--- ascending and descending cases we can use 'groupByRollingEither (<=)--- Fold.toList Fold.toList'.------ /Pre-release/-{-# INLINE groupByRollingEither #-}-groupByRollingEither :: Monad m =>-    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)-groupByRollingEither-    eq-    (Fold fstep1 finitial1 fextract1)-    (Fold fstep2 finitial2 fextract2) = Parser step initial extract--    where--    {-# INLINE grouper #-}-    grouper s1 s2 a = do-        return $ Continue 0 (GroupByGroupingPair a s1 s2)--    {-# INLINE grouperL2 #-}-    grouperL2 s1 s2 a = do-        res <- fstep1 s1 a-        return-            $ case res of-                FL.Done b -> Done 0 (Left b)-                FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)--    {-# INLINE grouperL #-}-    grouperL s1 s2 a0 a = do-        res <- fstep1 s1 a0-        case res of-            FL.Done b -> return $ Done 0 (Left b)-            FL.Partial s11 -> grouperL2 s11 s2 a--    {-# INLINE grouperR2 #-}-    grouperR2 s1 s2 a = do-        res <- fstep2 s2 a-        return-            $ case res of-                FL.Done b -> Done 0 (Right b)-                FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)--    {-# INLINE grouperR #-}-    grouperR s1 s2 a0 a = do-        res <- fstep2 s2 a0-        case res of-            FL.Done b -> return $ Done 0 (Right b)-            FL.Partial s21 -> grouperR2 s1 s21 a--    initial = do-        res1 <- finitial1-        res2 <- finitial2-        return-            $ case res1 of-                FL.Partial s1 ->-                    case res2 of-                        FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2-                        FL.Done b -> IDone (Right b)-                FL.Done b -> IDone (Left b)--    step (GroupByInitPair s1 s2) a = grouper s1 s2 a--    step (GroupByGroupingPair a0 s1 s2) a =-        if not (eq a0 a)-        then grouperL s1 s2 a0 a-        else grouperR s1 s2 a0 a--    step (GroupByGroupingPairL a0 s1 s2) a =-        if not (eq a0 a)-        then grouperL2 s1 s2 a-        else Done 1 . Left <$> fextract1 s1--    step (GroupByGroupingPairR a0 s1 s2) a =-        if eq a0 a-        then grouperR2 s1 s2 a-        else Done 1 . Right <$> fextract2 s2--    extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1-    extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1-    extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2-    extract (GroupByGroupingPair a s1 _) = do-                res <- fstep1 s1 a-                case res of-                    FL.Done b -> return $ Done 0 (Left b)-                    FL.Partial s11 -> Done 0 . Left <$> fextract1 s11---- XXX use an Unfold instead of a list?--- XXX custom combinators for matching list, array and stream?--- XXX rename to listBy?---- | Match the given sequence of elements using the given comparison function.--- Returns the original sequence if successful.------ Definition:------ >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs------ Examples:------ >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"--- Right "string"------ >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"--- Left (ParseError "streamEqBy: mismtach occurred")----{-# INLINE listEqBy #-}-listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]-listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs-{--listEqBy cmp str = Parser step initial extract--    where--    -- XXX Should return IDone in initial for [] case-    initial = return $ IPartial str--    step [] _ = return $ Done 0 str-    step [x] a =-        return-            $ if x `cmp` a-              then Done 0 str-              else Error "listEqBy: failed, yet to match the last element"-    step (x:xs) a =-        return-            $ if x `cmp` a-              then Continue 0 xs-              else Error-                       $ "listEqBy: failed, yet to match "-                       ++ show (length xs + 1) ++ " elements"--    extract xs =-        return-            $ Error-            $ "listEqBy: end of input, yet to match "-            ++ show (length xs) ++ " elements"--}--{-# INLINE streamEqByInternal #-}-streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()-streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract--    where--    initial = do-        r <- sstep defState state-        case r of-            D.Yield x s -> return $ IPartial (Just' x, s)-            D.Stop -> return $ IDone ()-            -- Need Skip/Continue in initial to loop right here-            D.Skip s -> return $ IPartial (Nothing', s)--    step (Just' x, st) a =-        if x `cmp` a-          then do-            r <- sstep defState st-            return-                $ case r of-                    D.Yield x1 s -> Continue 0 (Just' x1, s)-                    D.Stop -> Done 0 ()-                    D.Skip s -> Continue 1 (Nothing', s)-          else return $ Error "streamEqBy: mismtach occurred"-    step (Nothing', st) a = do-        r <- sstep defState st-        return-            $ case r of-                D.Yield x s -> do-                    if x `cmp` a-                    then Continue 0 (Nothing', s)-                    else Error "streamEqBy: mismatch occurred"-                D.Stop -> Done 1 ()-                D.Skip s -> Continue 1 (Nothing', s)--    extract _ = return $ Error "streamEqBy: end of input"---- | Like 'listEqBy' but uses a stream instead of a list and does not return--- the stream.----{-# INLINE streamEqBy #-}-streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()--- XXX Somehow composing this with "*>" is much faster on the microbenchmark.--- Need to investigate why.-streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()---- Rename to "list".--- | Match the input sequence with the supplied list and return it if--- successful.------ >>> listEq = Parser.listEqBy (==)----{-# INLINE listEq #-}-listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]-listEq = listEqBy (==)---- | Match if the input stream is a subsequence of the argument stream i.e. all--- the elements of the input stream occur, in order, in the argument stream.--- The elements do not have to occur consecutively. A sequence is considered a--- subsequence of itself.-{-# INLINE subsequenceBy #-}-subsequenceBy :: -- Monad m =>-    (a -> a -> Bool) -> Stream m a -> Parser a m ()-subsequenceBy = undefined--{---- Should go in Data.Parser.Regex in streamly package so that it can depend on--- regex backends.-{-# INLINE regexPosix #-}-regexPosix :: -- Monad m =>-    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))-regexPosix = undefined--{-# INLINE regexPCRE #-}-regexPCRE :: -- Monad m =>-    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))-regexPCRE = undefined--}------------------------------------------------------------------------------------ Transformations on input------------------------------------------------------------------------------------ Initial needs a "Continue" constructor to implement scans on parsers. As a--- parser can always return a Continue in initial when we feed the fold's--- initial result to it. We can work this around for postscan by introducing an--- initial state and calling "initial" only on the first input.---- | Stateful scan on the input of a parser using a Fold.------ /Unimplemented/----{-# INLINE postscan #-}-postscan :: -- Monad m =>-    Fold m a b -> Parser b m c -> Parser a m c-postscan = undefined--{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x-zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        fres <- finitial-        case fres of-            FL.Partial fs -> do-                r <- sstep defState state-                case r of-                    D.Yield x s -> return $ IPartial (Just' x, s, fs)-                    D.Stop -> do-                        x <- fextract fs-                        return $ IDone x-                    -- Need Skip/Continue in initial to loop right here-                    D.Skip s -> return $ IPartial (Nothing', s, fs)-            FL.Done x -> return $ IDone x--    step (Just' a, st, fs) b = do-        c <- zf a b-        fres <- fstep fs c-        case fres of-            FL.Partial fs1 -> do-                r <- sstep defState st-                case r of-                    D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)-                    D.Stop -> do-                        x <- fextract fs1-                        return $ Done 0 x-                    D.Skip s -> return $ Continue 1 (Nothing', s, fs1)-            FL.Done x -> return $ Done 0 x-    step (Nothing', st, fs) b = do-        r <- sstep defState st-        case r of-                D.Yield a s -> do-                    c <- zf a b-                    fres <- fstep fs c-                    case fres of-                        FL.Partial fs1 ->-                            return $ Continue 0 (Nothing', s, fs1)-                        FL.Done x -> return $ Done 0 x-                D.Stop -> do-                    x <- fextract fs-                    return $ Done 1 x-                D.Skip s -> return $ Continue 1 (Nothing', s, fs)--    extract _ = return $ Error "zipWithM: end of input"---- | Zip the input of a fold with a stream.------ /Pre-release/----{-# INLINE zip #-}-zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x-zip = zipWithM (curry return)---- | Pair each element of a fold input with its index, starting from index 0.------ /Pre-release/-{-# INLINE indexed #-}-indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b-indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)---- | @makeIndexFilter indexer filter predicate@ generates a fold filtering--- function using a fold indexing function that attaches an index to each input--- element and a filtering function that filters using @(index, element) ->--- Bool) as predicate.------ For example:------ @--- filterWithIndex = makeIndexFilter indexed filter--- filterWithAbsTime = makeIndexFilter timestamped filter--- filterWithRelTime = makeIndexFilter timeIndexed filter--- @------ /Pre-release/-{-# INLINE makeIndexFilter #-}-makeIndexFilter ::-       (Fold m (s, a) b -> Parser a m b)-    -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)-    -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)-makeIndexFilter f comb g = f . comb g . FL.lmap snd---- | @sampleFromthen offset stride@ samples the element at @offset@ index and--- then every element at strides of @stride@.------ /Pre-release/-{-# INLINE sampleFromthen #-}-sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b-sampleFromthen offset size =-    makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)-------------------------------------------------------------------------------------- Spanning------------------------------------------------------------------------------------- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the--- input as long as the predicate @p@ is 'True'.  @f2@ consumes the rest of the--- input.------ @--- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs------ > span_ (< 1) [1,2,3]--- ([],[1,2,3])------ > span_ (< 2) [1,2,3]--- ([1],[2,3])------ > span_ (< 4) [1,2,3]--- ([1,2,3],[])------ @------ /Pre-release/-{-# INLINE span #-}-span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)-span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)---- | Break the input stream into two groups, the first group takes the input as--- long as the predicate applied to the first element of the stream and next--- input element holds 'True', the second group takes the rest of the input.------ /Pre-release/----{-# INLINE spanBy #-}-spanBy ::-       Monad m-    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)-spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)---- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.--- predicate is applied to the previous and the next input elements.------ /Pre-release/-{-# INLINE spanByRolling #-}-spanByRolling ::-       Monad m-    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)-spanByRolling eq f1 f2 =-    noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)------------------------------------------------------------------------------------ nested parsers------------------------------------------------------------------------------------ | Takes at-most @n@ input elements.------ * Stops - when the collecting parser stops.--- * Fails - when the collecting parser fails.------ >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]--- Right [1,2]------ >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]--- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")------ /Internal/-{-# INLINE takeP #-}-takeP :: Monad m => Int -> Parser a m b -> Parser a m b-takeP lim (Parser pstep pinitial pextract) = Parser step initial extract--    where--    initial = do-        res <- pinitial-        case res of-            IPartial s ->-                if lim > 0-                then return $ IPartial $ Tuple' 0 s-                else iextract s-            IDone b -> return $ IDone b-            IError e -> return $ IError e--    step (Tuple' cnt r) a = do-        assertM(cnt < lim)-        res <- pstep r a-        let cnt1 = cnt + 1-        case res of-            Partial 0 s -> do-                assertM(cnt1 >= 0)-                if cnt1 < lim-                then return $ Partial 0 $ Tuple' cnt1 s-                else do-                    r1 <- pextract s-                    return $ case r1 of-                        Done n b -> Done n b-                        Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)-                        Error err -> Error err-                        Partial _ _ -> error "takeP: Partial in extract"--            Continue 0 s -> do-                assertM(cnt1 >= 0)-                if cnt1 < lim-                then return $ Continue 0 $ Tuple' cnt1 s-                else do-                    r1 <- pextract s-                    return $ case r1 of-                        Done n b -> Done n b-                        Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)-                        Error err -> Error err-                        Partial _ _ -> error "takeP: Partial in extract"-            Partial n s -> do-                let taken = cnt1 - n-                assertM(taken >= 0)-                return $ Partial n $ Tuple' taken s-            Continue n s -> do-                let taken = cnt1 - n-                assertM(taken >= 0)-                return $ Continue n $ Tuple' taken s-            Done n b -> return $ Done n b-            Error str -> return $ Error str--    extract (Tuple' cnt r) = do-        r1 <- pextract r-        return $ case r1 of-            Done n b -> Done n b-            Continue n s1 -> Continue n (Tuple' (cnt - n) s1)-            Error err -> Error err-            Partial _ _ -> error "takeP: Partial in extract"--    -- XXX Need to make the Initial type Step to remove this-    iextract s = do-        r <- pextract s-        return $ case r of-            Done _ b -> IDone b-            Error err -> IError err-            _ -> error "Bug: takeP invalid state in initial"---- | Run a parser without consuming the input.----{-# INLINE lookAhead #-}-lookAhead :: Monad m => Parser a m b -> Parser a m b-lookAhead (Parser step1 initial1 _) = Parser step initial extract--    where--    initial = do-        res <- initial1-        return $ case res of-            IPartial s -> IPartial (Tuple'Fused 0 s)-            IDone b -> IDone b-            IError e -> IError e--    step (Tuple'Fused cnt st) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        return-            $ case r of-                  Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)-                  Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)-                  Done _ b -> Done cnt1 b-                  Error err -> Error err--    -- XXX returning an error let's us backtrack.  To implement it in a way so-    -- that it terminates on eof without an error then we need a way to-    -- backtrack on eof, that will require extract to return 'Step' type.-    extract (Tuple'Fused n _) =-        return-            $ Error-            $ "lookAhead: end of input after consuming "-            ++ show n ++ " elements"------------------------------------------------------------------------------------ Interleaving-------------------------------------------------------------------------------------- To deinterleave we can chain two parsers one behind the other. The input is--- given to the first parser and the input definitively rejected by the first--- parser is given to the second parser.------ We can either have the parsers themselves buffer the input or use the shared--- global buffer to hold it until none of the parsers need it. When the first--- parser returns Skip (i.e. rewind) we let the second parser consume the--- rejected input and when it is done we move the cursor forward to the first--- parser again. This will require a "move forward" command as well.------ To implement grep we can use three parsers, one to find the pattern, one--- to store the context behind the pattern and one to store the context in--- front of the pattern. When a match occurs we need to emit the accumulator of--- all the three parsers. One parser can count the line numbers to provide the--- line number info.--{-# ANN type DeintercalateAllState Fuse #-}-data DeintercalateAllState fs sp ss =-      DeintercalateAllInitL !fs-    | DeintercalateAllL !fs !sp-    | DeintercalateAllInitR !fs-    | DeintercalateAllR !fs !ss---- XXX rename this to intercalate---- Having deintercalateAll for accepting or rejecting entire input could be--- useful. For example, in case of JSON parsing we get an entire block of--- key-value pairs which we need to verify. This version may be simpler, more--- efficient. We could implement this as a stream operation like parseMany.------ XXX Also, it may be a good idea to provide a parse driver for a fold. For--- example, in case of csv parsing as we are feeding a line to a fold we can--- parse it.---- | Like 'deintercalate' but the entire input must satisfy the pattern--- otherwise the parser fails. This is many times faster than deintercalate.------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.deintercalateAll p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Right []--- >>> Stream.parse p $ Stream.fromList "1"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Left (ParseError "takeWhile1: end of input")--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]----{-# INLINE deintercalateAll #-}-deintercalateAll :: Monad m =>-       Parser a m x-    -> Parser a m y-    -> Fold m (Either x y) z-    -> Parser a m z-deintercalateAll-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "deintercalate: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepL #-}-    runStepL fs sL a = do-        r <- stepL sL a-        case r of-            Partial n s -> return $ Partial n (DeintercalateAllL fs s)-            Continue n s -> return $ Continue n (DeintercalateAllL fs s)-            Done n b ->-                processL (fstep fs (Left b)) n DeintercalateAllInitR-            Error err -> return $ Error err--    {-# INLINE processR #-}-    processR foldAction n = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> do-                res <- initialL-                case res of-                    IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)-                    IDone _ -> errMsg "left" "succeed"-                    IError _ -> errMsg "left" "fail"-            FL.Done c -> return $ Done n c--    {-# INLINE runStepR #-}-    runStepR fs sR a = do-        r <- stepR sR a-        case r of-            Partial n s -> return $ Partial n (DeintercalateAllR fs s)-            Continue n s -> return $ Continue n (DeintercalateAllR fs s)-            Done n b -> processR (fstep fs (Right b)) n-            Error err -> return $ Error err--    step (DeintercalateAllInitL fs) a = do-        res <- initialL-        case res of-            IPartial s -> runStepL fs s a-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"-    step (DeintercalateAllL fs sL) a = runStepL fs sL a-    step (DeintercalateAllInitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (DeintercalateAllR fs sR) a = runStepR fs sR a--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)-    extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateAllL fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs (Left b)-            Error err -> return $ Error err-            Continue n s -> return $ Continue n (DeintercalateAllL fs s)-            Partial _ _ -> error "Partial in extract"-    extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateAllR _ _) =-        return $ Error "deintercalateAll: input ended at 'Right' value"--{-# ANN type DeintercalateState Fuse #-}-data DeintercalateState b fs sp ss =-      DeintercalateInitL !fs-    | DeintercalateL !Int !fs !sp-    | DeintercalateInitR !fs-    | DeintercalateR !Int !fs !ss-    | DeintercalateRL !Int !b !fs !sp---- XXX Add tests that the next character that we take after running a parser is--- correct. Especially for the parsers that maintain a count. In the stream--- finished case (extract) as well as not finished case.---- | Apply two parsers alternately to an input stream. The input stream is--- considered an interleaving of two patterns. The two parsers represent the--- two patterns. Parsing starts at the first parser and stops at the first--- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty--- input or single parse of the first parser is accepted.------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.deintercalate p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Right []--- >>> Stream.parse p $ Stream.fromList "1"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]----{-# INLINE deintercalate #-}-deintercalate :: Monad m =>-       Parser a m x-    -> Parser a m y-    -> Fold m (Either x y) z-    -> Parser a m z-deintercalate-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "deintercalate: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepL #-}-    runStepL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs (Left b)) n DeintercalateInitR-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE processR #-}-    processR cnt b fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)-            Done n b -> processR (cnt1 - n) b fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (DeintercalateInitL fs) a = do-        res <- initialL-        case res of-            IPartial s -> runStepL 0 fs s a-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"-    step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a-    step (DeintercalateInitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a-    step (DeintercalateRL cnt bR fs sL) a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)-            Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> do-                        fres <- fstep fs1 (Left bL)-                        case fres of-                            FL.Partial fs2 ->-                                return $ Partial n (DeintercalateInitR fs2)-                            FL.Done c -> return $ Done n c-                    -- XXX We could have the fold accept pairs of (bR, bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs (Left b)-            Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs-    extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs-    extract (DeintercalateRL cnt bR fs sL) = do-        r <- extractL sL-        case r of-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> extractResult n fs1 (Left bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs--{-# ANN type Deintercalate1State Fuse #-}-data Deintercalate1State b fs sp ss =-      Deintercalate1InitL !Int !fs !sp-    | Deintercalate1InitR !fs-    | Deintercalate1R !Int !fs !ss-    | Deintercalate1RL !Int !b !fs !sp---- | Apply two parsers alternately to an input stream. The input stream is--- considered an interleaving of two patterns. The two parsers represent the--- two patterns. Parsing starts at the first parser and stops at the first--- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty--- input or single parse of the first parser is accepted.------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.deintercalate1 p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Left (ParseError "takeWhile1: end of input")--- >>> Stream.parse p $ Stream.fromList "1"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]----{-# INLINE deintercalate1 #-}-deintercalate1 :: Monad m =>-       Parser a m x-    -> Parser a m y-    -> Fold m (Either x y) z-    -> Parser a m z-deintercalate1-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "deintercalate: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> do-                pres <- initialL-                case pres of-                    IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s-                    IDone _ -> errMsg "left" "succeed"-                    IError _ -> errMsg "left" "fail"-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepInitL #-}-    runStepInitL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs (Left b)) n Deintercalate1InitR-            Error err -> return $ Error err--    {-# INLINE processR #-}-    processR cnt b fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)-            Done n b -> processR (cnt1 - n) b fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a-    step (Deintercalate1InitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a-    step (Deintercalate1RL cnt bR fs sL) a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)-            Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> do-                        fres <- fstep fs1 (Left bL)-                        case fres of-                            FL.Partial fs2 ->-                                return $ Partial n (Deintercalate1InitR fs2)-                            FL.Done c -> return $ Done n c-                    -- XXX We could have the fold accept pairs of (bR, bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (Deintercalate1InitL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs (Left b)-            Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error err -> return $ Error err-    extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs-    extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs-    extract (Deintercalate1RL cnt bR fs sL) = do-        r <- extractL sL-        case r of-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> extractResult n fs1 (Left bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs--{-# ANN type SepByState Fuse #-}-data SepByState fs sp ss =-      SepByInitL !fs-    | SepByL !Int !fs !sp-    | SepByInitR !fs-    | SepByR !Int !fs !ss---- | Apply two parsers alternately to an input stream. Parsing starts at the--- first parser and stops at the first parser. The output of the first parser--- is emiited and the output of the second parser is discarded. It can be used--- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse--- of the first parser is accepted.------ Definitions:------ >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)--- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)------ Examples:------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.sepBy p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Right []--- >>> Stream.parse p $ Stream.fromList "1"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right ["1","2","3"]----{-# INLINE sepBy #-}-sepBy :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c--- This has similar performance as the custom impl below.--- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)-sepBy-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "sepBy: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> return $ IPartial $ SepByInitL fs-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepL #-}-    runStepL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs b) n SepByInitR-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE processR #-}-    processR cnt fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (SepByL cnt fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)-            Done n _ -> processR (cnt1 - n) fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (SepByInitL fs) a = do-        res <- initialL-        case res of-            IPartial s -> runStepL 0 fs s a-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"-    step (SepByL cnt fs sL) a = runStepL cnt fs sL a-    step (SepByInitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (SepByR cnt fs sR) a = runStepR cnt fs sR a--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (SepByInitL fs) = fmap (Done 0) $ fextract fs-    extract (SepByL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs b-            Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs-    extract (SepByInitR fs) = fmap (Done 0) $ fextract fs-    extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs---- | Non-backtracking version of sepBy. Several times faster.-{-# INLINE sepByAll #-}-sepByAll :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)---- XXX This can be implemented using refold, parse one and then continue--- collecting the rest in that.--{-# ANN type SepBy1State Fuse #-}-data SepBy1State fs sp ss =-      SepBy1InitL !Int !fs sp-    | SepBy1L !Int !fs !sp-    | SepBy1InitR !fs-    | SepBy1R !Int !fs !ss--{--{-# INLINE sepBy1 #-}-sepBy1 :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-sepBy1 p sep sink = do-    x <- p-    f <- fromEffect $ FL.reduce sink-    f1 <- fromEffect $ FL.snoc f x-    many (sep >> p) f1--}---- | Like 'sepBy' but requires at least one successful parse.------ Definition:------ >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)------ Examples:------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.sepBy1 p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Left (ParseError "takeWhile1: end of input")--- >>> Stream.parse p $ Stream.fromList "1"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right ["1","2","3"]----{-# INLINE sepBy1 #-}-sepBy1 :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-sepBy1-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "sepBy: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> do-                pres <- initialL-                case pres of-                    IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s-                    IDone _ -> errMsg "left" "succeed"-                    IError _ -> errMsg "left" "fail"-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepInitL #-}-    runStepInitL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs b) n SepBy1InitR-            Error err -> return $ Error err--    {-# INLINE runStepL #-}-    runStepL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs b) n SepBy1InitR-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE processR #-}-    processR cnt fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)-            Done n _ -> processR (cnt1 - n) fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a-    step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a-    step (SepBy1InitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (SepBy1InitL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs b-            Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error err -> return $ Error err-    extract (SepBy1L cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs b-            Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs-    extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs-    extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs------------------------------------------------------------------------------------ Interleaving a collection of parsers-------------------------------------------------------------------------------------- | Apply a collection of parsers to an input stream in a round robin fashion.--- Each parser is applied until it stops and then we repeat starting with the--- the first parser again.------ /Unimplemented/----{-# INLINE roundRobin #-}-roundRobin :: -- (Foldable t, Monad m) =>-    t (Parser a m b) -> Fold m b c -> Parser a m c-roundRobin _ps _f = undefined------------------------------------------------------------------------------------ Sequential Collection------------------------------------------------------------------------------------ | @sequence f p@ collects sequential parses of parsers in a--- serial stream @p@ using the fold @f@. Fails if the input ends or any--- of the parsers fail.------ /Pre-release/----{-# INLINE sequence #-}-sequence :: Monad m =>-    D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c-sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        fres <- finitial-        case fres of-            FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)-            FL.Done c -> return $ IDone c--    -- state does not contain any parser-    -- yield a new parser from the stream-    step (Nothing', ss, fs) _ = do-        sres <- sstep defState ss-        case sres of-            D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)-            D.Stop -> do-                c <- fextract fs-                return $ Done 1 c-            D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)--    -- state holds a parser that may or may not have been-    -- initialized. pinit holds the initial parser state-    -- or modified parser state respectively-    step (Just' (Parser pstep pinit pextr), ss, fs) a = do-        ps <- pinit-        case ps of-            IPartial ps1 -> do-                pres <- pstep ps1 a-                case pres of-                    Partial n ps2 ->-                        let newP =-                              Just' $ Parser pstep (return $ IPartial ps2) pextr-                        in return $ Partial n (newP, ss, fs)-                    Continue n ps2 ->-                        let newP =-                              Just' $ Parser pstep (return $ IPartial ps2) pextr-                        in return $ Continue n (newP, ss, fs)-                    Done n b -> do-                        fres <- fstep fs b-                        case fres of-                            FL.Partial fs1 ->-                                return $ Partial n (Nothing', ss, fs1)-                            FL.Done c -> return $ Done n c-                    Error msg -> return $ Error msg-            IDone b -> do-                fres <- fstep fs b-                case fres of-                    FL.Partial fs1 ->-                        return $ Partial 1 (Nothing', ss, fs1)-                    FL.Done c -> return $ Done 1 c-            IError err -> return $ Error err--    extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs-    extract (Just' (Parser pstep pinit pextr), ss, fs) = do-        ps <- pinit-        case ps of-            IPartial ps1 ->  do-                r <- pextr ps1-                case r of-                    Done n b -> do-                        res <- fstep fs b-                        case res of-                            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-                            FL.Done c -> return (Done n c)-                    Error err -> return $ Error err-                    Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)-                    Partial _ _ -> error "Partial in extract"-            IDone b -> do-                fres <- fstep fs b-                case fres of-                    FL.Partial fs1 -> fmap (Done 0) $ fextract fs1-                    FL.Done c -> return (Done 0 c)-            IError err -> return $ Error err------------------------------------------------------------------------------------ Alternative Collection----------------------------------------------------------------------------------{---- | @choice parsers@ applies the @parsers@ in order and returns the first--- successful parse.------ This is same as 'asum' but more efficient.------ /Broken/----{-# INLINE choice #-}-choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b-choice = foldl1 shortest--}------------------------------------------------------------------------------------ Sequential Repetition------------------------------------------------------------------------------------ | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the--- results. Parsing stops or fails if the collecting parser stops or fails.------ /Unimplemented/----{-# INLINE manyP #-}-manyP :: -- MonadCatch m =>-    Parser a m b -> Parser b m c -> Parser a m c-manyP _p _f = undefined---- | Collect zero or more parses. Apply the supplied parser repeatedly on the--- input stream and push the parse results to a downstream fold.------  Stops: when the downstream fold stops or the parser fails.---  Fails: never, produces zero or more results.------ >>> many = Parser.countBetween 0 maxBound------ Compare with 'Control.Applicative.many'.----{-# INLINE many #-}-many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-many = splitMany--- many = countBetween 0 maxBound---- Note: many1 would perhaps be a better name for this and consistent with--- other names like takeWhile1. But we retain the name "some" for--- compatibility.---- | Collect one or more parses. Apply the supplied parser repeatedly on the--- input stream and push the parse results to a downstream fold.------  Stops: when the downstream fold stops or the parser fails.---  Fails: if it stops without producing a single result.------ >>> some p f = Parser.manyP p (Parser.takeGE 1 f)--- >>> some = Parser.countBetween 1 maxBound------ Compare with 'Control.Applicative.some'.----{-# INLINE some #-}-some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-some = splitSome--- some p f = manyP p (takeGE 1 f)--- some = countBetween 1 maxBound---- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of--- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if--- the input ends or the parser fails before @m@ results are collected.------ >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)------ /Unimplemented/----{-# INLINE countBetween #-}-countBetween :: -- MonadCatch m =>-    Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c-countBetween _m _n _p = undefined--- countBetween m n p f = manyP p (takeBetween m n f)---- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using--- the fold @f@.  Fails if the input ends or the parser fails before @n@--- results are collected.------ >>> count n = Parser.countBetween n n--- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)------ /Unimplemented/----{-# INLINE count #-}-count :: -- MonadCatch m =>-    Int -> Parser a m b -> Fold m b c -> Parser a m c-count n = countBetween n n--- count n p f = manyP p (takeEQ n f)---- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a--- 'Fold'.  Parsing stops or fails if the collecting parser stops or fails.------ We can implemnent parsers like the following using 'manyTillP':------ @--- countBetweenTill m n f p = manyTillP (takeBetween m n f) p--- @------ /Unimplemented/----{-# INLINE manyTillP #-}-manyTillP :: -- Monad m =>-    Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c-manyTillP _p1 _p2 _f = undefined-    -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f--{-# ANN type ManyTillState Fuse #-}-data ManyTillState fs sr sl-    = ManyTillR !Int !fs !sr-    | ManyTillL !fs !sl---- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@--- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is--- tried again and so on. The parser stops when @test@ succeeds.  The output of--- @test@ is discarded and the output of @chunking@ is accumulated by the--- supplied fold. The parser fails if @chunking@ fails.------ Stops when the fold @f@ stops.----{-# INLINE manyTill #-}-manyTill :: Monad m-    => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-manyTill (Parser stepL initialL extractL)-         (Parser stepR initialR _)-         (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution: Mutual recursion--    scrutL fs p c d e = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ c (ManyTillL fs sl)-            IDone bl -> do-                fr <- fstep fs bl-                case fr of-                    FL.Partial fs1 -> scrutR fs1 p c d e-                    FL.Done fb -> return $ d fb-            IError err -> return $ e err--    scrutR fs p c d e = do-        resR <- initialR-        case resR of-            IPartial sr -> return $ p (ManyTillR 0 fs sr)-            IDone _ -> d <$> fextract fs-            IError _ -> scrutL fs p c d e--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> scrutR fs IPartial IPartial IDone IError-            FL.Done b -> return $ IDone b--    step (ManyTillR cnt fs st) a = do-        r <- stepR st a-        case r of-            Partial n s -> return $ Partial n (ManyTillR 0 fs s)-            Continue n s -> do-                assertM(cnt + 1 - n >= 0)-                return $ Continue n (ManyTillR (cnt + 1 - n) fs s)-            Done n _ -> do-                b <- fextract fs-                return $ Done n b-            Error _ -> do-                resL <- initialL-                case resL of-                    IPartial sl ->-                        return $ Continue (cnt + 1) (ManyTillL fs sl)-                    IDone bl -> do-                        fr <- fstep fs bl-                        let cnt1 = cnt + 1-                        case fr of-                            FL.Partial fs1 ->-                                scrutR-                                    fs1-                                    (Partial cnt1)-                                    (Continue cnt1)-                                    (Done cnt1)-                                    Error-                            FL.Done fb -> return $ Done cnt1 fb-                    IError err -> return $ Error err-    step (ManyTillL fs st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (ManyTillL fs s)-            Continue n s -> return $ Continue n (ManyTillL fs s)-            Done n b -> do-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s ->-                        scrutR s (Partial n) (Continue n) (Done n) Error-                    FL.Done b1 -> return $ Done n b1-            Error err -> return $ Error err--    extract (ManyTillL fs sR) = do-        res <- extractL sR-        case res of-            Done n b -> do-                r <- fstep fs b-                case r of-                    FL.Partial fs1 -> fmap (Done n) $ fextract fs1-                    FL.Done c -> return (Done n c)-            Error err -> return $ Error err-            Continue n s -> return $ Continue n (ManyTillL fs s)-            Partial _ _ -> error "Partial in extract"-    extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs---- | @manyThen f collect recover@ repeats the parser @collect@ on the input and--- collects the output in the supplied fold. If the the parser @collect@ fails,--- parser @recover@ is run until it stops and then we start repeating the--- parser @collect@ again. The parser fails if the recovery parser fails.------ For example, this can be used to find a key frame in a video stream after an--- error.------ /Unimplemented/----{-# INLINE manyThen #-}-manyThen :: -- (Foldable t, Monad m) =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-manyThen _parser _recover _f = undefined------------------------------------------------------------------------------------ Repeated Alternatives------------------------------------------------------------------------------------ | Keep trying a parser up to a maximum of @n@ failures.  When the parser--- fails the input consumed till now is dropped and the new instance is tried--- on the fresh input.------ /Unimplemented/----{-# INLINE retryMaxTotal #-}-retryMaxTotal :: -- (Monad m) =>-    Int -> Parser a m b -> Fold m b c -> Parser a m c-retryMaxTotal _n _p _f  = undefined---- | Like 'retryMaxTotal' but aborts after @n@ successive failures.------ /Unimplemented/----{-# INLINE retryMaxSuccessive #-}-retryMaxSuccessive :: -- (Monad m) =>-    Int -> Parser a m b -> Fold m b c -> Parser a m c-retryMaxSuccessive _n _p _f = undefined---- | Keep trying a parser until it succeeds.  When the parser fails the input--- consumed till now is dropped and the new instance is tried on the fresh--- input.------ /Unimplemented/----{-# INLINE retry #-}-retry :: -- (Monad m) =>-    Parser a m b -> Parser a m b-retry _p = undefined
− src/Streamly/Internal/Data/Parser/ParserD/Tee.hs 
@@ -1,617 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Parser.ParserD.Tee--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Parallel parsers. Distributing the input to multiple parsers at the same--- time.------ For simplicity, we are using code where a particular state is unreachable--- but it is not prevented by types.  Somehow uni-pattern match using "let"--- produces better optimized code compared to using @case@ match and using--- explicit error messages in unreachable cases.------ There seem to be no way to silence individual warnings so we use a global--- incomplete uni-pattern match warning suppression option for the file.--- Disabling the warning for other code as well  has the potential to mask off--- some legit warnings, therefore, we have segregated only the code that uses--- uni-pattern matches in this module.--module Streamly.Internal.Data.Parser.ParserD.Tee-    (-    {--    -- Parallel zipped-      teeWith-    , teeWithFst-    , teeWithMin--    -- Parallel alternatives-    , shortest-    , longest-    -}-    )-where--{--import Control.Exception (assert)-import Control.Monad.Catch (MonadCatch, try)-import Prelude-       hiding (any, all, takeWhile)--import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Parser.ParserD.Type-       (Initial(..), Parser(..), Step(..), ParseError)------------------------------------------------------------------------------------ Distribute input to two parsers and collect both results------------------------------------------------------------------------------------ When the input stream is distributed to two parsers, both the parsers can--- backtrack independently. Therefore, we need separate buffer state for each--- parser.------ ParserK------ We can keep the state of each parser in the zipper and pass around that--- zipper to the parsers. Each parser can consume from the zipper and then pass--- around the zipper to the other parser.------ ParserD------ In the approach we have taken here, the driver pushes one element at a time--- to the tee and each of the parsers in the tee may buffer it independently--- for backtracking. So they do not need to depend on the original stream--- source for individual parser backtracking. Problem arises when both the--- parsers backtrack and they do not need any input from the driver rather they--- must consume from their buffers. For such situation we may need a--- "Continue" style driver command from the tee so that the driver runs--- the tee without providing it any input. Or we may need a local driver loop--- until new input is to be demanded from the input stream.------ When the tee errors out or stops, the tee driver may have to backtrack by--- the specified amount (or the tee must return the leftover input). Therefore,--- the tee driver also has to buffer, this leads to triple buffering.------ When the tee stops we need to determine the backtracking amount from the--- leftover of both the parsers. Since both the parsers may have consumed--- different lengths of the stream we consider the maximum of the two as--- consumed.----  -- XXX We can use Initial instead of StepState-{-# ANN type StepState Fuse #-}-data StepState s a = StepState s | StepResult a---- | State of the pair of parsers in a tee composition--- Note: strictness annotation is important for fusing the constructors-{-# ANN type TeeState Fuse #-}-data TeeState sL sR x a b =--- @TeePair (past buffer, parser state, future-buffer1, future-buffer2) ...@-    TeePair !([x], StepState sL a, [x], [x]) !([x], StepState sR b, [x], [x])--{-# ANN type Res Fuse #-}-data Res = Yld Int | Stp Int | Skp | Err String---- | See 'Streamly.Internal.Data.Parser.teeWith'.------ /Broken/----{-# INLINE teeWith #-}-teeWith :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError err -> IError err-            IDone bl ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult bl, [], [])-                                            ([], StepState sr, [], [])-                     IDone br -> IDone $ zf bl br-                     IError err -> IError err-            IError err -> IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- XXX This is currently broken, even though both the parsers need to-    -- consume from their buffers after backtracking the driver would still be-    -- pushing more input to the buffers.-    ---    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n s ->-                let src0 = Prelude.take n buf1-                    src  = Prelude.reverse src0-                    state = ([], StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Yld n))-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Yld n1, Stp n2) -> Partial (min n1 n2) next-            (Stp n1, Yld n2) -> Partial (min n1 n2) next-            (Stp n1, Stp n2) ->-                -- Uni-pattern match results in better optimized code compared-                -- to a case match.-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in Done (min n1 n2) (zf rL rR)-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult rR, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        -- XXX If the unused count of this stream is lower than the unused-        -- count of the stopped stream, only then this will be correct. We need-        -- to fix the other case. We need to keep incrementing the unused count-        -- of the stopped stream and take the min of the two.-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n (zf rL rR)-            Skp -> Continue 0 next-            Err err -> Error err--    step (TeePair l@(_, StepResult rL, _, _)-                    (bufR, StepState sR, inpR1, inpR2)) x = do-        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        -- XXX If the unused count of this stream is lower than the unused-        -- count of the stopped stream, only then this will be correct. We need-        -- to fix the other case. We need to keep incrementing the unused count-        -- of the stopped stream and take the min of the two.-        return $ case stR of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rR, _, _) = r-                 in Done n (zf rL rR)-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                rL <- extractL sL-                rR <- extractR sR-                return $ zf rL rR-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                rL <- extractL sL-                return $ zf rL rR-            TeePair (_, StepResult  rL, _, _) (_, StepState sR, _, _) -> do-                rR <- extractR sR-                return $ zf rL rR-            TeePair (_, StepResult rL, _, _) (_, StepResult rR, _, _) ->-                return $ zf rL rR---- | See 'Streamly.Internal.Data.Parser.teeWithFst'.------ /Broken/----{-# INLINE teeWithFst #-}-teeWithFst :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-teeWithFst zf (Parser stepL initialL extractL)-              (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        case resL of-            IPartial sl ->-                return $ case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError err -> IError err-            IDone bl ->-                case resR of-                     IPartial sr -> IDone . zf bl <$> extractR sr-                     IDone br -> return $ IDone $ zf bl br-                     IError err -> return $ IError err-            IError err -> return $ IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        case (stL,stR) of-            -- XXX what if the first parser returns an unused count which is-            -- more than the second parser's unused count? It does not make-            -- sense for the second parser to consume more than the first-            -- parser. We reset the input cursor based on the first parser.-            -- Error out if the second one has consumed more then the first?-            (Stp n1, Stp _) ->-                -- Uni-pattern match results in better optimized code compared-                -- to a case match.-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in return $ Done n1 (zf rL rR)-            (Stp n1, Yld _) ->-                let (_, StepResult rL, _, _) = l-                    (_, StepState  ssR, _, _) = r-                 in do-                    rR <- extractR ssR-                    return $ Done n1 (zf rL rR)-            (Yld n1, Yld n2) -> return $ Partial (min n1 n2) next-            (Yld n1, Stp n2) -> return $ Partial (min n1 n2) next-            (Err err, _) -> return $ Error err-            (_, Err err) -> return $ Error err-            _ -> return $ Continue 0 next--    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult rR, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        -- XXX If the unused count of this stream is lower than the unused-        -- count of the stopped stream, only then this will be correct. We need-        -- to fix the other case. We need to keep incrementing the unused count-        -- of the stopped stream and take the min of the two.-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n (zf rL rR)-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                rL <- extractL sL-                rR <- extractR sR-                return $ zf rL rR-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                rL <- extractL sL-                return $ zf rL rR-            _ -> error "unreachable"---- | See 'Streamly.Internal.Data.Parser.teeWithMin'.------ /Unimplemented/----{-# INLINE teeWithMin #-}-teeWithMin ::-    -- Monad m =>-    (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-teeWithMin = undefined------------------------------------------------------------------------------------ Distribute input to two parsers and choose one result------------------------------------------------------------------------------------ | See 'Streamly.Internal.Data.Parser.shortest'.------ /Broken/----{-# INLINE shortest #-}-shortest :: Monad m => Parser x m a -> Parser x m a -> Parser x m a-shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =-    Parser step initial extract--    where--    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IDone br-                     IError err -> IError err-            IDone bl -> IDone bl-            IError errL ->-                case resR of-                     IPartial _ -> IError errL-                     IDone br -> IDone br-                     IError errR -> IError errR--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    -- XXX Even if a parse finished earlier it may not be shortest if the other-    -- parser finishes later but returns a lot of unconsumed input. Our current-    -- criterion of shortest is whichever parse decided to stop earlier.-    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Stp n1, _) ->-                let (_, StepResult rL, _, _) = l-                 in Done n1 rL-            (_, Stp n2) ->-                let (_, StepResult rR, _, _) = r-                 in Done n2 rR-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        case st of-            TeePair (_, StepState sL, _, _) _ -> extractL sL-            _ -> error "unreachable"---- | See 'Streamly.Internal.Data.Parser.longest'.------ /Broken/----{-# INLINE longest #-}-longest :: MonadCatch m => Parser x m a -> Parser x m a -> Parser x m a-longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where---    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError _ ->-                         IPartial $ TeePair ([], StepState sl, [], [])-                                            ([], StepResult undefined, [], [])-            IDone bl ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult bl, [], [])-                                            ([], StepState sr, [], [])-                     IDone _ -> IDone bl-                     IError _ -> IDone bl-            IError _ ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult undefined, [], [])-                                            ([], StepState sr, [], [])-                     IDone br -> IDone br-                     IError err -> IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Yld n1, Stp n2) -> Partial (min n1 n2) next-            (Stp n1, Yld n2) -> Partial (min n1 n2) next-            (Stp n1, Stp n2) ->-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in Done (max n1 n2) (if n1 >= n2 then rL else rR)-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    -- XXX the parser that finishes last may not be the longest because it may-    -- return a lot of unused input which makes it shorter. Our current-    -- criterion of deciding longest is based on whoever decides to finish-    -- last and not whoever consumed more input.-    ---    -- To actually know who made more progress we need to keep an account of-    -- how many items are unconsumed since the last yield.-    ---    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult _, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n rL-            Skp -> Continue 0 next-            Err err -> Error err--    step (TeePair l@(_, StepResult _, _, _)-                    (bufR, StepState sR, inpR1, inpR2)) x = do-        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case stR of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rR, _, _) = r-                 in Done n rR-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        -- XXX When results are partial we may not be able to precisely compare-        -- which parser has made more progress till now.  One way to do that is-        -- to figure out the actually consumed input up to the last yield.-        ---        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                r <- try $ extractL sL-                case r of-                    Left (_ :: ParseError) -> extractR sR-                    Right b -> return b-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                r <- try $ extractL sL-                case r of-                    Left (_ :: ParseError) -> return rR-                    Right b -> return b-            TeePair (_, StepResult rL, _, _) (_, StepState sR, _, _) -> do-                r <- try $ extractR sR-                case r of-                    Left (_ :: ParseError) -> return rL-                    Right b -> return b-            TeePair (_, StepResult _, _, _) (_, StepResult _, _, _) ->-                error "unreachable"--}
− src/Streamly/Internal/Data/Parser/ParserD/Type.hs 
@@ -1,1429 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Parser.ParserD.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Streaming and backtracking parsers.------ Parsers just extend folds.  Please read the 'Fold' design notes in--- "Streamly.Internal.Data.Fold.Type" for background on the design.------ = Parser Design------ The 'Parser' type or a parsing fold is a generalization of the 'Fold' type.--- The 'Fold' type /always/ succeeds on each input. Therefore, it does not need--- to buffer the input. In contrast, a 'Parser' may fail and backtrack to--- replay the input again to explore another branch of the parser. Therefore,--- it needs to buffer the input. Therefore, a 'Parser' is a fold with some--- additional requirements.  To summarize, unlike a 'Fold', a 'Parser':------ 1. may not generate a new value of the accumulator on every input, it may--- generate a new accumulator only after consuming multiple input elements--- (e.g. takeEQ).--- 2. on success may return some unconsumed input (e.g. takeWhile)--- 3. may fail and return all input without consuming it (e.g. satisfy)--- 4. backtrack and start inspecting the past input again (e.g. alt)------ These use cases require buffering and replaying of input.  To facilitate--- this, the step function of the 'Fold' is augmented to return the next state--- of the fold along with a command tag using a 'Step' functor, the tag tells--- the fold driver to manipulate the future input as the parser wishes. The--- 'Step' functor provides the following commands to the fold driver--- corresponding to the use cases outlined in the previous para:------ 1. 'Continue': buffer the current input and optionally go back to a previous---    position in the stream--- 2. 'Partial': buffer the current input and optionally go back to a previous---    position in the stream, drop the buffer before that position.--- 3. 'Done': parser succeeded, returns how much input was leftover--- 4. 'Error': indicates that the parser has failed without a result------ = How a Parser Works?------ A parser is just like a fold, it keeps consuming inputs from the stream and--- accumulating them in an accumulator. The accumulator of the parser could be--- a singleton value or it could be a collection of values e.g. a list.------ The parser may build a new output value from multiple input items. When it--- consumes an input item but needs more input to build a complete output item--- it uses @Continue 0 s@, yielding the intermediate state @s@ and asking the--- driver to provide more input.  When the parser determines that a new output--- value is complete it can use a @Done n b@ to terminate the parser with @n@--- items of input unused and the final value of the accumulator returned as--- @b@. If at any time the parser determines that the parse has failed it can--- return @Error err@.------ A parser building a collection of values (e.g. a list) can use the @Partial@--- constructor whenever a new item in the output collection is generated. If a--- parser building a collection of values has yielded at least one value then--- it is considered successful and cannot fail after that. In the current--- implementation, this is not automatically enforced, there is a rule that the--- parser MUST use only @Done@ for termination after the first @Partial@, it--- cannot use @Error@. It may be possible to change the implementation so that--- this rule is not required, but there may be some performance cost to it.------ 'Streamly.Internal.Data.Parser.takeWhile' and--- 'Streamly.Internal.Data.Parser.some' combinators are good examples of--- efficient implementations using all features of this representation.  It is--- possible to idiomatically build a collection of parsed items using a--- singleton parser and @Alternative@ instance instead of using a--- multi-yield parser.  However, this implementation is amenable to stream--- fusion and can therefore be much faster.------ = Error Handling------ When a parser's @step@ function is invoked it may terminate by either a--- 'Done' or an 'Error' return value. In an 'Alternative' composition an error--- return can make the composed parser backtrack and try another parser.------ If the stream stops before a parser could terminate then we use the--- @extract@ function of the parser to retrieve the last yielded value of the--- parser. If the parser has yielded at least one value then @extract@ MUST--- return a value without throwing an error, otherwise it uses the 'ParseError'--- exception to throw an error.------ We chose the exception throwing mechanism for @extract@ instead of using an--- explicit error return via an 'Either' type for keeping the interface simple--- as most of the time we do not need to catch the error in intermediate--- layers. Note that we cannot use exception throwing mechanism in @step@--- function because of performance reasons. 'Error' constructor in that case--- allows loop fusion and better performance.------ = Optimizing backtracking------ == Applicative Composition------ If a parser once returned 'Partial' it can never fail after that. This is--- used to reduce the buffering. A 'Partial' results in dropping the buffer and--- we cannot backtrack before that point.------ Parsers can be composed using an Alternative, if we are in an alternative--- composition we may have to backtrack to try the other branch.  When we--- compose two parsers using applicative @f <$> p1 <*> p2@ we can return a--- 'Partial' result only after both the parsers have succeeded. While running--- @p1@ we have to ensure that the input is not dropped until we have run @p2@,--- therefore we have to return a Continue instead of a Partial.------ However, if we know they both cannot fail then we know that the composed--- parser can never fail.  For this reason we should have "backtracking folds"--- as a separate type so that we can compose them in an efficient manner. In p1--- itself we can drop the buffer as soon as a 'Partial' result arrives. In--- fact, there is no Alternative composition for folds because they cannot--- fail.------ == Alternative Composition------ In @p1 <|> p2@ as soon as the parser p1 returns 'Partial' we know that it--- will not fail and we can immediately drop the buffer.------ If we are not using the parser in an alternative composition we can--- downgrade the parser to a backtracking fold and use the "backtracking--- fold"'s applicative for more efficient implementation. To downgrade we can--- translate the "Error" of parser to an exception.  This gives us best of both--- worlds, the applicative as well as alternative would have optimal--- backtracking buffer.------ The "many" for parsers would be different than "many" for folds. In case of--- folds an error would be propagated. In case of parsers the error would be--- ignored.------ = Implementation Approach------ Backtracking folds have an issue with tee style composition because each--- fold can backtrack independently, we will need independent buffers. Though--- this may be possible to implement it may not be efficient especially for--- folds that do not backtrack at all. Three types are possible, optimized for--- different use cases:------ * Non-backtracking folds: efficient Tee--- * Backtracking folds: efficient applicative--- * Parsers: alternative------ Downgrade parsers to backtracking folds for applicative used without--- alternative.  Upgrade backtracking folds to parsers when we have to use them--- as the last alternative.------ = Future Work------ It may make sense to move "takeWhile" type of parsers, which cannot fail but--- need some lookahead, to splitting folds.  This will allow such combinators--- to be accepted where we need an unfailing "Fold" type.------ Based on application requirements it should be possible to design even a--- richer interface to manipulate the input stream/buffer. For example, we--- could randomly seek into the stream in the forward or reverse directions or--- we can even seek to the end or from the end or seek from the beginning.------ We can distribute and scan/parse a stream using both folds and parsers and--- merge the resulting streams using different merge strategies (e.g.--- interleaving or serial).------ == Naming------ As far as possible, try that the names of the combinators in this module are--- consistent with:------ * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>--- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>--- * <http://hackage.haskell.org/package/megaparsec megaparsec>--- * <http://hackage.haskell.org/package/attoparsec attoparsec>--- * <http://hackage.haskell.org/package/parsec parsec>--module Streamly.Internal.Data.Parser.ParserD.Type-    (-    -- * Setup-    -- $setup--    -- * Types-      Initial (..)-    , Step (..)-    , extractStep-    , bimapOverrideCount-    , Parser (..)-    , ParseError (..)-    , rmapM--    -- * Constructors--    , fromPure-    , fromEffect-    , splitWith-    , split_--    , die-    , dieM-    , splitSome -- parseSome?-    , splitMany -- parseMany?-    , splitManyPost-    , alt-    , concatMap--    -- * Input transformation-    , lmap-    , lmapM-    , filter--    , noErrorUnsafeSplitWith-    , noErrorUnsafeSplit_-    , noErrorUnsafeConcatMap-    )-where--#include "inline.hs"-#include "assert.hs"--import Control.Applicative (Alternative(..), liftA2)-import Control.Exception (Exception(..))--- import Control.Monad (MonadPlus(..), (>=>))-import Control.Monad ((>=>))-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Bifunctor (Bifunctor(..))-import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Type (Fold(..), toList)--import qualified Control.Monad.Fail as Fail-import qualified Streamly.Internal.Data.Fold.Type as FL--import Prelude hiding (concatMap, filter)--#include "DocTestDataParser.hs"---- XXX The only differences between Initial and Step types are:------ * There are no backtracking counts in Initial--- * Continue and Partial are the same. Ideally Partial should mean that an--- empty result is valid and can be extracted; and Continue should mean that--- empty would result in an error on extraction. We can possibly distinguish--- the two cases.------ If we ignore the backtracking counts we can represent the Initial type using--- Step itself. That will also simplify the implementation of various parsers--- where the processing in intiial is just a sepcial case of step, see--- takeBetween for example.---- | The type of a 'Parser''s initial action.------ /Internal/----{-# ANN type Initial Fuse #-}-data Initial s b-    = IPartial !s   -- ^ Wait for step function to be called with state @s@.-    | IDone !b      -- ^ Return a result right away without an input.-    | IError !String -- ^ Return an error right away without an input.---- | @first@ maps on 'IPartial' and @second@ maps on 'IDone'.------ /Internal/----instance Bifunctor Initial where-    {-# INLINE bimap #-}-    bimap f _ (IPartial a) = IPartial (f a)-    bimap _ g (IDone b) = IDone (g b)-    bimap _ _ (IError err) = IError err---- | Maps a function over the result held by 'IDone'.------ >>> fmap = second------ /Internal/----instance Functor (Initial s) where-    {-# INLINE fmap #-}-    fmap = second---- We can simplify the Step type as follows:------ Partial Int (Either s (s, b)) -- Left continue, right partial result--- Done Int (Either String b)------ In this case Error may also have a "leftover" return. This means that after--- several successful partial results the last segment parsing failed and we--- are returning the leftover of that. The driver may choose to restart from--- the last segment where this parser failed or from the beginning.------ Folds can only return the right values. Parsers can also return lefts.---- | The return type of a 'Parser' step.------ The parse operation feeds the input stream to the parser one element at a--- time, representing a parse 'Step'. The parser may or may not consume the--- item and returns a result. If the result is 'Partial' we can either extract--- the result or feed more input to the parser. If the result is 'Continue', we--- must feed more input in order to get a result. If the parser returns 'Done'--- then the parser can no longer take any more input.------ If the result is 'Continue', the parse operation retains the input in a--- backtracking buffer, in case the parser may ask to backtrack in future.--- Whenever a 'Partial n' result is returned we first backtrack by @n@ elements--- in the input and then release any remaining backtracking buffer. Similarly,--- 'Continue n' backtracks to @n@ elements before the current position and--- starts feeding the input from that point for future invocations of the--- parser.------ If parser is not yet done, we can use the @extract@ operation on the @state@--- of the parser to extract a result. If the parser has not yet yielded a--- result, the operation fails with a 'ParseError' exception. If the parser--- yielded a 'Partial' result in the past the last partial result is returned.--- Therefore, if a parser yields a partial result once it cannot fail later on.------ The parser can never backtrack beyond the position where the last partial--- result left it at. The parser must ensure that the backtrack position is--- always after that.------ /Pre-release/----{-# ANN type Step Fuse #-}-data Step s b =-        Partial !Int !s-    -- ^ @Partial count state@. The following hold on Partial result:-    ---    -- 1. @extract@ on @state@ would succeed and give a result.-    -- 2. Input stream position is reset to @current position - count@.-    -- 3. All input before the new position is dropped. The parser can-    -- never backtrack beyond this position.--    | Continue !Int !s-    -- ^ @Continue count state@. The following hold on a Continue result:-    ---    -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would-    -- give that result as 'Done' otherwise it may return 'Error' or-    -- 'Continue'.-    -- 2. Input stream position is reset to @current position - count@.-    -- 3. the input is retained in a backtrack buffer.--    | Done !Int !b-    -- ^ Done with leftover input count and result.-    ---    -- @Done count result@ means the parser has finished, it will accept no-    -- more input, last @count@ elements from the input are unused and the-    -- result of the parser is in @result@.--    | Error !String-    -- ^ Parser failed without generating any output.-    ---    -- The parsing operation may backtrack to the beginning and try another-    -- alternative.---- | Map first function over the state and second over the result.-instance Bifunctor Step where-    {-# INLINE bimap #-}-    bimap f g step =-        case step of-            Partial n s -> Partial n (f s)-            Continue n s -> Continue n (f s)-            Done n b -> Done n (g b)-            Error err -> Error err---- | Bimap discarding the count, and using the supplied count instead.-bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1-bimapOverrideCount n f g step =-    case step of-        Partial _ s -> Partial n (f s)-        Continue _ s -> Continue n (f s)-        Done _ b -> Done n (g b)-        Error err -> Error err---- | fmap = second-instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap = second--{-# INLINE assertStepCount #-}-assertStepCount :: Int -> Step s b -> Step s b-assertStepCount i step =-    case step of-        Partial n _ -> assert (i == n) step-        Continue n _ -> assert (i == n) step-        Done n _ -> assert (i == n) step-        Error _ -> step---- | Map an extract function over the state of Step----{-# INLINE extractStep #-}-extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)-extractStep f res =-    case res of-        Partial n s1 -> assertStepCount n <$> f s1-        Done n b -> return $ Done n b-        Continue n s1 -> assertStepCount n <$> f s1-        Error err -> return $ Error err---- | Map a monadic function over the result @b@ in @Step s b@.------ /Internal/-{-# INLINE mapMStep #-}-mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)-mapMStep f res =-    case res of-        Partial n s -> pure $ Partial n s-        Done n b -> Done n <$> f b-        Continue n s -> pure $ Continue n s-        Error err -> pure $ Error err---- | A parser is a fold that can fail and is represented as @Parser step--- initial extract@. Before we drive a parser we call the @initial@ action to--- retrieve the initial state of the fold. The parser driver invokes @step@--- with the state returned by the previous step and the next input element. It--- results into a new state and a command to the driver represented by 'Step'--- type. The driver keeps invoking the step function until it stops or fails.--- At any point of time the driver can call @extract@ to inspect the result of--- the fold. If the parser hits the end of input 'extract' is called.--- It may result in an error or an output value.------ /Pre-release/----data Parser a m b =-    forall s. Parser-        (s -> a -> m (Step s b))-        -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is-        -- same as Partial 0. In other words it cannot backtrack.-        (m (Initial s b))-        -- Extract can only return Partial or Continue n. In other words it can-        -- only backtrack or return partial result/error. But we do not return-        -- result in Partial, therefore, we have to use Done instead of Partial.-        (s -> m (Step s b))---- | This exception is used when a parser ultimately fails, the user of the--- parser is intimated via this exception.------ /Pre-release/----newtype ParseError = ParseError String-    deriving Show--instance Exception ParseError where-    displayException (ParseError err) = err--instance Functor m => Functor (Parser a m) where-    {-# INLINE fmap #-}-    fmap f (Parser step1 initial1 extract) =-        Parser step initial (fmap3 f extract)--        where--        initial = fmap2 f initial1-        step s b = fmap2 f (step1 s b)-        fmap2 g = fmap (fmap g)-        fmap3 g = fmap2 (fmap g)----------------------------------------------------------------------------------- Mapping on the output----------------------------------------------------------------------------------- | @rmapM f parser@ maps the monadic function @f@ on the output of the parser.------ >>> rmap = fmap-{-# INLINE rmapM #-}-rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c-rmapM f (Parser step initial extract) =-    Parser step1 initial1 (extract >=> mapMStep f)--    where--    initial1 = do-        res <- initial-        -- this is mapM f over result-        case res of-            IPartial x -> return $ IPartial x-            IDone a -> IDone <$> f a-            IError err -> return $ IError err-    step1 s a = step s a >>= mapMStep f---- | A parser that always yields a pure value without consuming any input.----{-# INLINE_NORMAL fromPure #-}-fromPure :: Monad m => b -> Parser a m b-fromPure b = Parser undefined (pure $ IDone b) undefined---- | A parser that always yields the result of an effectful action without--- consuming any input.----{-# INLINE fromEffect #-}-fromEffect :: Monad m => m b -> Parser a m b-fromEffect b = Parser undefined (IDone <$> b) undefined------------------------------------------------------------------------------------ Sequential applicative----------------------------------------------------------------------------------{-# ANN type SeqParseState Fuse #-}-data SeqParseState sl f sr = SeqParseL !sl | SeqParseR !f !sr---- Note: this implementation of splitWith is fast because of stream fusion but--- has quadratic time complexity, because each composition adds a new branch--- that each subsequent parse's input element has to go through, therefore, it--- cannot scale to a large number of compositions. After around 100--- compositions the performance starts dipping rapidly beyond a CPS style--- unfused implementation.------ Note: This is a parsing dual of appending streams using--- 'Streamly.Data.Stream.append', it splits the streams using two parsers and--- zips the results.---- | Sequential parser application.------ Apply two parsers sequentially to an input stream. The first parser runs and--- processes the input, the remaining input is then passed to the second--- parser. If both parsers succeed, their outputs are combined using the--- supplied function. If either parser fails, the operation fails.------ This implementation is strict in the second argument, therefore, the--- following will fail:------ >>> Stream.parse (Parser.splitWith const (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]--- *** Exception: Prelude.undefined--- ...------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions.--- As a thumb rule use it for less than 8 compositions, use ParserK otherwise.------ Below are some common idioms that can be expressed using 'splitWith' and--- other parser primitives:------ >>> span p f1 f2 = Parser.splitWith (,) (Parser.takeWhile p f1) (Parser.fromFold f2)--- >>> spanBy eq f1 f2 = Parser.splitWith (,) (Parser.groupBy eq f1) (Parser.fromFold f2)------ /Pre-release/----{-# INLINE splitWith #-}-splitWith :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-splitWith func (Parser stepL initialL extractL)-               (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        -- XXX We can use bimap here if we make this a Step type-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqParseL sl-            IDone bl -> do-                resR <- initialR-                -- XXX We can use bimap here if we make this a Step type-                return $ case resR of-                    IPartial sr -> IPartial $ SeqParseR (func bl) sr-                    IDone br -> IDone (func bl br)-                    IError err -> IError err-            IError err -> return $ IError err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqParseL st) a = do-        -- Important: Please do not use Applicative here. See-        -- https://github.com/composewell/streamly/issues/1033 and the problem-        -- defined in split_ for more info.-        -- XXX Use bimap-        resL <- stepL st a-        case resL of-            -- Note: We need to buffer the input for a possible Alternative-            -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to-            -- backtrack and start running p3. So we need to keep the input-            -- buffered until we know that the applicative cannot fail.-            Partial n s -> return $ Continue n (SeqParseL s)-            Continue n s -> return $ Continue n (SeqParseL s)-            Done n b -> do-                -- XXX Use bimap if we make this a Step type-                -- fmap (bimap (SeqParseR (func b)) (func b)) initialR-                initR <- initialR-                return $ case initR of-                   IPartial sr -> Continue n $ SeqParseR (func b) sr-                   IDone br -> Done n (func b br)-                   IError err -> Error err-            Error err -> return $ Error err--    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)--    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)-    extract (SeqParseL sL) = do-        -- XXX Use bimap here-        rL <- extractL sL-        case rL of-            Done n bL -> do-                -- XXX Use bimap here if we use Step type in Initial-                iR <- initialR-                case iR of-                    IPartial sR -> do-                        fmap-                            (bimap (SeqParseR (func bL)) (func bL))-                            (extractR sR)-                    IDone bR -> return $ Done n $ func bL bR-                    IError err -> return $ Error err-            Error err -> return $ Error err-            Partial _ _ -> error "Bug: splitWith extract 'Partial'"-            Continue n s -> return $ Continue n (SeqParseL s)------------------------------------------------------------------------------------ Sequential applicative for backtracking folds------------------------------------------------------------------------------------ XXX Create a newtype for nonfailing parsers and downgrade the parser to that--- type before this operation and then upgrade.------ We can do an inspection testing to reject unwanted constructors at compile--- time.------ We can use the compiler to automatically annotate accumulators, terminating--- folds, non-failing parsers and failing parsers.---- | Works correctly only if both the parsers are guaranteed to never fail.-{-# INLINE noErrorUnsafeSplitWith #-}-noErrorUnsafeSplitWith :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-noErrorUnsafeSplitWith func (Parser stepL initialL extractL)-               (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    errMsg e = error $ "noErrorUnsafeSplitWith: unreachable: " ++ e--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqParseL sl-            IDone bl -> do-                resR <- initialR-                return $ bimap (SeqParseR (func bl)) (func bl) resR-            IError err -> errMsg err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqParseL st) a = do-        r <- stepL st a-        case r of-            -- Assume that the parser can never fail, therefore, we do not-            -- need to keep the input for backtracking.-            Partial n s -> return $ Partial n (SeqParseL s)-            Continue n s -> return $ Continue n (SeqParseL s)-            Done n b -> do-                res <- initialR-                return-                    $ case res of-                          IPartial sr -> Partial n $ SeqParseR (func b) sr-                          IDone br -> Done n (func b br)-                          IError err -> errMsg err-            Error err -> errMsg err--    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)--    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)--    extract (SeqParseL sL) = do-        rL <- extractL sL-        case rL of-            Done n bL -> do-                iR <- initialR-                case iR of-                    IPartial sR -> do-                        rR <- extractR sR-                        return-                            $ bimapOverrideCount-                                n (SeqParseR (func bL)) (func bL) rR-                    IDone bR -> return $ Done n $ func bL bR-                    IError err -> errMsg err-            Error err -> errMsg err-            Partial _ _ -> errMsg "Partial"-            Continue n s -> return $ Continue n (SeqParseL s)--{-# ANN type SeqAState Fuse #-}-data SeqAState sl sr = SeqAL !sl | SeqAR !sr---- This turns out to be slightly faster than splitWith---- | Sequential parser application ignoring the output of the first parser.--- Apply two parsers sequentially to an input stream.  The input is provided to--- the first parser, when it is done the remaining input is provided to the--- second parser. The output of the parser is the output of the second parser.--- The operation fails if any of the parsers fail.------ This implementation is strict in the second argument, therefore, the--- following will fail:------ >>> Stream.parse (Parser.split_ (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]--- *** Exception: Prelude.undefined--- ...------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions.--- As a thumb rule use it for less than 8 compositions, use ParserK otherwise.------ /Pre-release/----{-# INLINE split_ #-}-split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b-split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqAL sl-            IDone _ -> do-                resR <- initialR-                return $ first SeqAR resR-            IError err -> return $ IError err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqAL st) a = do-        -- Important: Do not use Applicative here. Applicative somehow caused-        -- the right action to run many times, not sure why though.-        resL <- stepL st a-        case resL of-            -- Note: this leads to buffering even if we are not in an-            -- Alternative composition.-            Partial n s -> return $ Continue n (SeqAL s)-            Continue n s -> return $ Continue n (SeqAL s)-            Done n _ -> do-                initR <- initialR-                return $ case initR of-                    IPartial s -> Continue n (SeqAR s)-                    IDone b -> Done n b-                    IError err -> Error err-            Error err -> return $ Error err--    step (SeqAR st) a = first SeqAR <$> stepR st a--    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)-    extract (SeqAL sL) = do-        rL <- extractL sL-        case rL of-            Done n _ -> do-                iR <- initialR-                -- XXX For initial we can have a bimap with leftover.-                case iR of-                    IPartial sR ->-                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)-                    IDone bR -> return $ Done n bR-                    IError err -> return $ Error err-            Error err -> return $ Error err-            Partial _ _ -> error "split_: Partial"-            Continue n s -> return $ Continue n (SeqAL s)---- For backtracking folds-{-# INLINE noErrorUnsafeSplit_ #-}-noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b-noErrorUnsafeSplit_-    (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    errMsg e = error $ "noErrorUnsafeSplit_: unreachable: " ++ e--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqAL sl-            IDone _ -> do-                resR <- initialR-                return $ first SeqAR resR-            IError err -> errMsg err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqAL st) a = do-        -- Important: Please do not use Applicative here. Applicative somehow-        -- caused the next action to run many times in the "tar" parsing code,-        -- not sure why though.-        resL <- stepL st a-        case resL of-            Partial n s -> return $ Partial n (SeqAL s)-            Continue n s -> return $ Continue n (SeqAL s)-            Done n _ -> do-                initR <- initialR-                return $ case initR of-                    IPartial s -> Partial n (SeqAR s)-                    IDone b -> Done n b-                    IError err -> errMsg err-            Error err -> errMsg err--    step (SeqAR st) a = first SeqAR <$> stepR st a--    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)-    extract (SeqAL sL) = do-        rL <- extractL sL-        case rL of-            Done n _ -> do-                iR <- initialR-                case iR of-                    IPartial sR -> do-                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)-                    IDone bR -> return $ Done n bR-                    IError err -> errMsg err-            Error err -> errMsg err-            Partial _ _ -> error "split_: Partial"-            Continue n s -> return $ Continue n (SeqAL s)---- | 'Applicative' form of 'splitWith'.-instance Monad m => Applicative (Parser a m) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = splitWith id--    {-# INLINE (*>) #-}-    (*>) = split_--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)------------------------------------------------------------------------------------ Sequential Alternative----------------------------------------------------------------------------------{-# ANN type AltParseState Fuse #-}-data AltParseState sl sr = AltParseL !Int !sl | AltParseR !sr---- Note: this implementation of alt is fast because of stream fusion but has--- quadratic time complexity, because each composition adds a new branch that--- each subsequent alternative's input element has to go through, therefore, it--- cannot scale to a large number of compositions---- | Sequential alternative. The input is first passed to the first parser, and--- if it succeeds, the result is returned. However, if the first parser fails,--- the parser driver backtracks and tries the same input on the second parser,--- returning the result if it succeeds.------ Note: This implementation is not lazy in the second argument. The following--- will fail:------ >> Stream.parse (Parser.satisfy (> 0) `Parser.alt` undefined) $ Stream.fromList [1..10]--- *** Exception: Prelude.undefined------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions.--- As a thumb rule use it for less than 8 compositions, use ParserK otherwise.------ /Time Complexity:/ O(n^2) where n is the number of compositions.------ /Pre-release/----{-# INLINE alt #-}-alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a-alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ AltParseL 0 sl-            IDone bl -> return $ IDone bl-            IError _ -> do-                resR <- initialR-                return $ case resR of-                    IPartial sr -> IPartial $ AltParseR sr-                    IDone br -> IDone br-                    IError err -> IError err--    -- Once a parser yields at least one value it cannot fail.  This-    -- restriction helps us make backtracking more efficient, as we do not need-    -- to keep the consumed items buffered after a yield. Note that we do not-    -- enforce this and if a misbehaving parser does not honor this then we can-    -- get unexpected results. XXX Can we detect and flag this?-    step (AltParseL cnt st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (AltParseL 0 s)-            Continue n s -> do-                assertM(cnt + 1 - n >= 0)-                return $ Continue n (AltParseL (cnt + 1 - n) s)-            Done n b -> return $ Done n b-            Error _ -> do-                res <- initialR-                return-                    $ case res of-                          IPartial rR -> Continue (cnt + 1) (AltParseR rR)-                          IDone b -> Done (cnt + 1) b-                          IError err -> Error err--    step (AltParseR st) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n (AltParseR s)-            Continue n s -> Continue n (AltParseR s)-            Done n b -> Done n b-            Error err -> Error err--    extract (AltParseR sR) = fmap (first AltParseR) (extractR sR)--    extract (AltParseL cnt sL) = do-        rL <- extractL sL-        case rL of-            Done n b -> return $ Done n b-            Error _ -> do-                res <- initialR-                return-                    $ case res of-                          IPartial rR -> Continue cnt (AltParseR rR)-                          IDone b -> Done cnt b-                          IError err -> Error err-            Partial _ _ -> error "Bug: alt: extractL 'Partial'"-            Continue n s -> do-                assertM(n == cnt)-                return $ Continue n (AltParseL 0 s)--{-# ANN type Fused3 Fuse #-}-data Fused3 a b c = Fused3 !a !b !c---- | See documentation of 'Streamly.Internal.Data.Parser.many'.------ /Pre-release/----{-# INLINE splitMany #-}-splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution! There is mutual recursion here, inlining the right functions is-    -- important.--    handleCollect partial done fres =-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ partial $ Fused3 ps 0 fs-                    IDone pb ->-                        runCollectorWith (handleCollect partial done) fs pb-                    IError _ -> done <$> fextract fs-            FL.Done fb -> return $ done fb--    runCollectorWith cont fs pb = fstep fs pb >>= cont--    -- See notes in Fold.many for the reason why the parser must be initialized-    -- right away instead of on first input.-    initial = finitial >>= handleCollect IPartial IDone--    {-# INLINE step #-}-    step (Fused3 st cnt fs) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs--    extract (Fused3 _ 0 fs) = fmap (Done 0) (fextract fs)-    extract (Fused3 s cnt fs) = do-        r <- extract1 s-        case r of-            Error _ -> fmap (Done cnt) (fextract fs)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitMany: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 fs))---- | Like splitMany, but inner fold emits an output at the end even if no input--- is received.------ /Internal/----{-# INLINE splitManyPost #-}-splitManyPost :: Monad m =>  Parser a m b -> Fold m b c -> Parser a m c-splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution! There is mutual recursion here, inlining the right functions is-    -- important.--    handleCollect partial done fres =-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ partial $ Fused3 ps 0 fs-                    IDone pb ->-                        runCollectorWith (handleCollect partial done) fs pb-                    IError _ -> done <$> fextract fs-            FL.Done fb -> return $ done fb--    runCollectorWith cont fs pb = fstep fs pb >>= cont--    initial = finitial >>= handleCollect IPartial IDone--    {-# INLINE step #-}-    step (Fused3 st cnt fs) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    extract (Fused3 s cnt fs) = do-        r <- extract1 s-        case r of-            Error _ -> fmap (Done cnt) (fextract fs)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitMany: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 fs))---- | See documentation of 'Streamly.Internal.Data.Parser.some'.------ /Pre-release/----{-# INLINE splitSome #-}-splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution! There is mutual recursion here, inlining the right functions is-    -- important.--    handleCollect partial done fres =-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ partial $ Fused3 ps 0 $ Right fs-                    IDone pb ->-                        runCollectorWith (handleCollect partial done) fs pb-                    IError _ -> done <$> fextract fs-            FL.Done fb -> return $ done fb--    runCollectorWith cont fs pb = fstep fs pb >>= cont--    initial = do-        fres <- finitial-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ IPartial $ Fused3 ps 0 $ Left fs-                    IDone pb ->-                        runCollectorWith (handleCollect IPartial IDone) fs pb-                    IError err -> return $ IError err-            FL.Done _ ->-                return-                    $ IError-                    $ "splitSome: The collecting fold terminated without"-                          ++ " consuming any elements."--    {-# INLINE step #-}-    step (Fused3 st cnt (Left fs)) a = do-        r <- step1 st a-        -- In the Left state, count is used only for the assert-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) (Left fs))-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) (Left fs))-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error err -> return $ Error err-    step (Fused3 st cnt (Right fs)) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Partial n (Fused3 s (cnt1 - n) (Right fs))-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) (Right fs))-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> Done cnt1 <$> fextract fs--    extract (Fused3 s cnt (Left fs)) = do-        r <- extract1 s-        case r of-            Error err -> return (Error err)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitSome: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 (Left fs)))-    extract (Fused3 s cnt (Right fs)) = do-        r <- extract1 s-        case r of-            Error _ -> fmap (Done cnt) (fextract fs)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitSome: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 (Right fs)))---- | A parser that always fails with an error message without consuming--- any input.----{-# INLINE_NORMAL die #-}-die :: Monad m => String -> Parser a m b-die err = Parser undefined (pure (IError err)) undefined---- | A parser that always fails with an effectful error message and without--- consuming any input.------ /Pre-release/----{-# INLINE dieM #-}-dieM :: Monad m => m String -> Parser a m b-dieM err = Parser undefined (IError <$> err) undefined---- Note: The default implementations of "some" and "many" loop infinitely--- because of the strict pattern match on both the arguments in applicative and--- alternative. With the direct style parser type we cannot use the mutually--- recursive definitions of "some" and "many".------ Note: With the direct style parser type, the list in "some" and "many" is--- accumulated strictly, it cannot be consumed lazily.---- | Sequential alternative. The input is first passed to the first parser, and--- if it succeeds, the result is returned. However, if the first parser fails,--- the parser driver backtracks and tries the same input on the second parser,--- returning the result if it succeeds.------ Note: The implementation of '<|>' is not lazy in the second--- argument. The following code will fail:------ >>> Stream.parse (Parser.satisfy (> 0) <|> undefined) $ Stream.fromList [1..10]--- *** Exception: Prelude.undefined--- ...------ WARNING! this is not suitable for large scale use. As a thumb rule stream--- fusion works well for less than 8 compositions of this operation, otherwise--- consider using 'ParserK'. Do not use recursive parser implementations based--- on this Alternative instance.--instance Monad m => Alternative (Parser a m) where-    {-# INLINE empty #-}-    empty = die "empty"--    {-# INLINE (<|>) #-}-    (<|>) = alt--    {-# INLINE many #-}-    many = flip splitMany toList--    {-# INLINE some #-}-    some = flip splitSome toList--{-# ANN type ConcatParseState Fuse #-}-data ConcatParseState sl m a b =-      ConcatParseL !sl-    | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Step s b))---- | Map a 'Parser' returning function on the result of a 'Parser'.------ /Pre-release/----{-# INLINE concatMap #-}-concatMap :: Monad m =>-    (b -> Parser a m c) -> Parser a m b -> Parser a m c-concatMap func (Parser stepL initialL extractL) = Parser step initial extract--    where--    {-# INLINE initializeR #-}-    initializeR (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR-            IDone br -> IDone br-            IError err -> IError err--    initial = do-        res <- initialL-        case res of-            IPartial s -> return $ IPartial $ ConcatParseL s-            IDone b -> initializeR (func b)-            IError err -> return $ IError err--    {-# INLINE initializeRL #-}-    initializeRL n (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> Continue n $ ConcatParseR stepR sr extractR-            IDone br -> Done n br-            IError err -> Error err--    step (ConcatParseL st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Continue n (ConcatParseL s)-            Continue n s -> return $ Continue n (ConcatParseL s)-            Done n b -> initializeRL n (func b)-            Error err -> return $ Error err--    step (ConcatParseR stepR st extractR) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n $ ConcatParseR stepR s extractR-            Continue n s -> Continue n $ ConcatParseR stepR s extractR-            Done n b -> Done n b-            Error err -> Error err--    {-# INLINE extractP #-}-    extractP n (Parser stepR initialR extractR) = do-        res <- initialR-        case res of-            IPartial s ->-                fmap-                    (first (\s1 -> ConcatParseR stepR s1 extractR))-                    (extractR s)-            IDone b -> return (Done n b)-            IError err -> return $ Error err--    extract (ConcatParseR stepR s extractR) =-        fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)-    extract (ConcatParseL sL) = do-        rL <- extractL sL-        case rL of-            Error err -> return $ Error err-            Done n b -> extractP n $ func b-            Partial _ _ -> error "concatMap: extract Partial"-            Continue n s -> return $ Continue n (ConcatParseL s)--{-# INLINE noErrorUnsafeConcatMap #-}-noErrorUnsafeConcatMap :: Monad m =>-    (b -> Parser a m c) -> Parser a m b -> Parser a m c-noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =-    Parser step initial extract--    where--    {-# INLINE initializeR #-}-    initializeR (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR-            IDone br -> IDone br-            IError err -> IError err--    initial = do-        res <- initialL-        case res of-            IPartial s -> return $ IPartial $ ConcatParseL s-            IDone b -> initializeR (func b)-            IError err -> return $ IError err--    {-# INLINE initializeRL #-}-    initializeRL n (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> Partial n $ ConcatParseR stepR sr extractR-            IDone br -> Done n br-            IError err -> Error err--    step (ConcatParseL st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (ConcatParseL s)-            Continue n s -> return $ Continue n (ConcatParseL s)-            Done n b -> initializeRL n (func b)-            Error err -> return $ Error err--    step (ConcatParseR stepR st extractR) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n $ ConcatParseR stepR s extractR-            Continue n s -> Continue n $ ConcatParseR stepR s extractR-            Done n b -> Done n b-            Error err -> Error err--    {-# INLINE extractP #-}-    extractP n (Parser stepR initialR extractR) = do-        res <- initialR-        case res of-            IPartial s ->-                fmap-                    (first (\s1 -> ConcatParseR stepR s1 extractR))-                    (extractR s)-            IDone b -> return (Done n b)-            IError err -> return $ Error err--    extract (ConcatParseR stepR s extractR) =-        fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)-    extract (ConcatParseL sL) = do-        rL <- extractL sL-        case rL of-            Error err -> return $ Error err-            Done n b -> extractP n $ func b-            Partial _ _ -> error "concatMap: extract Partial"-            Continue n s -> return $ Continue n (ConcatParseL s)---- Note: The monad instance has quadratic performance complexity. It works fine--- for small number of compositions but for a scalable implementation we need a--- CPS version.---- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions. As a--- thumb rule use it for less than 8 compositions, use 'ParserK' otherwise.----instance Monad m => Monad (Parser a m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--    {-# INLINE (>>) #-}-    (>>) = (*>)--instance Monad m => Fail.MonadFail (Parser a m) where-    {-# INLINE fail #-}-    fail = die--{---- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.----instance Monad m => MonadPlus (Parser a m) where-    {-# INLINE mzero #-}-    mzero = die "mzero"--    {-# INLINE mplus #-}-    mplus = alt--}--instance (Monad m, MonadIO m) => MonadIO (Parser a m) where-    {-# INLINE liftIO #-}-    liftIO = fromEffect . liftIO----------------------------------------------------------------------------------- Mapping on input----------------------------------------------------------------------------------- | @lmap f parser@ maps the function @f@ on the input of the parser.------ >>> Stream.parse (Parser.lmap (\x -> x * x) (Parser.fromFold Fold.sum)) (Stream.enumerateFromTo 1 100)--- Right 338350------ > lmap = Parser.lmapM return----{-# INLINE lmap #-}-lmap :: (a -> b) -> Parser b m r -> Parser a m r-lmap f (Parser step begin done) = Parser step1 begin done--    where--    step1 x a = step x (f a)---- | @lmapM f parser@ maps the monadic function @f@ on the input of the parser.----{-# INLINE lmapM #-}-lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r-lmapM f (Parser step begin done) = Parser step1 begin done--    where--    step1 x a = f a >>= step x---- | Include only those elements that pass a predicate.------ >>> Stream.parse (Parser.filter (> 5) (Parser.fromFold Fold.sum)) $ Stream.fromList [1..10]--- Right 40----{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b-filter f (Parser step initial extract) = Parser step1 initial extract--    where--    step1 x a = if f a then step x a else return $ Partial 0 x
− src/Streamly/Internal/Data/Parser/ParserK/Type.hs 
@@ -1,545 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Parser.ParserK.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ CPS style implementation of parsers.------ The CPS representation allows linear performance for Applicative, sequence,--- Monad, Alternative, and choice operations compared to the quadratic--- complexity of the corresponding direct style operations. However, direct--- style operations allow fusion with ~10x better performance than CPS.------ The direct style representation does not allow for recursive definitions of--- "some" and "many" whereas CPS allows that.------ 'Applicative' and 'Control.Applicative.Alternative' type class based--- combinators from the--- <http://hackage.haskell.org/package/parser-combinators parser-combinators>--- package can also be used with the 'ParserK' type.--module Streamly.Internal.Data.Parser.ParserK.Type-    (-      Step (..)-    , Input (..)-    , ParseResult (..)-    , ParserK (..)-    , fromParser-    -- , toParser-    , fromPure-    , fromEffect-    , die-    )-where--#include "ArrayMacros.h"-#include "assert.hs"-#include "inline.hs"--import Control.Applicative (Alternative(..), liftA2)-import Control.Monad (MonadPlus(..), ap)-import Control.Monad.IO.Class (MonadIO, liftIO)--- import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Proxy (Proxy(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unbox)-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Control.Monad.Fail as Fail-import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD--data Input a = None | Chunk {-# UNPACK #-} !(Array a)---- | The intermediate result of running a parser step. The parser driver may--- stop with a final result, pause with a continuation to resume, or fail with--- an error.------ See ParserD docs. This is the same as the ParserD Step except that it uses a--- continuation in Partial and Continue constructors instead of a state in case--- of ParserD.------ /Pre-release/----data Step a m r =-    -- The Int is the current stream position index wrt to the start of the-    -- array.-      Done !Int r-      -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.-      -- measure if that works any better.-      -- Array a -> m (Step a m r), m (Step a m r)-    | Partial !Int (Input a -> m (Step a m r))-    | Continue !Int (Input a -> m (Step a m r))-    | Error !Int String--instance Functor m => Functor (Step a m) where-    fmap f (Done n r) = Done n (f r)-    fmap f (Partial n k) = Partial n (fmap (fmap f) . k)-    fmap f (Continue n k) = Continue n (fmap (fmap f) . k)-    fmap _ (Error n e) = Error n e---- Note: Passing position index separately instead of passing it with the--- result causes huge regression in expression parsing becnhmarks.---- | The parser's result.------ Int is the position index into the current input array. Could be negative.--- Cannot be beyond the input array max bound.------ /Pre-release/----data ParseResult b =-      Success !Int !b      -- Position index, result-    | Failure !Int !String -- Position index, error---- | Map a function over 'Success'.-instance Functor ParseResult where-    fmap f (Success n b) = Success n (f b)-    fmap _ (Failure n e) = Failure n e---- XXX Change the type to the shape (a -> m r -> m r) -> (m r -> m r) -> m r------ The parse continuation would be: Array a -> m (Step a m r) -> m (Step a m r)--- The extract continuation would be: m (Step a m r) -> m (Step a m r)------ Use Step itself in place of ParseResult.---- | A continuation passing style parser representation. A continuation of--- 'Step's, each step passes a state and a parse result to the next 'Step'. The--- resulting 'Step' may carry a continuation that consumes input 'a' and--- results in another 'Step'. Essentially, the continuation may either consume--- input without a result or return a result with no further input to be--- consumed.----newtype ParserK a m b = MkParser-    { runParser :: forall r.-           -- Using "Input" in runParser is not necessary but it avoids making-           -- one more function call to get the input. This could be helpful-           -- for cases where we process just one element per call.-           ---           -- Do not eta reduce the applications of this continuation.-           ---           (ParseResult b -> Int -> Input a -> m (Step a m r))-           -- XXX Maintain and pass the original position in the stream. that-           -- way we can also report better errors. Use a Context structure for-           -- passing the state.--           -- Stream position index wrt to the current input array start. If-           -- negative then backtracking is required before using the array.-           -- The parser should use "Continue -n" in this case if it needs to-           -- consume input. Negative value cannot be beyond the current-           -- backtrack buffer. Positive value cannot be beyond array length.-           -- If the parser needs to advance beyond the array length it should-           -- use "Continue +n".-        -> Int-           -- used elem count, a count of elements consumed by the parser. If-           -- an Alternative fails we need to backtrack by this amount.-        -> Int-           -- The second argument is the used count as described above. The-           -- current input position is carried as part of 'Success'-           -- constructor of 'ParseResult'.-           -- XXX Use Array a, determine eof by using a nil array-        -> Input a-        -> m (Step a m r)-    }------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ XXX rewrite this using ParserD, expose rmapM from ParserD.--- | Maps a function over the output of the parser.----instance Functor m => Functor (ParserK a m) where-    {-# INLINE fmap #-}-    fmap f parser = MkParser $ \k n st arr ->-        let k1 res = k (fmap f res)-         in runParser parser k1 n st arr------------------------------------------------------------------------------------ Sequential applicative------------------------------------------------------------------------------------ This is the dual of stream "fromPure".------ | A parser that always yields a pure value without consuming any input.------ /Pre-release/----{-# INLINE fromPure #-}-fromPure :: b -> ParserK a m b-fromPure b = MkParser $ \k n st arr -> k (Success n b) st arr---- | See 'Streamly.Internal.Data.Parser.fromEffect'.------ /Pre-release/----{-# INLINE fromEffect #-}-fromEffect :: Monad m => m b -> ParserK a m b-fromEffect eff =-    MkParser $ \k n st arr -> eff >>= \b -> k (Success n b) st arr---- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that--- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'--- when fusion is important.----instance Monad m => Applicative (ParserK a m) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = ap--    {-# INLINE (*>) #-}-    p1 *> p2 = MkParser $ \k n st arr ->-        let k1 (Success n1 _) s input = runParser p2 k n1 s input-            k1 (Failure n1 e) s input = k (Failure n1 e) s input-        in runParser p1 k1 n st arr--    {-# INLINE (<*) #-}-    p1 <* p2 = MkParser $ \k n st arr ->-        let k1 (Success n1 b) s1 input =-                let k2 (Success n2 _) s2 input2  = k (Success n2 b) s2 input2-                    k2 (Failure n2 e) s2 input2  = k (Failure n2 e) s2 input2-                in runParser p2 k2 n1 s1 input-            k1 (Failure n1 e) s1 input = k (Failure n1 e) s1 input-        in runParser p1 k1 n st arr--    {-# INLINE liftA2 #-}-    liftA2 f p = (<*>) (fmap f p)------------------------------------------------------------------------------------ Monad------------------------------------------------------------------------------------ This is the dual of "nil".------ | A parser that always fails with an error message without consuming--- any input.------ /Pre-release/----{-# INLINE die #-}-die :: String -> ParserK a m b-die err = MkParser (\k n st arr -> k (Failure n err) st arr)---- | Monad composition can be used for lookbehind parsers, we can make the--- future parses depend on the previously parsed values.------ If we have to parse "a9" or "9a" but not "99" or "aa" we can use the--- following parser:------ @--- backtracking :: MonadCatch m => PR.Parser Char m String--- backtracking =---     sequence [PR.satisfy isDigit, PR.satisfy isAlpha]---     '<|>'---     sequence [PR.satisfy isAlpha, PR.satisfy isDigit]--- @------ We know that if the first parse resulted in a digit at the first place then--- the second parse is going to fail.  However, we waste that information and--- parse the first character again in the second parse only to know that it is--- not an alphabetic char.  By using lookbehind in a 'Monad' composition we can--- avoid redundant work:------ @--- data DigitOrAlpha = Digit Char | Alpha Char------ lookbehind :: MonadCatch m => PR.Parser Char m String--- lookbehind = do---     x1 \<-    Digit '<$>' PR.satisfy isDigit---          '<|>' Alpha '<$>' PR.satisfy isAlpha------     -- Note: the parse depends on what we parsed already---     x2 <- case x1 of---         Digit _ -> PR.satisfy isAlpha---         Alpha _ -> PR.satisfy isDigit------     return $ case x1 of---         Digit x -> [x,x2]---         Alpha x -> [x,x2]--- @------ See also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance--- does not fuse, use 'Streamly.Internal.Data.Parser.concatMap' when you need--- fusion.----instance Monad m => Monad (ParserK a m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    p >>= f = MkParser $ \k n st arr ->-        let k1 (Success n1 b) s1 inp = runParser (f b) k n1 s1 inp-            k1 (Failure n1 e) s1 inp = k (Failure n1 e) s1 inp-         in runParser p k1 n st arr--    {-# INLINE (>>) #-}-    (>>) = (*>)--#if !(MIN_VERSION_base(4,13,0))-    -- This is redefined instead of just being Fail.fail to be-    -- compatible with base 4.8.-    {-# INLINE fail #-}-    fail = die-#endif-instance Monad m => Fail.MonadFail (ParserK a m) where-    {-# INLINE fail #-}-    fail = die--instance MonadIO m => MonadIO (ParserK a m) where-    {-# INLINE liftIO #-}-    liftIO = fromEffect . liftIO------------------------------------------------------------------------------------ Alternative------------------------------------------------------------------------------------ | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and--- run the second parser if the first one fails.------ The "some" and "many" operations of alternative accumulate results in a pure--- list which is not scalable and streaming. Instead use--- 'Streamly.Internal.Data.Parser.some' and--- 'Streamly.Internal.Data.Parser.many' for fusible operations with composable--- accumulation of results.------ See also 'Streamly.Internal.Data.Parser.alt'. This 'Alternative' instance--- does not fuse, use 'Streamly.Internal.Data.Parser.alt' when you need--- fusion.----instance Monad m => Alternative (ParserK a m) where-    {-# INLINE empty #-}-    empty = die "empty"--    {-# INLINE (<|>) #-}-    p1 <|> p2 = MkParser $ \k n _ arr ->-        let-            k1 (Failure pos _) used input = runParser p2 k (pos - used) 0 input-            k1 success _ input = k success 0 input-        in runParser p1 k1 n 0 arr--    -- some and many are implemented here instead of using default definitions-    -- so that we can use INLINE on them. It gives 50% performance improvement.--    {-# INLINE many #-}-    many v = many_v--        where--        many_v = some_v <|> pure []-        some_v = (:) <$> v <*> many_v--    {-# INLINE some #-}-    some v = some_v--        where--        many_v = some_v <|> pure []-        some_v = (:) <$> v <*> many_v---- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as--- '<|>', it selects the first succeeding parser.----instance Monad m => MonadPlus (ParserK a m) where-    {-# INLINE mzero #-}-    mzero = die "mzero"--    {-# INLINE mplus #-}-    mplus = (<|>)--{--instance MonadTrans (ParserK a) where-    {-# INLINE lift #-}-    lift = fromEffect--}------------------------------------------------------------------------------------ Convert ParserD to ParserK----------------------------------------------------------------------------------{-# INLINE parseDToK #-}-parseDToK-    :: forall m a s b r. (Monad m, Unbox a)-    => (s -> a -> m (ParserD.Step s b))-    -> m (ParserD.Initial s b)-    -> (s -> m (ParserD.Step s b))-    -> (ParseResult b -> Int -> Input a -> m (Step a m r))-    -> Int-    -> Int-    -> Input a-    -> m (Step a m r)-parseDToK pstep initial extract cont !offset0 !usedCount !input = do-    res <- initial-    case res of-        ParserD.IPartial pst -> do-            case input of-                Chunk arr -> parseContChunk usedCount offset0 pst arr-                None -> parseContNothing usedCount pst-        ParserD.IDone b -> cont (Success offset0 b) usedCount input-        ParserD.IError err -> cont (Failure offset0 err) usedCount input--    where--    -- XXX We can maintain an absolute position instead of relative that will-    -- help in reporting of error location in the stream.-    {-# NOINLINE parseContChunk #-}-    parseContChunk !count !offset !state arr@(Array contents start end) = do-         if offset >= 0-         then go SPEC (start + offset * SIZE_OF(a)) state-         else return $ Continue offset (parseCont count state)--        where--        {-# INLINE onDone #-}-        onDone n b =-            assert (n <= Array.length arr)-                (cont (Success n b) (count + n - offset) (Chunk arr))--        {-# INLINE callParseCont #-}-        callParseCont constr n pst1 =-            assert (n < 0 || n >= Array.length arr)-                (return $ constr n (parseCont (count + n - offset) pst1))--        {-# INLINE onPartial #-}-        onPartial = callParseCont Partial--        {-# INLINE onContinue #-}-        onContinue = callParseCont Continue--        {-# INLINE onError #-}-        onError n err =-            cont (Failure n err) (count + n - offset) (Chunk arr)--        {-# INLINE onBack #-}-        onBack offset1 elemSize constr pst = do-            let pos = offset1 - start-             in if pos >= 0-                then go SPEC offset1 pst-                else constr (pos `div` elemSize) pst--        -- Note: div may be expensive but the alternative is to maintain an element-        -- offset in addition to a byte offset or just the element offset and use-        -- multiplication to get the byte offset every time, both these options-        -- turned out to be more expensive than using div.-        go !_ !cur !pst | cur >= end =-            onContinue ((end - start) `div` SIZE_OF(a))  pst-        go !_ !cur !pst = do-            let !x = unsafeInlineIO $ peekWith contents cur-            pRes <- pstep pst x-            let elemSize = SIZE_OF(a)-                next = INDEX_NEXT(cur,a)-                back n = next - n * elemSize-                curOff = (cur - start) `div` elemSize-                nextOff = (next - start) `div` elemSize-            -- The "n" here is stream position index wrt the array start, and-            -- not the backtrack count as returned by byte stream parsers.-            case pRes of-                ParserD.Done 0 b ->-                    onDone nextOff b-                ParserD.Done 1 b ->-                    onDone curOff b-                ParserD.Done n b ->-                    onDone ((back n - start) `div` elemSize) b-                ParserD.Partial 0 pst1 ->-                    go SPEC next pst1-                ParserD.Partial 1 pst1 ->-                    go SPEC cur pst1-                ParserD.Partial n pst1 ->-                    onBack (back n) elemSize onPartial pst1-                ParserD.Continue 0 pst1 ->-                    go SPEC next pst1-                ParserD.Continue 1 pst1 ->-                    go SPEC cur pst1-                ParserD.Continue n pst1 ->-                    onBack (back n) elemSize onContinue pst1-                ParserD.Error err ->-                    onError curOff err--    {-# NOINLINE parseContNothing #-}-    parseContNothing !count !pst = do-        r <- extract pst-        case r of-            -- IMPORTANT: the n here is from the byte stream parser, that means-            -- it is the backtrack element count and not the stream position-            -- index into the current input array.-            ParserD.Done n b ->-                assert (n >= 0)-                    (cont (Success (- n) b) (count - n) None)-            ParserD.Continue n pst1 ->-                assert (n >= 0)-                    (return $ Continue (- n) (parseCont (count - n) pst1))-            ParserD.Error err ->-                -- XXX It is called only when there is no input arr. So using 0-                -- as the position is correct?-                cont (Failure 0 err) count None-            ParserD.Partial _ _ -> error "Bug: parseDToK Partial unreachable"--    -- XXX Maybe we can use two separate continuations instead of using-    -- Just/Nothing cases here. That may help in avoiding the parseContJust-    -- function call.-    {-# INLINE parseCont #-}-    parseCont !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr-    parseCont !cnt !pst None = parseContNothing cnt pst---- | Convert a raw byte 'Parser' to a chunked 'ParserK'.------ /Pre-release/----{-# INLINE_LATE fromParser #-}-fromParser :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK a m b-fromParser (ParserD.Parser step initial extract) =-    MkParser $ parseDToK step initial extract--{------------------------------------------------------------------------------------ Convert CPS style 'Parser' to direct style 'D.Parser'------------------------------------------------------------------------------------ | A continuation to extract the result when a CPS parser is done.-{-# INLINE parserDone #-}-parserDone :: Monad m => ParseResult b -> Int -> Input a -> m (Step a m b)-parserDone (Success n b) _ None = return $ Done n b-parserDone (Failure n e) _ None = return $ Error n e-parserDone _ _ _ = error "Bug: toParser: called with input"---- | Convert a CPS style 'ParserK' to a direct style 'ParserD.Parser'.------ /Pre-release/----{-# INLINE_LATE toParser #-}-toParser :: Monad m => ParserK a m b -> ParserD.Parser a m b-toParser parser = ParserD.Parser step initial extract--    where--    initial = pure (ParserD.IPartial (\x -> runParser parser 0 0 x parserDone))--    step cont a = do-        r <- cont (Single a)-        return $ case r of-            Done n b -> ParserD.Done n b-            Error _ e -> ParserD.Error e-            Partial n cont1 -> ParserD.Partial n cont1-            Continue n cont1 -> ParserD.Continue n cont1--    extract cont = do-        r <- cont None-        case r of-            Done n b -> return $ ParserD.Done n b-            Error _ e -> return $ ParserD.Error e-            Partial _ cont1 -> extract cont1-            Continue n cont1 -> return $ ParserD.Continue n cont1--#ifndef DISABLE_FUSION-{-# RULES "fromParser/toParser fusion" [2]-    forall s. toParser (fromParser s) = s #-}-{-# RULES "toParser/fromParser fusion" [2]-    forall s. fromParser (toParser s) = s #-}-#endif--}
+ src/Streamly/Internal/Data/Parser/Tee.hs view
@@ -0,0 +1,617 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++#include "inline.hs"++-- |+-- Module      : Streamly.Internal.Data.Parser.ParserD.Tee+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Parallel parsers. Distributing the input to multiple parsers at the same+-- time.+--+-- For simplicity, we are using code where a particular state is unreachable+-- but it is not prevented by types.  Somehow uni-pattern match using "let"+-- produces better optimized code compared to using @case@ match and using+-- explicit error messages in unreachable cases.+--+-- There seem to be no way to silence individual warnings so we use a global+-- incomplete uni-pattern match warning suppression option for the file.+-- Disabling the warning for other code as well  has the potential to mask off+-- some legit warnings, therefore, we have segregated only the code that uses+-- uni-pattern matches in this module.++module Streamly.Internal.Data.Parser.Tee+    (+    {-+    -- Parallel zipped+      teeWith+    , teeWithFst+    , teeWithMin++    -- Parallel alternatives+    , shortest+    , longest+    -}+    )+where++{-+import Control.Exception (assert)+import Control.Monad.Catch (MonadCatch, try)+import Prelude+       hiding (any, all, takeWhile)++import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Parser.ParserD.Type+       (Initial(..), Parser(..), Step(..), ParseError)++-------------------------------------------------------------------------------+-- Distribute input to two parsers and collect both results+-------------------------------------------------------------------------------++-- When the input stream is distributed to two parsers, both the parsers can+-- backtrack independently. Therefore, we need separate buffer state for each+-- parser.+--+-- ParserK+--+-- We can keep the state of each parser in the zipper and pass around that+-- zipper to the parsers. Each parser can consume from the zipper and then pass+-- around the zipper to the other parser.+--+-- ParserD+--+-- In the approach we have taken here, the driver pushes one element at a time+-- to the tee and each of the parsers in the tee may buffer it independently+-- for backtracking. So they do not need to depend on the original stream+-- source for individual parser backtracking. Problem arises when both the+-- parsers backtrack and they do not need any input from the driver rather they+-- must consume from their buffers. For such situation we may need a+-- "Continue" style driver command from the tee so that the driver runs+-- the tee without providing it any input. Or we may need a local driver loop+-- until new input is to be demanded from the input stream.+--+-- When the tee errors out or stops, the tee driver may have to backtrack by+-- the specified amount (or the tee must return the leftover input). Therefore,+-- the tee driver also has to buffer, this leads to triple buffering.+--+-- When the tee stops we need to determine the backtracking amount from the+-- leftover of both the parsers. Since both the parsers may have consumed+-- different lengths of the stream we consider the maximum of the two as+-- consumed.+--+  -- XXX We can use Initial instead of StepState+{-# ANN type StepState Fuse #-}+data StepState s a = StepState s | StepResult a++-- | State of the pair of parsers in a tee composition+-- Note: strictness annotation is important for fusing the constructors+{-# ANN type TeeState Fuse #-}+data TeeState sL sR x a b =+-- @TeePair (past buffer, parser state, future-buffer1, future-buffer2) ...@+    TeePair !([x], StepState sL a, [x], [x]) !([x], StepState sR b, [x], [x])++{-# ANN type Res Fuse #-}+data Res = Yld Int | Stp Int | Skp | Err String++-- | See 'Streamly.Internal.Data.Parser.teeWith'.+--+-- /Broken/+--+{-# INLINE teeWith #-}+teeWith :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        return $ case resL of+            IPartial sl ->+                case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])+                                                    ([], StepResult br, [], [])+                     IError err -> IError err+            IDone bl ->+                case resR of+                     IPartial sr ->+                         IPartial $ TeePair ([], StepResult bl, [], [])+                                            ([], StepState sr, [], [])+                     IDone br -> IDone $ zf bl br+                     IError err -> IError err+            IError err -> IError err++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- XXX This is currently broken, even though both the parsers need to+    -- consume from their buffers after backtracking the driver would still be+    -- pushing more input to the buffers.+    --+    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n s ->+                let src0 = Prelude.take n buf1+                    src  = Prelude.reverse src0+                    state = ([], StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Yld n))+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            Error err -> return (undefined, Err err)++    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case (stL,stR) of+            (Yld n1, Yld n2) -> Partial (min n1 n2) next+            (Yld n1, Stp n2) -> Partial (min n1 n2) next+            (Stp n1, Yld n2) -> Partial (min n1 n2) next+            (Stp n1, Stp n2) ->+                -- Uni-pattern match results in better optimized code compared+                -- to a case match.+                let (_, StepResult rL, _, _) = l+                    (_, StepResult rR, _, _) = r+                 in Done (min n1 n2) (zf rL rR)+            (Err err, _) -> Error err+            (_, Err err) -> Error err+            _ -> Continue 0 next++    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                r@(_, StepResult rR, _, _)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        let next = TeePair l r+        -- XXX If the unused count of this stream is lower than the unused+        -- count of the stopped stream, only then this will be correct. We need+        -- to fix the other case. We need to keep incrementing the unused count+        -- of the stopped stream and take the min of the two.+        return $ case stL of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rL, _, _) = l+                 in Done n (zf rL rR)+            Skp -> Continue 0 next+            Err err -> Error err++    step (TeePair l@(_, StepResult rL, _, _)+                    (bufR, StepState sR, inpR1, inpR2)) x = do+        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        -- XXX If the unused count of this stream is lower than the unused+        -- count of the stopped stream, only then this will be correct. We need+        -- to fix the other case. We need to keep incrementing the unused count+        -- of the stopped stream and take the min of the two.+        return $ case stR of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rR, _, _) = r+                 in Done n (zf rL rR)+            Skp -> Continue 0 next+            Err err -> Error err++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        case st of+            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do+                rL <- extractL sL+                rR <- extractR sR+                return $ zf rL rR+            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do+                rL <- extractL sL+                return $ zf rL rR+            TeePair (_, StepResult  rL, _, _) (_, StepState sR, _, _) -> do+                rR <- extractR sR+                return $ zf rL rR+            TeePair (_, StepResult rL, _, _) (_, StepResult rR, _, _) ->+                return $ zf rL rR++-- | See 'Streamly.Internal.Data.Parser.teeWithFst'.+--+-- /Broken/+--+{-# INLINE teeWithFst #-}+teeWithFst :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+teeWithFst zf (Parser stepL initialL extractL)+              (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        case resL of+            IPartial sl ->+                return $ case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])+                                                    ([], StepResult br, [], [])+                     IError err -> IError err+            IDone bl ->+                case resR of+                     IPartial sr -> IDone . zf bl <$> extractR sr+                     IDone br -> return $ IDone $ zf bl br+                     IError err -> return $ IError err+            IError err -> return $ IError err++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n _ -> return (undefined, Yld n) -- Not implemented+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            Error err -> return (undefined, Err err)++    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        case (stL,stR) of+            -- XXX what if the first parser returns an unused count which is+            -- more than the second parser's unused count? It does not make+            -- sense for the second parser to consume more than the first+            -- parser. We reset the input cursor based on the first parser.+            -- Error out if the second one has consumed more then the first?+            (Stp n1, Stp _) ->+                -- Uni-pattern match results in better optimized code compared+                -- to a case match.+                let (_, StepResult rL, _, _) = l+                    (_, StepResult rR, _, _) = r+                 in return $ Done n1 (zf rL rR)+            (Stp n1, Yld _) ->+                let (_, StepResult rL, _, _) = l+                    (_, StepState  ssR, _, _) = r+                 in do+                    rR <- extractR ssR+                    return $ Done n1 (zf rL rR)+            (Yld n1, Yld n2) -> return $ Partial (min n1 n2) next+            (Yld n1, Stp n2) -> return $ Partial (min n1 n2) next+            (Err err, _) -> return $ Error err+            (_, Err err) -> return $ Error err+            _ -> return $ Continue 0 next++    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                r@(_, StepResult rR, _, _)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        let next = TeePair l r+        -- XXX If the unused count of this stream is lower than the unused+        -- count of the stopped stream, only then this will be correct. We need+        -- to fix the other case. We need to keep incrementing the unused count+        -- of the stopped stream and take the min of the two.+        return $ case stL of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rL, _, _) = l+                 in Done n (zf rL rR)+            Skp -> Continue 0 next+            Err err -> Error err++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        case st of+            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do+                rL <- extractL sL+                rR <- extractR sR+                return $ zf rL rR+            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do+                rL <- extractL sL+                return $ zf rL rR+            _ -> error "unreachable"++-- | See 'Streamly.Internal.Data.Parser.teeWithMin'.+--+-- /Unimplemented/+--+{-# INLINE teeWithMin #-}+teeWithMin ::+    -- Monad m =>+    (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+teeWithMin = undefined++-------------------------------------------------------------------------------+-- Distribute input to two parsers and choose one result+-------------------------------------------------------------------------------++-- | See 'Streamly.Internal.Data.Parser.shortest'.+--+-- /Broken/+--+{-# INLINE shortest #-}+shortest :: Monad m => Parser x m a -> Parser x m a -> Parser x m a+shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =+    Parser step initial extract++    where++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        return $ case resL of+            IPartial sl ->+                case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IDone br+                     IError err -> IError err+            IDone bl -> IDone bl+            IError errL ->+                case resR of+                     IPartial _ -> IError errL+                     IDone br -> IDone br+                     IError errR -> IError errR++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n _ -> return (undefined, Yld n) -- Not implemented+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            Error err -> return (undefined, Err err)++    -- XXX Even if a parse finished earlier it may not be shortest if the other+    -- parser finishes later but returns a lot of unconsumed input. Our current+    -- criterion of shortest is whichever parse decided to stop earlier.+    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case (stL,stR) of+            (Stp n1, _) ->+                let (_, StepResult rL, _, _) = l+                 in Done n1 rL+            (_, Stp n2) ->+                let (_, StepResult rR, _, _) = r+                 in Done n2 rR+            (Yld n1, Yld n2) -> Partial (min n1 n2) next+            (Err err, _) -> Error err+            (_, Err err) -> Error err+            _ -> Continue 0 next++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        case st of+            TeePair (_, StepState sL, _, _) _ -> extractL sL+            _ -> error "unreachable"++-- | See 'Streamly.Internal.Data.Parser.longest'.+--+-- /Broken/+--+{-# INLINE longest #-}+longest :: MonadCatch m => Parser x m a -> Parser x m a -> Parser x m a+longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where+++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        return $ case resL of+            IPartial sl ->+                case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])+                                                    ([], StepResult br, [], [])+                     IError _ ->+                         IPartial $ TeePair ([], StepState sl, [], [])+                                            ([], StepResult undefined, [], [])+            IDone bl ->+                case resR of+                     IPartial sr ->+                         IPartial $ TeePair ([], StepResult bl, [], [])+                                            ([], StepState sr, [], [])+                     IDone _ -> IDone bl+                     IError _ -> IDone bl+            IError _ ->+                case resR of+                     IPartial sr ->+                         IPartial $ TeePair ([], StepResult undefined, [], [])+                                            ([], StepState sr, [], [])+                     IDone br -> IDone br+                     IError err -> IError err++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n _ -> return (undefined, Yld n) -- Not implemented+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            Error err -> return (undefined, Err err)++    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case (stL,stR) of+            (Yld n1, Yld n2) -> Partial (min n1 n2) next+            (Yld n1, Stp n2) -> Partial (min n1 n2) next+            (Stp n1, Yld n2) -> Partial (min n1 n2) next+            (Stp n1, Stp n2) ->+                let (_, StepResult rL, _, _) = l+                    (_, StepResult rR, _, _) = r+                 in Done (max n1 n2) (if n1 >= n2 then rL else rR)+            (Err err, _) -> Error err+            (_, Err err) -> Error err+            _ -> Continue 0 next++    -- XXX the parser that finishes last may not be the longest because it may+    -- return a lot of unused input which makes it shorter. Our current+    -- criterion of deciding longest is based on whoever decides to finish+    -- last and not whoever consumed more input.+    --+    -- To actually know who made more progress we need to keep an account of+    -- how many items are unconsumed since the last yield.+    --+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                r@(_, StepResult _, _, _)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        let next = TeePair l r+        return $ case stL of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rL, _, _) = l+                 in Done n rL+            Skp -> Continue 0 next+            Err err -> Error err++    step (TeePair l@(_, StepResult _, _, _)+                    (bufR, StepState sR, inpR1, inpR2)) x = do+        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case stR of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rR, _, _) = r+                 in Done n rR+            Skp -> Continue 0 next+            Err err -> Error err++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        -- XXX When results are partial we may not be able to precisely compare+        -- which parser has made more progress till now.  One way to do that is+        -- to figure out the actually consumed input up to the last yield.+        --+        case st of+            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do+                r <- try $ extractL sL+                case r of+                    Left (_ :: ParseError) -> extractR sR+                    Right b -> return b+            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do+                r <- try $ extractL sL+                case r of+                    Left (_ :: ParseError) -> return rR+                    Right b -> return b+            TeePair (_, StepResult rL, _, _) (_, StepState sR, _, _) -> do+                r <- try $ extractR sR+                case r of+                    Left (_ :: ParseError) -> return rL+                    Right b -> return b+            TeePair (_, StepResult _, _, _) (_, StepResult _, _, _) ->+                error "unreachable"+-}
+ src/Streamly/Internal/Data/Parser/Type.hs view
@@ -0,0 +1,1452 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Parser.ParserD.Type+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Streaming and backtracking parsers.+--+-- Parsers just extend folds.  Please read the 'Fold' design notes in+-- "Streamly.Internal.Data.Fold.Type" for background on the design.+--+-- = Parser Design+--+-- The 'Parser' type or a parsing fold is a generalization of the 'Fold' type.+-- The 'Fold' type /always/ succeeds on each input. Therefore, it does not need+-- to buffer the input. In contrast, a 'Parser' may fail and backtrack to+-- replay the input again to explore another branch of the parser. Therefore,+-- it needs to buffer the input. Therefore, a 'Parser' is a fold with some+-- additional requirements.  To summarize, unlike a 'Fold', a 'Parser':+--+-- 1. may not generate a new value of the accumulator on every input, it may+-- generate a new accumulator only after consuming multiple input elements+-- (e.g. takeEQ).+-- 2. on success may return some unconsumed input (e.g. takeWhile)+-- 3. may fail and return all input without consuming it (e.g. satisfy)+-- 4. backtrack and start inspecting the past input again (e.g. alt)+--+-- These use cases require buffering and replaying of input.  To facilitate+-- this, the step function of the 'Fold' is augmented to return the next state+-- of the fold along with a command tag using a 'Step' functor, the tag tells+-- the fold driver to manipulate the future input as the parser wishes. The+-- 'Step' functor provides the following commands to the fold driver+-- corresponding to the use cases outlined in the previous para:+--+-- 1. 'Continue': buffer the current input and optionally go back to a previous+--    position in the stream+-- 2. 'Partial': buffer the current input and optionally go back to a previous+--    position in the stream, drop the buffer before that position.+-- 3. 'Done': parser succeeded, returns how much input was leftover+-- 4. 'Error': indicates that the parser has failed without a result+--+-- = How a Parser Works?+--+-- A parser is just like a fold, it keeps consuming inputs from the stream and+-- accumulating them in an accumulator. The accumulator of the parser could be+-- a singleton value or it could be a collection of values e.g. a list.+--+-- The parser may build a new output value from multiple input items. When it+-- consumes an input item but needs more input to build a complete output item+-- it uses @Continue 0 s@, yielding the intermediate state @s@ and asking the+-- driver to provide more input.  When the parser determines that a new output+-- value is complete it can use a @Done n b@ to terminate the parser with @n@+-- items of input unused and the final value of the accumulator returned as+-- @b@. If at any time the parser determines that the parse has failed it can+-- return @Error err@.+--+-- A parser building a collection of values (e.g. a list) can use the @Partial@+-- constructor whenever a new item in the output collection is generated. If a+-- parser building a collection of values has yielded at least one value then+-- it is considered successful and cannot fail after that. In the current+-- implementation, this is not automatically enforced, there is a rule that the+-- parser MUST use only @Done@ for termination after the first @Partial@, it+-- cannot use @Error@. It may be possible to change the implementation so that+-- this rule is not required, but there may be some performance cost to it.+--+-- 'Streamly.Internal.Data.Parser.takeWhile' and+-- 'Streamly.Internal.Data.Parser.some' combinators are good examples of+-- efficient implementations using all features of this representation.  It is+-- possible to idiomatically build a collection of parsed items using a+-- singleton parser and @Alternative@ instance instead of using a+-- multi-yield parser.  However, this implementation is amenable to stream+-- fusion and can therefore be much faster.+--+-- = Error Handling+--+-- When a parser's @step@ function is invoked it may terminate by either a+-- 'Done' or an 'Error' return value. In an 'Alternative' composition an error+-- return can make the composed parser backtrack and try another parser.+--+-- If the stream stops before a parser could terminate then we use the+-- @extract@ function of the parser to retrieve the last yielded value of the+-- parser. If the parser has yielded at least one value then @extract@ MUST+-- return a value without throwing an error, otherwise it uses the 'ParseError'+-- exception to throw an error.+--+-- We chose the exception throwing mechanism for @extract@ instead of using an+-- explicit error return via an 'Either' type for keeping the interface simple+-- as most of the time we do not need to catch the error in intermediate+-- layers. Note that we cannot use exception throwing mechanism in @step@+-- function because of performance reasons. 'Error' constructor in that case+-- allows loop fusion and better performance.+--+-- = Optimizing backtracking+--+-- == Applicative Composition+--+-- If a parser once returned 'Partial' it can never fail after that. This is+-- used to reduce the buffering. A 'Partial' results in dropping the buffer and+-- we cannot backtrack before that point.+--+-- Parsers can be composed using an Alternative, if we are in an alternative+-- composition we may have to backtrack to try the other branch.  When we+-- compose two parsers using applicative @f <$> p1 <*> p2@ we can return a+-- 'Partial' result only after both the parsers have succeeded. While running+-- @p1@ we have to ensure that the input is not dropped until we have run @p2@,+-- therefore we have to return a Continue instead of a Partial.+--+-- However, if we know they both cannot fail then we know that the composed+-- parser can never fail.  For this reason we should have "backtracking folds"+-- as a separate type so that we can compose them in an efficient manner. In p1+-- itself we can drop the buffer as soon as a 'Partial' result arrives. In+-- fact, there is no Alternative composition for folds because they cannot+-- fail.+--+-- == Alternative Composition+--+-- In @p1 <|> p2@ as soon as the parser p1 returns 'Partial' we know that it+-- will not fail and we can immediately drop the buffer.+--+-- If we are not using the parser in an alternative composition we can+-- downgrade the parser to a backtracking fold and use the "backtracking+-- fold"'s applicative for more efficient implementation. To downgrade we can+-- translate the "Error" of parser to an exception.  This gives us best of both+-- worlds, the applicative as well as alternative would have optimal+-- backtracking buffer.+--+-- The "many" for parsers would be different than "many" for folds. In case of+-- folds an error would be propagated. In case of parsers the error would be+-- ignored.+--+-- = Implementation Approach+--+-- Backtracking folds have an issue with tee style composition because each+-- fold can backtrack independently, we will need independent buffers. Though+-- this may be possible to implement it may not be efficient especially for+-- folds that do not backtrack at all. Three types are possible, optimized for+-- different use cases:+--+-- * Non-backtracking folds: efficient Tee+-- * Backtracking folds: efficient applicative+-- * Parsers: alternative+--+-- Downgrade parsers to backtracking folds for applicative used without+-- alternative.  Upgrade backtracking folds to parsers when we have to use them+-- as the last alternative.+--+-- = Future Work+--+-- It may make sense to move "takeWhile" type of parsers, which cannot fail but+-- need some lookahead, to splitting folds.  This will allow such combinators+-- to be accepted where we need an unfailing "Fold" type.+--+-- Based on application requirements it should be possible to design even a+-- richer interface to manipulate the input stream/buffer. For example, we+-- could randomly seek into the stream in the forward or reverse directions or+-- we can even seek to the end or from the end or seek from the beginning.+--+-- We can distribute and scan/parse a stream using both folds and parsers and+-- merge the resulting streams using different merge strategies (e.g.+-- interleaving or serial).+--+-- == Naming+--+-- As far as possible, try that the names of the combinators in this module are+-- consistent with:+--+-- * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>+-- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>+-- * <http://hackage.haskell.org/package/megaparsec megaparsec>+-- * <http://hackage.haskell.org/package/attoparsec attoparsec>+-- * <http://hackage.haskell.org/package/parsec parsec>++module Streamly.Internal.Data.Parser.Type+    (+    -- * Types+      Initial (..)+    , Step (..)+    , extractStep+    , bimapOverrideCount+    , Parser (..)+    , ParseError (..)+    , rmapM++    -- * Constructors++    , fromPure+    , fromEffect+    , splitWith+    , split_++    , die+    , dieM+    , splitSome -- parseSome?+    , splitMany -- parseMany?+    , splitManyPost+    , alt+    , concatMap++    -- * Input transformation+    , lmap+    , lmapM+    , filter++    , noErrorUnsafeSplitWith+    , noErrorUnsafeSplit_+    , noErrorUnsafeConcatMap+    )+where++#include "inline.hs"+#include "assert.hs"++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Applicative (Alternative(..))+import Control.Exception (Exception(..))+-- import Control.Monad (MonadPlus(..), (>=>))+import Control.Monad ((>=>))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Bifunctor (Bifunctor(..))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Fold.Type (Fold(..), toList)++import qualified Control.Monad.Fail as Fail+import qualified Streamly.Internal.Data.Fold.Type as FL++import Prelude hiding (concatMap, filter)++#include "DocTestDataParser.hs"++-- XXX The only differences between Initial and Step types are:+--+-- * There are no backtracking counts in Initial+-- * Continue and Partial are the same. Ideally Partial should mean that an+-- empty result is valid and can be extracted; and Continue should mean that+-- empty would result in an error on extraction. We can possibly distinguish+-- the two cases.+--+-- If we ignore the backtracking counts we can represent the Initial type using+-- Step itself. That will also simplify the implementation of various parsers+-- where the processing in intiial is just a sepcial case of step, see+-- takeBetween for example.++-- | The type of a 'Parser''s initial action.+--+-- /Internal/+--+{-# ANN type Initial Fuse #-}+data Initial s b+    = IPartial !s   -- ^ Wait for step function to be called with state @s@.+    | IDone !b      -- ^ Return a result right away without an input.+    | IError !String -- ^ Return an error right away without an input.++-- | @first@ maps on 'IPartial' and @second@ maps on 'IDone'.+--+-- /Internal/+--+instance Bifunctor Initial where+    {-# INLINE bimap #-}+    bimap f _ (IPartial a) = IPartial (f a)+    bimap _ g (IDone b) = IDone (g b)+    bimap _ _ (IError err) = IError err++-- | Maps a function over the result held by 'IDone'.+--+-- >>> fmap = second+--+-- /Internal/+--+instance Functor (Initial s) where+    {-# INLINE fmap #-}+    fmap = second++-- We can simplify the Step type as follows:+--+-- Partial Int (Either s (s, b)) -- Left continue, right partial result+-- Done Int (Either String b)+--+-- In this case Error may also have a "leftover" return. This means that after+-- several successful partial results the last segment parsing failed and we+-- are returning the leftover of that. The driver may choose to restart from+-- the last segment where this parser failed or from the beginning.+--+-- Folds can only return the right values. Parsers can also return lefts.++-- | The return type of a 'Parser' step.+--+-- The parse operation feeds the input stream to the parser one element at a+-- time, representing a parse 'Step'. The parser may or may not consume the+-- item and returns a result. If the result is 'Partial' we can either extract+-- the result or feed more input to the parser. If the result is 'Continue', we+-- must feed more input in order to get a result. If the parser returns 'Done'+-- then the parser can no longer take any more input.+--+-- If the result is 'Continue', the parse operation retains the input in a+-- backtracking buffer, in case the parser may ask to backtrack in future.+-- Whenever a 'Partial n' result is returned we first backtrack by @n@ elements+-- in the input and then release any remaining backtracking buffer. Similarly,+-- 'Continue n' backtracks to @n@ elements before the current position and+-- starts feeding the input from that point for future invocations of the+-- parser.+--+-- If parser is not yet done, we can use the @extract@ operation on the @state@+-- of the parser to extract a result. If the parser has not yet yielded a+-- result, the operation fails with a 'ParseError' exception. If the parser+-- yielded a 'Partial' result in the past the last partial result is returned.+-- Therefore, if a parser yields a partial result once it cannot fail later on.+--+-- The parser can never backtrack beyond the position where the last partial+-- result left it at. The parser must ensure that the backtrack position is+-- always after that.+--+-- /Pre-release/+--+{-# ANN type Step Fuse #-}+data Step s b =+        Partial !Int !s+    -- ^ @Partial count state@. The following hold on Partial result:+    --+    -- 1. @extract@ on @state@ would succeed and give a result.+    -- 2. Input stream position is reset to @current position - count@.+    -- 3. All input before the new position is dropped. The parser can+    -- never backtrack beyond this position.++    | Continue !Int !s+    -- ^ @Continue count state@. The following hold on a Continue result:+    --+    -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would+    -- give that result as 'Done' otherwise it may return 'Error' or+    -- 'Continue'.+    -- 2. Input stream position is reset to @current position - count@.+    -- 3. the input is retained in a backtrack buffer.++    | Done !Int !b+    -- ^ Done with leftover input count and result.+    --+    -- @Done count result@ means the parser has finished, it will accept no+    -- more input, last @count@ elements from the input are unused and the+    -- result of the parser is in @result@.++    | Error !String+    -- ^ Parser failed without generating any output.+    --+    -- The parsing operation may backtrack to the beginning and try another+    -- alternative.++-- | Map first function over the state and second over the result.+instance Bifunctor Step where+    {-# INLINE bimap #-}+    bimap f g step =+        case step of+            Partial n s -> Partial n (f s)+            Continue n s -> Continue n (f s)+            Done n b -> Done n (g b)+            Error err -> Error err++-- | Bimap discarding the count, and using the supplied count instead.+bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1+bimapOverrideCount n f g step =+    case step of+        Partial _ s -> Partial n (f s)+        Continue _ s -> Continue n (f s)+        Done _ b -> Done n (g b)+        Error err -> Error err++-- | fmap = second+instance Functor (Step s) where+    {-# INLINE fmap #-}+    fmap = second++{-# INLINE assertStepCount #-}+assertStepCount :: Int -> Step s b -> Step s b+assertStepCount i step =+    case step of+        Partial n _ -> assert (i == n) step+        Continue n _ -> assert (i == n) step+        Done n _ -> assert (i == n) step+        Error _ -> step++-- | Map an extract function over the state of Step+--+{-# INLINE extractStep #-}+extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)+extractStep f res =+    case res of+        Partial n s1 -> assertStepCount n <$> f s1+        Done n b -> return $ Done n b+        Continue n s1 -> assertStepCount n <$> f s1+        Error err -> return $ Error err++-- | Map a monadic function over the result @b@ in @Step s b@.+--+-- /Internal/+{-# INLINE mapMStep #-}+mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)+mapMStep f res =+    case res of+        Partial n s -> pure $ Partial n s+        Done n b -> Done n <$> f b+        Continue n s -> pure $ Continue n s+        Error err -> pure $ Error err++-- | A parser is a fold that can fail and is represented as @Parser step+-- initial extract@. Before we drive a parser we call the @initial@ action to+-- retrieve the initial state of the fold. The parser driver invokes @step@+-- with the state returned by the previous step and the next input element. It+-- results into a new state and a command to the driver represented by 'Step'+-- type. The driver keeps invoking the step function until it stops or fails.+-- At any point of time the driver can call @extract@ to inspect the result of+-- the fold. If the parser hits the end of input 'extract' is called.+-- It may result in an error or an output value.+--+-- /Pre-release/+--+data Parser a m b =+    forall s. Parser+        (s -> a -> m (Step s b))+        -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is+        -- same as Partial 0. In other words it cannot backtrack.+        (m (Initial s b))+        -- Extract can only return Partial or Continue n. In other words it can+        -- only backtrack or return partial result/error. But we do not return+        -- result in Partial, therefore, we have to use Done instead of Partial.+        (s -> m (Step s b))++-- | This exception is used when a parser ultimately fails, the user of the+-- parser is intimated via this exception.+--+-- /Pre-release/+--+newtype ParseError = ParseError String+    deriving Show++instance Exception ParseError where+    displayException (ParseError err) = err++-- | Map a function on the result i.e. on @b@ in @Parser a m b@.+instance Functor m => Functor (Parser a m) where+    {-# INLINE fmap #-}+    fmap f (Parser step1 initial1 extract) =+        Parser step initial (fmap3 f extract)++        where++        initial = fmap2 f initial1+        step s b = fmap2 f (step1 s b)+        fmap2 g = fmap (fmap g)+        fmap3 g = fmap2 (fmap g)++------------------------------------------------------------------------------+-- Mapping on the output+------------------------------------------------------------------------------++-- | @rmapM f parser@ maps the monadic function @f@ on the output of the parser.+--+-- >>> rmap = fmap+{-# INLINE rmapM #-}+rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c+rmapM f (Parser step initial extract) =+    Parser step1 initial1 (extract >=> mapMStep f)++    where++    initial1 = do+        res <- initial+        -- this is mapM f over result+        case res of+            IPartial x -> return $ IPartial x+            IDone a -> IDone <$> f a+            IError err -> return $ IError err+    step1 s a = step s a >>= mapMStep f++-- | A parser that always yields a pure value without consuming any input.+--+{-# INLINE_NORMAL fromPure #-}+fromPure :: Monad m => b -> Parser a m b+fromPure b = Parser undefined (pure $ IDone b) undefined++-- | A parser that always yields the result of an effectful action without+-- consuming any input.+--+{-# INLINE fromEffect #-}+fromEffect :: Monad m => m b -> Parser a m b+fromEffect b = Parser undefined (IDone <$> b) undefined++-------------------------------------------------------------------------------+-- Sequential applicative+-------------------------------------------------------------------------------++{-# ANN type SeqParseState Fuse #-}+data SeqParseState sl f sr = SeqParseL !sl | SeqParseR !f !sr++-- Note: this implementation of splitWith is fast because of stream fusion but+-- has quadratic time complexity, because each composition adds a new branch+-- that each subsequent parse's input element has to go through, therefore, it+-- cannot scale to a large number of compositions. After around 100+-- compositions the performance starts dipping rapidly beyond a CPS style+-- unfused implementation.+--+-- Note: This is a parsing dual of appending streams using+-- 'Streamly.Data.Stream.append', it splits the streams using two parsers and+-- zips the results.++-- | Sequential parser application. Apply two parsers sequentially to an input+-- stream. The first parser runs and processes the input, the remaining input+-- is then passed to the second parser. If both parsers succeed, their outputs+-- are combined using the supplied function. If either parser fails, the+-- operation fails.+--+-- This combinator delivers high performance by stream fusion but it comes with+-- some limitations. For those cases use the 'Applicative' instance of+-- 'Streamly.Data.ParserK.ParserK'.+--+-- CAVEAT 1: NO RECURSION. This function is strict in both arguments. As a+-- result, if a parser is defined recursively using this, it may cause an+-- infintie loop. The following example checks the strictness:+--+-- >>> p = Parser.splitWith const (Parser.satisfy (> 0)) undefined+-- >>> Stream.parse p $ Stream.fromList [1]+-- *** Exception: Prelude.undefined+-- ...+--+-- CAVEAT 2: QUADRATIC TIME COMPLEXITY. Static composition is fast due to+-- stream fusion, but it works well only for limited (e.g. up to 8)+-- compositions, use "Streamly.Data.ParserK" for larger compositions.+--+-- Below are some common idioms that can be expressed using 'splitWith':+--+-- >>> span p f1 f2 = Parser.splitWith (,) (Parser.takeWhile p f1) (Parser.fromFold f2)+-- >>> spanBy eq f1 f2 = Parser.splitWith (,) (Parser.groupBy eq f1) (Parser.fromFold f2)+--+-- /Pre-release/+--+{-# INLINE splitWith #-}+splitWith :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+splitWith func (Parser stepL initialL extractL)+               (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    initial = do+        -- XXX We can use bimap here if we make this a Step type+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqParseL sl+            IDone bl -> do+                resR <- initialR+                -- XXX We can use bimap here if we make this a Step type+                return $ case resR of+                    IPartial sr -> IPartial $ SeqParseR (func bl) sr+                    IDone br -> IDone (func bl br)+                    IError err -> IError err+            IError err -> return $ IError err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a Done at some point.+    step (SeqParseL st) a = do+        -- Important: Please do not use Applicative here. See+        -- https://github.com/composewell/streamly/issues/1033 and the problem+        -- defined in split_ for more info.+        -- XXX Use bimap+        resL <- stepL st a+        case resL of+            -- Note: We need to buffer the input for a possible Alternative+            -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to+            -- backtrack and start running p3. So we need to keep the input+            -- buffered until we know that the applicative cannot fail.+            Partial n s -> return $ Continue n (SeqParseL s)+            Continue n s -> return $ Continue n (SeqParseL s)+            Done n b -> do+                -- XXX Use bimap if we make this a Step type+                -- fmap (bimap (SeqParseR (func b)) (func b)) initialR+                initR <- initialR+                return $ case initR of+                   IPartial sr -> Continue n $ SeqParseR (func b) sr+                   IDone br -> Done n (func b br)+                   IError err -> Error err+            Error err -> return $ Error err++    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)++    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)+    extract (SeqParseL sL) = do+        -- XXX Use bimap here+        rL <- extractL sL+        case rL of+            Done n bL -> do+                -- XXX Use bimap here if we use Step type in Initial+                iR <- initialR+                case iR of+                    IPartial sR -> do+                        fmap+                            (bimap (SeqParseR (func bL)) (func bL))+                            (extractR sR)+                    IDone bR -> return $ Done n $ func bL bR+                    IError err -> return $ Error err+            Error err -> return $ Error err+            Partial _ _ -> error "Bug: splitWith extract 'Partial'"+            Continue n s -> return $ Continue n (SeqParseL s)++-------------------------------------------------------------------------------+-- Sequential applicative for backtracking folds+-------------------------------------------------------------------------------++-- XXX Create a newtype for nonfailing parsers and downgrade the parser to that+-- type before this operation and then upgrade.+--+-- We can do an inspection testing to reject unwanted constructors at compile+-- time.+--+-- We can use the compiler to automatically annotate accumulators, terminating+-- folds, non-failing parsers and failing parsers.++-- | Better performance 'splitWith' for non-failing parsers.+--+-- Does not work correctly for parsers that can fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+{-# INLINE noErrorUnsafeSplitWith #-}+noErrorUnsafeSplitWith :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+noErrorUnsafeSplitWith func (Parser stepL initialL extractL)+               (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    errMsg e = error $ "noErrorUnsafeSplitWith: unreachable: " ++ e++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqParseL sl+            IDone bl -> do+                resR <- initialR+                return $ bimap (SeqParseR (func bl)) (func bl) resR+            IError err -> errMsg err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a Done at some point.+    step (SeqParseL st) a = do+        r <- stepL st a+        case r of+            -- Assume that the parser can never fail, therefore, we do not+            -- need to keep the input for backtracking.+            Partial n s -> return $ Partial n (SeqParseL s)+            Continue n s -> return $ Continue n (SeqParseL s)+            Done n b -> do+                res <- initialR+                return+                    $ case res of+                          IPartial sr -> Partial n $ SeqParseR (func b) sr+                          IDone br -> Done n (func b br)+                          IError err -> errMsg err+            Error err -> errMsg err++    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)++    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)++    extract (SeqParseL sL) = do+        rL <- extractL sL+        case rL of+            Done n bL -> do+                iR <- initialR+                case iR of+                    IPartial sR -> do+                        rR <- extractR sR+                        return+                            $ bimapOverrideCount+                                n (SeqParseR (func bL)) (func bL) rR+                    IDone bR -> return $ Done n $ func bL bR+                    IError err -> errMsg err+            Error err -> errMsg err+            Partial _ _ -> errMsg "Partial"+            Continue n s -> return $ Continue n (SeqParseL s)++{-# ANN type SeqAState Fuse #-}+data SeqAState sl sr = SeqAL !sl | SeqAR !sr++-- This turns out to be slightly faster than splitWith++-- | Sequential parser application ignoring the output of the first parser.+-- Apply two parsers sequentially to an input stream.  The input is provided to+-- the first parser, when it is done the remaining input is provided to the+-- second parser. The output of the parser is the output of the second parser.+-- The operation fails if any of the parsers fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+-- This implementation is strict in the second argument, therefore, the+-- following will fail:+--+-- >>> Stream.parse (Parser.split_ (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]+-- *** Exception: Prelude.undefined+-- ...+--+-- /Pre-release/+--+{-# INLINE split_ #-}+split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqAL sl+            IDone _ -> do+                resR <- initialR+                return $ first SeqAR resR+            IError err -> return $ IError err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a Done at some point.+    step (SeqAL st) a = do+        -- Important: Do not use Applicative here. Applicative somehow caused+        -- the right action to run many times, not sure why though.+        resL <- stepL st a+        case resL of+            -- Note: this leads to buffering even if we are not in an+            -- Alternative composition.+            Partial n s -> return $ Continue n (SeqAL s)+            Continue n s -> return $ Continue n (SeqAL s)+            Done n _ -> do+                initR <- initialR+                return $ case initR of+                    IPartial s -> Continue n (SeqAR s)+                    IDone b -> Done n b+                    IError err -> Error err+            Error err -> return $ Error err++    step (SeqAR st) a = first SeqAR <$> stepR st a++    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)+    extract (SeqAL sL) = do+        rL <- extractL sL+        case rL of+            Done n _ -> do+                iR <- initialR+                -- XXX For initial we can have a bimap with leftover.+                case iR of+                    IPartial sR ->+                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)+                    IDone bR -> return $ Done n bR+                    IError err -> return $ Error err+            Error err -> return $ Error err+            Partial _ _ -> error "split_: Partial"+            Continue n s -> return $ Continue n (SeqAL s)++-- | Better performance 'split_' for non-failing parsers.+--+-- Does not work correctly for parsers that can fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+{-# INLINE noErrorUnsafeSplit_ #-}+noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+noErrorUnsafeSplit_+    (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    errMsg e = error $ "noErrorUnsafeSplit_: unreachable: " ++ e++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqAL sl+            IDone _ -> do+                resR <- initialR+                return $ first SeqAR resR+            IError err -> errMsg err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a Done at some point.+    step (SeqAL st) a = do+        -- Important: Please do not use Applicative here. Applicative somehow+        -- caused the next action to run many times in the "tar" parsing code,+        -- not sure why though.+        resL <- stepL st a+        case resL of+            Partial n s -> return $ Partial n (SeqAL s)+            Continue n s -> return $ Continue n (SeqAL s)+            Done n _ -> do+                initR <- initialR+                return $ case initR of+                    IPartial s -> Partial n (SeqAR s)+                    IDone b -> Done n b+                    IError err -> errMsg err+            Error err -> errMsg err++    step (SeqAR st) a = first SeqAR <$> stepR st a++    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)+    extract (SeqAL sL) = do+        rL <- extractL sL+        case rL of+            Done n _ -> do+                iR <- initialR+                case iR of+                    IPartial sR -> do+                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)+                    IDone bR -> return $ Done n bR+                    IError err -> errMsg err+            Error err -> errMsg err+            Partial _ _ -> error "split_: Partial"+            Continue n s -> return $ Continue n (SeqAL s)++-- | READ THE CAVEATS in 'splitWith' before using this instance.+--+-- >>> pure = Parser.fromPure+-- >>> (<*>) = Parser.splitWith id+-- >>> (*>) = Parser.split_+instance Monad m => Applicative (Parser a m) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = splitWith id++    {-# INLINE (*>) #-}+    (*>) = split_++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++-------------------------------------------------------------------------------+-- Sequential Alternative+-------------------------------------------------------------------------------++{-# ANN type AltParseState Fuse #-}+data AltParseState sl sr = AltParseL !Int !sl | AltParseR !sr++-- Note: this implementation of alt is fast because of stream fusion but has+-- quadratic time complexity, because each composition adds a new branch that+-- each subsequent alternative's input element has to go through, therefore, it+-- cannot scale to a large number of compositions++-- | Sequential alternative. The input is first passed to the first parser,+-- if it succeeds, the result is returned. However, if the first parser fails,+-- the parser driver backtracks and tries the same input on the second+-- (alternative) parser, returning the result if it succeeds.+--+-- This combinator delivers high performance by stream fusion but it comes with+-- some limitations. For those cases use the 'Alternative' instance of+-- 'Streamly.Data.ParserK.ParserK'.+--+-- CAVEAT 1: NO RECURSION. This function is strict in both arguments. As a+-- result, if a parser is defined recursively using this, it may cause an+-- infintie loop. The following example checks the strictness:+--+-- >>> p = Parser.satisfy (> 0) `Parser.alt` undefined+-- >>> Stream.parse p $ Stream.fromList [1..10]+-- *** Exception: Prelude.undefined+--+-- CAVEAT 2: QUADRATIC TIME COMPLEXITY. Static composition is fast due to+-- stream fusion, but it works well only for limited (e.g. up to 8)+-- compositions, use "Streamly.Data.ParserK" for larger compositions.+--+-- /Time Complexity:/ O(n^2) where n is the number of compositions.+--+-- /Pre-release/+--+{-# INLINE alt #-}+alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a+alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ AltParseL 0 sl+            IDone bl -> return $ IDone bl+            IError _ -> do+                resR <- initialR+                return $ case resR of+                    IPartial sr -> IPartial $ AltParseR sr+                    IDone br -> IDone br+                    IError err -> IError err++    -- Once a parser yields at least one value it cannot fail.  This+    -- restriction helps us make backtracking more efficient, as we do not need+    -- to keep the consumed items buffered after a yield. Note that we do not+    -- enforce this and if a misbehaving parser does not honor this then we can+    -- get unexpected results. XXX Can we detect and flag this?+    step (AltParseL cnt st) a = do+        r <- stepL st a+        case r of+            Partial n s -> return $ Partial n (AltParseL 0 s)+            Continue n s -> do+                assertM(cnt + 1 - n >= 0)+                return $ Continue n (AltParseL (cnt + 1 - n) s)+            Done n b -> return $ Done n b+            Error _ -> do+                res <- initialR+                return+                    $ case res of+                          IPartial rR -> Continue (cnt + 1) (AltParseR rR)+                          IDone b -> Done (cnt + 1) b+                          IError err -> Error err++    step (AltParseR st) a = do+        r <- stepR st a+        return $ case r of+            Partial n s -> Partial n (AltParseR s)+            Continue n s -> Continue n (AltParseR s)+            Done n b -> Done n b+            Error err -> Error err++    extract (AltParseR sR) = fmap (first AltParseR) (extractR sR)++    extract (AltParseL cnt sL) = do+        rL <- extractL sL+        case rL of+            Done n b -> return $ Done n b+            Error _ -> do+                res <- initialR+                return+                    $ case res of+                          IPartial rR -> Continue cnt (AltParseR rR)+                          IDone b -> Done cnt b+                          IError err -> Error err+            Partial _ _ -> error "Bug: alt: extractL 'Partial'"+            Continue n s -> do+                assertM(n == cnt)+                return $ Continue n (AltParseL 0 s)++{-# ANN type Fused3 Fuse #-}+data Fused3 a b c = Fused3 !a !b !c++-- | See documentation of 'Streamly.Internal.Data.Parser.many'.+--+-- /Pre-release/+--+{-# INLINE splitMany #-}+splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    handleCollect partial done fres =+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ partial $ Fused3 ps 0 fs+                    IDone pb ->+                        runCollectorWith (handleCollect partial done) fs pb+                    IError _ -> done <$> ffinal fs+            FL.Done fb -> return $ done fb++    runCollectorWith cont fs pb = fstep fs pb >>= cont++    -- See notes in Fold.many for the reason why the parser must be initialized+    -- right away instead of on first input.+    initial = finitial >>= handleCollect IPartial IDone++    {-# INLINE step #-}+    step (Fused3 st cnt fs) a = do+        r <- step1 st a+        let cnt1 = cnt + 1+        case r of+            Partial n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) fs)+            Continue n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) fs)+            Done n b -> do+                assertM(cnt1 - n >= 0)+                fstep fs b >>= handleCollect (Partial n) (Done n)+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt xs++    extract (Fused3 _ 0 fs) = fmap (Done 0) (ffinal fs)+    extract (Fused3 s cnt fs) = do+        r <- extract1 s+        case r of+            Error _ -> fmap (Done cnt) (ffinal fs)+            Done n b -> do+                assertM(n <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    FL.Partial s1 -> fmap (Done n) (ffinal s1)+                    FL.Done b1 -> return (Done n b1)+            Partial _ _ -> error "splitMany: Partial in extract"+            Continue n s1 -> do+                assertM(n == cnt)+                return (Continue n (Fused3 s1 0 fs))++-- | Like splitMany, but inner fold emits an output at the end even if no input+-- is received.+--+-- /Internal/+--+{-# INLINE splitManyPost #-}+splitManyPost :: Monad m =>  Parser a m b -> Fold m b c -> Parser a m c+splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    handleCollect partial done fres =+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ partial $ Fused3 ps 0 fs+                    IDone pb ->+                        runCollectorWith (handleCollect partial done) fs pb+                    IError _ -> done <$> ffinal fs+            FL.Done fb -> return $ done fb++    runCollectorWith cont fs pb = fstep fs pb >>= cont++    initial = finitial >>= handleCollect IPartial IDone++    {-# INLINE step #-}+    step (Fused3 st cnt fs) a = do+        r <- step1 st a+        let cnt1 = cnt + 1+        case r of+            Partial n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) fs)+            Continue n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) fs)+            Done n b -> do+                assertM(cnt1 - n >= 0)+                fstep fs b >>= handleCollect (Partial n) (Done n)+            Error _ -> do+                xs <- ffinal fs+                return $ Done cnt1 xs++    extract (Fused3 s cnt fs) = do+        r <- extract1 s+        case r of+            Error _ -> fmap (Done cnt) (ffinal fs)+            Done n b -> do+                assertM(n <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    FL.Partial s1 -> fmap (Done n) (ffinal s1)+                    FL.Done b1 -> return (Done n b1)+            Partial _ _ -> error "splitMany: Partial in extract"+            Continue n s1 -> do+                assertM(n == cnt)+                return (Continue n (Fused3 s1 0 fs))++-- | See documentation of 'Streamly.Internal.Data.Parser.some'.+--+-- /Pre-release/+--+{-# INLINE splitSome #-}+splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+splitSome (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    handleCollect partial done fres =+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ partial $ Fused3 ps 0 $ Right fs+                    IDone pb ->+                        runCollectorWith (handleCollect partial done) fs pb+                    IError _ -> done <$> ffinal fs+            FL.Done fb -> return $ done fb++    runCollectorWith cont fs pb = fstep fs pb >>= cont++    initial = do+        fres <- finitial+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ IPartial $ Fused3 ps 0 $ Left fs+                    IDone pb ->+                        runCollectorWith (handleCollect IPartial IDone) fs pb+                    IError err -> return $ IError err+            FL.Done _ ->+                return+                    $ IError+                    $ "splitSome: The collecting fold terminated without"+                          ++ " consuming any elements."++    {-# INLINE step #-}+    step (Fused3 st cnt (Left fs)) a = do+        r <- step1 st a+        -- In the Left state, count is used only for the assert+        let cnt1 = cnt + 1+        case r of+            Partial n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) (Left fs))+            Continue n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) (Left fs))+            Done n b -> do+                assertM(cnt1 - n >= 0)+                fstep fs b >>= handleCollect (Partial n) (Done n)+            Error err -> return $ Error err+    step (Fused3 st cnt (Right fs)) a = do+        r <- step1 st a+        let cnt1 = cnt + 1+        case r of+            Partial n s -> do+                assertM(cnt1 - n >= 0)+                return $ Partial n (Fused3 s (cnt1 - n) (Right fs))+            Continue n s -> do+                assertM(cnt1 - n >= 0)+                return $ Continue n (Fused3 s (cnt1 - n) (Right fs))+            Done n b -> do+                assertM(cnt1 - n >= 0)+                fstep fs b >>= handleCollect (Partial n) (Done n)+            Error _ -> Done cnt1 <$> ffinal fs++    extract (Fused3 s cnt (Left fs)) = do+        r <- extract1 s+        case r of+            Error err -> return (Error err)+            Done n b -> do+                assertM(n <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    FL.Partial s1 -> fmap (Done n) (ffinal s1)+                    FL.Done b1 -> return (Done n b1)+            Partial _ _ -> error "splitSome: Partial in extract"+            Continue n s1 -> do+                assertM(n == cnt)+                return (Continue n (Fused3 s1 0 (Left fs)))+    extract (Fused3 s cnt (Right fs)) = do+        r <- extract1 s+        case r of+            Error _ -> fmap (Done cnt) (ffinal fs)+            Done n b -> do+                assertM(n <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    FL.Partial s1 -> fmap (Done n) (ffinal s1)+                    FL.Done b1 -> return (Done n b1)+            Partial _ _ -> error "splitSome: Partial in extract"+            Continue n s1 -> do+                assertM(n == cnt)+                return (Continue n (Fused3 s1 0 (Right fs)))++-- | A parser that always fails with an error message without consuming+-- any input.+--+{-# INLINE_NORMAL die #-}+die :: Monad m => String -> Parser a m b+die err = Parser undefined (pure (IError err)) undefined++-- | A parser that always fails with an effectful error message and without+-- consuming any input.+--+-- /Pre-release/+--+{-# INLINE dieM #-}+dieM :: Monad m => m String -> Parser a m b+dieM err = Parser undefined (IError <$> err) undefined++-- Note: The default implementations of "some" and "many" loop infinitely+-- because of the strict pattern match on both the arguments in applicative and+-- alternative. With the direct style parser type we cannot use the mutually+-- recursive definitions of "some" and "many".+--+-- Note: With the direct style parser type, the list in "some" and "many" is+-- accumulated strictly, it cannot be consumed lazily.++-- | READ THE CAVEATS in 'alt' before using this instance.+--+-- >>> empty = Parser.die "empty"+-- >>> (<|>) = Parser.alt+-- >>> many = flip Parser.many Fold.toList+-- >>> some = flip Parser.some Fold.toList+instance Monad m => Alternative (Parser a m) where+    {-# INLINE empty #-}+    empty = die "empty"++    {-# INLINE (<|>) #-}+    (<|>) = alt++    {-# INLINE many #-}+    many = flip splitMany toList++    {-# INLINE some #-}+    some = flip splitSome toList++{-# ANN type ConcatParseState Fuse #-}+data ConcatParseState sl m a b =+      ConcatParseL !sl+    | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Step s b))++-- XXX Does it fuse completely? Check and update, it cannot fuse the+-- dynamically generated parser.++-- | Map a 'Parser' returning function on the result of a 'Parser'.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+-- /Pre-release/+--+{-# INLINE concatMap #-}+concatMap :: Monad m =>+    (b -> Parser a m c) -> Parser a m b -> Parser a m c+concatMap func (Parser stepL initialL extractL) = Parser step initial extract++    where++    {-# INLINE initializeR #-}+    initializeR (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR+            IDone br -> IDone br+            IError err -> IError err++    initial = do+        res <- initialL+        case res of+            IPartial s -> return $ IPartial $ ConcatParseL s+            IDone b -> initializeR (func b)+            IError err -> return $ IError err++    {-# INLINE initializeRL #-}+    initializeRL n (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> Continue n $ ConcatParseR stepR sr extractR+            IDone br -> Done n br+            IError err -> Error err++    step (ConcatParseL st) a = do+        r <- stepL st a+        case r of+            Partial n s -> return $ Continue n (ConcatParseL s)+            Continue n s -> return $ Continue n (ConcatParseL s)+            Done n b -> initializeRL n (func b)+            Error err -> return $ Error err++    step (ConcatParseR stepR st extractR) a = do+        r <- stepR st a+        return $ case r of+            Partial n s -> Partial n $ ConcatParseR stepR s extractR+            Continue n s -> Continue n $ ConcatParseR stepR s extractR+            Done n b -> Done n b+            Error err -> Error err++    {-# INLINE extractP #-}+    extractP n (Parser stepR initialR extractR) = do+        res <- initialR+        case res of+            IPartial s ->+                fmap+                    (first (\s1 -> ConcatParseR stepR s1 extractR))+                    (extractR s)+            IDone b -> return (Done n b)+            IError err -> return $ Error err++    extract (ConcatParseR stepR s extractR) =+        fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)+    extract (ConcatParseL sL) = do+        rL <- extractL sL+        case rL of+            Error err -> return $ Error err+            Done n b -> extractP n $ func b+            Partial _ _ -> error "concatMap: extract Partial"+            Continue n s -> return $ Continue n (ConcatParseL s)++-- | Better performance 'concatMap' for non-failing parsers.+--+-- Does not work correctly for parsers that can fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+{-# INLINE noErrorUnsafeConcatMap #-}+noErrorUnsafeConcatMap :: Monad m =>+    (b -> Parser a m c) -> Parser a m b -> Parser a m c+noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =+    Parser step initial extract++    where++    {-# INLINE initializeR #-}+    initializeR (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR+            IDone br -> IDone br+            IError err -> IError err++    initial = do+        res <- initialL+        case res of+            IPartial s -> return $ IPartial $ ConcatParseL s+            IDone b -> initializeR (func b)+            IError err -> return $ IError err++    {-# INLINE initializeRL #-}+    initializeRL n (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> Partial n $ ConcatParseR stepR sr extractR+            IDone br -> Done n br+            IError err -> Error err++    step (ConcatParseL st) a = do+        r <- stepL st a+        case r of+            Partial n s -> return $ Partial n (ConcatParseL s)+            Continue n s -> return $ Continue n (ConcatParseL s)+            Done n b -> initializeRL n (func b)+            Error err -> return $ Error err++    step (ConcatParseR stepR st extractR) a = do+        r <- stepR st a+        return $ case r of+            Partial n s -> Partial n $ ConcatParseR stepR s extractR+            Continue n s -> Continue n $ ConcatParseR stepR s extractR+            Done n b -> Done n b+            Error err -> Error err++    {-# INLINE extractP #-}+    extractP n (Parser stepR initialR extractR) = do+        res <- initialR+        case res of+            IPartial s ->+                fmap+                    (first (\s1 -> ConcatParseR stepR s1 extractR))+                    (extractR s)+            IDone b -> return (Done n b)+            IError err -> return $ Error err++    extract (ConcatParseR stepR s extractR) =+        fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)+    extract (ConcatParseL sL) = do+        rL <- extractL sL+        case rL of+            Error err -> return $ Error err+            Done n b -> extractP n $ func b+            Partial _ _ -> error "concatMap: extract Partial"+            Continue n s -> return $ Continue n (ConcatParseL s)++-- Note: The monad instance has quadratic performance complexity. It works fine+-- for small number of compositions but for a scalable implementation we need a+-- CPS version.++-- | READ THE CAVEATS in 'concatMap' before using this instance.+--+-- >>> (>>=) = flip Parser.concatMap+--+instance Monad m => Monad (Parser a m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap++    {-# INLINE (>>) #-}+    (>>) = (*>)++-- | >>> fail = Parser.die+instance Monad m => Fail.MonadFail (Parser a m) where+    {-# INLINE fail #-}+    fail = die++{-+-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.+--+instance Monad m => MonadPlus (Parser a m) where+    {-# INLINE mzero #-}+    mzero = die "mzero"++    {-# INLINE mplus #-}+    mplus = alt+-}++-- | >>> liftIO = Parser.fromEffect . liftIO+instance (MonadIO m) => MonadIO (Parser a m) where+    {-# INLINE liftIO #-}+    liftIO = fromEffect . liftIO++------------------------------------------------------------------------------+-- Mapping on input+------------------------------------------------------------------------------++-- | @lmap f parser@ maps the function @f@ on the input of the parser.+--+-- >>> Stream.parse (Parser.lmap (\x -> x * x) (Parser.fromFold Fold.sum)) (Stream.enumerateFromTo 1 100)+-- Right 338350+--+-- > lmap = Parser.lmapM return+--+{-# INLINE lmap #-}+lmap :: (a -> b) -> Parser b m r -> Parser a m r+lmap f (Parser step begin done) = Parser step1 begin done++    where++    step1 x a = step x (f a)++-- | @lmapM f parser@ maps the monadic function @f@ on the input of the parser.+--+{-# INLINE lmapM #-}+lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r+lmapM f (Parser step begin done) = Parser step1 begin done++    where++    step1 x a = f a >>= step x++-- | Include only those elements that pass a predicate.+--+-- >>> Stream.parse (Parser.filter (> 5) (Parser.fromFold Fold.sum)) $ Stream.fromList [1..10]+-- Right 40+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+filter f (Parser step initial extract) = Parser step1 initial extract++    where++    step1 x a = if f a then step x a else return $ Partial 0 x
+ src/Streamly/Internal/Data/ParserK.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.ParserK+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.ParserK+    (+      module Streamly.Internal.Data.ParserK.Type+    )+where++import Streamly.Internal.Data.ParserK.Type
+ src/Streamly/Internal/Data/ParserK/Type.hs view
@@ -0,0 +1,752 @@+-- |+-- Module      : Streamly.Internal.Data.Parser.ParserK.Type+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- CPS style implementation of parsers.+--+-- The CPS representation allows linear performance for Applicative, sequence,+-- Monad, Alternative, and choice operations compared to the quadratic+-- complexity of the corresponding direct style operations. However, direct+-- style operations allow fusion with ~10x better performance than CPS.+--+-- The direct style representation does not allow for recursive definitions of+-- "some" and "many" whereas CPS allows that.+--+-- 'Applicative' and 'Control.Applicative.Alternative' type class based+-- combinators from the+-- <http://hackage.haskell.org/package/parser-combinators parser-combinators>+-- package can also be used with the 'ParserK' type.++module Streamly.Internal.Data.ParserK.Type+    (+      Step (..)+    , Input (..)+    , ParseResult (..)+    , ParserK (..)+    , adaptC+    , adapt+    , adaptCG+    -- , toParser+    , fromPure+    , fromEffect+    , die+    )+where++#include "ArrayMacros.h"+#include "assert.hs"+#include "inline.hs"++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Applicative (Alternative(..))+import Control.Monad (MonadPlus(..), ap)+import Control.Monad.IO.Class (MonadIO, liftIO)+-- import Control.Monad.Trans.Class (MonadTrans(lift))+import Data.Proxy (Proxy(..))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Unbox (Unbox(..))+import Streamly.Internal.System.IO (unsafeInlineIO)++import qualified Control.Monad.Fail as Fail+import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.MutArray.Generic as GenArr+    ( getIndexUnsafeWith+    )+import qualified Streamly.Internal.Data.Array.Generic as GenArr+import qualified Streamly.Internal.Data.Parser.Type as ParserD++-- Note: We cannot use an Array directly as input because we need to identify+-- the end of input case using None. We cannot do that using nil Array as nil+-- Arrays can be encountered in normal input as well.+--+-- We could specialize the ParserK type to use an Array directly, that provides+-- some performance improvement. The best advantage of that is when we consume+-- one element at a time from the array. If we really want that perf+-- improvement we can use a special ParserK type with the following Input.+--+-- data Input a = None | Chunk {-# UNPACK #-} !(Array a)+--+data Input a = None | Chunk a++-- | The intermediate result of running a parser step. The parser driver may+-- stop with a final result, pause with a continuation to resume, or fail with+-- an error.+--+-- See ParserD docs. This is the same as the ParserD Step except that it uses a+-- continuation in Partial and Continue constructors instead of a state in case+-- of ParserD.+--+-- /Pre-release/+--+data Step a m r =+    -- The Int is the current stream position index wrt to the start of the+    -- array.+      Done !Int r+    | Partial !Int (Input a -> m (Step a m r))+    | Continue !Int (Input a -> m (Step a m r))+    | Error !Int String++instance Functor m => Functor (Step a m) where+    fmap f (Done n r) = Done n (f r)+    fmap f (Partial n k) = Partial n (fmap (fmap f) . k)+    fmap f (Continue n k) = Continue n (fmap (fmap f) . k)+    fmap _ (Error n e) = Error n e++-- Note: Passing position index separately instead of passing it with the+-- result causes huge regression in expression parsing becnhmarks.++-- | The parser's result.+--+-- Int is the position index into the current input array. Could be negative.+-- Cannot be beyond the input array max bound.+--+-- /Pre-release/+--+data ParseResult b =+      Success !Int !b      -- Position index, result+    | Failure !Int !String -- Position index, error++-- | Map a function over 'Success'.+instance Functor ParseResult where+    fmap f (Success n b) = Success n (f b)+    fmap _ (Failure n e) = Failure n e++-- XXX Change the type to the shape (a -> m r -> m r) -> (m r -> m r) -> m r+--+-- The parse continuation would be: Array a -> m (Step a m r) -> m (Step a m r)+-- The extract continuation would be: m (Step a m r) -> m (Step a m r)+--+-- Use Step itself in place of ParseResult.++-- | A continuation passing style parser representation. A continuation of+-- 'Step's, each step passes a state and a parse result to the next 'Step'. The+-- resulting 'Step' may carry a continuation that consumes input 'a' and+-- results in another 'Step'. Essentially, the continuation may either consume+-- input without a result or return a result with no further input to be+-- consumed.+--+newtype ParserK a m b = MkParser+    { runParser :: forall r.+           -- Using "Input" in runParser is not necessary but it avoids making+           -- one more function call to get the input. This could be helpful+           -- for cases where we process just one element per call.+           --+           -- Do not eta reduce the applications of this continuation.+           --+           (ParseResult b -> Int -> Input a -> m (Step a m r))+           -- XXX Maintain and pass the original position in the stream. that+           -- way we can also report better errors. Use a Context structure for+           -- passing the state.++           -- Stream position index wrt to the current input array start. If+           -- negative then backtracking is required before using the array.+           -- The parser should use "Continue -n" in this case if it needs to+           -- consume input. Negative value cannot be beyond the current+           -- backtrack buffer. Positive value cannot be beyond array length.+           -- If the parser needs to advance beyond the array length it should+           -- use "Continue +n".+        -> Int+           -- used elem count, a count of elements consumed by the parser. If+           -- an Alternative fails we need to backtrack by this amount.+        -> Int+           -- The second argument is the used count as described above. The+           -- current input position is carried as part of 'Success'+           -- constructor of 'ParseResult'.+        -> Input a+        -> m (Step a m r)+    }++-------------------------------------------------------------------------------+-- Functor+-------------------------------------------------------------------------------++-- XXX rewrite this using ParserD, expose rmapM from ParserD.++-- | Map a function on the result i.e. on @b@ in @Parser a m b@.+instance Functor m => Functor (ParserK a m) where+    {-# INLINE fmap #-}+    fmap f parser = MkParser $ \k n st arr ->+        let k1 res = k (fmap f res)+         in runParser parser k1 n st arr++-------------------------------------------------------------------------------+-- Sequential applicative+-------------------------------------------------------------------------------++-- This is the dual of stream "fromPure".++-- | A parser that always yields a pure value without consuming any input.+--+-- /Pre-release/+--+{-# INLINE fromPure #-}+fromPure :: b -> ParserK a m b+fromPure b = MkParser $ \k n st arr -> k (Success n b) st arr++-- | See 'Streamly.Internal.Data.Parser.fromEffect'.+--+-- /Pre-release/+--+{-# INLINE fromEffect #-}+fromEffect :: Monad m => m b -> ParserK a m b+fromEffect eff =+    MkParser $ \k n st arr -> eff >>= \b -> k (Success n b) st arr++-- | @f \<$> p1 \<*> p2@ applies parsers p1 and p2 sequentially to an input+-- stream. The first parser runs and processes the input, the remaining input+-- is then passed to the second parser. If both parsers succeed, their outputs+-- are applied to the function @f@. If either parser fails, the operation+-- fails.+--+instance Monad m => Applicative (ParserK a m) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = ap++    {-# INLINE (*>) #-}+    p1 *> p2 = MkParser $ \k n st arr ->+        let k1 (Success n1 _) s input = runParser p2 k n1 s input+            k1 (Failure n1 e) s input = k (Failure n1 e) s input+        in runParser p1 k1 n st arr++    {-# INLINE (<*) #-}+    p1 <* p2 = MkParser $ \k n st arr ->+        let k1 (Success n1 b) s1 input =+                let k2 (Success n2 _) s2 input2  = k (Success n2 b) s2 input2+                    k2 (Failure n2 e) s2 input2  = k (Failure n2 e) s2 input2+                in runParser p2 k2 n1 s1 input+            k1 (Failure n1 e) s1 input = k (Failure n1 e) s1 input+        in runParser p1 k1 n st arr++    {-# INLINE liftA2 #-}+    liftA2 f p = (<*>) (fmap f p)++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++-- This is the dual of "nil".+--+-- | A parser that always fails with an error message without consuming+-- any input.+--+-- /Pre-release/+--+{-# INLINE die #-}+die :: String -> ParserK a m b+die err = MkParser (\k n st arr -> k (Failure n err) st arr)++-- | Monad composition can be used for lookbehind parsers, we can dynamically+-- compose new parsers based on the results of the previously parsed values.+instance Monad m => Monad (ParserK a m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    p >>= f = MkParser $ \k n st arr ->+        let k1 (Success n1 b) s1 inp = runParser (f b) k n1 s1 inp+            k1 (Failure n1 e) s1 inp = k (Failure n1 e) s1 inp+         in runParser p k1 n st arr++    {-# INLINE (>>) #-}+    (>>) = (*>)++#if !(MIN_VERSION_base(4,13,0))+    -- This is redefined instead of just being Fail.fail to be+    -- compatible with base 4.8.+    {-# INLINE fail #-}+    fail = die+#endif+instance Monad m => Fail.MonadFail (ParserK a m) where+    {-# INLINE fail #-}+    fail = die++instance MonadIO m => MonadIO (ParserK a m) where+    {-# INLINE liftIO #-}+    liftIO = fromEffect . liftIO++-------------------------------------------------------------------------------+-- Alternative+-------------------------------------------------------------------------------++-- | @p1 \<|> p2@ passes the input to parser p1, if it succeeds, the result is+-- returned. However, if p1 fails, the parser driver backtracks and tries the+-- same input on the alternative parser p2, returning the result if it+-- succeeds.+--+instance Monad m => Alternative (ParserK a m) where+    {-# INLINE empty #-}+    empty = die "empty"++    {-# INLINE (<|>) #-}+    p1 <|> p2 = MkParser $ \k n _ arr ->+        let+            k1 (Failure pos _) used input = runParser p2 k (pos - used) 0 input+            k1 success _ input = k success 0 input+        in runParser p1 k1 n 0 arr++    -- some and many are implemented here instead of using default definitions+    -- so that we can use INLINE on them. It gives 50% performance improvement.++    {-# INLINE many #-}+    many v = many_v++        where++        many_v = some_v <|> pure []+        some_v = (:) <$> v <*> many_v++    {-# INLINE some #-}+    some v = some_v++        where++        many_v = some_v <|> pure []+        some_v = (:) <$> v <*> many_v++-- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as+-- '<|>', it selects the first succeeding parser.+--+instance Monad m => MonadPlus (ParserK a m) where+    {-# INLINE mzero #-}+    mzero = die "mzero"++    {-# INLINE mplus #-}+    mplus = (<|>)++{-+instance MonadTrans (ParserK a) where+    {-# INLINE lift #-}+    lift = fromEffect+-}++-------------------------------------------------------------------------------+-- Convert ParserD to ParserK+-------------------------------------------------------------------------------++--------------------------------------------------------------------------------+-- Chunked+--------------------------------------------------------------------------------++{-# INLINE adaptCWith #-}+adaptCWith+    :: forall m a s b r. (Monad m, Unbox a)+    => (s -> a -> m (ParserD.Step s b))+    -> m (ParserD.Initial s b)+    -> (s -> m (ParserD.Step s b))+    -> (ParseResult b -> Int -> Input (Array a) -> m (Step (Array a) m r))+    -> Int+    -> Int+    -> Input (Array a)+    -> m (Step (Array a) m r)+adaptCWith pstep initial extract cont !offset0 !usedCount !input = do+    res <- initial+    case res of+        ParserD.IPartial pst -> do+            case input of+                Chunk arr -> parseContChunk usedCount offset0 pst arr+                None -> parseContNothing usedCount pst+        ParserD.IDone b -> cont (Success offset0 b) usedCount input+        ParserD.IError err -> cont (Failure offset0 err) usedCount input++    where++    -- XXX We can maintain an absolute position instead of relative that will+    -- help in reporting of error location in the stream.+    {-# NOINLINE parseContChunk #-}+    parseContChunk !count !offset !state arr@(Array contents start end) = do+         if offset >= 0+         then go SPEC (start + offset * SIZE_OF(a)) state+         else return $ Continue offset (parseCont count state)++        where++        {-# INLINE onDone #-}+        onDone n b =+            assert (n <= Array.length arr)+                (cont (Success n b) (count + n - offset) (Chunk arr))++        {-# INLINE callParseCont #-}+        callParseCont constr n pst1 =+            assert (n < 0 || n >= Array.length arr)+                (return $ constr n (parseCont (count + n - offset) pst1))++        {-# INLINE onPartial #-}+        onPartial = callParseCont Partial++        {-# INLINE onContinue #-}+        onContinue = callParseCont Continue++        {-# INLINE onError #-}+        onError n err =+            cont (Failure n err) (count + n - offset) (Chunk arr)++        {-# INLINE onBack #-}+        onBack offset1 elemSize constr pst = do+            let pos = offset1 - start+             in if pos >= 0+                then go SPEC offset1 pst+                else constr (pos `div` elemSize) pst++        -- Note: div may be expensive but the alternative is to maintain an element+        -- offset in addition to a byte offset or just the element offset and use+        -- multiplication to get the byte offset every time, both these options+        -- turned out to be more expensive than using div.+        go !_ !cur !pst | cur >= end =+            onContinue ((end - start) `div` SIZE_OF(a))  pst+        go !_ !cur !pst = do+            let !x = unsafeInlineIO $ peekAt cur contents+            pRes <- pstep pst x+            let elemSize = SIZE_OF(a)+                next = INDEX_NEXT(cur,a)+                back n = next - n * elemSize+                curOff = (cur - start) `div` elemSize+                nextOff = (next - start) `div` elemSize+            -- The "n" here is stream position index wrt the array start, and+            -- not the backtrack count as returned by byte stream parsers.+            case pRes of+                ParserD.Done 0 b ->+                    onDone nextOff b+                ParserD.Done 1 b ->+                    onDone curOff b+                ParserD.Done n b ->+                    onDone ((back n - start) `div` elemSize) b+                ParserD.Partial 0 pst1 ->+                    go SPEC next pst1+                ParserD.Partial 1 pst1 ->+                    go SPEC cur pst1+                ParserD.Partial n pst1 ->+                    onBack (back n) elemSize onPartial pst1+                ParserD.Continue 0 pst1 ->+                    go SPEC next pst1+                ParserD.Continue 1 pst1 ->+                    go SPEC cur pst1+                ParserD.Continue n pst1 ->+                    onBack (back n) elemSize onContinue pst1+                ParserD.Error err ->+                    onError curOff err++    {-# NOINLINE parseContNothing #-}+    parseContNothing !count !pst = do+        r <- extract pst+        case r of+            -- IMPORTANT: the n here is from the byte stream parser, that means+            -- it is the backtrack element count and not the stream position+            -- index into the current input array.+            ParserD.Done n b ->+                assert (n >= 0)+                    (cont (Success (- n) b) (count - n) None)+            ParserD.Continue n pst1 ->+                assert (n >= 0)+                    (return $ Continue (- n) (parseCont (count - n) pst1))+            ParserD.Error err ->+                -- XXX It is called only when there is no input arr. So using 0+                -- as the position is correct?+                cont (Failure 0 err) count None+            ParserD.Partial _ _ -> error "Bug: adaptCWith Partial unreachable"++    -- XXX Maybe we can use two separate continuations instead of using+    -- Just/Nothing cases here. That may help in avoiding the parseContJust+    -- function call.+    {-# INLINE parseCont #-}+    parseCont !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr+    parseCont !cnt !pst None = parseContNothing cnt pst++-- | Convert an element 'Parser' to a chunked 'ParserK'. A chunked parser is+-- more efficient than an element parser.+--+-- /Pre-release/+--+{-# INLINE_LATE adaptC #-}+adaptC :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK (Array a) m b+adaptC (ParserD.Parser step initial extract) =+    MkParser $ adaptCWith step initial extract++--------------------------------------------------------------------------------+-- Singular+--------------------------------------------------------------------------------++{-# INLINE adaptWith #-}+adaptWith+    :: forall m a s b r. (Monad m)+    => (s -> a -> m (ParserD.Step s b))+    -> m (ParserD.Initial s b)+    -> (s -> m (ParserD.Step s b))+    -> (ParseResult b -> Int -> Input a -> m (Step a m r))+    -> Int+    -> Int+    -> Input a+    -> m (Step a m r)+adaptWith pstep initial extract cont !relPos !usedCount !input = do+    res <- initial+    case res of+        ParserD.IPartial pst -> do+            -- XXX can we come here with relPos 1?+            if relPos == 0+            then+                case input of+                    Chunk arr -> parseContChunk usedCount pst arr+                    None -> parseContNothing usedCount pst+            -- XXX Previous code was using Continue in this case+            else pure $ Partial relPos (parseCont usedCount pst)+        ParserD.IDone b -> cont (Success relPos b) usedCount input+        ParserD.IError err -> cont (Failure relPos err) usedCount input++    where++    -- XXX We can maintain an absolute position instead of relative that will+    -- help in reporting of error location in the stream.+    {-# NOINLINE parseContChunk #-}+    parseContChunk !count !state x = do+         go SPEC state++        where++        go !_ !pst = do+            pRes <- pstep pst x+            case pRes of+                ParserD.Done 0 b ->+                    cont (Success 1 b) (count + 1) (Chunk x)+                ParserD.Done 1 b ->+                    cont (Success 0 b) count (Chunk x)+                ParserD.Done n b ->+                    cont (Success (1 - n) b) (count + 1 - n) (Chunk x)+                ParserD.Partial 0 pst1 ->+                    pure $ Partial 1 (parseCont (count + 1) pst1)+                ParserD.Partial 1 pst1 ->+                    -- XXX Since we got Partial, the driver should drop the+                    -- buffer, we should call the driver here?+                    go SPEC pst1+                ParserD.Partial n pst1 ->+                    pure $ Partial (1 - n) (parseCont (count + 1 - n) pst1)+                ParserD.Continue 0 pst1 ->+                    pure $ Continue 1 (parseCont (count + 1) pst1)+                ParserD.Continue 1 pst1 ->+                    go SPEC pst1+                ParserD.Continue n pst1 ->+                    pure $ Continue (1 - n) (parseCont (count + 1 - n) pst1)+                ParserD.Error err ->+                    -- XXX fix undefined+                    cont (Failure 0 err) count (Chunk x)++    {-# NOINLINE parseContNothing #-}+    parseContNothing !count !pst = do+        r <- extract pst+        case r of+            -- IMPORTANT: the n here is from the byte stream parser, that means+            -- it is the backtrack element count and not the stream position+            -- index into the current input array.+            ParserD.Done n b ->+                assert (n >= 0)+                    (cont (Success (- n) b) (count - n) None)+            ParserD.Continue n pst1 ->+                assert (n >= 0)+                    (return $ Continue (- n) (parseCont (count - n) pst1))+            ParserD.Error err ->+                -- XXX It is called only when there is no input arr. So using 0+                -- as the position is correct?+                cont (Failure 0 err) count None+            ParserD.Partial _ _ -> error "Bug: adaptCWith Partial unreachable"++    -- XXX Maybe we can use two separate continuations instead of using+    -- Just/Nothing cases here. That may help in avoiding the parseContJust+    -- function call.+    {-# INLINE parseCont #-}+    parseCont !cnt !pst (Chunk arr) = parseContChunk cnt pst arr+    parseCont !cnt !pst None = parseContNothing cnt pst++-- | Convert a 'Parser' to 'ParserK'.+--+-- /Pre-release/+--+{-# INLINE_LATE adapt #-}+adapt :: Monad m => ParserD.Parser a m b -> ParserK a m b+adapt (ParserD.Parser step initial extract) =+    MkParser $ adaptWith step initial extract++--------------------------------------------------------------------------------+-- Chunked Generic+--------------------------------------------------------------------------------++{-# INLINE adaptCGWith #-}+adaptCGWith+    :: forall m a s b r. (Monad m)+    => (s -> a -> m (ParserD.Step s b))+    -> m (ParserD.Initial s b)+    -> (s -> m (ParserD.Step s b))+    -> (ParseResult b -> Int -> Input (GenArr.Array a) -> m (Step (GenArr.Array a) m r))+    -> Int+    -> Int+    -> Input (GenArr.Array a)+    -> m (Step (GenArr.Array a) m r)+adaptCGWith pstep initial extract cont !offset0 !usedCount !input = do+    res <- initial+    case res of+        ParserD.IPartial pst -> do+            case input of+                Chunk arr -> parseContChunk usedCount offset0 pst arr+                None -> parseContNothing usedCount pst+        ParserD.IDone b -> cont (Success offset0 b) usedCount input+        ParserD.IError err -> cont (Failure offset0 err) usedCount input++    where++    {-# NOINLINE parseContChunk #-}+    parseContChunk !count !offset !state arr@(GenArr.Array contents start len) = do+         if offset >= 0+         then go SPEC (start + offset) state+         else return $ Continue offset (parseCont count state)++        where++        {-# INLINE end #-}+        end = start + len++        {-# INLINE onDone #-}+        onDone n b =+            assert (n <= GenArr.length arr)+                (cont (Success n b) (count + n - offset) (Chunk arr))++        {-# INLINE callParseCont #-}+        callParseCont constr n pst1 =+            assert (n < 0 || n >= GenArr.length arr)+                (return $ constr n (parseCont (count + n - offset) pst1))++        {-# INLINE onPartial #-}+        onPartial = callParseCont Partial++        {-# INLINE onContinue #-}+        onContinue = callParseCont Continue++        {-# INLINE onError #-}+        onError n err =+            cont (Failure n err) (count + n - offset) (Chunk arr)++        {-# INLINE onBack #-}+        onBack offset1 constr pst = do+            let pos = offset1 - start+             in if pos >= 0+                then go SPEC offset1 pst+                else constr pos pst++        go !_ !cur !pst | cur >= end =+            onContinue len  pst+        go !_ !cur !pst = do+            let !x = unsafeInlineIO $ GenArr.getIndexUnsafeWith contents cur+            pRes <- pstep pst x+            let next = cur + 1+                back n = next - n+                curOff = cur - start+                nextOff = next - start+            -- The "n" here is stream position index wrt the array start, and+            -- not the backtrack count as returned by byte stream parsers.+            case pRes of+                ParserD.Done 0 b ->+                    onDone nextOff b+                ParserD.Done 1 b ->+                    onDone curOff b+                ParserD.Done n b ->+                    onDone (back n - start) b+                ParserD.Partial 0 pst1 ->+                    go SPEC next pst1+                ParserD.Partial 1 pst1 ->+                    go SPEC cur pst1+                ParserD.Partial n pst1 ->+                    onBack (back n) onPartial pst1+                ParserD.Continue 0 pst1 ->+                    go SPEC next pst1+                ParserD.Continue 1 pst1 ->+                    go SPEC cur pst1+                ParserD.Continue n pst1 ->+                    onBack (back n) onContinue pst1+                ParserD.Error err ->+                    onError curOff err++    {-# NOINLINE parseContNothing #-}+    parseContNothing !count !pst = do+        r <- extract pst+        case r of+            -- IMPORTANT: the n here is from the byte stream parser, that means+            -- it is the backtrack element count and not the stream position+            -- index into the current input array.+            ParserD.Done n b ->+                assert (n >= 0)+                    (cont (Success (- n) b) (count - n) None)+            ParserD.Continue n pst1 ->+                assert (n >= 0)+                    (return $ Continue (- n) (parseCont (count - n) pst1))+            ParserD.Error err ->+                -- XXX It is called only when there is no input arr. So using 0+                -- as the position is correct?+                cont (Failure 0 err) count None+            ParserD.Partial _ _ -> error "Bug: adaptCGWith Partial unreachable"++    {-# INLINE parseCont #-}+    parseCont !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr+    parseCont !cnt !pst None = parseContNothing cnt pst++-- | A generic 'adaptC'. Similar to 'adaptC' but is not constrained to 'Unbox'+-- types.+--+-- /Pre-release/+--+{-# INLINE_LATE adaptCG #-}+adaptCG ::+       Monad m => ParserD.Parser a m b -> ParserK (GenArr.Array a) m b+adaptCG (ParserD.Parser step initial extract) =+    MkParser $ adaptCGWith step initial extract++{-+-------------------------------------------------------------------------------+-- Convert CPS style 'Parser' to direct style 'D.Parser'+-------------------------------------------------------------------------------++-- | A continuation to extract the result when a CPS parser is done.+{-# INLINE parserDone #-}+parserDone :: Monad m => ParseResult b -> Int -> Input a -> m (Step a m b)+parserDone (Success n b) _ None = return $ Done n b+parserDone (Failure n e) _ None = return $ Error n e+parserDone _ _ _ = error "Bug: toParser: called with input"++-- | Convert a CPS style 'ParserK' to a direct style 'ParserD.Parser'.+--+-- /Pre-release/+--+{-# INLINE_LATE toParser #-}+toParser :: Monad m => ParserK a m b -> ParserD.Parser a m b+toParser parser = ParserD.Parser step initial extract++    where++    initial = pure (ParserD.IPartial (\x -> runParser parser 0 0 x parserDone))++    step cont a = do+        r <- cont (Single a)+        return $ case r of+            Done n b -> ParserD.Done n b+            Error _ e -> ParserD.Error e+            Partial n cont1 -> ParserD.Partial n cont1+            Continue n cont1 -> ParserD.Continue n cont1++    extract cont = do+        r <- cont None+        case r of+            Done n b -> return $ ParserD.Done n b+            Error _ e -> return $ ParserD.Error e+            Partial _ cont1 -> extract cont1+            Continue n cont1 -> return $ ParserD.Continue n cont1++{-# RULES "fromParser/toParser fusion" [2]+    forall s. toParser (fromParser s) = s #-}+{-# RULES "toParser/fromParser fusion" [2]+    forall s. fromParser (toParser s) = s #-}+-}
src/Streamly/Internal/Data/Pipe.hs view
@@ -24,11 +24,10 @@ module Streamly.Internal.Data.Pipe     (     -- * Pipe Type-      Pipe+      module Streamly.Internal.Data.Pipe.Type      -- * Pipes     -- ** Mapping-    , map     , mapM      {-@@ -112,11 +111,9 @@     , groupsRollingBy     -} -    -- * Composing Pipes-    , tee-    , zipWith-    , compose ++     {-     -- * Distributing     -- |@@ -244,9 +241,9 @@  -- import Streamly.Data.Fold.Types (Fold(..)) import Streamly.Internal.Data.Pipe.Type-       (Pipe(..), PipeState(..), Step(..), zipWith, tee, map, compose)+ -- import Streamly.Internal.Data.Array.Type (Array)--- import Streamly.Internal.Data.Ring.Unboxed (Ring)+-- import Streamly.Internal.Data.Ring (Ring) -- import Streamly.Internal.Data.Stream (Stream) -- import Streamly.Internal.Data.Time.Units -- (AbsTime, MilliSecond64(..), addToAbsTime, diffAbsTime, toRelTime,@@ -256,8 +253,8 @@  -- import qualified Streamly.Internal.Data.Array.Type as A -- import qualified Streamly.Data.Stream as S--- import qualified Streamly.Internal.Data.Stream.StreamD as D--- import qualified Streamly.Internal.Data.Stream.StreamK as K+-- import qualified Streamly.Internal.Data.Stream as D+-- import qualified Streamly.Internal.Data.StreamK as K -- import qualified Streamly.Internal.Data.Stream.Common as P  ------------------------------------------------------------------------------
src/Streamly/Internal/Data/Producer.hs view
@@ -24,31 +24,24 @@ -- unecessary function calls can be avoided.  module Streamly.Internal.Data.Producer-    ( Producer (..)+    (+      module Streamly.Internal.Data.Producer.Source+    , module Streamly.Internal.Data.Producer.Type      -- * Converting     , simplify--    -- * Producers-    , nil-    , nilM-    , unfoldrM     , fromStreamD-    , fromList--    -- * Combinators-    , NestedLoop (..)-    , concat     ) where  #include "inline.hs" -import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..))+import Streamly.Internal.Data.Stream.Step (Step(..))+import Streamly.Internal.Data.Stream.Type (Stream(..)) import Streamly.Internal.Data.SVar.Type (defState) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) +import Streamly.Internal.Data.Producer.Source import Streamly.Internal.Data.Producer.Type import Prelude hiding (concat)
src/Streamly/Internal/Data/Producer/Source.hs view
@@ -36,11 +36,11 @@ import Control.Exception (assert) import GHC.Exts (SpecConstrAnnotation(..)) import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))+import Streamly.Internal.Data.Parser (ParseError(..), Step(..)) import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Streamly.Internal.Data.Stream.Step (Step(..)) -import qualified Streamly.Internal.Data.Parser.ParserD as ParserD+import qualified Streamly.Internal.Data.Parser as ParserD -- import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK  import Prelude hiding (read)@@ -160,7 +160,11 @@                         return (Right b, unread src s1)                     Error err -> do                         s1 <- uextract s-                        return (Left (ParseError err), unread [x] s1)+                        let src  = Prelude.reverse (getList buf)+                        return+                            ( Left (ParseError err)+                            , unread (src ++ [x]) s1+                            )             Skip s -> go SPEC s buf pst             Stop -> goStop buf pst @@ -190,7 +194,11 @@                 return (Right b, unread src s1)             Error err -> do                     s1 <- uextract s-                    return (Left (ParseError err), unread (x:xs) s1)+                    let src  = Prelude.reverse (getList buf)+                    return+                        ( Left (ParseError err)+                        , unread (src ++ (x:xs)) s1+                        )      -- This is a simplified gobuf     goExtract !_ buf (List []) !pst = goStop buf pst@@ -216,8 +224,12 @@                 let src0 = Prelude.take n (x:getList buf)                     src  = Prelude.reverse src0                 return (Right b, unread src (source Nothing))-            Error err ->-                    return (Left (ParseError err), unread (x:xs) (source Nothing))+            Error err -> do+                    let src  = Prelude.reverse (getList buf)+                    return+                        ( Left (ParseError err)+                        , unread (src ++ (x:xs)) (source Nothing)+                        )      -- This is a simplified goExtract     {-# INLINE goStop #-}@@ -238,8 +250,9 @@                 let src0 = Prelude.take n (getList buf)                     src  = Prelude.reverse src0                 return (Right b, unread src (source Nothing))-            Error err ->-                return (Left (ParseError err), source Nothing)+            Error err -> do+                let src  = Prelude.reverse (getList buf)+                return (Left (ParseError err), unread src (source Nothing))  {- -- | Parse a buffered source using a parser, returning the parsed value and the
src/Streamly/Internal/Data/Producer/Type.hs view
@@ -33,7 +33,7 @@ #include "inline.hs"  import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Streamly.Internal.Data.Stream.Step (Step(..)) import Prelude hiding (concat, map)  ------------------------------------------------------------------------------
src/Streamly/Internal/Data/Refold/Type.hs view
@@ -47,12 +47,12 @@ import Fusion.Plugin.Types (Fuse(..)) import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep) -import Prelude hiding (take, iterate)+import Prelude hiding (Foldable(..), take, iterate)  -- $setup -- >>> :m -- >>> import qualified Streamly.Internal.Data.Refold.Type as Refold--- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold+-- >>> import qualified Streamly.Internal.Data.Fold as Fold -- >>> import qualified Streamly.Internal.Data.Stream as Stream  -- All folds in the Fold module should be implemented using Refolds.
src/Streamly/Internal/Data/Ring.hs view
@@ -1,164 +1,619 @@ -- | -- Module      : Streamly.Internal.Data.Ring--- Copyright   : (c) 2021 Composewell Technologies--- License     : BSD-3-Clause+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3 -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC --+-- A ring array is a circular mutable array. +-- XXX Write benchmarks+-- XXX Make the implementation similar to mutable array+-- XXX Rename this module to Data.RingArray.Storable+ module Streamly.Internal.Data.Ring     ( Ring(..) -    -- * Generation-    , createRing-    , writeLastN+    -- * Construction+    , new+    , newRing+    , writeN -    -- * Modification-    , seek-    , unsafeInsertRingWith+    , advance+    , moveBy+    , startOf -    -- * Conversion-    , toMutArray-    , toStreamWith+    -- * Random writes+    , unsafeInsert+    , slide+    , putIndex+    , modifyIndex++    -- * Unfolds+    , read+    , readRev++    -- * Random reads+    , getIndex+    , getIndexUnsafe+    , getIndexRev++    -- * Size+    , length+    , byteLength+    -- , capacity+    , byteCapacity+    , bytesFree++    -- * Casting+    , cast+    , castUnsafe+    , asBytes+    , fromArray++    -- * Folds+    , unsafeFoldRing+    , unsafeFoldRingM+    , unsafeFoldRingFullM+    , unsafeFoldRingNM++    -- * Stream of Arrays+    , ringsOf++    -- * Fast Byte Comparisons+    , unsafeEqArray+    , unsafeEqArrayN++    , slidingWindow+    , slidingWindowWith     ) where -#include "assert.hs"+#include "ArrayMacros.h"+#include "inline.hs" -import Control.Monad.IO.Class (liftIO, MonadIO)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Array.Generic.Mut.Type-    ( MutArray(..)-    , new-    , uninit-    , putIndexUnsafe-    , putSliceUnsafe-    )--- import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream-import qualified Streamly.Internal.Data.Fold.Type as Fold+import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Word (Word8)+import Foreign.Storable+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+import Foreign.Ptr (plusPtr, minusPtr, castPtr)+import Streamly.Internal.Data.Unbox as Unboxed (Unbox(peekAt))+import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)+import GHC.Ptr (Ptr(..))+import Streamly.Internal.Data.MutArray.Type (MutArray)+import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Stream.Step (Step(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.System.IO (unsafeInlineIO) --- XXX Use MutableArray rather than keeping a MutArray here.+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.Array.Type as A++import Prelude hiding (length, concat, read)++-- $setup+-- >>> :m+-- >>> import qualified Streamly.Internal.Data.Ring as Ring++-- | A ring buffer is a mutable array of fixed size. Initially the array is+-- empty, with ringStart pointing at the start of allocated memory. We call the+-- next location to be written in the ring as ringHead. Initially ringHead ==+-- ringStart. When the first item is added, ringHead points to ringStart ++-- sizeof item. When the buffer becomes full ringHead would wrap around to+-- ringStart. When the buffer is full, ringHead always points at the oldest+-- item in the ring and the newest item added always overwrites the oldest+-- item.+--+-- When using it we should keep in mind that a ringBuffer is a mutable data+-- structure. We should not leak out references to it for immutable use.+-- data Ring a = Ring-    { ringArr :: MutArray a-    -- XXX We can keep the current fill amount, Or we can keep a count of total-    -- elements inserted and compute ring head as well using mod on that,-    -- assuming it won't overflow. But mod could be expensive.-    , ringHead :: !Int -- current index to be over-written-    , ringMax :: !Int  -- first index beyond allocated memory+    { ringStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address+    , ringBound :: {-# UNPACK #-} !(Ptr a)        -- first address beyond allocated memory     }  ---------------------------------------------------------------------------------- Generation+-- Construction ------------------------------------------------------------------------------- --- XXX If we align the ringMax to nearest power of two then computation of the--- index to write could be cheaper.-{-# INLINE createRing #-}-createRing :: MonadIO m => Int -> m (Ring a)-createRing count = liftIO $ do-    arr <- new count-    arr1 <- uninit arr count+-- | Get the first address of the ring as a pointer.+startOf :: Ring a -> Ptr a+startOf = unsafeForeignPtrToPtr . ringStart++-- | Create a new ringbuffer and return the ring buffer and the ringHead.+-- Returns the ring and the ringHead, the ringHead is same as ringStart.+{-# INLINE new #-}+new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)+new count = do+    let size = count * max 1 (sizeOf (undefined :: a))+    fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))+    let p = unsafeForeignPtrToPtr fptr     return (Ring-        { ringArr = arr1-        , ringHead = 0-        , ringMax = count-        })+        { ringStart = fptr+        , ringBound = p `plusPtr` size+        }, p) +-- XXX Rename this to "new".+--+-- | @newRing count@ allocates an empty array that can hold 'count' items.  The+-- memory of the array is uninitialized and the allocation is aligned as per+-- the 'Storable' instance of the type.+--+-- /Unimplemented/+{-# INLINE newRing #-}+newRing :: Int -> m (Ring a)+newRing = undefined -{-# INLINE writeLastN #-}-writeLastN :: MonadIO m => Int -> Fold m a (Ring a)-writeLastN n = Fold step initial extract+-- | Advance the ringHead by 1 item, wrap around if we hit the end of the+-- array.+{-# INLINE advance #-}+advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a+advance Ring{..} ringHead =+    let ptr = PTR_NEXT(ringHead,a)+    in if ptr <  ringBound+       then ptr+       else unsafeForeignPtrToPtr ringStart +-- | Move the ringHead by n items. The direction depends on the sign on whether+-- n is positive or negative. Wrap around if we hit the beginning or end of the+-- array.+{-# INLINE moveBy #-}+moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a+moveBy by Ring {..} ringHead = ringStartPtr `plusPtr` advanceFromHead+     where -    initial = do+    elemSize = STORABLE_SIZE_OF(a)+    ringStartPtr = unsafeForeignPtrToPtr ringStart+    lenInBytes = ringBound `minusPtr` ringStartPtr+    offInBytes = ringHead `minusPtr` ringStartPtr+    len = assert (lenInBytes `mod` elemSize == 0) $ lenInBytes `div` elemSize+    off = assert (offInBytes `mod` elemSize == 0) $ offInBytes `div` elemSize+    advanceFromHead = (off + by `mod` len) * elemSize++-- XXX Move the writeLastN from array module here.+--+-- | @writeN n@ is a rolling fold that keeps the last n elements of the stream+-- in a ring array.+--+-- /Unimplemented/+{-# INLINE writeN #-}+writeN :: -- (Storable a, MonadIO m) =>+    Int -> Fold m a (Ring a)+writeN = undefined++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | Cast a mutable array to a ring array.+fromArray :: MutArray a -> Ring a+fromArray = undefined++-------------------------------------------------------------------------------+-- Conversion to/from array+-------------------------------------------------------------------------------++-- | Modify a given index of a ring array using a modifier function.+--+-- /Unimplemented/+modifyIndex :: -- forall m a b. (MonadIO m, Storable a) =>+    Ring a -> Int -> (a -> (a, b)) -> m b+modifyIndex = undefined++-- | /O(1)/ Write the given element at the given index in the ring array.+-- Performs in-place mutation of the array.+--+-- >>> putIndex arr ix val = Ring.modifyIndex arr ix (const (val, ()))+--+-- /Unimplemented/+{-# INLINE putIndex #-}+putIndex :: -- (MonadIO m, Storable a) =>+    Ring a -> Int -> a -> m ()+putIndex = undefined++-- | Insert an item at the head of the ring, when the ring is full this+-- replaces the oldest item in the ring with the new item. This is unsafe+-- beause ringHead supplied is not verified to be within the Ring. Also,+-- the ringStart foreignPtr must be guaranteed to be alive by the caller.+{-# INLINE unsafeInsert #-}+unsafeInsert :: Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)+unsafeInsert rb ringHead newVal = do+    poke ringHead newVal+    -- touchForeignPtr (ringStart rb)+    return $ advance rb ringHead++-- | Insert an item at the head of the ring, when the ring is full this+-- replaces the oldest item in the ring with the new item.+--+-- /Unimplemented/+slide :: -- forall m a. (MonadIO m, Storable a) =>+    Ring a -> a -> m (Ring a)+slide = undefined++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the ring array.+{-# INLINE_NORMAL getIndexUnsafe #-}+getIndexUnsafe :: -- forall m a. (MonadIO m, Storable a) =>+    Ring a -> Int -> m a+getIndexUnsafe = undefined++-- | /O(1)/ Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: -- (MonadIO m, Storable a) =>+    Ring a -> Int -> m a+getIndex = undefined++-- | /O(1)/ Lookup the element at the given index from the end of the array.+-- Index starts from 0.+--+-- Slightly faster than computing the forward index and using getIndex.+--+{-# INLINE getIndexRev #-}+getIndexRev :: -- (MonadIO m, Storable a) =>+    Ring a -> Int -> m a+getIndexRev = undefined++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++-- | /O(1)/ Get the byte length of the array.+--+-- /Unimplemented/+{-# INLINE byteLength #-}+byteLength :: Ring a -> Int+byteLength = undefined++-- | /O(1)/ Get the length of the array i.e. the number of elements in the+-- array.+--+-- Note that 'byteLength' is less expensive than this operation, as 'length'+-- involves a costly division operation.+--+-- /Unimplemented/+{-# INLINE length #-}+length :: -- forall a. Storable a =>+    Ring a -> Int+length = undefined++-- | Get the total capacity of an array. An array may have space reserved+-- beyond the current used length of the array.+--+-- /Pre-release/+{-# INLINE byteCapacity #-}+byteCapacity :: Ring a -> Int+byteCapacity = undefined++-- | The remaining capacity in the array for appending more elements without+-- reallocation.+--+-- /Pre-release/+{-# INLINE bytesFree #-}+bytesFree :: Ring a -> Int+bytesFree = undefined++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- XXX We can read the ring in a loop and use "take" to restrict the number of+-- elements to be taken.+--+-- | Read n elements from the ring starting at the supplied ring head. If n is+-- more than the ring size it keeps reading the ring in a circular fashion.+--+-- If the ring is not full the user must ensure than n is less than or equal to+-- the number of valid elements in the ring.+--+-- /Internal/+{-# INLINE_NORMAL read #-}+read :: forall m a. (MonadIO m, Storable a) => Unfold m (Ring a, Ptr a, Int) a+read = Unfold step return++    where++    step (rb, rh, n) = do         if n <= 0-        then Fold.Done <$> createRing 0+        then do+            liftIO $ touchForeignPtr (ringStart rb)+            return Stop         else do-            rb <- createRing n-            return $ Fold.Partial $ Tuple' rb (0 :: Int)+            x <- liftIO $ peek rh+            let rh1 = advance rb rh+            return $ Yield x (rb, rh1, n - 1) -    step (Tuple' rb cnt) x = do-        rh1 <- liftIO $ unsafeInsertRingWith rb x-        return $ Fold.Partial $ Tuple' (rb {ringHead = rh1}) (cnt + 1)+-- | Unfold a ring array into a stream in reverse order.+--+-- /Unimplemented/+{-# INLINE_NORMAL readRev #-}+readRev :: -- forall m a. (MonadIO m, Storable a) =>+    Unfold m (MutArray a) a+readRev = undefined -    extract (Tuple' rb@Ring{..} cnt) =-        return $-            if cnt < ringMax-            then Ring ringArr 0 ringHead-            else rb+-------------------------------------------------------------------------------+-- Stream of arrays+------------------------------------------------------------------------------- +-- XXX Move this module to a lower level Ring/Type module and move ringsOf to a+-- higher level ring module where we can import "scan".++-- | @ringsOf n stream@ groups the input stream into a stream of+-- ring arrays of size n. Each ring is a sliding window of size n.+--+-- /Unimplemented/+{-# INLINE_NORMAL ringsOf #-}+ringsOf :: -- forall m a. (MonadIO m, Storable a) =>+    Int -> Stream m a -> Stream m (MutArray a)+ringsOf = undefined -- Stream.scan (writeN n)+ ---------------------------------------------------------------------------------- Modification+-- Casting ------------------------------------------------------------------------------- --- XXX This is safe--- Take the ring head and return the new ring head.-{-# INLINE unsafeInsertRingWith #-}-unsafeInsertRingWith :: Ring a -> a -> IO Int-unsafeInsertRingWith Ring{..} x = do-    assertM(ringMax >= 1)-    assertM(ringHead < ringMax)-    putIndexUnsafe ringHead ringArr x-    let rh1 = ringHead + 1-        next = if rh1 == ringMax then 0 else rh1-    return next+-- | Cast an array having elements of type @a@ into an array having elements of+-- type @b@. The array size must be a multiple of the size of type @b@.+--+-- /Unimplemented/+--+castUnsafe :: Ring a -> Ring b+castUnsafe = undefined --- | Move the ring head clockwise (+ve adj) or counter clockwise (-ve adj) by--- the given amount.-{-# INLINE seek #-}-seek :: MonadIO m => Int -> Ring a -> m (Ring a)-seek adj rng@Ring{..}-    | ringMax > 0 = liftIO $ do-        -- XXX try avoiding mod when in bounds-        let idx1 = ringHead + adj-            next = mod idx1 ringMax-        return $ Ring ringArr next ringMax-    | otherwise = pure rng+-- | Cast an @Array a@ into an @Array Word8@.+--+-- /Unimplemented/+--+asBytes :: Ring a -> Ring Word8+asBytes = castUnsafe +-- | Cast an array having elements of type @a@ into an array having elements of+-- type @b@. The length of the array should be a multiple of the size of the+-- target element otherwise 'Nothing' is returned.+--+-- /Pre-release/+--+cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)+cast arr =+    let len = byteLength arr+        r = len `mod` STORABLE_SIZE_OF(b)+     in if r /= 0+        then Nothing+        else Just $ castUnsafe arr+ ---------------------------------------------------------------------------------- Conversion+-- Equality ------------------------------------------------------------------------------- --- | @toMutArray rignHeadAdjustment lengthToRead ring@.--- Convert the ring into a boxed mutable array. Note that the returned MutArray--- may share the same underlying memory as the Ring.-{-# INLINE toMutArray #-}-toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)-toMutArray adj n Ring{..} = do-    let len = min ringMax n-    let idx = mod (ringHead + adj) ringMax-        end = idx + len-    if end <= ringMax-    then-        -- putSliceUnsafe ringArr idx arr1 0 len-        return $ ringArr { arrStart = idx, arrLen = len }-    else do-        -- XXX Just swap the elements in the existing ring and return the-        -- same array without reallocation.-        arr <- liftIO $ new len-        arr1 <- uninit arr len-        putSliceUnsafe ringArr idx arr1 0 (ringMax - idx)-        putSliceUnsafe ringArr 0 arr1 (ringMax - idx) (end - ringMax)-        return arr1+-- XXX remove all usage of unsafeInlineIO+--+-- | Like 'unsafeEqArray' but compares only N bytes instead of entire length of+-- the ring buffer. This is unsafe because the ringHead Ptr is not checked to+-- be in range.+{-# INLINE unsafeEqArrayN #-}+unsafeEqArrayN :: Ring a -> Ptr a -> A.Array a -> Int -> Bool+unsafeEqArrayN Ring{..} rh A.Array{..} nBytes+    | nBytes < 0 = error "unsafeEqArrayN: n should be >= 0"+    | nBytes == 0 = True+    | otherwise = unsafeInlineIO $ check (castPtr rh) 0 --- This would be theoretically slower than toMutArray because of a branch--- introduced for each element in the second half of the ring.+    where --- | Seek by n and then read the entire ring. Use 'take' on the stream to--- restrict the reads.-toStreamWith :: Int -> Ring a -> Stream m a-toStreamWith = undefined-{--toStreamWith n Ring{..}-    | ringMax > 0 = concatEffect $ liftIO $ do-        idx <- readIORef ringHead-        let idx1 = idx + adj-            next = mod idx1 ringMax-            s1 = undefined  -- stream initial slice-            s2 = undefined  -- stream next slice-        return (s1 `Stream.append` s2)-    | otherwise = Stream.nil--}+    w8Contents = arrContents++    check p i = do+        (relem :: Word8) <- peek p+        aelem <- peekAt i w8Contents+        if relem == aelem+        then go (p `plusPtr` 1) (i + 1)+        else return False++    go p i+        | i == nBytes = return True+        | castPtr p == ringBound =+            go (castPtr (unsafeForeignPtrToPtr ringStart)) i+        | castPtr p == rh = touchForeignPtr ringStart >> return True+        | otherwise = check p i++-- XXX This is not modular. We should probably just convert the array and the+-- ring buffer to streams and compare the two streams. Need to check perf+-- though.++-- | Byte compare the entire length of ringBuffer with the given array,+-- starting at the supplied ringHead pointer.  Returns true if the Array and+-- the ringBuffer have identical contents.+--+-- This is unsafe because the ringHead Ptr is not checked to be in range. The+-- supplied array must be equal to or bigger than the ringBuffer, ARRAY BOUNDS+-- ARE NOT CHECKED.+{-# INLINE unsafeEqArray #-}+unsafeEqArray :: Ring a -> Ptr a -> A.Array a -> Bool+unsafeEqArray Ring{..} rh A.Array{..} =+    unsafeInlineIO $ check (castPtr rh) 0++    where++    w8Contents = arrContents++    check p i = do+        (relem :: Word8) <- peek p+        aelem <- peekAt i w8Contents+        if relem == aelem+        then go (p `plusPtr` 1) (i + 1)+        else return False++    go p i+        | castPtr p ==+              ringBound = go (castPtr (unsafeForeignPtrToPtr ringStart)) i+        | castPtr p == rh = touchForeignPtr ringStart >> return True+        | otherwise = check p i++-------------------------------------------------------------------------------+-- Folding+-------------------------------------------------------------------------------++-- XXX We can unfold it into a stream and fold the stream instead.+-- XXX use MonadIO+--+-- | Fold the buffer starting from ringStart up to the given 'Ptr' using a pure+-- step function. This is useful to fold the items in the ring when the ring is+-- not full. The supplied pointer is usually the end of the ring.+--+-- Unsafe because the supplied Ptr is not checked to be in range.+{-# INLINE unsafeFoldRing #-}+unsafeFoldRing :: forall a b. Storable a+    => Ptr a -> (b -> a -> b) -> b -> Ring a -> b+unsafeFoldRing ptr f z Ring{..} =+    let !res = unsafeInlineIO $ withForeignPtr ringStart $ \p ->+                    go z p ptr+    in res+    where+      go !acc !p !q+        | p == q = return acc+        | otherwise = do+            x <- peek p+            go (f acc x) (PTR_NEXT(p,a)) q++-- XXX Can we remove MonadIO here?+withForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b+withForeignPtrM fp fn = do+    r <- fn $ unsafeForeignPtrToPtr fp+    liftIO $ touchForeignPtr fp+    return r++-- | Like unsafeFoldRing but with a monadic step function.+{-# INLINE unsafeFoldRingM #-}+unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a)+    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+unsafeFoldRingM ptr f z Ring {..} =+    withForeignPtrM ringStart $ \x -> go z x ptr+  where+    go !acc !start !end+        | start == end = return acc+        | otherwise = do+            let !x = unsafeInlineIO $ peek start+            acc1 <- f acc x+            go acc1 (PTR_NEXT(start,a)) end++-- | Fold the entire length of a ring buffer starting at the supplied ringHead+-- pointer.  Assuming the supplied ringHead pointer points to the oldest item,+-- this would fold the ring starting from the oldest item to the newest item in+-- the ring.+--+-- Note, this will crash on ring of 0 size.+--+{-# INLINE unsafeFoldRingFullM #-}+unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a)+    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+unsafeFoldRingFullM rh f z rb@Ring {..} =+    withForeignPtrM ringStart $ \_ -> go z rh+  where+    go !acc !start = do+        let !x = unsafeInlineIO $ peek start+        acc' <- f acc x+        let ptr = advance rb start+        if ptr == rh+            then return acc'+            else go acc' ptr++-- | Fold @Int@ items in the ring starting at @Ptr a@.  Won't fold more+-- than the length of the ring.+--+-- Note, this will crash on ring of 0 size.+--+{-# INLINE unsafeFoldRingNM #-}+unsafeFoldRingNM :: forall m a b. (MonadIO m, Storable a)+    => Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+unsafeFoldRingNM count rh f z rb@Ring {..} =+    withForeignPtrM ringStart $ \_ -> go count z rh++    where++    go 0 acc _ = return acc+    go !n !acc !start = do+        let !x = unsafeInlineIO $ peek start+        acc' <- f acc x+        let ptr = advance rb start+        if ptr == rh || n == 0+            then return acc'+            else go (n - 1) acc' ptr++data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Show++-- | Like slidingWindow but also provides the entire ring contents as an Array.+-- The array reflects the state of the ring after inserting the incoming+-- element.+--+-- IMPORTANT NOTE: The ring is mutable, therefore, the result of @(m (Array+-- a))@ action depends on when it is executed. It does not capture the sanpshot+-- of the ring at a particular time.+{-# INLINE slidingWindowWith #-}+slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)+    => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b+slidingWindowWith n (Fold step1 initial1 extract1 final1) =+    Fold step initial extract final++    where++    initial = do+        if n <= 0+        then error "Window size must be > 0"+        else do+            r <- initial1+            (rb, rh) <- liftIO $ new n+            return $+                case r of+                    Partial s -> Partial $ Tuple4' rb rh (0 :: Int) s+                    Done b -> Done b++    toArray foldRing rb rh = do+        -- Using unpinned array here instead of pinned+        arr <- liftIO $ MA.new n+        let snoc' b a = liftIO $ MA.snocUnsafe b a+        foldRing rh snoc' arr rb++    step (Tuple4' rb rh i st) a+        | i < n = do+            rh1 <- liftIO $ unsafeInsert rb rh a+            liftIO $ touchForeignPtr (ringStart rb)+            let action = toArray unsafeFoldRingM rb (PTR_NEXT(rh, a))+            r <- step1 st ((a, Nothing), action)+            return $+                case r of+                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s+                    Done b -> Done b+        | otherwise = do+            old <- liftIO $ peek rh+            rh1 <- liftIO $ unsafeInsert rb rh a+            liftIO $ touchForeignPtr (ringStart rb)+            r <- step1 st ((a, Just old), toArray unsafeFoldRingFullM rb rh1)+            return $+                case r of+                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s+                    Done b -> Done b++    extract (Tuple4' _ _ _ st) = extract1 st++    final (Tuple4' _ _ _ st) = final1 st++-- | @slidingWindow collector@ is an incremental sliding window+-- fold that does not require all the intermediate elements in a computation.+-- This maintains @n@ elements in the window, when a new element comes it slides+-- out the oldest element and the new element along with the old element are+-- supplied to the collector fold.+--+-- The 'Maybe' type is for the case when initially the window is filling and+-- there is no old element.+--+{-# INLINE slidingWindow #-}+slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a)+    => Int -> Fold m (a, Maybe a) b -> Fold m a b+slidingWindow n f = slidingWindowWith n (lmap fst f)
+ src/Streamly/Internal/Data/Ring/Generic.hs view
@@ -0,0 +1,185 @@+-- |+-- Module      : Streamly.Internal.Data.Ring.Generic+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.Data.Ring.Generic+    ( Ring(..)++    -- * Generation+    , createRing+    , writeLastN++    -- * Modification+    , seek+    , unsafeInsertRingWith++    -- * Conversion+    , toMutArray+    , copyToMutArray+    , toStreamWith+    ) where++#include "assert.hs"++import Control.Monad.IO.Class (liftIO, MonadIO)+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.MutArray.Generic (MutArray(..))++-- import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Fold.Type as Fold+import qualified Streamly.Internal.Data.MutArray.Generic as MutArray++-- XXX Use MutableArray rather than keeping a MutArray here.+data Ring a = Ring+    { ringArr :: MutArray a+    -- XXX We can keep the current fill amount, Or we can keep a count of total+    -- elements inserted and compute ring head as well using mod on that,+    -- assuming it won't overflow. But mod could be expensive.+    , ringHead :: !Int -- current index to be over-written+    , ringMax :: !Int  -- first index beyond allocated memory+    }++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++-- XXX If we align the ringMax to nearest power of two then computation of the+-- index to write could be cheaper.+{-# INLINE createRing #-}+createRing :: MonadIO m => Int -> m (Ring a)+createRing count = liftIO $ do+    arr <- MutArray.new count+    arr1 <- MutArray.uninit arr count+    return (Ring+        { ringArr = arr1+        , ringHead = 0+        , ringMax = count+        })+++-- | Note that it is not safe to return a reference to the mutable Ring using a+-- scan as the Ring is continuously getting mutated. You could however copy out+-- the Ring.+{-# INLINE writeLastN #-}+writeLastN :: MonadIO m => Int -> Fold m a (Ring a)+writeLastN n = Fold step initial extract extract++    where++    initial = do+        if n <= 0+        then Fold.Done <$> createRing 0+        else do+            rb <- createRing n+            return $ Fold.Partial $ Tuple' rb (0 :: Int)++    step (Tuple' rb cnt) x = do+        rh1 <- liftIO $ unsafeInsertRingWith rb x+        return $ Fold.Partial $ Tuple' (rb {ringHead = rh1}) (cnt + 1)++    extract (Tuple' rb@Ring{..} cnt) =+        return $+            if cnt < ringMax+            then Ring ringArr 0 ringHead+            else rb++-------------------------------------------------------------------------------+-- Modification+-------------------------------------------------------------------------------++-- XXX This is safe+-- Take the ring head and return the new ring head.+{-# INLINE unsafeInsertRingWith #-}+unsafeInsertRingWith :: Ring a -> a -> IO Int+unsafeInsertRingWith Ring{..} x = do+    assertM(ringMax >= 1)+    assertM(ringHead < ringMax)+    MutArray.putIndexUnsafe ringHead ringArr x+    let rh1 = ringHead + 1+        next = if rh1 == ringMax then 0 else rh1+    return next++-- | Move the ring head clockwise (+ve adj) or counter clockwise (-ve adj) by+-- the given amount.+{-# INLINE seek #-}+seek :: MonadIO m => Int -> Ring a -> m (Ring a)+seek adj rng@Ring{..}+    | ringMax > 0 = liftIO $ do+        -- XXX try avoiding mod when in bounds+        let idx1 = ringHead + adj+            next = mod idx1 ringMax+        return $ Ring ringArr next ringMax+    | otherwise = pure rng++-------------------------------------------------------------------------------+-- Conversion+-------------------------------------------------------------------------------++-- | @toMutArray rignHeadAdjustment lengthToRead ring@.+-- Convert the ring into a boxed mutable array. Note that the returned MutArray+-- shares the same underlying memory as the Ring, the user of this API needs to+-- ensure that the ring is not mutated during and after the conversion.+--+{-# INLINE toMutArray #-}+toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+toMutArray adj n Ring{..} =+    -- XXX for empty Ring it will raise an Exception: divide by zero+    if ringMax <= 0+    then MutArray.nil+    else do+        let len = min ringMax n+        let idx = mod (ringHead + adj) ringMax+            end = idx + len+        if end <= ringMax+        then+            return $ ringArr { arrStart = idx, arrLen = len }+        else do+            -- XXX Just swap the elements in the existing ring and return the+            -- same array without reallocation.+            arr <- liftIO $ MutArray.new len+            arr1 <- MutArray.uninit arr len+            MutArray.putSliceUnsafe ringArr idx arr1 0 (ringMax - idx)+            MutArray.putSliceUnsafe ringArr 0 arr1 (ringMax - idx) (end - ringMax)+            return arr1++-- | Copy out the mutable ring to a mutable Array.+{-# INLINE copyToMutArray #-}+copyToMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+copyToMutArray adj n Ring{..} = do+    if ringMax <= 0+    then MutArray.nil+    else do+        let len = min ringMax n+        let idx = mod (ringHead + adj) ringMax+            end = idx + len+        arr <- MutArray.new len+        arr1 <- MutArray.uninit arr len+        MutArray.putSliceUnsafe ringArr idx arr1 0 (ringMax - idx)+        MutArray.putSliceUnsafe ringArr 0 arr1 (ringMax - idx) (end - ringMax)+        return arr1++-- This would be theoretically slower than toMutArray because of a branch+-- introduced for each element in the second half of the ring.++-- | Seek by n and then read the entire ring. Use 'take' on the stream to+-- restrict the reads.+toStreamWith :: Int -> Ring a -> Stream m a+toStreamWith = undefined+{-+toStreamWith n Ring{..}+    | ringMax > 0 = concatEffect $ liftIO $ do+        idx <- readIORef ringHead+        let idx1 = idx + adj+            next = mod idx1 ringMax+            s1 = undefined  -- stream initial slice+            s2 = undefined  -- stream next slice+        return (s1 `Stream.append` s2)+    | otherwise = Stream.nil+-}
− src/Streamly/Internal/Data/Ring/Unboxed.hs 
@@ -1,615 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Ring.Unboxed--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ A ring array is a circular mutable array.---- XXX Write benchmarks--- XXX Make the implementation similar to mutable array--- XXX Rename this module to Data.RingArray.Storable--module Streamly.Internal.Data.Ring.Unboxed-    ( Ring(..)--    -- * Construction-    , new-    , newRing-    , writeN--    , advance-    , moveBy-    , startOf--    -- * Random writes-    , unsafeInsert-    , slide-    , putIndex-    , modifyIndex--    -- * Unfolds-    , read-    , readRev--    -- * Random reads-    , getIndex-    , getIndexUnsafe-    , getIndexRev--    -- * Size-    , length-    , byteLength-    -- , capacity-    , byteCapacity-    , bytesFree--    -- * Casting-    , cast-    , castUnsafe-    , asBytes-    , fromArray--    -- * Folds-    , unsafeFoldRing-    , unsafeFoldRingM-    , unsafeFoldRingFullM-    , unsafeFoldRingNM--    -- * Stream of Arrays-    , ringsOf--    -- * Fast Byte Comparisons-    , unsafeEqArray-    , unsafeEqArrayN--    , slidingWindow-    , slidingWindowWith-    ) where--#include "ArrayMacros.h"-#include "inline.hs"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Foreign.Storable-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Ptr (plusPtr, minusPtr, castPtr)-import Streamly.Internal.Data.Unboxed as Unboxed (Unbox, peekWith)-import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)-import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.Array.Mut.Type (MutArray)-import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Type as A--import Prelude hiding (length, concat, read)---- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Ring.Unboxed as Ring---- | A ring buffer is a mutable array of fixed size. Initially the array is--- empty, with ringStart pointing at the start of allocated memory. We call the--- next location to be written in the ring as ringHead. Initially ringHead ==--- ringStart. When the first item is added, ringHead points to ringStart +--- sizeof item. When the buffer becomes full ringHead would wrap around to--- ringStart. When the buffer is full, ringHead always points at the oldest--- item in the ring and the newest item added always overwrites the oldest--- item.------ When using it we should keep in mind that a ringBuffer is a mutable data--- structure. We should not leak out references to it for immutable use.----data Ring a = Ring-    { ringStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address-    , ringBound :: {-# UNPACK #-} !(Ptr a)        -- first address beyond allocated memory-    }------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ | Get the first address of the ring as a pointer.-startOf :: Ring a -> Ptr a-startOf = unsafeForeignPtrToPtr . ringStart---- | Create a new ringbuffer and return the ring buffer and the ringHead.--- Returns the ring and the ringHead, the ringHead is same as ringStart.-{-# INLINE new #-}-new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)-new count = do-    let size = count * max 1 (sizeOf (undefined :: a))-    fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))-    let p = unsafeForeignPtrToPtr fptr-    return (Ring-        { ringStart = fptr-        , ringBound = p `plusPtr` size-        }, p)---- XXX Rename this to "new".------ | @newRing count@ allocates an empty array that can hold 'count' items.  The--- memory of the array is uninitialized and the allocation is aligned as per--- the 'Storable' instance of the type.------ /Unimplemented/-{-# INLINE newRing #-}-newRing :: Int -> m (Ring a)-newRing = undefined---- | Advance the ringHead by 1 item, wrap around if we hit the end of the--- array.-{-# INLINE advance #-}-advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a-advance Ring{..} ringHead =-    let ptr = PTR_NEXT(ringHead,a)-    in if ptr <  ringBound-       then ptr-       else unsafeForeignPtrToPtr ringStart---- | Move the ringHead by n items. The direction depends on the sign on whether--- n is positive or negative. Wrap around if we hit the beginning or end of the--- array.-{-# INLINE moveBy #-}-moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a-moveBy by Ring {..} ringHead = ringStartPtr `plusPtr` advanceFromHead--    where--    elemSize = STORABLE_SIZE_OF(a)-    ringStartPtr = unsafeForeignPtrToPtr ringStart-    lenInBytes = ringBound `minusPtr` ringStartPtr-    offInBytes = ringHead `minusPtr` ringStartPtr-    len = assert (lenInBytes `mod` elemSize == 0) $ lenInBytes `div` elemSize-    off = assert (offInBytes `mod` elemSize == 0) $ offInBytes `div` elemSize-    advanceFromHead = (off + by `mod` len) * elemSize---- XXX Move the writeLastN from array module here.------ | @writeN n@ is a rolling fold that keeps the last n elements of the stream--- in a ring array.------ /Unimplemented/-{-# INLINE writeN #-}-writeN :: -- (Storable a, MonadIO m) =>-    Int -> Fold m a (Ring a)-writeN = undefined------------------------------------------------------------------------------------ Conversions------------------------------------------------------------------------------------ | Cast a mutable array to a ring array.-fromArray :: MutArray a -> Ring a-fromArray = undefined------------------------------------------------------------------------------------ Conversion to/from array------------------------------------------------------------------------------------ | Modify a given index of a ring array using a modifier function.------ /Unimplemented/-modifyIndex :: -- forall m a b. (MonadIO m, Storable a) =>-    Ring a -> Int -> (a -> (a, b)) -> m b-modifyIndex = undefined---- | /O(1)/ Write the given element at the given index in the ring array.--- Performs in-place mutation of the array.------ >>> putIndex arr ix val = Ring.modifyIndex arr ix (const (val, ()))------ /Unimplemented/-{-# INLINE putIndex #-}-putIndex :: -- (MonadIO m, Storable a) =>-    Ring a -> Int -> a -> m ()-putIndex = undefined---- | Insert an item at the head of the ring, when the ring is full this--- replaces the oldest item in the ring with the new item. This is unsafe--- beause ringHead supplied is not verified to be within the Ring. Also,--- the ringStart foreignPtr must be guaranteed to be alive by the caller.-{-# INLINE unsafeInsert #-}-unsafeInsert :: Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)-unsafeInsert rb ringHead newVal = do-    poke ringHead newVal-    -- touchForeignPtr (ringStart rb)-    return $ advance rb ringHead---- | Insert an item at the head of the ring, when the ring is full this--- replaces the oldest item in the ring with the new item.------ /Unimplemented/-slide :: -- forall m a. (MonadIO m, Storable a) =>-    Ring a -> a -> m (Ring a)-slide = undefined------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the ring array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: -- forall m a. (MonadIO m, Storable a) =>-    Ring a -> Int -> m a-getIndexUnsafe = undefined---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: -- (MonadIO m, Storable a) =>-    Ring a -> Int -> m a-getIndex = undefined---- | /O(1)/ Lookup the element at the given index from the end of the array.--- Index starts from 0.------ Slightly faster than computing the forward index and using getIndex.----{-# INLINE getIndexRev #-}-getIndexRev :: -- (MonadIO m, Storable a) =>-    Ring a -> Int -> m a-getIndexRev = undefined------------------------------------------------------------------------------------ Size------------------------------------------------------------------------------------ | /O(1)/ Get the byte length of the array.------ /Unimplemented/-{-# INLINE byteLength #-}-byteLength :: Ring a -> Int-byteLength = undefined---- | /O(1)/ Get the length of the array i.e. the number of elements in the--- array.------ Note that 'byteLength' is less expensive than this operation, as 'length'--- involves a costly division operation.------ /Unimplemented/-{-# INLINE length #-}-length :: -- forall a. Storable a =>-    Ring a -> Int-length = undefined---- | Get the total capacity of an array. An array may have space reserved--- beyond the current used length of the array.------ /Pre-release/-{-# INLINE byteCapacity #-}-byteCapacity :: Ring a -> Int-byteCapacity = undefined---- | The remaining capacity in the array for appending more elements without--- reallocation.------ /Pre-release/-{-# INLINE bytesFree #-}-bytesFree :: Ring a -> Int-bytesFree = undefined------------------------------------------------------------------------------------ Unfolds------------------------------------------------------------------------------------ XXX We can read the ring in a loop and use "take" to restrict the number of--- elements to be taken.------ | Read n elements from the ring starting at the supplied ring head. If n is--- more than the ring size it keeps reading the ring in a circular fashion.------ If the ring is not full the user must ensure than n is less than or equal to--- the number of valid elements in the ring.------ /Internal/-{-# INLINE_NORMAL read #-}-read :: forall m a. (MonadIO m, Storable a) => Unfold m (Ring a, Ptr a, Int) a-read = Unfold step return--    where--    step (rb, rh, n) = do-        if n <= 0-        then do-            liftIO $ touchForeignPtr (ringStart rb)-            return Stop-        else do-            x <- liftIO $ peek rh-            let rh1 = advance rb rh-            return $ Yield x (rb, rh1, n - 1)---- | Unfold a ring array into a stream in reverse order.------ /Unimplemented/-{-# INLINE_NORMAL readRev #-}-readRev :: -- forall m a. (MonadIO m, Storable a) =>-    Unfold m (MutArray a) a-readRev = undefined------------------------------------------------------------------------------------ Stream of arrays------------------------------------------------------------------------------------ XXX Move this module to a lower level Ring/Type module and move ringsOf to a--- higher level ring module where we can import "scan".---- | @ringsOf n stream@ groups the input stream into a stream of--- ring arrays of size n. Each ring is a sliding window of size n.------ /Unimplemented/-{-# INLINE_NORMAL ringsOf #-}-ringsOf :: -- forall m a. (MonadIO m, Storable a) =>-    Int -> Stream m a -> Stream m (MutArray a)-ringsOf = undefined -- Stream.scan (writeN n)------------------------------------------------------------------------------------ Casting------------------------------------------------------------------------------------ | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The array size must be a multiple of the size of type @b@.------ /Unimplemented/----castUnsafe :: Ring a -> Ring b-castUnsafe = undefined---- | Cast an @Array a@ into an @Array Word8@.------ /Unimplemented/----asBytes :: Ring a -> Ring Word8-asBytes = castUnsafe---- | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The length of the array should be a multiple of the size of the--- target element otherwise 'Nothing' is returned.------ /Pre-release/----cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)-cast arr =-    let len = byteLength arr-        r = len `mod` STORABLE_SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ XXX remove all usage of unsafeInlineIO------ | Like 'unsafeEqArray' but compares only N bytes instead of entire length of--- the ring buffer. This is unsafe because the ringHead Ptr is not checked to--- be in range.-{-# INLINE unsafeEqArrayN #-}-unsafeEqArrayN :: Ring a -> Ptr a -> A.Array a -> Int -> Bool-unsafeEqArrayN Ring{..} rh A.Array{..} nBytes-    | nBytes < 0 = error "unsafeEqArrayN: n should be >= 0"-    | nBytes == 0 = True-    | otherwise = unsafeInlineIO $ check (castPtr rh) 0--    where--    w8Contents = arrContents--    check p i = do-        (relem :: Word8) <- peek p-        aelem <- peekWith w8Contents i-        if relem == aelem-        then go (p `plusPtr` 1) (i + 1)-        else return False--    go p i-        | i == nBytes = return True-        | castPtr p == ringBound =-            go (castPtr (unsafeForeignPtrToPtr ringStart)) i-        | castPtr p == rh = touchForeignPtr ringStart >> return True-        | otherwise = check p i---- XXX This is not modular. We should probably just convert the array and the--- ring buffer to streams and compare the two streams. Need to check perf--- though.---- | Byte compare the entire length of ringBuffer with the given array,--- starting at the supplied ringHead pointer.  Returns true if the Array and--- the ringBuffer have identical contents.------ This is unsafe because the ringHead Ptr is not checked to be in range. The--- supplied array must be equal to or bigger than the ringBuffer, ARRAY BOUNDS--- ARE NOT CHECKED.-{-# INLINE unsafeEqArray #-}-unsafeEqArray :: Ring a -> Ptr a -> A.Array a -> Bool-unsafeEqArray Ring{..} rh A.Array{..} =-    unsafeInlineIO $ check (castPtr rh) 0--    where--    w8Contents = arrContents--    check p i = do-        (relem :: Word8) <- peek p-        aelem <- peekWith w8Contents i-        if relem == aelem-        then go (p `plusPtr` 1) (i + 1)-        else return False--    go p i-        | castPtr p ==-              ringBound = go (castPtr (unsafeForeignPtrToPtr ringStart)) i-        | castPtr p == rh = touchForeignPtr ringStart >> return True-        | otherwise = check p i------------------------------------------------------------------------------------ Folding------------------------------------------------------------------------------------ XXX We can unfold it into a stream and fold the stream instead.--- XXX use MonadIO------ | Fold the buffer starting from ringStart up to the given 'Ptr' using a pure--- step function. This is useful to fold the items in the ring when the ring is--- not full. The supplied pointer is usually the end of the ring.------ Unsafe because the supplied Ptr is not checked to be in range.-{-# INLINE unsafeFoldRing #-}-unsafeFoldRing :: forall a b. Storable a-    => Ptr a -> (b -> a -> b) -> b -> Ring a -> b-unsafeFoldRing ptr f z Ring{..} =-    let !res = unsafeInlineIO $ withForeignPtr ringStart $ \p ->-                    go z p ptr-    in res-    where-      go !acc !p !q-        | p == q = return acc-        | otherwise = do-            x <- peek p-            go (f acc x) (PTR_NEXT(p,a)) q---- XXX Can we remove MonadIO here?-withForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b-withForeignPtrM fp fn = do-    r <- fn $ unsafeForeignPtrToPtr fp-    liftIO $ touchForeignPtr fp-    return r---- | Like unsafeFoldRing but with a monadic step function.-{-# INLINE unsafeFoldRingM #-}-unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a)-    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b-unsafeFoldRingM ptr f z Ring {..} =-    withForeignPtrM ringStart $ \x -> go z x ptr-  where-    go !acc !start !end-        | start == end = return acc-        | otherwise = do-            let !x = unsafeInlineIO $ peek start-            acc1 <- f acc x-            go acc1 (PTR_NEXT(start,a)) end---- | Fold the entire length of a ring buffer starting at the supplied ringHead--- pointer.  Assuming the supplied ringHead pointer points to the oldest item,--- this would fold the ring starting from the oldest item to the newest item in--- the ring.------ Note, this will crash on ring of 0 size.----{-# INLINE unsafeFoldRingFullM #-}-unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a)-    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b-unsafeFoldRingFullM rh f z rb@Ring {..} =-    withForeignPtrM ringStart $ \_ -> go z rh-  where-    go !acc !start = do-        let !x = unsafeInlineIO $ peek start-        acc' <- f acc x-        let ptr = advance rb start-        if ptr == rh-            then return acc'-            else go acc' ptr---- | Fold @Int@ items in the ring starting at @Ptr a@.  Won't fold more--- than the length of the ring.------ Note, this will crash on ring of 0 size.----{-# INLINE unsafeFoldRingNM #-}-unsafeFoldRingNM :: forall m a b. (MonadIO m, Storable a)-    => Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b-unsafeFoldRingNM count rh f z rb@Ring {..} =-    withForeignPtrM ringStart $ \_ -> go count z rh--    where--    go 0 acc _ = return acc-    go !n !acc !start = do-        let !x = unsafeInlineIO $ peek start-        acc' <- f acc x-        let ptr = advance rb start-        if ptr == rh || n == 0-            then return acc'-            else go (n - 1) acc' ptr--data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Show---- | Like slidingWindow but also provides the entire ring contents as an Array.--- The array reflects the state of the ring after inserting the incoming--- element.------ IMPORTANT NOTE: The ring is mutable, therefore, the result of @(m (Array--- a))@ action depends on when it is executed. It does not capture the sanpshot--- of the ring at a particular time.-{-# INLINE slidingWindowWith #-}-slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)-    => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b-slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract--    where--    initial = do-        if n <= 0-        then error "Window size must be > 0"-        else do-            r <- initial1-            (rb, rh) <- liftIO $ new n-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh (0 :: Int) s-                    Done b -> Done b--    toArray foldRing rb rh = do-        arr <- liftIO $ MA.newPinned n-        let snoc' b a = liftIO $ MA.snocUnsafe b a-        foldRing rh snoc' arr rb--    step (Tuple4' rb rh i st) a-        | i < n = do-            rh1 <- liftIO $ unsafeInsert rb rh a-            liftIO $ touchForeignPtr (ringStart rb)-            let action = toArray unsafeFoldRingM rb (PTR_NEXT(rh, a))-            r <- step1 st ((a, Nothing), action)-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s-                    Done b -> Done b-        | otherwise = do-            old <- liftIO $ peek rh-            rh1 <- liftIO $ unsafeInsert rb rh a-            liftIO $ touchForeignPtr (ringStart rb)-            r <- step1 st ((a, Just old), toArray unsafeFoldRingFullM rb rh1)-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s-                    Done b -> Done b--    extract (Tuple4' _ _ _ st) = extract1 st---- | @slidingWindow collector@ is an incremental sliding window--- fold that does not require all the intermediate elements in a computation.--- This maintains @n@ elements in the window, when a new element comes it slides--- out the oldest element and the new element along with the old element are--- supplied to the collector fold.------ The 'Maybe' type is for the case when initially the window is filling and--- there is no old element.----{-# INLINE slidingWindow #-}-slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a)-    => Int -> Fold m (a, Maybe a) b -> Fold m a b-slidingWindow n f = slidingWindowWith n (lmap fst f)
+ src/Streamly/Internal/Data/Serialize/TH.hs view
@@ -0,0 +1,524 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH+    (+    -- Deriving+      deriveSerialize+    , deriveSerializeWith++    -- Utilities+    , module Streamly.Internal.Data.Serialize.TH.Bottom+    -- ** Common+    , module Streamly.Internal.Data.Serialize.TH.Common+    -- ** RecHeader+    , module Streamly.Internal.Data.Serialize.TH.RecHeader+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.List (foldl')+import Data.Word (Word16, Word32, Word64, Word8)++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Streamly.Internal.Data.Serialize.Type++import Streamly.Internal.Data.Unbox.TH+    ( DataCon(..)+    , DataType(..)+    , reifyDataType+    )++import qualified Streamly.Internal.Data.Serialize.TH.RecHeader as RecHeader++import Streamly.Internal.Data.Serialize.TH.Bottom+import Streamly.Internal.Data.Serialize.TH.Common+import Streamly.Internal.Data.Serialize.TH.RecHeader++--------------------------------------------------------------------------------+-- Domain specific helpers+--------------------------------------------------------------------------------++exprGetSize :: Q Exp -> (Int, Type) -> Q Exp+exprGetSize acc (i, _) = [|addSizeTo $(acc) $(varE (mkFieldName i))|]++getTagSize :: Int -> Int+getTagSize numConstructors+    | numConstructors == 1 = 0+    | fromIntegral (maxBound :: Word8) >= numConstructors = 1+    | fromIntegral (maxBound :: Word16) >= numConstructors = 2+    | fromIntegral (maxBound :: Word32) >= numConstructors = 4+    | fromIntegral (maxBound :: Word64) >= numConstructors = 8+    | otherwise = error "Too many constructors"++getTagType :: Int -> Name+getTagType numConstructors+    | numConstructors == 1 = error "No tag for 1 constructor"+    | fromIntegral (maxBound :: Word8) >= numConstructors = ''Word8+    | fromIntegral (maxBound :: Word16) >= numConstructors = ''Word16+    | fromIntegral (maxBound :: Word32) >= numConstructors = ''Word32+    | fromIntegral (maxBound :: Word64) >= numConstructors = ''Word64+    | otherwise = error "Too many constructors"++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++getNameBaseLen :: Name -> Word8+getNameBaseLen cname =+    let x = length (nameBase cname)+     in if x > 63+        then error "Max Constructor Len: 63 characters"+        else fromIntegral x++conEncLen :: Name -> Word8+conEncLen cname = getNameBaseLen cname + 1++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++mkSizeOfExpr :: Bool -> Bool -> TypeOfType -> Q Exp+mkSizeOfExpr True False tyOfTy =+    case tyOfTy of+        UnitType cname ->+            lamE+                [varP _acc, wildP]+                [|$(varE _acc) + $(litIntegral (conEncLen cname))|]+        TheType con ->+            lamE+                [varP _acc, varP _x]+                (caseE (varE _x) [matchCons (varE _acc) con])+        MultiType constructors -> sizeOfHeadDt constructors++    where++    sizeOfFields acc fields =+        foldl' exprGetSize acc $ zip [0..] fields++    matchCons acc (SimpleDataCon cname fields) =+        let a = litIntegral (conEncLen cname)+            b = sizeOfFields acc (map snd fields)+            expr = [|$(a) + $(b)|]+         in matchConstructor cname (length fields) expr++    sizeOfHeadDt cons =+        let acc = [|$(varE _acc)|]+         in lamE+                [varP _acc, varP _x]+                (caseE (varE _x) (fmap (matchCons acc) cons))++mkSizeOfExpr False False tyOfTy =+    case tyOfTy of+        UnitType _ -> lamE [varP _acc, wildP] [|$(varE _acc) + 1|]+        TheType con ->+            lamE+                [varP _acc, varP _x]+                (caseE (varE _x) [matchCons (varE _acc) con])+        MultiType constructors -> sizeOfHeadDt constructors++    where++    tagSizeExp numConstructors =+        litE (IntegerL (fromIntegral (getTagSize numConstructors)))++    -- XXX fields of the same type can be folded together, will reduce the code+    -- size when there are many fields of the same type.+    -- XXX const size fields can be calculated statically.+    -- XXX This can result in large compilation times due to nesting when there+    -- are many constructors. We can create a list and sum the list at run time+    -- to avoid that depending on the number of constructors. Or using a let+    -- statement for each case may help?+    -- appE (varE 'sum) (listE (acc : map (exprGetSize (litE (IntegerL 0))) (zip [0..] fields)))+    sizeOfFields acc fields =+        foldl' exprGetSize acc $ zip [0..] fields++    matchCons acc (SimpleDataCon cname fields) =+        let expr = sizeOfFields acc (map snd fields)+         in matchConstructor cname (length fields) expr++    -- XXX We fix VarSize for simplicity. Should be changed later.+    sizeOfHeadDt cons =+        let numCons = length cons+            acc = [|$(varE _acc) + $(tagSizeExp numCons)|]+         in lamE+                [varP _acc, varP _x]+                (caseE (varE _x) (fmap (matchCons acc) cons))++mkSizeOfExpr False True (TheType con) = RecHeader.mkRecSizeOfExpr con++mkSizeOfExpr _ _ _ = errorUnimplemented++mkSizeDec :: SerializeConfig -> Type -> [DataCon] -> Q [Dec]+mkSizeDec (SerializeConfig {..}) headTy cons = do+    -- INLINE on sizeOf actually worsens some benchmarks, and improves none+    sizeOfMethod <-+        mkSizeOfExpr+            cfgConstructorTagAsString+            cfgRecordSyntaxWithHeader+            (typeOfType headTy cons)+    pure+        ( maybe+            []+            (\x -> [PragmaD (InlineP 'addSizeTo x FunLike AllPhases)])+            cfgInlineSize+         ++ [FunD 'addSizeTo [Clause [] (NormalB sizeOfMethod) []]]+        )++--------------------------------------------------------------------------------+-- Peek+--------------------------------------------------------------------------------++mkDeserializeExpr :: Bool -> Bool -> Type -> TypeOfType -> Q Exp+mkDeserializeExpr True False headTy tyOfTy =+    case tyOfTy of+        UnitType cname -> deserializeConsExpr [SimpleDataCon cname []]+        TheType con -> deserializeConsExpr [con]+        MultiType cons -> deserializeConsExpr cons++  where++    deserializeConsExpr cons = do+        conLen <- newName "conLen"+        off1 <- newName "off1"+        [|do ($(varP off1), $(varP conLen) :: Word8) <-+                 deserializeAt+                     $(varE _initialOffset)+                     $(varE _arr)+                     $(varE _endOffset)+             $(multiIfE (map (guardCon conLen off1) cons ++ [catchAll]))|]++    catchAll =+        normalGE+            [|True|]+            [|error+               ("Found invalid tag while peeking (" +++                   $(lift (pprint headTy)) ++ ")")|]++    guardCon conLen off con@(SimpleDataCon cname _) = do+        let lenCname = getNameBaseLen cname+            tag = map c2w (nameBase cname)+        normalGE+            [|($(litIntegral lenCname) == $(varE conLen))+                   && $(xorCmp tag off _arr)|]+            [|let $(varP (makeI 0)) = $(varE off) + $(litIntegral lenCname)+               in $(mkDeserializeExprOne 'deserializeAt con)|]++mkDeserializeExpr False False headTy tyOfTy =+    case tyOfTy of+        -- Unit constructor+        UnitType cname ->+            [|pure ($(varE _initialOffset) + 1, $(conE cname))|]+        -- Product type+        TheType con ->+            letE+                [valD (varP (mkName "i0")) (normalB (varE _initialOffset)) []]+                (mkDeserializeExprOne 'deserializeAt con)+        -- Sum type+        MultiType cons -> do+            let lenCons = length cons+                tagType = getTagType lenCons+            doE+                [ bindS+                      (tupP [varP (mkName "i0"), varP _tag])+                      [|deserializeAt $(varE _initialOffset) $(varE _arr) $(varE _endOffset)|]+                , noBindS+                      (caseE+                           (sigE (varE _tag) (conT tagType))+                           (map peekMatch (zip [0 ..] cons) ++ [peekErr]))+                ]+  where+    peekMatch (i, con) =+        match+            (litP (IntegerL i))+            (normalB (mkDeserializeExprOne 'deserializeAt con)) []+    peekErr =+        match+            wildP+            (normalB+                -- XXX Print the tag+                 [|error+                       ("Found invalid tag while peeking (" +++                        $(lift (pprint headTy)) ++ ")")|])+            []++mkDeserializeExpr False True _ (TheType con@(SimpleDataCon _ fields)) = do+    deserializeWithKeys <- newName "deserializeWithKeys"+    updateFunc <- newName "updateFunc"+    updateFuncDec <- RecHeader.conUpdateFuncDec updateFunc fields+    deserializeWithKeysDec <-+        RecHeader.mkDeserializeKeysDec deserializeWithKeys updateFunc con+    letE+        (pure <$> (deserializeWithKeysDec ++ updateFuncDec))+        (RecHeader.mkRecDeserializeExpr+             _initialOffset+             _endOffset+             deserializeWithKeys+             con)++mkDeserializeExpr _ _ _ _ = errorUnimplemented++mkDeserializeDec :: SerializeConfig -> Type -> [DataCon] -> Q [Dec]+mkDeserializeDec (SerializeConfig {..}) headTy cons = do+    peekMethod <-+        mkDeserializeExpr+            cfgConstructorTagAsString+            cfgRecordSyntaxWithHeader+            headTy+            (typeOfType headTy cons)+    pure+        ( maybe+            []+            (\x -> [PragmaD (InlineP 'deserializeAt x FunLike AllPhases)])+            cfgInlineDeserialize+         +++            [ FunD+              'deserializeAt+              [ Clause+                    (if isUnitType cons && not cfgConstructorTagAsString+                         then [VarP _initialOffset, WildP, WildP]+                         else [VarP _initialOffset, VarP _arr, VarP _endOffset])+                    (NormalB peekMethod)+                    []+              ]+            ]+        )++--------------------------------------------------------------------------------+-- Poke+--------------------------------------------------------------------------------++mkSerializeExprTag :: Name -> Int -> Q Exp+mkSerializeExprTag tagType tagVal =+    [|serializeAt+          $(varE _initialOffset)+          $(varE _arr)+          $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]++mkSerializeExpr :: Bool -> Bool -> TypeOfType -> Q Exp+mkSerializeExpr True False tyOfTy =+    case tyOfTy of+        -- Unit type+        UnitType cname ->+            caseE+                (varE _val)+                [serializeDataCon (SimpleDataCon cname [])]+        -- Product type+        (TheType con) ->+            caseE+                (varE _val)+                [serializeDataCon con]+        -- Sum type+        (MultiType cons) ->+            caseE+                (varE _val)+                (map serializeDataCon cons)++    where++    serializeDataCon (SimpleDataCon cname fields) = do+        let tagLen8 = getNameBaseLen cname+            conEnc = tagLen8 : map c2w (nameBase cname)+        matchConstructor+            cname+            (length fields)+            (doE [ bindS+                       (varP (mkName "i0"))+                       (serializeW8List _initialOffset _arr conEnc)+                 , noBindS (mkSerializeExprFields 'serializeAt fields)+                 ])++mkSerializeExpr False False tyOfTy =+    case tyOfTy of+        -- Unit type+        UnitType _ -> [|pure ($(varE _initialOffset) + 1)|]+        -- Product type+        (TheType (SimpleDataCon cname fields)) ->+            letE+                [valD (varP (mkName "i0")) (normalB (varE _initialOffset)) []]+                (caseE+                     (varE _val)+                     [ matchConstructor+                           cname+                           (length fields)+                           (mkSerializeExprFields 'serializeAt fields)+                     ])+        -- Sum type+        (MultiType cons) -> do+            let lenCons = length cons+                tagType = getTagType lenCons+            caseE+                (varE _val)+                (map (\(tagVal, (SimpleDataCon cname fields)) ->+                          matchConstructor+                              cname+                              (length fields)+                              (doE [ bindS+                                         (varP (mkName "i0"))+                                         (mkSerializeExprTag tagType tagVal)+                                   , noBindS+                                         (mkSerializeExprFields+                                              'serializeAt+                                              fields)+                                   ]))+                     (zip [0 ..] cons))++mkSerializeExpr False True (TheType con) =+    RecHeader.mkRecSerializeExpr _initialOffset con++mkSerializeExpr _ _ _ = errorUnimplemented++mkSerializeDec :: SerializeConfig -> Type -> [DataCon] -> Q [Dec]+mkSerializeDec (SerializeConfig {..}) headTy cons = do+    pokeMethod <-+        mkSerializeExpr+            cfgConstructorTagAsString+            cfgRecordSyntaxWithHeader+            (typeOfType headTy cons)+    pure+        ( maybe+            []+            (\x -> [PragmaD (InlineP 'serializeAt x FunLike AllPhases)])+            cfgInlineSerialize+         +++            [FunD+                  'serializeAt+                  [ Clause+                        (if isUnitType cons && not cfgConstructorTagAsString+                             then [VarP _initialOffset, WildP, WildP]+                             else [VarP _initialOffset, VarP _arr, VarP _val])+                        (NormalB pokeMethod)+                        []+                  ]+            ]+        )++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++-- | A general function to derive Serialize instances where you can control+-- which Constructors of the datatype to consider and what the Context for the+-- 'Serialize' instance would be.+--+-- Consider the datatype:+-- @+-- data CustomDataType a b+--     = CDTConstructor1+--     | CDTConstructor2 Bool+--     | CDTConstructor3 Bool b+--     deriving (Show, Eq)+-- @+--+-- Usage:+-- @+-- $(deriveSerializeInternal+--       serializeConfig+--       [AppT (ConT ''Serialize) (VarT (mkName "b"))]+--       (AppT+--            (AppT (ConT ''CustomDataType) (VarT (mkName "a")))+--            (VarT (mkName "b")))+--       [ DataCon 'CDTConstructor1 [] [] []+--       , DataCon 'CDTConstructor2 [] [] [(Nothing, (ConT ''Bool))]+--       , DataCon+--             'CDTConstructor3+--             []+--             []+--             [(Nothing, (ConT ''Bool)), (Nothing, (VarT (mkName "b")))]+--       ])+-- @+deriveSerializeInternal ::+       SerializeConfig -> Type -> [DataCon] -> ([Dec] -> Q [Dec]) -> Q [Dec]+deriveSerializeInternal conf headTy cons next = do+    sizeDec <- mkSizeDec conf headTy cons+    peekDec <- mkDeserializeDec conf headTy cons+    pokeDec <- mkSerializeDec conf headTy cons+    let methods = concat [sizeDec, peekDec, pokeDec]+    next methods++-- | @deriveSerializeWith config-modifier instance-dec@ generates a template+-- Haskell splice consisting of a declaration of a 'Serialize' instance.+-- @instance-dec@ is a template Haskell declaration splice consisting of a+-- standard Haskell instance declaration without the type class methods (e.g.+-- @[d|instance Serialize a => Serialize (Maybe a)|]@).+--+-- The type class methods for the given instance are generated according to the+-- supplied @config-modifier@ parameter. See 'SerializeConfig' for default+-- configuration settings.+--+-- Usage:+--+-- @+-- \$(deriveSerializeWith+--       ( inlineSerializeAt (Just NoInline)+--       . inlineDeserializeAt (Just NoInline)+--       )+--       [d|instance Serialize a => Serialize (Maybe a)|])+-- @+deriveSerializeWith ::+    (SerializeConfig -> SerializeConfig) -> Q [Dec] -> Q [Dec]+deriveSerializeWith modifier mDecs = do+    dec <- mDecs+    case dec of+        [InstanceD mo preds headTyWC []] -> do+            let headTy = unwrap dec headTyWC+            dt <- reifyDataType (getMainTypeName dec headTy)+            let cons = dtCons dt+            deriveSerializeInternal+                (modifier serializeConfig) headTy cons (next mo preds headTyWC)+        _ -> errorMessage dec++    where++    next mo preds headTyWC methods = pure [InstanceD mo preds headTyWC methods]++    errorMessage dec =+        error $ unlines+            [ "Error: deriveSerializeWith:"+            , ""+            , ">> " ++ pprint dec+            , ""+            , "The supplied declaration is not a valid instance declaration."+            , "Provide a valid Haskell instance declaration without a body."+            , ""+            , "Examples:"+            , "instance Serialize (Proxy a)"+            , "instance Serialize a => Serialize (Identity a)"+            , "instance Serialize (TableT Identity)"+            ]++    unwrap _ (AppT (ConT _) r) = r+    unwrap dec _ = errorMessage dec++    getMainTypeName dec = go++        where++        go (ConT nm) = nm+        go (AppT l _) = go l+        go _ = errorMessage dec++-- | Given an 'Serialize' instance declaration splice without the methods (e.g.+-- @[d|instance Serialize a => Serialize (Maybe a)|]@), generate an instance+-- declaration including all the type class method implementations.+--+-- >>> deriveSerialize = deriveSerializeWith id+--+-- Usage:+--+-- @+-- \$(deriveSerialize+--       [d|instance Serialize a => Serialize (Maybe a)|])+-- @+deriveSerialize :: Q [Dec] -> Q [Dec]+deriveSerialize = deriveSerializeWith id
+ src/Streamly/Internal/Data/Serialize/TH/Bottom.hs view
@@ -0,0 +1,475 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH.Bottom+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH.Bottom+    (+    -- ** Config+      SerializeConfig(..)+    , serializeConfig+    , inlineAddSizeTo+    , inlineSerializeAt+    , inlineDeserializeAt+    , encodeConstrNames+    , encodeRecordFields++    -- ** Other Utilities+    , TypeOfType(..)+    , typeOfType+    , SimpleDataCon(..)+    , simplifyDataCon+    , Field+    , mkFieldName+    , isUnitType+    , isRecordSyntax+    , c2w+    , wListToString+    , xorCmp+    , serializeW8List+    , litIntegral+    , litProxy+    , matchConstructor+    , openConstructor+    , makeI+    , makeN+    , makeA+    , int_w8+    , int_w32+    , w32_int+    , w8_int+    , _acc+    , _arr+    , _endOffset+    , _initialOffset+    , _x+    , _tag+    , _val+    , errorUnsupported+    , errorUnimplemented+    ) where++import Data.Maybe (isJust)+import Data.Char (chr, ord)+import Data.List (foldl')+import Data.Word (Word16, Word32, Word64, Word8)+import Data.Bits (Bits, (.|.), shiftL, zeroBits, xor)+import Streamly.Internal.System.IO (unsafeInlineIO)+import Streamly.Internal.Data.Unbox (Unbox)+import Data.Proxy (Proxy)++import Language.Haskell.TH+import Streamly.Internal.Data.Serialize.Type++import qualified Streamly.Internal.Data.Unbox as Unbox++import Streamly.Internal.Data.Unbox.TH (DataCon(..))++--------------------------------------------------------------------------------+-- Config+--------------------------------------------------------------------------------++-- NOTE: 'Nothing' is not eqvivalant to 'Just Inlinable'. Ie. Having no inline+-- specific pragma and having an Inlinable pragma are different. Having an+-- Inlinable pragma makes GHC put the code in the interface file whereas having+-- no inline specific pragma let's GHC decide whether to put the code in+-- interface file or not.++-- | Configuration to control how the 'Serialize' instance is generated. The+-- configuration is opaque and is modified by composing config modifier+-- functions, for example:+--+-- >>> (inlineSerializeAt (Just NoInline)) . (inlineSerializeAt (Just Inlinable))+--+-- The default configuration settings are:+--+-- * 'inlineAddSizeTo' Nothing+-- * 'inlineSerializeAt' (Just Inline)+-- * 'inlineDeserializeAt' (Just Inline)+--+-- The following experimental options are also available:+--+-- * 'encodeConstrNames' False+-- * 'encodeRecordFields' False+--+data SerializeConfig =+    SerializeConfig+        { cfgInlineSize :: Maybe Inline+        , cfgInlineSerialize :: Maybe Inline+        , cfgInlineDeserialize :: Maybe Inline+        , cfgConstructorTagAsString :: Bool+        , cfgRecordSyntaxWithHeader :: Bool+        }++-- | How should we inline the 'addSizeTo' function? The default is 'Nothing'+-- which means left to the compiler. Forcing inline on @addSizeTo@ function+-- actually worsens some benchmarks and improves none.+inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig+inlineAddSizeTo v cfg = cfg {cfgInlineSize = v}++-- XXX Should we make the default Inlinable instead?++-- | How should we inline the 'serialize' function? The default 'Just Inline'.+-- However, aggressive inlining can bloat the code and increase in compilation+-- times when there are big functions and too many nesting levels so you can+-- change it accordingly. A 'Nothing' value leaves the decision to the+-- compiler.+inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+inlineSerializeAt v cfg = cfg {cfgInlineSerialize = v}++-- XXX Should we make the default Inlinable instead?++-- | How should we inline the 'deserialize' function? See guidelines in+-- 'inlineSerializeAt'.+inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+inlineDeserializeAt v cfg = cfg {cfgInlineDeserialize = v}++-- | __Experimental__+--+-- In sum types, use Latin-1 encoded original constructor names rather than+-- binary values to identify constructors. This option is not applicable to+-- product types.+--+-- This option enables the following behavior:+--+-- * __Reordering__: Order of the fields can be changed without affecting+-- serialization.+-- * __Addition__: If a field is added in the new version, the old version of+-- the data type can still be deserialized by the new version. The new value+-- would never occur in the old one.+-- * __Deletion__: If a field is deleted in the new version, deserialization+-- of the old version will result in an error. TBD: We can possibly designate a+-- catch-all case to handle this scenario.+--+-- Note that if you change a type, change the semantics of a type, or delete a+-- field and add a new field with the same name, deserialization of old data+-- may result in silent unexpected behavior.+--+-- This option has to be the same on both encoding and decoding side.+--+-- The default is 'False'.+--+encodeConstrNames :: Bool -> SerializeConfig -> SerializeConfig+encodeConstrNames v cfg = cfg {cfgConstructorTagAsString = v}++-- XXX We can deserialize each field to Either, so if there is a+-- deserialization error in any field it can handled independently. Also, a+-- unique type/version identifier of the field (based on the versions of the+-- packages, full module name space + type identifier) can be serialized along+-- with the value for stricter compatibility, semantics checking. Or we can+-- store a type hash.++-- | __Experimental__+--+-- In explicit record types, use Latin-1 encoded record field names rather than+-- binary values to identify the record fields. Note that this option is not+-- applicable to sum types. Also, it does not work on a product type which is+-- not a record, because there are no field names to begin with.+--+-- This option enables the following behavior:+--+-- * __Reordering__: Order of the fields can be changed without affecting+-- serialization.+-- * __Addition__: If a 'Maybe' type field is added in the new version, the old+-- version of the data type can still be deserialized by the new version, the+-- field value in the older version is assumed to be 'Nothing'. If any other+-- type of field is added, deserialization of the older version results in an+-- error but only when that field is actually accessed in the deserialized+-- record.+-- * __Deletion__: If a field is deleted in the new version and it is+-- encountered in a previously serialized version then the field is discarded.+--+-- This option has to be the same on both encoding and decoding side.+--+-- There is a constant performance overhead proportional to the total length of+-- the record field names and the number of record fields.+--+-- The default is 'False'.+--+encodeRecordFields :: Bool -> SerializeConfig -> SerializeConfig+encodeRecordFields v cfg = cfg {cfgRecordSyntaxWithHeader = v}++serializeConfig :: SerializeConfig+serializeConfig =+    SerializeConfig+        { cfgInlineSize = Nothing+        , cfgInlineSerialize = Just Inline+        , cfgInlineDeserialize = Just Inline+        , cfgConstructorTagAsString = False+        , cfgRecordSyntaxWithHeader = False+        }++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++type Field = (Maybe Name, Type)++_x :: Name+_x = mkName "x"++_acc :: Name+_acc = mkName "acc"++_arr :: Name+_arr = mkName "arr"++_tag :: Name+_tag = mkName "tag"++_initialOffset :: Name+_initialOffset = mkName "initialOffset"++_endOffset :: Name+_endOffset = mkName "endOffset"++_val :: Name+_val = mkName "val"++mkFieldName :: Int -> Name+mkFieldName i = mkName ("field" ++ show i)++makeI :: Int -> Name+makeI i = mkName $ "i" ++ show i++makeN :: Int -> Name+makeN i = mkName $ "n" ++ show i++makeA :: Int -> Name+makeA i = mkName $ "a" ++ show i++--------------------------------------------------------------------------------+-- Domain specific helpers+--------------------------------------------------------------------------------++openConstructor :: Name -> Int -> Q Pat+openConstructor cname numFields =+    conP cname (map varP (map mkFieldName [0 .. (numFields - 1)]))++matchConstructor :: Name -> Int -> Q Exp -> Q Match+matchConstructor cname numFields exp0 =+    match (openConstructor cname numFields) (normalB exp0) []++--------------------------------------------------------------------------------+-- Constructor types+--------------------------------------------------------------------------------++data SimpleDataCon =+    SimpleDataCon Name [Field]+    deriving (Eq)++simplifyDataCon :: DataCon -> SimpleDataCon+simplifyDataCon (DataCon cname _ _ fields) = SimpleDataCon cname fields++data TypeOfType+    = UnitType Name             -- 1 constructor and 1 field+    | TheType SimpleDataCon      -- 1 constructor and 1+ fields+    | MultiType [SimpleDataCon] -- 1+ constructors+    deriving (Eq)++typeOfType :: Type -> [DataCon] -> TypeOfType+typeOfType headTy [] =+    error+        ("Attempting to get size with no constructors (" +++         (pprint headTy) ++ ")")+typeOfType _ [DataCon cname _ _ []] = UnitType cname+typeOfType _ [con@(DataCon _ _ _ _)] = TheType $ simplifyDataCon con+typeOfType _ cons = MultiType $ map simplifyDataCon cons++isUnitType :: [DataCon] -> Bool+isUnitType [DataCon _ _ _ []] = True+isUnitType _ = False++isRecordSyntax :: SimpleDataCon -> Bool+isRecordSyntax (SimpleDataCon _ fields) = and (isJust . fst <$> fields)++--------------------------------------------------------------------------------+-- Type casting+--------------------------------------------------------------------------------++int_w8 :: Int -> Word8+int_w8 = fromIntegral++int_w32 :: Int -> Word32+int_w32 = fromIntegral++w8_w16 :: Word8 -> Word16+w8_w16 = fromIntegral++w8_w32 :: Word8 -> Word32+w8_w32 = fromIntegral++w8_w64 :: Word8 -> Word64+w8_w64 = fromIntegral++w8_int :: Word8 -> Int+w8_int = fromIntegral++w32_int :: Word32 -> Int+w32_int = fromIntegral++c2w :: Char -> Word8+c2w = fromIntegral . ord++wListToString :: [Word8] -> String+wListToString = fmap (chr . fromIntegral)++--------------------------------------------------------------------------------+-- Bit manipulation+--------------------------------------------------------------------------------++shiftAdd :: Bits a => (b -> a) -> [b] -> a+shiftAdd conv xs =+    foldl' (.|.) zeroBits $+    map (\(j, x) -> shiftL x (j * 8)) $ zip [0 ..] $ map conv xs++-- Note: This only works in little endian machines+-- TODO:+-- Instead of generating this via TH can't we write it directly in Haskell and+-- use that? Creating one comparison function for each deserialization may be+-- too much code and may not be necessary.+-- Benchmark both the implementations and check.+xorCmp :: [Word8] -> Name -> Name -> Q Exp+xorCmp tag off arr =+    case tagLen of+        x | x < 2 -> [|$(go8 0) == zeroBits|]+        x | x < 4 -> [|$(go16 0) == zeroBits|]+        x | x < 8 -> [|$(go32 0) == zeroBits|]+        _ -> [|$(go64 0) == zeroBits|]+  where+    tagLen = length tag+    go8 i | i >= tagLen = [|zeroBits|]+    go8 i = do+        let wIntegral = litIntegral i+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word8) .|.+          $(go8 (i + 1))|]+    go16 i+        | i >= tagLen = [|zeroBits|]+    go16 i+        | tagLen - i < 2 = go16 (tagLen - 2)+    go16 i = do+        let wIntegral =+                litIntegral+                    (shiftAdd w8_w16 [tag !! i, tag !! (i + 1)] :: Word16)+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word16) .|.+          $(go16 (i + 2))|]+    go32 i+        | i >= tagLen = [|zeroBits|]+    go32 i+        | tagLen - i < 4 = go32 (tagLen - 4)+    go32 i = do+        let wIntegral =+                litIntegral+                    (shiftAdd+                         w8_w32+                         [ tag !! i+                         , tag !! (i + 1)+                         , tag !! (i + 2)+                         , tag !! (i + 3)+                         ] :: Word32)+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word32) .|.+          $(go32 (i + 4))|]+    go64 i+        | i >= tagLen = [|zeroBits|]+    go64 i+        | tagLen - i < 8 = go64 (tagLen - 8)+    go64 i = do+        let wIntegral =+                litIntegral+                    (shiftAdd+                         w8_w64+                         [ tag !! i+                         , tag !! (i + 1)+                         , tag !! (i + 2)+                         , tag !! (i + 3)+                         , tag !! (i + 4)+                         , tag !! (i + 5)+                         , tag !! (i + 6)+                         , tag !! (i + 7)+                         ])+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word64) .|.+          $(go64 (i + 8))|]++--------------------------------------------------------------------------------+-- Primitive serialization+--------------------------------------------------------------------------------++-- TODO:+-- Will this be too much of a code bloat?+-- Loop with the loop body unrolled?+-- Serialize this in batches similar to batch comparision in xorCmp?+serializeW8List :: Name -> Name -> [Word8] -> Q Exp+serializeW8List off arr w8List = do+    [|let $(varP (makeN 0)) = $(varE off)+       in $(doE (fmap makeBind [0 .. (lenW8List - 1)] +++                 [noBindS ([|pure $(varE (makeN lenW8List))|])]))|]++    where++    lenW8List = length w8List+    makeBind i =+        bindS+            (varP (makeN (i + 1)))+            [|$(varE 'serializeAt)+                  $(varE (makeN i))+                  $(varE arr)+                  ($(litIntegral (w8List !! i)) :: Word8)|]++--------------------------------------------------------------------------------+-- TH Helpers+--------------------------------------------------------------------------------++litIntegral :: Integral a => a -> Q Exp+litIntegral = litE . IntegerL . fromIntegral++litProxy :: Unbox a => Proxy a -> Q Exp+litProxy = litE . IntegerL . fromIntegral . Unbox.sizeOf++--------------------------------------------------------------------------------+-- Error codes+--------------------------------------------------------------------------------++errorUnsupported :: String -> a+errorUnsupported err =+    error+        $ unlines+              [ "Unsupported"+              , "==========="+              , "This is improper use of the library."+              , "This case is unsupported."+              , "Please contact the developer if this case is of interest."+              , ""+              , "Message"+              , "-------"+              , err+              ]++errorUnimplemented :: a+errorUnimplemented =+    error+        $ unlines+              [ "Unimplemented"+              , "============="+              , "Please contact the developer if this case is of interest."+              ]
+ src/Streamly/Internal/Data/Serialize/TH/Common.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH.Common+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH.Common+    ( mkDeserializeExprOne+    , mkSerializeExprFields+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Language.Haskell.TH+import Streamly.Internal.Data.Serialize.TH.Bottom++--------------------------------------------------------------------------------+-- Code+--------------------------------------------------------------------------------++mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp+mkDeserializeExprOne peeker (SimpleDataCon cname fields) =+    case fields of+        -- Only tag is serialized for unit fields, no actual value+        [] -> [|pure ($(varE (mkName "i0")), $(conE cname))|]+        _ ->+            doE+                (concat+                     [ fmap makeBind [0 .. (numFields - 1)]+                     , [ noBindS+                             (appE+                                  (varE 'pure)+                                  (tupE+                                       [ varE (makeI numFields)+                                       , appsE+                                             (conE cname :+                                              (map (varE . makeA)+                                                   [0 .. (numFields - 1)]))+                                       ]))+                       ]+                     ])+  where+    numFields = length fields+    makeBind i =+        bindS+            (tupP [varP (makeI (i + 1)), varP (makeA i)])+            [|$(varE peeker) $(varE (makeI i)) $(varE _arr) $(varE _endOffset)|]++mkSerializeExprFields :: Name -> [Field] -> Q Exp+mkSerializeExprFields poker fields =+    case fields of+        -- Unit constructor, do nothing just tag is enough+        [] -> [|pure ($(varE (mkName "i0")))|]+        _ ->+            doE+                (fmap makeBind [0 .. (numFields - 1)] +++                 [noBindS ([|pure $(varE (makeI numFields))|])])+  where+    numFields = length fields+    makeBind i =+        bindS+            (varP (makeI (i + 1)))+            [|$(varE poker)+                   $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]
+ src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs view
@@ -0,0 +1,411 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH.RecHeader+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH.RecHeader+    ( mkRecSerializeExpr+    , mkRecDeserializeExpr+    , mkRecSizeOfExpr+    , conUpdateFuncDec+    , mkDeserializeKeysDec+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Monad (void)+import Data.List (foldl')+import Data.Word (Word32, Word8)+import Data.Maybe (fromJust)+import Language.Haskell.TH+import Streamly.Internal.Data.Serialize.Type (Serialize(..))+import Data.Foldable (foldlM)+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)+import Data.Proxy (Proxy(..))++import qualified Streamly.Internal.Data.Unbox as Unbox++import Streamly.Internal.Data.Serialize.TH.Bottom+import Streamly.Internal.Data.Serialize.TH.Common++--------------------------------------------------------------------------------+-- Notes+--------------------------------------------------------------------------------++-- Compatibility Algorithm+-- =======================+--+-- The algorithm is written without any low level implementation details. See+-- the code for any low level implementation details.+--+-- Serialization:+-- --------------+--+-- To serialize the data,+--+-- * Get the list of keys for the record as @keyList@.+-- * Serialize the @keyList@.+-- * Serialize the @fields@ one-by-one after serializing the @keyList@.+--+-- Deserialization:+-- ----------------+--+-- To deserialize the data to type @T@,+--+-- __Checking for type match__:+--+-- * Get the list of keys for type @T@ as @targetKeyList@.+-- * Get the list of keys encoded as @encodedKeyList@.+-- * If @targetKeyList == encodedKeyList@ see the __Type Match__ section else+--   see the __No Type Match__ section.+--+-- __Type Match__:+--+-- * Decode the fields one-by-one and construct the type @T@ in the end.+--+-- __No Type Match__:+--+-- * Decode the list of keys encoded into @encodedKeyList@.+-- * Get the list of keys for type @T@ as @targetKeyList@.+-- * Loop through @encodedKeyList@ and start deserializing the encoded data.+-- * If the key is present in @encodedKeyList@ and not in @targetKeyList@+--   then skip parsing the corresponding value.+-- * If the key is present in @targetKeyList@ and not in @encodedKeyList@+--   then set the value for that key as @Nothing@.+-- * If the key is present in both @encodedKeyList@ and in @targetKeyList@+--   parse the value.+-- * Construct @T@ after parsing all the data.++-- Developer Notes+-- ===============+--+-- * Record update syntax is not robust across language extensions and common+--   record plugins (like record-dot-processor, large-records, etc.).++--------------------------------------------------------------------------------+-- Compact lists+--------------------------------------------------------------------------------++-- Like haskell list but the maximum length of the list is 255+newtype CompactList a =+    CompactList+        { unCompactList :: [a]+        }++-- We use 'Word8' to encode the length, hence the maximim number of elements in+-- the list is 255.+instance forall a. Serialize a => Serialize (CompactList a) where++    -- {-# INLINE addSizeTo #-}+    addSizeTo acc (CompactList xs) =+        foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Word8))) xs++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE deserializeAt #-}+    deserializeAt off arr sz = do+        (off1, len8) <- deserializeAt off arr sz :: IO (Int, Word8)+        let len = w8_int len8+            peekList f o i | i >= 3 = do+              -- Unfold the loop three times+              (o1, x1) <- deserializeAt o arr sz+              (o2, x2) <- deserializeAt o1 arr sz+              (o3, x3) <- deserializeAt o2 arr sz+              peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3)+            peekList f o 0 = pure (o, f [])+            peekList f o i = do+              (o1, x) <- deserializeAt o arr sz+              peekList (f . (x:)) o1 (i - 1)+        (nextOff, lst) <- peekList id off1 len+        pure (nextOff, CompactList lst)++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE serializeAt #-}+    serializeAt off arr (CompactList val) = do+        void $ serializeAt off arr (int_w8 (length val) :: Word8)+        let off1 = off + Unbox.sizeOf (Proxy :: Proxy Word8)+        let pokeList o [] = pure o+            pokeList o (x:xs) = do+              o1 <- serializeAt o arr x+              pokeList o1 xs+        pokeList off1 val++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++fieldToNameBase :: Field -> String+fieldToNameBase = nameBase . fromJust . fst++isMaybeType :: Type -> Bool+isMaybeType (AppT (ConT m) _) = m == ''Maybe+isMaybeType _ = False++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++-- We add 4 here because we use 'serializeWithSize' for serializing.+exprGetSize :: Q Exp -> (Int, Type) -> Q Exp+exprGetSize acc (i, _) =+    [|addSizeTo $(acc) $(varE (mkFieldName i)) + 4|]++sizeOfHeader :: SimpleDataCon -> Int+sizeOfHeader (SimpleDataCon _ fields) =+    sizeForFinalOff + sizeForHeaderLength + sizeForNumFields+        + sum (map ((+ sizeForFieldLen) . length . fieldToNameBase) fields)++    where++    sizeForFinalOff = 4+    sizeForHeaderLength = 4 -- Max header length is (255 * (255 + 1) + 1) and+                            -- hence 2 bytes is enough to store it. But we still+                            -- use 4 bytes as using 2 bytes introduces+                            -- regression.+    sizeForNumFields = 1 -- At max 255 fields in the record constructor+    sizeForFieldLen = 1  -- At max 255 letters in the key++mkRecSizeOfExpr :: SimpleDataCon -> Q Exp+mkRecSizeOfExpr con = do+    n_acc <- newName "acc"+    n_x <- newName "x"+    (lamE+         [varP n_acc, varP n_x]+         [|$(litIntegral hlen) ++            $(caseE (varE n_x) [matchCons (varE n_acc) con])|])++    where++    hlen = sizeOfHeader con+    sizeOfFields acc fields = foldl' exprGetSize acc $ zip [0 ..] fields+    matchCons acc (SimpleDataCon cname fields) =+        let expr = sizeOfFields acc (map snd fields)+         in matchConstructor cname (length fields) expr++--------------------------------------------------------------------------------+-- Header+--------------------------------------------------------------------------------++headerValue :: SimpleDataCon -> [Word8]+headerValue (SimpleDataCon _ fields) =+    int_w8 numFields : concat (fmap lengthPrependedFieldEncoding fields)++    where++    -- Error out if the number of fields or the length of key is >= 256. We use+    -- Word8 for encoding the info and hence the max value is 255.+    numFields =+        let lenFields = length fields+         in if lenFields <= 255+            then lenFields+            else errorUnsupported+                     "Number of fields in the record should be <= 255."+    lengthPrependedFieldEncoding field =+        let fEnc =+                let fEnc_ = map c2w (fieldToNameBase field)+                    lenFEnc = length fEnc_+                 in if lenFEnc <= 255+                    then fEnc_+                    else+                        errorUnsupported+                            "Length of any key should be <= 255."+         in (int_w8 (length fEnc)) : fEnc++--------------------------------------------------------------------------------+-- Peek+--------------------------------------------------------------------------------++-- Encoding the size is required if we want to skip the field without knowing+-- its type. We encode the size as 'Word32' hence there is a 4 bytes increase+-- in size.+{-# INLINE serializeWithSize #-}+serializeWithSize :: Serialize a => Int -> MutByteArray -> a -> IO Int+serializeWithSize off arr val = do+    off1 <- serializeAt (off + 4) arr val+    Unbox.pokeAt off arr (int_w32 (off1 - off - 4) :: Word32)+    pure off1++mkRecSerializeExpr :: Name -> SimpleDataCon -> Q Exp+mkRecSerializeExpr initialOffset (con@(SimpleDataCon cname fields)) = do+    afterHLen <- newName "afterHLen"+    -- Encoding the header length is required.+    -- We first compare the header length encoded and the current header+    -- length. Only if the header lengths match, we compare the headers.+    [|do $(varP afterHLen) <-+             serializeAt+                 ($(varE initialOffset) + 4)+                 $(varE _arr)+                 ($(litIntegral hlen) :: Word32)+         $(varP (makeI 0)) <- $(serializeW8List afterHLen _arr hval)+         let $(openConstructor cname (length fields)) = $(varE _val)+         finalOff <- $(mkSerializeExprFields 'serializeWithSize fields)+         Unbox.pokeAt+             $(varE initialOffset)+             $(varE _arr)+             ((fromIntegral :: Int -> Word32)+                  (finalOff - $(varE initialOffset)))+         pure finalOff|]++    where++    hval = headerValue con+    hlen = length hval++--------------------------------------------------------------------------------+-- Poke+--------------------------------------------------------------------------------++{-# INLINE deserializeWithSize #-}+deserializeWithSize ::+       Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+deserializeWithSize off arr endOff = deserializeAt (off + 4) arr endOff++conUpdateFuncDec :: Name -> [Field] -> Q [Dec]+conUpdateFuncDec funcName fields = do+    prevAcc <- newName "prevAcc"+    curOff <- newName "curOff"+    endOff <- newName "endOff"+    arr <- newName "arr"+    key <- newName "key"+    method <-+        (caseE+             (varE key)+             (concat+                  [ map (matchField arr endOff (prevAcc, curOff)) fnames+                  , [ match+                          wildP+                          (normalB+                               [|do (valOff, valLen :: Word32) <-+                                        deserializeAt+                                            $(varE curOff)+                                            $(varE arr)+                                            $(varE endOff)+                                    pure+                                        ( $(varE prevAcc)+                                        , valOff + w32_int valLen)|])+                          []+                    ]+                  ]))+    pure+        [ PragmaD (InlineP funcName NoInline FunLike AllPhases)+        , FunD+              funcName+              [ Clause+                    [ VarP arr+                    , VarP endOff+                    , TupP [VarP prevAcc, VarP curOff]+                    , VarP key+                    ]+                    (NormalB method)+                    []+              ]+        ]++    where++    fnames = fmap (fromJust . fst) fields+    matchField :: Name -> Name -> (Name, Name) -> Name -> Q Match+    matchField arr endOff (acc, currOff) fname = do+        let fnameLit = StringL (nameBase fname)+        match+            (litP fnameLit)+            (normalB+                 [|do (valOff, valLen :: Word32) <-+                        deserializeAt+                            $(varE currOff)+                            $(varE arr)+                            $(varE endOff)+                      pure+                          ( ($(litE fnameLit), $(varE currOff)) : $(varE acc)+                          , valOff + w32_int valLen)|])+            []++mkDeserializeKeysDec :: Name -> Name -> SimpleDataCon -> Q [Dec]+mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do+    hOff <- newName "hOff"+    finalOff <- newName "finalOff"+    arr <- newName "arr"+    endOff <- newName "endOff"+    kvEncoded <- newName "kvEncoded"+    finalRec <- newName "finalRec"+    let deserializeFieldExpr (Just name, ty) = do+            let nameLit = litE (StringL (nameBase name))+            [|case lookup $(nameLit) $(varE kvEncoded) of+                  Nothing -> $(emptyTy name ty)+                  Just off -> do+                      val <- deserializeWithSize off $(varE arr) $(varE endOff)+                      pure $ snd val|]+        deserializeFieldExpr _ =+            errorUnsupported "The datatype should use record syntax."+    method <-+        [|do (dataOff, hlist :: CompactList (CompactList Word8)) <-+                 deserializeAt $(varE hOff) $(varE arr) $(varE endOff)+             let keys = wListToString . unCompactList <$> unCompactList hlist+             ($(varP kvEncoded), _) <-+                 foldlM+                     ($(varE updateFunc) $(varE arr) $(varE endOff))+                     ([], dataOff)+                     keys+             $(varP finalRec) <-+                 $(foldl+                       (\acc i ->+                            [|$(acc) <*>+                              $(deserializeFieldExpr i)|])+                       [|pure $(conE cname)|]+                       fields)+             pure ($(varE finalOff), $(varE finalRec))|]+    pure+        [ PragmaD (InlineP funcName NoInline FunLike AllPhases)+        , FunD+              funcName+              [ Clause+                    [ VarP hOff+                    , VarP finalOff+                    , VarP arr+                    , VarP endOff+                    ]+                    (NormalB method)+                    []+              ]+        ]++    where++    emptyTy k ty =+        if isMaybeType ty+            then [|pure Nothing|]+            else [|error $(litE (StringL (nameBase k ++ " is not found.")))|]+++mkRecDeserializeExpr :: Name -> Name -> Name -> SimpleDataCon -> Q Exp+mkRecDeserializeExpr initialOff endOff deserializeWithKeys con = do+    hOff <- newName "hOff"+    let  sizeForFinalOff = 4     -- Word32+         sizeForHeaderLength = 4 -- Word32+         sizePreData = sizeForFinalOff + sizeForHeaderLength + hlen+    [|do (hlenOff, encLen :: Word32) <-+             deserializeAt $(varE initialOff) $(varE _arr) $(varE endOff)+         ($(varP hOff), hlen1 :: Word32) <-+             deserializeAt hlenOff $(varE _arr) $(varE endOff)+         if (hlen1 == $(litIntegral hlen)) && $(xorCmp hval hOff _arr)+         then do+             let $(varP (makeI 0)) =+                     $(varE initialOff) ++                     $(litIntegral sizePreData)+             $(mkDeserializeExprOne 'deserializeWithSize con)+         else $(varE deserializeWithKeys)+                  $(varE hOff)+                  ($(varE initialOff) + w32_int encLen)+                  $(varE _arr)+                  $(varE endOff)|]++    where++    hval = headerValue con+    hlen = length hval
+ src/Streamly/Internal/Data/Serialize/Type.hs view
@@ -0,0 +1,317 @@+-- |+-- Module      : Streamly.Internal.Data.Serialize.Type+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--++module Streamly.Internal.Data.Serialize.Type+    (+      Serialize(..)+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Monad (when)+import Data.List (foldl')+import Data.Proxy (Proxy (..))+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))+import Streamly.Internal.Data.Array.Type (Array(..))+import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))+import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))+import GHC.Stable (StablePtr(..))++import qualified Streamly.Internal.Data.MutByteArray.Type as MBA+import qualified Streamly.Internal.Data.Unbox as Unbox+import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.MutArray as MutArray++import GHC.Exts++--------------------------------------------------------------------------------+-- Developer Note+--------------------------------------------------------------------------------++-- IMPORTANT+-- =========+--+-- Don't ever serialize the absolute offsets in the encoding. Serialize length+-- instead. Absolute offsets are NOT stable.+--+-- They will only work if the start offset of the Array when encoding and+-- decoding is the same. This is almost never the case.++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++-- | The 'Serialize' type class provides operations for serialization and+-- deserialization of general Haskell data types to and from their byte stream+-- representation.+--+-- Unlike 'Unbox', 'Serialize' uses variable length encoding, therefore, it can+-- serialize recursive and variable length data types like lists, or variable+-- length sum types where the length of the value may vary depending on a+-- particular constructor. For variable length data types the length is encoded+-- along with the data.+--+-- The 'deserializeAt' operation reads bytes from the mutable byte array and+-- builds a Haskell data type from these bytes, the number of bytes it reads+-- depends on the type and the encoded value it is reading. 'serializeAt'+-- operation converts a Haskell data type to its binary representation which+-- must consist of as many bytes as added by the @addSizeTo@ operation for that+-- value and then stores these bytes into the mutable byte array. The+-- programmer is expected to use the @addSizeTo@ operation and allocate an+-- array of sufficient length before calling 'serializeAt'.+--+-- IMPORTANT: The serialized data's byte ordering remains the same as the host+-- machine's byte order. Therefore, it can not be deserialized from host+-- machines with a different byte ordering.+--+-- Instances can be derived via Template Haskell, or written manually.+--+-- Here is an example, for deriving an instance of this type class using+-- template Haskell:+--+-- >>> :{+-- data Object = Object+--     { _obj1 :: [Int]+--     , _obj2 :: Int+--     }+-- :}+--+-- @+-- import Streamly.Data.MutByteArray (deriveSerialize)+-- \$(deriveSerialize [d|instance Serialize Object|])+-- @+--+-- See 'Streamly.Data.MutByteArray.deriveSerialize' and+-- 'Streamly.Data.MutByteArray.deriveSerializeWith' for more information on+-- deriving using Template Haskell.+--+-- Here is an example of a manual instance.+--+-- >>> import Streamly.Data.MutByteArray (Serialize(..))+--+-- >>> :{+-- instance Serialize Object where+--     addSizeTo acc obj = addSizeTo (addSizeTo acc (_obj1 obj)) (_obj2 obj)+--     deserializeAt i arr len = do+--          -- Check the array bounds before reading+--         (i1, x0) <- deserializeAt i arr len+--         (i2, x1) <- deserializeAt i1 arr len+--         pure (i2, Object x0 x1)+--     serializeAt i arr (Object x0 x1) = do+--         i1 <- serializeAt i arr x0+--         i2 <- serializeAt i1 arr x1+--         pure i2+-- :}+--+class Serialize a where+    -- XXX Use (a -> Sum Int) instead, remove the Size type++    -- A left fold step to fold a generic structure to its serializable size.+    -- It is of the form @Int -> a -> Int@ because you can have tail-recursive+    -- traversal of the structures.++    -- | @addSizeTo accum value@ returns @accum@ incremented by the size of the+    -- serialized representation of @value@ in bytes. Size cannot be zero. It+    -- should be at least 1 byte.+    addSizeTo :: Int -> a -> Int++    -- We can implement the following functions without returning the `Int`+    -- offset but that may require traversing the Haskell structure again to get+    -- the size. Therefore, this is a performance optimization.++    -- | @deserializeAt byte-offset array arrayLen@ deserializes a value from+    -- the given byte-offset in the array. Returns a tuple consisting of the+    -- next byte-offset and the deserialized value.+    --+    -- The arrayLen passed is the entire length of the input buffer. It is to+    -- be used to check if we would overflow the input buffer when+    -- deserializing.+    --+    -- Throws an exception if the operation would exceed the supplied arrayLen.+    deserializeAt :: Int -> MutByteArray -> Int -> IO (Int, a)++    -- | @serializeAt byte-offset array value@ writes the serialized+    -- representation of the @value@ in the array at the given byte-offset.+    -- Returns the next byte-offset.+    --+    -- This is an unsafe operation, the programmer must ensure that the array+    -- has enough space available to serialize the value as determined by the+    -- @addSizeTo@ operation.+    serializeAt :: Int -> MutByteArray -> a -> IO Int++--------------------------------------------------------------------------------+-- Instances+--------------------------------------------------------------------------------++-- _size is the length from array start to the last accessed byte.+#ifdef DEBUG+{-# INLINE checkBounds #-}+checkBounds :: String -> Int -> MutByteArray -> IO ()+checkBounds _label _size _arr = do+    sz <- MBA.sizeOfMutableByteArray _arr+    if (_size > sz)+    then error+        $ _label+            ++ ": accessing array at offset = "+            ++ show (_size - 1)+            ++ " max valid offset = " ++ show (sz - 1)+    else return ()+#endif++-- Note: Instead of passing around the size parameter, we can use+-- (sizeOfMutableByteArray arr) for checking the array bound, but that turns+-- out to be more expensive.+--+-- Another way to optimize this is to avoid the check for fixed size+-- structures. For fixed size structures we can do a check at the top level and+-- then use checkless deserialization using the Unbox type class. That will+-- require ConstSize and VarSize constructors in size. The programmer can+-- bundle all const size fields in a newtype to make serialization faster. This+-- can speed up the computation of size when serializing and checking size when+-- deserialing.+--+-- For variable size non-recursive structures a separate size validation method+-- could be used to validate the size before deserializing. "validate" can also+-- be used to collpase multiple chunks of arrays coming from network into a+-- single array for deserializing. But that can also be done by framing the+-- serialized value with a size header.+--+{-# INLINE deserializeChecked #-}+deserializeChecked :: forall a. Unbox a => Int -> MutByteArray -> Int -> IO (Int, a)+deserializeChecked off arr sz =+    let next = off + Unbox.sizeOf (Proxy :: Proxy a)+     in do+        -- Keep likely path in the straight branch.+        if (next <= sz)+        then Unbox.peekAt off arr >>= \val -> pure (next, val)+        else error+            $ "deserializeAt: accessing array at offset = "+                ++ show (next - 1)+                ++ " max valid offset = " ++ show (sz - 1)++{-# INLINE serializeUnsafe #-}+serializeUnsafe :: forall a. Unbox a => Int -> MutByteArray -> a -> IO Int+serializeUnsafe off arr val =+    let next = off + Unbox.sizeOf (Proxy :: Proxy a)+     in do+#ifdef DEBUG+        checkBounds "serializeAt" next arr+#endif+        Unbox.pokeAt off arr val+        pure next++#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \+instance Serialize _type where \+; {-# INLINE addSizeTo #-} \+;    addSizeTo acc _ = acc +  Unbox.sizeOf (Proxy :: Proxy _type) \+; {-# INLINE deserializeAt #-} \+;    deserializeAt off arr end = deserializeChecked off arr end :: IO (Int, _type) \+; {-# INLINE serializeAt #-} \+;    serializeAt =  \+        serializeUnsafe :: Int -> MutByteArray -> _type -> IO Int++DERIVE_SERIALIZE_FROM_UNBOX(())+DERIVE_SERIALIZE_FROM_UNBOX(Bool)+DERIVE_SERIALIZE_FROM_UNBOX(Char)+DERIVE_SERIALIZE_FROM_UNBOX(Int8)+DERIVE_SERIALIZE_FROM_UNBOX(Int16)+DERIVE_SERIALIZE_FROM_UNBOX(Int32)+DERIVE_SERIALIZE_FROM_UNBOX(Int)+DERIVE_SERIALIZE_FROM_UNBOX(Int64)+DERIVE_SERIALIZE_FROM_UNBOX(Word)+DERIVE_SERIALIZE_FROM_UNBOX(Word8)+DERIVE_SERIALIZE_FROM_UNBOX(Word16)+DERIVE_SERIALIZE_FROM_UNBOX(Word32)+DERIVE_SERIALIZE_FROM_UNBOX(Word64)+DERIVE_SERIALIZE_FROM_UNBOX(Double)+DERIVE_SERIALIZE_FROM_UNBOX(Float)+DERIVE_SERIALIZE_FROM_UNBOX((StablePtr a))+DERIVE_SERIALIZE_FROM_UNBOX((Ptr a))+DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))++instance forall a. Serialize a => Serialize [a] where++    -- {-# INLINE addSizeTo #-}+    addSizeTo acc xs =+        foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE deserializeAt #-}+    deserializeAt off arr sz = do+        (off1, len64) <- deserializeAt off arr sz :: IO (Int, Int64)+        let len = (fromIntegral :: Int64 -> Int) len64+            peekList f o i | i >= 3 = do+              -- Unfold the loop three times+              (o1, x1) <- deserializeAt o arr sz+              (o2, x2) <- deserializeAt o1 arr sz+              (o3, x3) <- deserializeAt o2 arr sz+              peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3)+            peekList f o 0 = pure (o, f [])+            peekList f o i = do+              (o1, x) <- deserializeAt o arr sz+              peekList (f . (x:)) o1 (i - 1)+        peekList id off1 len++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE serializeAt #-}+    serializeAt off arr val = do+        let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int64)+        let pokeList acc o [] =+              Unbox.pokeAt off arr (acc :: Int64) >> pure o+            pokeList acc o (x:xs) = do+              o1 <- serializeAt o arr x+              pokeList (acc + 1) o1 xs+        pokeList 0 off1 val++instance+#ifdef DEVBUILD+    Unbox a =>+#endif+  Serialize (Array a) where+    {-# INLINE addSizeTo #-}+    addSizeTo i (Array {..}) = i + (arrEnd - arrStart) + 8++    {-# INLINE deserializeAt #-}+    deserializeAt off arr len = do+        (off1, byteLen) <- deserializeAt off arr len :: IO (Int, Int)+        let off2 = off1 + byteLen+        when (off2 > len) $+            error+                $ "deserializeAt: accessing array at offset = "+                    ++ show (off2 - 1)+                    ++ " max valid offset = " ++ show (len - 1)+        -- XXX Use MutByteArray.cloneSliceUnsafe+        let slice = MutArray.MutArray arr off1 off2 off2+        newArr <- MutArray.clone slice+        pure (off2, Array.unsafeFreeze newArr)++    {-# INLINE serializeAt #-}+    serializeAt off arr (Array {..}) = do+        let arrLen = arrEnd - arrStart+        off1 <- serializeAt off arr arrLen+        MBA.putSliceUnsafe arrContents arrStart arr off1 arrLen+        pure (off1 + arrLen)++instance (Serialize a, Serialize b) => Serialize (a, b) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc (a, b) = addSizeTo (addSizeTo acc a) b++    {-# INLINE serializeAt #-}+    serializeAt off arr (a, b) = do+        off1 <- serializeAt off arr a+        serializeAt off1 arr b++    {-# INLINE deserializeAt #-}+    deserializeAt off arr end = do+        (off1, a) <- deserializeAt off arr end+        (off2, b) <- deserializeAt off1 arr end+        pure (off2, (a, b))
src/Streamly/Internal/Data/Stream.hs view
@@ -1,14 +1,42 @@ -- | -- Module      : Streamly.Internal.Data.Stream--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC --+-- Direct style re-implementation of CPS stream in+-- "Streamly.Internal.Data.StreamK".  The symbol or suffix 'D' in this+-- module denotes the "Direct" style.  GHC is able to INLINE and fuse direct+-- style better, providing better performance than CPS implementation.+--+-- @+-- import qualified Streamly.Internal.Data.Stream as D+-- @+ module Streamly.Internal.Data.Stream-    ( module Streamly.Internal.Data.Stream.StreamD+    (+      module Streamly.Internal.Data.Stream.Type+    , module Streamly.Internal.Data.Stream.Generate+    , module Streamly.Internal.Data.Stream.Eliminate+    , module Streamly.Internal.Data.Stream.Exception+    , module Streamly.Internal.Data.Stream.Lift+    , module Streamly.Internal.Data.Stream.Transformer+    , module Streamly.Internal.Data.Stream.Nesting+    , module Streamly.Internal.Data.Stream.Transform+    , module Streamly.Internal.Data.Stream.Top+    , module Streamly.Internal.Data.Stream.Container     ) where -import Streamly.Internal.Data.Stream.StreamD+import Streamly.Internal.Data.Stream.Type+import Streamly.Internal.Data.Stream.Generate+import Streamly.Internal.Data.Stream.Eliminate+import Streamly.Internal.Data.Stream.Exception+import Streamly.Internal.Data.Stream.Lift+import Streamly.Internal.Data.Stream.Transformer+import Streamly.Internal.Data.Stream.Nesting+import Streamly.Internal.Data.Stream.Transform+import Streamly.Internal.Data.Stream.Top+import Streamly.Internal.Data.Stream.Container
− src/Streamly/Internal/Data/Stream/Bottom.hs 
@@ -1,670 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Bottom--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Bottom level Stream module that can be used by all other upper level--- Stream modules.--module Streamly.Internal.Data.Stream.Bottom-    (-    -- * Generation-      fromPure-    , fromEffect-    , fromList-    , timesWith-    , absTimesWith-    , relTimesWith--    -- * Folds-    , fold-    , foldBreak-    , foldBreak2-    , foldEither-    , foldEither2-    , foldConcat--    -- * Builders-    , foldAdd-    , foldAddLazy--    -- * Scans-    , smapM-    -- $smapM_Notes-    , postscan-    , catMaybes-    , scanMaybe--    , take-    , takeWhile-    , takeEndBy-    , drop-    , findIndices--    -- * Merge-    , intersperseM--    -- * Fold and Unfold-    , reverse-    , reverse'--    -- * Expand-    , concatEffect-    , concatEffect2-    , concatMapM-    , concatMap--    -- * Reduce-    , foldManyPost--    -- * Zipping-    , zipWithM-    , zipWith-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Fold.Type (Fold (..))-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Internal.Data.SVar.Type (defState)--import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamK as K-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Prelude hiding (take, takeWhile, drop, reverse, concatMap, map, zipWith)--import Streamly.Internal.Data.Stream.Type------- $setup--- >>> :m--- >>> import Control.Monad (join, (>=>), (<=<))--- >>> import Data.Function (fix, (&))--- >>> import Data.Functor.Identity (Identity)--- >>> import Data.Maybe (fromJust, isJust)--- >>> import Prelude hiding (take, takeWhile, drop, reverse)--- >>> import Streamly.Data.Array (Array)--- >>> import Streamly.Data.Fold (Fold)--- >>> import Streamly.Data.Stream (Stream)--- >>> import System.IO.Unsafe (unsafePerformIO)--- >>> import qualified Streamly.Data.Array as Array--- >>> import qualified Streamly.Data.MutArray as MArray--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Parser as Parser--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Fold as Fold (toStream)--- >>> import Streamly.Internal.Data.Stream as Stream----------------------------------------------------------------------------------- Generation - Time related----------------------------------------------------------------------------------- | @timesWith g@ returns a stream of time value tuples. The first component--- of the tuple is an absolute time reference (epoch) denoting the start of the--- stream and the second component is a time relative to the reference.------ The argument @g@ specifies the granularity of the relative time in seconds.--- A lower granularity clock gives higher precision but is more expensive in--- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.------ >>> import Control.Concurrent (threadDelay)--- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE timesWith #-}-timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)-timesWith g = fromStreamD $ D.timesWith g---- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated--- as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimesWith #-}-absTimesWith :: MonadIO m => Double -> Stream m AbsTime-absTimesWith = fmap (uncurry addToAbsTime64) . timesWith---- | @relTimesWith g@ returns a stream of relative time values starting from 0,--- using a clock of granularity @g@ specified in seconds. A low granularity--- clock is more expensive in terms of CPU usage.  Any granularity lower than 1--- ms is treated as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimesWith #-}-relTimesWith :: MonadIO m => Double -> Stream m RelTime64-relTimesWith = fmap snd . timesWith----------------------------------------------------------------------------------- Elimination - Running a Fold----------------------------------------------------------------------------------- | Append a stream to a fold lazily to build an accumulator incrementally.------ Example, to continue folding a list of streams on the same sum fold:------ >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]]--- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams--- >>> Stream.fold f Stream.nil--- 55----{-# INLINE foldAddLazy #-}-foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b-foldAddLazy f s = D.foldAddLazy f $ toStreamD s---- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce---- |--- >>> foldAdd = flip Fold.addStream----foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)-foldAdd f = fold (Fold.duplicate f)---- >>> fold f = Fold.extractM . Stream.foldAddLazy f--- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f--- >>> fold f = Fold.extractM <=< Stream.foldAdd f---- | Fold a stream using the supplied left 'Fold' and reducing the resulting--- expression strictly at each step. The behavior is similar to 'foldl''. A--- 'Fold' can terminate early without consuming the full stream. See the--- documentation of individual 'Fold's for termination behavior.------ Definitions:------ >>> fold f = fmap fst . Stream.foldBreak f--- >>> fold f = Stream.parse (Parser.fromFold f)------ Example:------ >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)--- 5050----{-# INLINE fold #-}-fold :: Monad m => Fold m a b -> Stream m a -> m b-fold fl strm = D.fold fl $ D.fromStreamK $ toStreamK strm---- Alternative name foldSome, but may be confused vs foldMany.---- | Like 'fold' but also returns the remaining stream. The resulting stream--- would be 'Stream.nil' if the stream finished before the fold.------ /CPS/----{-# INLINE foldBreak #-}-foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-foldBreak fl strm = fmap f $ K.foldBreak fl (toStreamK strm)--    where--    f (b, str) = (b, fromStreamK str)---- XXX The quadratic slowdown in recursive use is because recursive function--- cannot be inlined and StreamD/StreamK conversions pile up and cannot be--- eliminated by rewrite rules.---- | Like 'foldBreak' but fuses.------ /Note:/ Unlike 'foldBreak', recursive application on the resulting stream--- would lead to quadratic slowdown. If you need recursion with fusion (within--- one iteration of recursion) use StreamD.foldBreak directly.------ /Internal/-{-# INLINE foldBreak2 #-}-foldBreak2 :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-foldBreak2 fl strm = fmap f $ D.foldBreak fl $ toStreamD strm--    where--    f (b, str) = (b, fromStreamD str)---- | Fold resulting in either breaking the stream or continuation of the fold.--- Instead of supplying the input stream in one go we can run the fold multiple--- times, each time supplying the next segment of the input stream. If the fold--- has not yet finished it returns a fold that can be run again otherwise it--- returns the fold result and the residual stream.------ /Internal/-{-# INLINE foldEither #-}-foldEither :: Monad m =>-    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))-foldEither fl strm = fmap (fmap f) $ K.foldEither fl $ toStreamK strm--    where--    f (b, str) = (b, fromStreamK str)---- | Like 'foldEither' but fuses. However, recursive application on resulting--- stream would lead to quadratic slowdown.------ /Internal/-{-# INLINE foldEither2 #-}-foldEither2 :: Monad m =>-    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))-foldEither2 fl strm = fmap (fmap f) $ D.foldEither fl $ toStreamD strm--    where--    f (b, str) = (b, fromStreamD str)---- XXX Array folds can be implemented using this.--- foldContainers? Specialized to foldArrays.---- | Generate streams from individual elements of a stream and fold the--- concatenation of those streams using the supplied fold. Return the result of--- the fold and residual stream.------ For example, this can be used to efficiently fold an Array Word8 stream--- using Word8 folds.------ The outer stream forces CPS to allow scalable appends and the inner stream--- forces direct style for stream fusion.------ /Internal/-{-# INLINE foldConcat #-}-foldConcat :: Monad m =>-    Producer m a b -> Fold m b c -> Stream m a -> m (c, Stream m a)-foldConcat-    (Producer pstep pinject pextract)-    (Fold fstep begin done)-    stream = do--    res <- begin-    case res of-        Fold.Partial fs -> go fs streamK-        Fold.Done fb -> return (fb, fromStreamK streamK)--    where--    streamK = toStreamK stream--    go !acc m1 = do-        let stop = do-                r <- done acc-                return (r, fromStreamK K.nil)-            single a = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> do-                        r <- done fs-                        return (r, fromStreamK K.nil)-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, fromStreamK (K.fromPure x))-            yieldk a r = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> go fs r-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, fromStreamK (x `K.cons` r))-         in K.foldStream defState yieldk single stop m1--    {-# INLINE go1 #-}-    go1 !_ !fs st = do-        r <- pstep st-        case r of-            D.Yield x s -> do-                res <- fstep fs x-                case res of-                    Fold.Done b -> return $ Right (b, s)-                    Fold.Partial fs1 -> go1 SPEC fs1 s-            D.Skip s -> go1 SPEC fs s-            D.Stop -> return $ Left fs----------------------------------------------------------------------------------- Transformation---------------------------------------------------------------------------------{---- |--- >>> map = fmap------ Same as 'fmap'.------ >>> Stream.fold Fold.toList $ fmap (+1) $ Stream.fromList [1,2,3]--- [2,3,4]----{-# INLINE map #-}-map :: Monad m => (a -> b) -> Stream m a -> Stream m b-map f = fromStreamD . D.map f . toStreamD--}---- | Postscan a stream using the given monadic fold.------ The following example extracts the input stream up to a point where the--- running average of elements is no more than 10:------ >>> import Data.Maybe (fromJust)--- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> s = Stream.enumerateFromTo 1.0 100.0--- >>> :{---  Stream.fold Fold.toList---   $ fmap (fromJust . fst)---   $ Stream.takeWhile (\(_,x) -> x <= 10)---   $ Stream.postscan (Fold.tee Fold.latest avg) s--- :}--- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0]----{-# INLINE postscan #-}-postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b-postscan fld = fromStreamD . D.postscan fld . toStreamD---- $smapM_Notes------ The stateful step function can be simplified to @(s -> a -> m b)@ to provide--- a read-only environment. However, that would just be 'mapM'.------ The initial action could be @m (s, Maybe b)@, and we can also add a final--- action @s -> m (Maybe b)@. This can be used to get pre/post scan like--- functionality and also to flush the state in the end like scanlMAfter'.--- We can also use it along with a fusible version of bracket to get--- scanlMAfter' like functionality. See issue #677.------ This can be further generalized to a type similar to Fold/Parser, giving it--- filtering and parsing capability as well (this is in fact equivalent to--- parseMany):------ smapM :: (s -> a -> m (Step s b)) -> m s -> Stream m a -> Stream m b------- | A stateful 'mapM', equivalent to a left scan, more like mapAccumL.--- Hopefully, this is a better alternative to @scan@. Separation of state from--- the output makes it easier to think in terms of a shared state, and also--- makes it easier to keep the state fully strict and the output lazy.------ See also: 'postscan'------ /Pre-release/----{-# INLINE smapM #-}-smapM :: Monad m =>-       (s -> a -> m (s, b))-    -> m s-    -> Stream m a-    -> Stream m b-smapM step initial stream =-    -- XXX implement this directly instead of using postscan-    let f = Fold.foldlM'-                (\(s, _) a -> step s a)-                (fmap (,undefined) initial)-     in fmap snd $ postscan f stream---- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.------ >>> catMaybes = Stream.mapMaybe id--- >>> catMaybes = fmap fromJust . Stream.filter isJust------ /Pre-release/----{-# INLINE catMaybes #-}-catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a--- catMaybes = fmap fromJust . filter isJust-catMaybes = fromStreamD . D.catMaybes . toStreamD---- | Use a filtering fold on a stream.------ >>> scanMaybe f = Stream.catMaybes . Stream.postscan f----{-# INLINE scanMaybe #-}-scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b-scanMaybe p = catMaybes . postscan p----------------------------------------------------------------------------------- Transformation - Trimming----------------------------------------------------------------------------------- | Take first 'n' elements from the stream and discard the rest.----{-# INLINE take #-}-take :: Monad m => Int -> Stream m a -> Stream m a--- take n = scanMaybe (Fold.taking n)-take n m = fromStreamD $ D.take n $ toStreamD m---- | End the stream as soon as the predicate fails on an element.----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- takeWhile p = scanMaybe (Fold.takingEndBy_ (not . p))-takeWhile p m = fromStreamD $ D.takeWhile p $ toStreamD m--{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- takeEndBy p = scanMaybe (Fold.takingEndBy p)-takeEndBy p m = fromStreamD $ D.takeEndBy p $ toStreamD m---- | Discard first 'n' elements from the stream and take the rest.----{-# INLINE drop #-}-drop :: Monad m => Int -> Stream m a -> Stream m a--- drop n = scanMaybe (Fold.dropping n)-drop n m = fromStreamD $ D.drop n $ toStreamD m----------------------------------------------------------------------------------- Searching----------------------------------------------------------------------------------- | Find all the indices where the element in the stream satisfies the given--- predicate.------ >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)----{-# INLINE findIndices #-}-findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int--- findIndices p = scanMaybe (Fold.findIndices p)-findIndices p m = fromStreamD $ D.findIndices p (toStreamD m)----------------------------------------------------------------------------------- Transformation by Inserting----------------------------------------------------------------------------------- intersperseM = intersperseMWith 1---- | Insert an effect and its output before consuming an element of a stream--- except the first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') input--- h.,e.,l.,l.,o"h,e,l,l,o"------ Be careful about the order of effects. In the above example we used trace--- after the intersperse, if we use it before the intersperse the output would--- be he.l.l.o."h,e,l,l,o".------ >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input--- he.l.l.o."h,e,l,l,o"----{-# INLINE intersperseM #-}-intersperseM :: Monad m => m a -> Stream m a -> Stream m a-intersperseM m = fromStreamD . D.intersperseM m . toStreamD----------------------------------------------------------------------------------- Transformation by Reordering----------------------------------------------------------------------------------- XXX Use a compact region list to temporarily store the list, in both reverse--- as well as in reverse'.------ /Note:/ 'reverse'' is much faster than this, use that when performance--- matters.------ | Returns the elements of the stream in reverse order.  The stream must be--- finite. Note that this necessarily buffers the entire stream in memory.------ >>> reverse = Stream.foldlT (flip Stream.cons) Stream.nil----{-# INLINE reverse #-}-reverse :: Stream m a -> Stream m a-reverse s = fromStreamK $ K.reverse $ toStreamK s---- | Like 'reverse' but several times faster, requires a 'Storable' instance.------ /O(n) space/------ /Pre-release/-{-# INLINE reverse' #-}-reverse' :: (MonadIO m, Unbox a) => Stream m a -> Stream m a--- reverse' s = fromStreamD $ D.reverse' $ toStreamD s-reverse' =-        fromStreamD-        . A.flattenArraysRev -- unfoldMany A.readRev-        . D.fromStreamK-        . K.reverse-        . D.toStreamK-        . A.chunksOf defaultChunkSize-        . toStreamD----------------------------------------------------------------------------------- Combine streams and flatten----------------------------------------------------------------------------------- | Map a stream producing monadic function on each element of the stream--- and then flatten the results into a single stream. Since the stream--- generation function is monadic, unlike 'concatMap', it can produce an--- effect at the beginning of each iteration of the inner loop.------ See 'unfoldMany' for a fusible alternative.----{-# INLINE concatMapM #-}-concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b-concatMapM f m = fromStreamD $ D.concatMapM (fmap toStreamD . f) (toStreamD m)---- | Map a stream producing function on each element of the stream and then--- flatten the results into a single stream.------ >>> concatMap f = Stream.concatMapM (return . f)--- >>> concatMap f = Stream.concatMapWith Stream.append f--- >>> concatMap f = Stream.concat . fmap f--- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream)------ See 'unfoldMany' for a fusible alternative.----{-# INLINE concatMap #-}-concatMap ::Monad m => (a -> Stream m b) -> Stream m a -> Stream m b-concatMap f m = fromStreamD $ D.concatMap (toStreamD . f) (toStreamD m)---- >>> concatEffect = Stream.concat . lift    -- requires (MonadTrans t)--- >>> concatEffect = join . lift             -- requires (MonadTrans t, Monad (Stream m))---- | Given a stream value in the underlying monad, lift and join the underlying--- monad with the stream monad.------ >>> concatEffect = Stream.concat . Stream.fromEffect------ See also: 'concat', 'sequence'------ See 'concatEffect2' for a fusible alternative.------  /CPS/----{-# INLINE concatEffect #-}-concatEffect :: Monad m => m (Stream m a) -> Stream m a-concatEffect generator =-    fromStreamK $ K.concatEffect $ fmap toStreamK generator--{-# INLINE concatEffect2 #-}-concatEffect2 :: Monad m => m (Stream m a) -> Stream m a--- concatEffect generator = concatMapM (\() -> generator) (fromPure ())-concatEffect2 generator =-    fromStreamD $ D.concatEffect $ fmap toStreamD generator---- XXX Need a more intuitive name, and need to reconcile the names--- foldMany/fold/parse/parseMany/parseManyPost etc.---- | Like 'foldMany' but evaluates the fold before the stream, and yields its--- output even if the stream is empty, therefore, always results in a non-empty--- output even on an empty stream (default result of the fold).------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f--- >>> fmany $ Stream.fromList []--- [0]------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7,0]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream without consuming the input.------ /Pre-release/----{-# INLINE foldManyPost #-}-foldManyPost-    :: Monad m-    => Fold m a b-    -> Stream m a-    -> Stream m b-foldManyPost f m = fromStreamD $ D.foldManyPost f (toStreamD m)----------------------------------------------------------------------------------- Zipping----------------------------------------------------------------------------------- | Like 'zipWith' but using a monadic zipping function.----{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c-zipWithM f m1 m2 = fromStreamK $ K.zipWithM f (toStreamK m1) (toStreamK m2)---- | Stream @a@ is evaluated first, followed by stream @b@, the resulting--- elements @a@ and @b@ are then zipped using the supplied zip function and the--- result @c@ is yielded to the consumer.------ If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends--- first, the element @a@ from previous evaluation of stream @a@ is discarded.------ >>> s1 = Stream.fromList [1,2,3]--- >>> s2 = Stream.fromList [4,5,6]--- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2--- [5,7,9]----{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWith f m1 m2 = fromStreamK $ K.zipWith f (toStreamK m1) (toStreamK m2)
− src/Streamly/Internal/Data/Stream/Chunked.hs 
@@ -1,1215 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Chunked--- 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.Stream.Chunked-    (-    -- * Creation-      chunksOf--    -- * Flattening to elements-    , concat-    , concatRev-    , interpose-    , interposeSuffix-    , intercalateSuffix-    , unlines--    -- * Elimination-    -- ** Element Folds-    -- The byte level foldBreak can work as efficiently as the chunk level. We-    -- can flatten the stream to byte stream and use that. But if we want the-    -- remaining stream to be a chunk stream then this could be handy. But it-    -- could also be implemented using parseBreak.-    , foldBreak -- StreamK.foldBreakChunks-    , foldBreakD-    -- The byte level parseBreak cannot work efficiently. Because the stream-    -- will have to be a StreamK for backtracking, StreamK at byte level would-    -- not be efficient.-    , parseBreak -- StreamK.parseBreakChunks-    -- , parseBreakD-    -- , foldManyChunks-    -- , parseManyChunks--    -- ** Array Folds-    -- XXX Use Parser.Chunked instead, need only chunkedParseBreak,-    -- foldBreak can be implemented using parseBreak. Use StreamK.-    , runArrayFold-    , runArrayFoldBreak-    -- , parseArr-    , runArrayParserDBreak -- StreamK.chunkedParseBreak-    , runArrayFoldMany     -- StreamK.chunkedParseMany--    , toArray--    -- * Compaction-    -- We can use something like foldManyChunks, parseManyChunks with a take-    -- fold.-    , lpackArraysChunksOf -- Fold.compactChunks-    , compact -- rechunk, compactChunks--    -- * Splitting-    -- We can use something like foldManyChunks, parseManyChunks with an-    -- appropriate splitting fold.-    , splitOn       -- Stream.rechunkOn-    , splitOnSuffix -- Stream.rechunkOnSuffix-    )-where--#include "ArrayMacros.h"-#include "inline.hs"--import Data.Bifunctor (second)-import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Streamly.Internal.Data.Unboxed (Unbox, peekWith, sizeOf)-import Fusion.Plugin.Types (Fuse(..))-import GHC.Exts (SpecConstrAnnotation(..))-import GHC.Types (SPEC(..))-import Prelude hiding (null, last, (!!), read, concat, unlines)--import Streamly.Data.Fold (Fold)-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Array.Mut.Type (MutArray)-import Streamly.Internal.Data.Fold.Chunked (ChunkFold(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamK (StreamK, fromStream, toStream)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Array.Mut.Type-    (allocBytesToElemCount)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Data.Fold as FL-import qualified Streamly.Internal.Data.Array as A-import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Mut.Stream as AS-import qualified Streamly.Internal.Data.Fold.Type as FL (Fold(..), Step(..))-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-    (Parser(..), Initial(..))-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K---- XXX Since these are immutable arrays MonadIO constraint can be removed from--- most places.------------------------------------------------------------------------------------ Generation------------------------------------------------------------------------------------ | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ > chunksOf n = Stream.groupsOf n (Array.writeN n)------ /Pre-release/-{-# INLINE chunksOf #-}-chunksOf :: (MonadIO m, Unbox a)-    => Int -> Stream m a -> Stream m (Array a)-chunksOf = A.chunksOf------------------------------------------------------------------------------------ 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 :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- concat m = fromStreamD $ A.flattenArrays (toStreamD m)--- concat m = fromStreamD $ D.concatMap A.toStreamD (toStreamD m)-concat = D.unfoldMany A.reader---- | Convert a stream of arrays into a stream of their elements reversing the--- contents of each array before flattening.------ > concatRev = Stream.unfoldMany Array.readerRev------ @since 0.7.0-{-# INLINE concatRev #-}-concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m)-concatRev = D.unfoldMany A.readerRev------------------------------------------------------------------------------------ Intersperse and append------------------------------------------------------------------------------------ | Flatten a stream of arrays after inserting the given element between--- arrays.------ /Pre-release/-{-# INLINE interpose #-}-interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a-interpose x = D.interpose x A.reader--{-# INLINE intercalateSuffix #-}-intercalateSuffix :: (Monad m, Unbox a)-    => Array a -> Stream m (Array a) -> Stream m a-intercalateSuffix = D.intercalateSuffix A.reader---- | Flatten a stream of arrays appending the given element after each--- array.------ @since 0.7.0-{-# INLINE interposeSuffix #-}-interposeSuffix :: (Monad m, Unbox a)-    => a -> Stream m (Array a) -> Stream m a--- interposeSuffix x = fromStreamD . A.unlines x . toStreamD-interposeSuffix x = D.interposeSuffix x A.reader--data FlattenState s =-      OuterLoop s-    | InnerLoop s !MA.MutableByteArray !Int !Int---- XXX This is a special case of interposeSuffix, can be removed.--- XXX Remove monadIO constraint-{-# INLINE_NORMAL unlines #-}-unlines :: forall m a. (MonadIO m, Unbox a)-    => a -> D.Stream m (Array a) -> D.Stream m a-unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state)-    where-    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield Array{..} s ->-                D.Skip (InnerLoop s arrContents arrStart arrEnd)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p end) | p == end =-        return $ D.Yield sep $ OuterLoop st--    step' _ (InnerLoop st contents p end) = do-        x <- liftIO $ peekWith contents p-        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)------------------------------------------------------------------------------------ Compact------------------------------------------------------------------------------------ XXX These would not be needed once we implement compactLEFold, see--- module Streamly.Internal.Data.Array.Mut.Stream------ XXX Note that this thaws immutable arrays for appending, that may be--- problematic if multiple users do the same thing, however, immutable arrays--- would usually have no capacity to append, therefore, a copy will be forced--- anyway. Confirm this. We can forcefully trim the array capacity before thaw--- to ensure this.-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)-packArraysChunksOf n str =-    D.map A.unsafeFreeze $ AS.packArraysChunksOf n $ D.map A.unsafeThaw str---- XXX instead of writing two different versions of this operation, we should--- write it as a pipe.------ XXX Confirm that immutable arrays won't be modified.-{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> Fold m (Array a) () -> Fold m (Array a) ()-lpackArraysChunksOf n fld =-    FL.lmap A.unsafeThaw $ AS.lpackArraysChunksOf n (FL.lmap A.unsafeFreeze 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, Unbox a)-    => Int -> Stream m (Array a) -> Stream m (Array a)-compact = packArraysChunksOf------------------------------------------------------------------------------------ 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 byte (D.Stream step state) = D.Stream step' (Initial state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Initial st) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                (arr1, marr2) <- A.breakOn byte arr-                return $ case marr2 of-                    Nothing   -> D.Skip (Buffering s arr1)-                    Just arr2 -> D.Skip (Yielding arr1 (Splitting s arr2))-            D.Skip s -> return $ D.Skip (Initial s)-            D.Stop -> return D.Stop--    step' gst (Buffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                (arr1, marr2) <- A.breakOn byte arr-                buf' <- A.splice buf arr1-                return $ case marr2 of-                    Nothing -> D.Skip (Buffering s buf')-                    Just x -> D.Skip (Yielding buf' (Splitting s x))-            D.Skip s -> return $ D.Skip (Buffering s buf)-            D.Stop -> return $-                if A.byteLength buf == 0-                then D.Stop-                else D.Skip (Yielding buf Finishing)--    step' _ (Splitting st buf) = do-        (arr1, marr2) <- A.breakOn byte buf-        return $ case marr2 of-                Nothing -> D.Skip $ Buffering st arr1-                Just arr2 -> D.Skip $ Yielding arr1 (Splitting st arr2)--    step' _ (Yielding arr next) = return $ D.Yield arr next-    step' _ Finishing = return 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-    :: (MonadIO m)-    => Word8-    -> Stream m (Array Word8)-    -> Stream m (Array Word8)-splitOn byte = D.splitInnerBy (A.breakOn byte) A.splice--{-# INLINE splitOnSuffix #-}-splitOnSuffix-    :: (MonadIO m)-    => Word8-    -> Stream m (Array Word8)-    -> Stream m (Array Word8)--- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s-splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice------------------------------------------------------------------------------------ Elimination - Running folds----------------------------------------------------------------------------------{-# INLINE_NORMAL foldBreakD #-}-foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>-    Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))-foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do-    res <- initial-    case res of-        FL.Partial fs -> go SPEC state fs-        FL.Done fb -> return $! (fb, stream)--    where--    {-# INLINE go #-}-    go !_ st !fs = do-        r <- step defState st-        case r of-            D.Yield (Array contents start end) s ->-                let fp = Tuple' end contents-                 in goArray SPEC s fp start fs-            D.Skip s -> go SPEC s fs-            D.Stop -> do-                b <- extract fs-                return (b, D.nil)--    goArray !_ s (Tuple' end _) !cur !fs-        | cur == end = do-            go SPEC s fs-    goArray !_ st fp@(Tuple' end contents) !cur !fs = do-        x <- liftIO $ peekWith contents cur-        res <- fstep fs x-        let next = INDEX_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array contents next end-                return $! (b, D.cons arr (D.Stream step st))-            FL.Partial fs1 -> goArray SPEC st fp next fs1--{-# INLINE_NORMAL foldBreakK #-}-foldBreakK :: forall m a b. (MonadIO m, Unbox a) =>-    Fold m a b -> K.StreamK m (Array a) -> m (b, K.StreamK m (Array a))-foldBreakK (FL.Fold fstep initial extract) stream = do-    res <- initial-    case res of-        FL.Partial fs -> go fs stream-        FL.Done fb -> return (fb, stream)--    where--    {-# INLINE go #-}-    go !fs st = do-        let stop = (, K.nil) <$> extract fs-            single a = yieldk a K.nil-            yieldk (Array contents start end) r =-                let fp = Tuple' end contents-                 in goArray fs r fp start-         in K.foldStream defState yieldk single stop st--    goArray !fs st (Tuple' end _) !cur-        | cur == end = do-            go fs st-    goArray !fs st fp@(Tuple' end contents) !cur = do-        x <- liftIO $ peekWith contents cur-        res <- fstep fs x-        let next = INDEX_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array contents next end-                return $! (b, K.cons arr st)-            FL.Partial fs1 -> goArray fs1 st fp next---- | Fold an array stream using the supplied 'Fold'. Returns the fold result--- and the unconsumed stream.------ > foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)------ /Internal/----{-# INLINE_NORMAL foldBreak #-}-foldBreak ::-       (MonadIO m, Unbox a)-    => Fold m a b-    -> StreamK m (A.Array a)-    -> m (b, StreamK m (A.Array a))--- foldBreak f s = fmap fromStreamD <$> foldBreakD f (toStreamD s)-foldBreak = foldBreakK--- If foldBreak performs better than runArrayFoldBreak we can use a rewrite--- rule to rewrite runArrayFoldBreak to fold.--- foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)------------------------------------------------------------------------------------ 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. Unbox a => Int -> [Array a] -> [Array a]-takeArrayListRev = go--    where--    go _ [] = []-    go n _ | n <= 0 = []-    go n (x:xs) =-        let len = Array.length x-        in if n > len-           then x : go (n - len) xs-           else if n == len-           then [x]-           else let !(Array contents _ end) = x-                    !start = end - (n * SIZE_OF(a))-                 in [Array contents start 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. Unbox a => Int -> [Array a] -> ([Array a],[Array a])-splitAtArrayListRev n ls-  | n <= 0 = ([], ls)-  | otherwise = go n ls-    where-        go :: Int -> [Array a] -> ([Array a], [Array a])-        go _  []     = ([], [])-        go m (x:xs) =-            let len = Array.length x-                (xs', xs'') = go (m - len) xs-             in if m > len-                then (x:xs', xs'')-                else if m == len-                then ([x],xs)-                else let !(Array contents start end) = x-                         end1 = end - (m * SIZE_OF(a))-                         arr2 = Array contents start end1-                         arr1 = Array contents end1 end-                      in ([arr1], arr2: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, Unbox a)-    => Int -> Stream m (MutArray a) -> m (MutArray a)-spliceArraysLenUnsafe len buffered = do-    arr <- liftIO $ MA.newPinned len-    D.foldlM' MA.spliceUnsafe (return arr) buffered--{-# INLINE _spliceArrays #-}-_spliceArrays :: (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-_spliceArrays s = do-    buffered <- D.foldr K.cons K.nil s-    len <- K.fold FL.sum (fmap Array.length buffered)-    arr <- liftIO $ MA.newPinned len-    final <- D.foldlM' writeArr (return arr) (toStream buffered)-    return $ A.unsafeFreeze final--    where--    writeArr dst arr = MA.spliceUnsafe dst (A.unsafeThaw arr)--{-# INLINE _spliceArraysBuffered #-}-_spliceArraysBuffered :: (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-_spliceArraysBuffered s = do-    buffered <- D.foldr K.cons K.nil s-    len <- K.fold FL.sum (fmap Array.length buffered)-    A.unsafeFreeze <$>-        spliceArraysLenUnsafe len (fmap A.unsafeThaw (toStream buffered))--{-# INLINE spliceArraysRealloced #-}-spliceArraysRealloced :: forall m a. (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-spliceArraysRealloced s = do-    let n = allocBytesToElemCount (undefined :: a) (4 * 1024)-        idst = liftIO $ MA.newPinned n--    arr <- D.foldlM' MA.spliceExp idst (fmap A.unsafeThaw s)-    liftIO $ A.unsafeFreeze <$> MA.rightSize 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, Unbox a) => Stream m (Array a) -> m (Array a)-toArray = 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 :: (MonadIO m, Unbox 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, Unbox a)-    => Int -> Fold m a (Stream Identity (Array a))-_toArraysOf n = FL.groupsOf 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 {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 parseBreakD #-}-parseBreakD ::-       forall m a b. (MonadIO m, MonadThrow m, Unbox a)-    => PRD.Parser a m b-    -> D.Stream m (Array.Array a)-    -> m (b, D.Stream m (Array.Array a))-parseBreakD-    (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do--    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (b, stream)-        PRD.IError err -> throwM $ ParseError 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 !_ st backBuf !pst = do-        r <- step defState st-        case r of-            D.Yield (Array contents start end) s ->-                gobuf SPEC s backBuf-                    (Tuple' end contents) start pst-            D.Skip s -> go SPEC s backBuf pst-            D.Stop -> do-                b <- extract pst-                return (b, D.nil)--    -- Use strictness on "cur" to keep it unboxed-    gobuf !_ s backBuf (Tuple' end _) !cur !pst-        | cur == end = do-            go SPEC s backBuf pst-    gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do-        x <- liftIO $ peekWith contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 pst1 ->-                 gobuf SPEC s (List []) fp next pst1-            PR.Partial n pst1 -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let src0 = Prelude.take n (x:getList backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                let !(Array cont1 start end1) = src-                    fp1 = Tuple' end1 cont1-                gobuf SPEC s (List []) fp1 start pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC s (List (x:getList backBuf)) fp next pst1-            PR.Continue n pst1 -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:getList backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                let !(Array cont1 start end1) = src-                    fp1 = Tuple' end1 cont1-                gobuf SPEC s (List buf1) fp1 start pst1-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (b, D.cons arr (D.Stream step s))-            PR.Done n b -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let src0 = Prelude.take n (x:getList backBuf)-                    -- XXX create the array in reverse instead-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    -- XXX Use StreamK to avoid adding arbitrary layers of-                    -- constructors every time.-                    str = D.cons arr0 (D.cons arr1 (D.Stream step s))-                return (b, str)-            PR.Error err -> throwM $ ParseError err--}--{-# INLINE_NORMAL parseBreakK #-}-parseBreakK ::-       forall m a b. (MonadIO m, Unbox a)-    => PRD.Parser a m b-    -> K.StreamK m (Array.Array a)-    -> m (Either ParseError b, K.StreamK m (Array.Array a))-parseBreakK (PRD.Parser pstep initial extract) stream = do-    res <- initial-    case res of-        PRD.IPartial s -> go s stream []-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    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 !pst st backBuf = do-        let stop = goStop pst backBuf -- (, K.nil) <$> extract pst-            single a = yieldk a K.nil-            yieldk arr r = goArray pst backBuf r arr-         in K.foldStream defState yieldk single stop st--    -- Use strictness on "cur" to keep it unboxed-    goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf-    goArray !pst backBuf st (Array contents cur end) = do-        x <- liftIO $ peekWith contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 s ->-                 goArray s [] st (Array contents next end)-            PR.Partial n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goArray s [] st src-            PR.Continue 0 s ->-                goArray s (x:backBuf) st (Array contents next end)-            PR.Continue n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goArray s buf1 st src-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (Right b, K.cons arr st)-            PR.Done n b -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    str = K.cons arr0 (K.cons arr1 st)-                return (Right b, str)-            PR.Error err -> do-                let str = K.cons (Array contents cur end) stream-                return (Left (ParseError err), str)--    -- This is a simplified goArray-    goExtract !pst backBuf (Array _ cur end)-        | cur == end = goStop pst backBuf-    goExtract !pst backBuf (Array contents cur end) = do-        x <- liftIO $ peekWith contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 s ->-                 goExtract s [] (Array contents next end)-            PR.Partial n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goExtract s [] src-            PR.Continue 0 s ->-                goExtract s backBuf (Array contents next end)-            PR.Continue n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goExtract s buf1 src-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (Right b, K.fromPure arr)-            PR.Done n b -> do-                assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    str = K.cons arr0 (K.fromPure arr1)-                return (Right b, str)-            PR.Error err -> do-                let str = K.fromPure (Array contents cur end)-                return (Left (ParseError err), str)--    -- This is a simplified goExtract-    {-# INLINE goStop #-}-    goStop !pst backBuf = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-            PR.Continue 0 s ->-                goStop s backBuf-            PR.Continue n s -> do-                assert (n <= Prelude.length backBuf) (return ())-                let (src0, buf1) = splitAt n backBuf-                    arr = A.fromListN n (Prelude.reverse src0)-                goExtract s buf1 arr-            PR.Done 0 b ->-                return (Right b, K.nil)-            PR.Done n b -> do-                assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                return (Right b, K.fromPure arr0)-            PR.Error err ->-                return (Left (ParseError err), K.nil)---- | 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 parseBreak #-}-parseBreak ::-       (MonadIO m, Unbox a)-    => PR.Parser a m b-    -> StreamK m (A.Array a)-    -> m (Either ParseError b, StreamK m (A.Array a))-{--parseBreak p s =-    fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)--}-parseBreak = parseBreakK------------------------------------------------------------------------------------ Elimination - Running Array Folds and parsers------------------------------------------------------------------------------------ | Note that this is not the same as using a @Parser (Array a) m b@ with the--- regular "Streamly.Internal.Data.IsStream.parse" function. The regular parse--- would consume the input arrays as single unit. This parser parses in the way--- as described in the ChunkFold module. The input arrays are treated as @n@--- element units and can be consumed partially. The remaining elements are--- inserted in the source stream as an array.----{-# INLINE_NORMAL runArrayParserDBreak #-}-runArrayParserDBreak ::-       forall m a b. (MonadIO m, Unbox a)-    => PRD.Parser (Array a) m b-    -> D.Stream m (Array.Array a)-    -> m (Either ParseError b, D.Stream m (Array.Array a))-runArrayParserDBreak-    (PRD.Parser pstep initial extract)-    stream@(D.Stream step state) = do--    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    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 _ st backBuf !pst = do-        r <- step defState st-        case r of-            D.Yield x s -> gobuf SPEC [x] s backBuf pst-            D.Skip s -> go SPEC s backBuf pst-            D.Stop -> goStop backBuf pst--    gobuf !_ [] s backBuf !pst = go SPEC s backBuf pst-    gobuf !_ (x:xs) s backBuf !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                 gobuf SPEC xs s (List []) pst1-            PR.Partial n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC src s (List []) pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC xs s (List (x:getList backBuf)) pst1-            PR.Continue n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC src s (List buf1) pst1-            PR.Done 0 b -> do-                let str = D.append (D.fromList xs) (D.Stream step s)-                return (Right b, str)-            PR.Done n b -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src = Prelude.reverse src0 ++ xs-                return (Right b, D.append (D.fromList src) (D.Stream step s))-            PR.Error err -> do-                let strm = D.append (D.fromList (x:xs)) (D.Stream step s)-                return (Left (ParseError err), strm)--    -- This is a simplified gobuf-    goExtract _ [] backBuf !pst = goStop backBuf pst-    goExtract _ (x:xs) backBuf !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                 goExtract SPEC xs (List []) pst1-            PR.Partial n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC src (List []) pst1-            PR.Continue 0 pst1 ->-                goExtract SPEC xs (List (x:getList backBuf)) pst1-            PR.Continue n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC src (List buf1) pst1-            PR.Done 0 b ->-                return (Right b, D.fromList xs)-            PR.Done n b -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src = Prelude.reverse src0 ++ xs-                return (Right b, D.fromList src)-            PR.Error err ->-                return (Left (ParseError err), D.fromList (x:xs))--    -- This is a simplified goExtract-    {-# INLINE goStop #-}-    goStop backBuf pst = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: runArrayParserDBreak: Partial in extract"-            PR.Continue 0 pst1 ->-                goStop backBuf pst1-            PR.Continue n pst1 -> do-                assert-                    (n <= sum (map Array.length (getList backBuf)))-                    (return ())-                let (src0, buf1) = splitAtArrayListRev n (getList backBuf)-                    src = Prelude.reverse src0-                goExtract SPEC src (List buf1) pst1-            PR.Done 0 b -> return (Right b, D.nil)-            PR.Done n b -> do-                assert-                    (n <= sum (map Array.length (getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (getList backBuf)-                    src = Prelude.reverse src0-                return (Right b, D.fromList src)-            PR.Error err ->-                return (Left (ParseError err), D.nil)--{---- | 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, Unbox a)-    => ASF.Parser a m b-    -> Stream m (A.Array a)-    -> m (b, Stream m (A.Array a))-parseArr p s = fmap fromStreamD <$> parseBreakD p (toStreamD s)--}---- | Fold an array stream using the supplied array stream 'Fold'.------ /Pre-release/----{-# INLINE runArrayFold #-}-runArrayFold :: (MonadIO m, Unbox a) =>-    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b)-runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStream s)---- | Like 'fold' but also returns the remaining stream.------ /Pre-release/----{-# INLINE runArrayFoldBreak #-}-runArrayFoldBreak :: (MonadIO m, Unbox a) =>-    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b, StreamK m (A.Array a))-runArrayFoldBreak (ChunkFold p) s =-    second fromStream <$> runArrayParserDBreak p (toStream s)--{-# ANN type ParseChunksState Fuse #-}-data ParseChunksState x inpBuf st pst =-      ParseChunksInit inpBuf st-    | ParseChunksInitBuf inpBuf-    | ParseChunksInitLeftOver inpBuf-    | ParseChunksStream st inpBuf !pst-    | ParseChunksStop inpBuf !pst-    | ParseChunksBuf inpBuf st inpBuf !pst-    | ParseChunksExtract inpBuf inpBuf !pst-    | ParseChunksYield x (ParseChunksState x inpBuf st pst)--{-# INLINE_NORMAL runArrayFoldManyD #-}-runArrayFoldManyD-    :: (Monad m, Unbox a)-    => ChunkFold m a b-    -> D.Stream m (Array a)-    -> D.Stream m (Either ParseError b)-runArrayFoldManyD-    (ChunkFold (PRD.Parser pstep initial extract)) (D.Stream step state) =--    D.Stream stepOuter (ParseChunksInit [] 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 gst (ParseChunksInit [] st) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                res <- initial-                case res of-                    PRD.IPartial ps ->-                        return $ D.Skip $ ParseChunksBuf [x] s [] ps-                    PRD.IDone pb -> do-                        let next = ParseChunksInit [x] s-                        return $ D.Skip $ ParseChunksYield (Right pb) next-                    PRD.IError err -> do-                        let next = ParseChunksInitLeftOver []-                        return-                            $ D.Skip-                            $ ParseChunksYield (Left (ParseError err)) next-            D.Skip s -> return $ D.Skip $ ParseChunksInit [] s-            D.Stop   -> return D.Stop--    -- Buffer is not empty, go to buffered processing loop-    stepOuter _ (ParseChunksInit src st) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ D.Skip $ ParseChunksBuf src st [] ps-            PRD.IDone pb ->-                let next = ParseChunksInit src st-                 in return $ D.Skip $ ParseChunksYield (Right pb) next-            PRD.IError err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    -- This is a simplified ParseChunksInit-    stepOuter _ (ParseChunksInitBuf src) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ D.Skip $ ParseChunksExtract src [] ps-            PRD.IDone pb ->-                let next = ParseChunksInitBuf src-                 in return $ D.Skip $ ParseChunksYield (Right pb) next-            PRD.IError err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    -- XXX we just discard any leftover input at the end-    stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop--    -- Buffer is empty, process elements from the stream-    stepOuter gst (ParseChunksStream st backBuf pst) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 ->-                        return $ D.Skip $ ParseChunksStream s [] pst1-                    PR.Partial n pst1 -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let src0 = takeArrayListRev n (x:backBuf)-                            src  = Prelude.reverse src0-                        return $ D.Skip $ ParseChunksBuf src s [] pst1-                    PR.Continue 0 pst1 ->-                        return $ D.Skip $ ParseChunksStream s (x:backBuf) pst1-                    PR.Continue n pst1 -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let (src0, buf1) = splitAtArrayListRev n (x:backBuf)-                            src  = Prelude.reverse src0-                        return $ D.Skip $ ParseChunksBuf src s buf1 pst1-                    PR.Done 0 b -> do-                        return $ D.Skip $-                            ParseChunksYield (Right b) (ParseChunksInit [] s)-                    PR.Done n b -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let src0 = takeArrayListRev n (x:backBuf)-                            src = Prelude.reverse src0-                            next = ParseChunksInit src s-                        return-                            $ D.Skip-                            $ ParseChunksYield (Right b) next-                    PR.Error err -> do-                        let next = ParseChunksInitLeftOver []-                        return-                            $ D.Skip-                            $ ParseChunksYield (Left (ParseError err)) next--            D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst-            D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst--    -- go back to stream processing mode-    stepOuter _ (ParseChunksBuf [] s buf pst) =-        return $ D.Skip $ ParseChunksStream s buf pst--    -- buffered processing loop-    stepOuter _ (ParseChunksBuf (x:xs) s backBuf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ D.Skip $ ParseChunksBuf xs s [] pst1-            PR.Partial n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksBuf src s [] pst1-            PR.Continue 0 pst1 ->-                return $ D.Skip $ ParseChunksBuf xs s (x:backBuf) pst1-            PR.Continue n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksBuf src s buf1 pst1-            PR.Done 0 b ->-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)-            PR.Done n b -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src = Prelude.reverse src0 ++ xs-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit src s)-            PR.Error err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    -- This is a simplified ParseChunksBuf-    stepOuter _ (ParseChunksExtract [] buf pst) =-        return $ D.Skip $ ParseChunksStop buf pst--    stepOuter _ (ParseChunksExtract (x:xs) backBuf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ D.Skip $ ParseChunksExtract xs [] pst1-            PR.Partial n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksExtract src [] pst1-            PR.Continue 0 pst1 ->-                return $ D.Skip $ ParseChunksExtract xs (x:backBuf) pst1-            PR.Continue n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b ->-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)-            PR.Done n b -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src = Prelude.reverse src0 ++ xs-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next---    -- This is a simplified ParseChunksExtract-    stepOuter _ (ParseChunksStop backBuf pst) = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "runArrayFoldManyD: Partial in extract"-            PR.Continue 0 pst1 ->-                return $ D.Skip $ ParseChunksStop backBuf pst1-            PR.Continue n pst1 -> do-                assert (n <= sum (map Array.length backBuf)) (return ())-                let (src0, buf1) = splitAtArrayListRev n backBuf-                    src  = Prelude.reverse src0-                return $ D.Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b ->-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitLeftOver [])-            PR.Done n b -> do-                assert (n <= sum (map Array.length backBuf)) (return ())-                let src0 = takeArrayListRev n backBuf-                    src = Prelude.reverse src0-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next---- | Apply an 'ChunkFold' repeatedly on an array stream and emit the--- fold outputs in the output stream.------ See "Streamly.Data.Stream.foldMany" for more details.------ /Pre-release/-{-# INLINE runArrayFoldMany #-}-runArrayFoldMany-    :: (Monad m, Unbox a)-    => ChunkFold m a b-    -> StreamK m (Array a)-    -> StreamK m (Either ParseError b)-runArrayFoldMany p m = fromStream $ runArrayFoldManyD p (toStream m)
− src/Streamly/Internal/Data/Stream/Common.hs 
@@ -1,105 +0,0 @@-{-# OPTIONS_GHC -Wno-orphans #-}---- |--- Module      : Streamly.Internal.Data.Stream.Common--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Low level functions using StreamK as the intermediate stream type. These--- functions are used in other stream modules to implement their instances.----module Streamly.Internal.Data.Stream.Common-    (-    -- * Conversion operations-      fromList-    , toList--    -- * Fold operations-    , foldr-    , foldl'-    , fold--    -- * Zip style operations-    , eqBy-    , cmpBy-    )-where--#include "inline.hs"--import Streamly.Internal.Data.Fold.Type (Fold (..))--import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D--import Prelude hiding (foldr, repeat)----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- |--- @--- fromList = 'Prelude.foldr' 'K.cons' 'K.nil'--- @------ Construct a stream from a list of pure values. This is more efficient than--- 'K.fromFoldable' for serial streams.----{-# INLINE_EARLY fromList #-}-fromList :: Monad m => [a] -> K.StreamK m a-fromList = D.toStreamK . D.fromList-{-# RULES "fromList fallback to StreamK" [1]-    forall a. D.toStreamK (D.fromList a) = K.fromFoldable a #-}---- | Convert a stream into a list in the underlying monad.----{-# INLINE toList #-}-toList :: Monad m => K.StreamK m a -> m [a]-toList m = D.toList $ D.fromStreamK m----------------------------------------------------------------------------------- Folds---------------------------------------------------------------------------------{-# INLINE foldrM #-}-foldrM :: Monad m => (a -> m b -> m b) -> m b -> K.StreamK m a -> m b-foldrM step acc m = D.foldrM step acc $ D.fromStreamK m--{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> K.StreamK m a -> m b-foldr f z = foldrM (\a b -> f a <$> b) (return z)---- | Strict left associative fold.----{-# INLINE foldl' #-}-foldl' ::-    Monad m => (b -> a -> b) -> b -> K.StreamK m a -> m b-foldl' step begin m = D.foldl' step begin $ D.fromStreamK m---{-# INLINE fold #-}-fold :: Monad m => Fold m a b -> K.StreamK m a -> m b-fold fld m = D.fold fld $ D.fromStreamK m----------------------------------------------------------------------------------- Comparison----------------------------------------------------------------------------------- | Compare two streams for equality----{-# INLINE eqBy #-}-eqBy :: Monad m =>-    (a -> b -> Bool) -> K.StreamK m a -> K.StreamK m b -> m Bool-eqBy f m1 m2 = D.eqBy f (D.fromStreamK m1) (D.fromStreamK m2)---- | Compare two streams----{-# INLINE cmpBy #-}-cmpBy-    :: Monad m-    => (a -> b -> Ordering) -> K.StreamK m a -> K.StreamK m b -> m Ordering-cmpBy f m1 m2 = D.cmpBy f (D.fromStreamK m1) (D.fromStreamK m2)
+ src/Streamly/Internal/Data/Stream/Container.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Container+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Stream operations that require transformers or containers like Set or Map.++module Streamly.Internal.Data.Stream.Container+    (+      nub++    -- * Joins for unconstrained types+    , joinLeftGeneric+    , joinOuterGeneric++    -- * Joins with Ord constraint+    , joinInner+    , joinLeft+    , joinOuter+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.State.Strict (get, put)+import Data.Function ((&))+import Data.Maybe (isJust)+import Streamly.Internal.Data.Stream.Step (Step(..))+import Streamly.Internal.Data.Stream.Type+    (Stream(..), mkCross, unCross)++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Array.Generic as Array+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Stream.Nesting as Stream+import qualified Streamly.Internal.Data.Stream.Generate as Stream+import qualified Streamly.Internal.Data.Stream.Transform as Stream+import qualified Streamly.Internal.Data.Stream.Transformer as Stream++#include "DocTestDataStream.hs"++-- | The memory used is proportional to the number of unique elements in the+-- stream. If we want to limit the memory we can just use "take" to limit the+-- uniq elements in the stream.+{-# INLINE_NORMAL nub #-}+nub :: (Monad m, Ord a) => Stream m a -> Stream m a+nub (Stream step1 state1) = Stream step (Set.empty, state1)++    where++    step gst (set, st) = do+        r <- step1 gst st+        return+            $ case r of+                Yield x s ->+                    if Set.member x set+                    then Skip (set, s)+                    else Yield x (Set.insert x set, s)+                Skip s -> Skip (set, s)+                Stop -> Stop++-- XXX Generate error if a duplicate insertion is attempted?+toMap ::  (Monad m, Ord k) => Stream m (k, v) -> m (Map.Map k v)+toMap =+    let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty+     in Stream.fold f++-- If the second stream is too big it can be partitioned based on hashes and+-- then we can process one parition at a time.+--+-- XXX An IntMap may be faster when the keys are Int.+-- XXX Use hashmap instead of map?+--+-- | Like 'joinInner' but uses a 'Map' for efficiency.+--+-- If the input streams have duplicate keys, the behavior is undefined.+--+-- For space efficiency use the smaller stream as the second stream.+--+-- Space: O(n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE joinInner #-}+joinInner :: (Monad m, Ord k) =>+    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)+joinInner s1 s2 =+    Stream.concatEffect $ do+        km <- toMap s2+        pure $ Stream.mapMaybe (joinAB km) s1++    where++    joinAB kvm (k, a) =+        case k `Map.lookup` kvm of+            Just b -> Just (k, a, b)+            Nothing -> Nothing++-- XXX We can do this concurrently.+-- XXX If the second stream is sorted and passed as an Array or a seek capable+-- stream then we could use binary search if we have an Ord instance or+-- Ordering returning function. The time complexity would then become (m x log+-- n).++-- XXX Check performance of StreamD vs StreamK++-- | Like 'joinInner' but emit @(a, Just b)@, and additionally, for those @a@'s+-- that are not equal to any @b@ emit @(a, Nothing)@.+--+-- The second stream is evaluated multiple times. If the stream is a+-- consume-once stream then the caller should cache it in an 'Data.Array.Array'+-- before calling this function. Caching may also improve performance if the+-- stream is expensive to evaluate.+--+-- >>> joinRightGeneric eq = flip (Stream.joinLeftGeneric eq)+--+-- Space: O(n) assuming the second stream is cached in memory.+--+-- Time: O(m x n)+--+-- /Unimplemented/+{-# INLINE joinLeftGeneric #-}+joinLeftGeneric :: Monad m =>+    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+joinLeftGeneric eq s1 s2 = Stream.evalStateT (return False) $ unCross $ do+    a <- mkCross (Stream.liftInner s1)+    -- XXX should we use StreamD monad here?+    -- XXX Is there a better way to perform some action at the end of a loop+    -- iteration?+    mkCross (Stream.fromEffect $ put False)+    let final = Stream.concatEffect $ do+            r <- get+            if r+            then pure Stream.nil+            else pure (Stream.fromPure Nothing)+    b <- mkCross (fmap Just (Stream.liftInner s2) `Stream.append` final)+    case b of+        Just b1 ->+            if a `eq` b1+            then do+                mkCross (Stream.fromEffect $ put True)+                return (a, Just b1)+            else mkCross Stream.nil+        Nothing -> return (a, Nothing)++-- XXX rename to joinLeftOrd?++-- | A more efficient 'joinLeft' using a hashmap for efficiency.+--+-- Space: O(n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE joinLeft #-}+joinLeft :: (Ord k, Monad m) =>+    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)+joinLeft s1 s2 =+    Stream.concatEffect $ do+        km <- toMap s2+        return $ fmap (joinAB km) s1++            where++            joinAB km (k, a) =+                case k `Map.lookup` km of+                    Just b -> (k, a, Just b)+                    Nothing -> (k, a, Nothing)++-- XXX We can do this concurrently.++-- XXX Check performance of StreamD vs StreamK++-- | Like 'joinLeft' but emits a @(Just a, Just b)@. Like 'joinLeft', for those+-- @a@'s that are not equal to any @b@ emit @(Just a, Nothing)@, but+-- additionally, for those @b@'s that are not equal to any @a@ emit @(Nothing,+-- Just b)@.+--+-- For space efficiency use the smaller stream as the second stream.+--+-- Space: O(n)+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE joinOuterGeneric #-}+joinOuterGeneric :: MonadIO m =>+       (a -> b -> Bool)+    -> Stream m a+    -> Stream m b+    -> Stream m (Maybe a, Maybe b)+joinOuterGeneric eq s1 s =+    Stream.concatEffect $ do+        inputArr <- Array.fromStream s+        let len = Array.length inputArr+        foundArr <-+            Stream.fold+            (MA.writeN len)+            (Stream.fromList (Prelude.replicate len False))+        return $ go inputArr foundArr `Stream.append` leftOver inputArr foundArr++    where++    leftOver inputArr foundArr =+            let stream1 = Array.read inputArr+                stream2 = Stream.unfold MA.reader foundArr+            in Stream.filter+                    isJust+                    ( Stream.zipWith (\x y ->+                        if y+                        then Nothing+                        else Just (Nothing, Just x)+                        ) stream1 stream2+                    ) & Stream.catMaybes++    evalState = Stream.evalStateT (return False) . unCross++    go inputArr foundArr = evalState $ do+        a <- mkCross (Stream.liftInner s1)+        -- XXX should we use StreamD monad here?+        -- XXX Is there a better way to perform some action at the end of a loop+        -- iteration?+        mkCross (Stream.fromEffect $ put False)+        let final = Stream.concatEffect $ do+                r <- get+                if r+                then pure Stream.nil+                else pure (Stream.fromPure Nothing)+        (i, b) <-+            let stream = Array.read inputArr+             in mkCross+                (Stream.indexed $ fmap Just (Stream.liftInner stream) `Stream.append` final)++        case b of+            Just b1 ->+                if a `eq` b1+                then do+                    mkCross (Stream.fromEffect $ put True)+                    MA.putIndex i foundArr True+                    return (Just a, Just b1)+                else mkCross Stream.nil+            Nothing -> return (Just a, Nothing)++-- Put the b's that have been paired, in another hash or mutate the hash to set+-- a flag. At the end go through @Stream m b@ and find those that are not in that+-- hash to return (Nothing, b).++-- | Like 'joinOuter' but uses a 'Map' for efficiency.+--+-- Space: O(m + n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE joinOuter #-}+joinOuter ::+    (Ord k, MonadIO m) =>+    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)+joinOuter s1 s2 =+    Stream.concatEffect $ do+        km1 <- kvFold s1+        km2 <- kvFold s2++        -- XXX Not sure if toList/fromList would fuse optimally. We may have to+        -- create a fused Map.toStream function.+        let res1 = fmap (joinAB km2)+                        $ Stream.fromList $ Map.toList km1+                    where+                    joinAB km (k, a) =+                        case k `Map.lookup` km of+                            Just b -> (k, Just a, Just b)+                            Nothing -> (k, Just a, Nothing)++        -- XXX We can take advantage of the lookups in the first pass above to+        -- reduce the number of lookups in this pass. If we keep mutable cells+        -- in the second Map, we can flag it in the first pass and not do any+        -- lookup in the second pass if it is flagged.+        let res2 = Stream.mapMaybe (joinAB km1)+                        $ Stream.fromList $ Map.toList km2+                    where+                    joinAB km (k, b) =+                        case k `Map.lookup` km of+                            Just _ -> Nothing+                            Nothing -> Just (k, Nothing, Just b)++        return $ Stream.append res1 res2++        where++        -- XXX Generate error if a duplicate insertion is attempted?+        kvFold =+            let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty+             in Stream.fold f
− src/Streamly/Internal/Data/Stream/Cross.hs 
@@ -1,143 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.Cross--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Cross-    (-      CrossStream (..)-    )-where--import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Applicative (liftA2)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity(..))-import GHC.Exts (IsList(..), IsString(..))-import Streamly.Internal.Data.Stream.Type (Stream)--import qualified Streamly.Internal.Data.Stream.Type as Stream-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---- $setup--- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream----------------------------------------------------------------------------------- Stream with a cross product style monad instance----------------------------------------------------------------------------------- | A newtype wrapper for the 'Stream' type with a cross product style monad--- instance.------ Semigroup instance appends two streams.------ A 'Monad' bind behaves like a @for@ loop:------ >>> :{--- Stream.fold Fold.toList $ unCrossStream $ do---      x <- CrossStream (Stream.fromList [1,2]) -- foreach x in stream---      return x--- :}--- [1,2]------ Nested monad binds behave like nested @for@ loops:------ >>> :{--- Stream.fold Fold.toList $ unCrossStream $ do---     x <- CrossStream (Stream.fromList [1,2]) -- foreach x in stream---     y <- CrossStream (Stream.fromList [3,4]) -- foreach y in stream---     return (x, y)--- :}--- [(1,3),(1,4),(2,3),(2,4)]----newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a}-        deriving (Functor, Semigroup, Monoid, Foldable)---- Pure (Identity monad) stream instances-deriving instance Traversable (CrossStream Identity)-deriving instance IsList (CrossStream Identity a)-deriving instance (a ~ Char) => IsString (CrossStream Identity a)-deriving instance Eq a => Eq (CrossStream Identity a)-deriving instance Ord a => Ord (CrossStream Identity a)-deriving instance Show a => Show (CrossStream Identity a)-deriving instance Read a => Read (CrossStream Identity a)----------------------------------------------------------------------------------- Applicative----------------------------------------------------------------------------------- Note: we need to define all the typeclass operations because we want to--- INLINE them.-instance Monad m => Applicative (CrossStream m) where-    {-# INLINE pure #-}-    pure x = CrossStream (Stream.fromPure x)--    {-# INLINE (<*>) #-}-    (CrossStream s1) <*> (CrossStream s2) =-        CrossStream (Stream.crossApply s1 s2)-    -- (<*>) = K.crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (CrossStream s1) *> (CrossStream s2) =-        CrossStream (Stream.crossApplySnd s1 s2)-    -- (*>)  = K.crossApplySnd--    {-# INLINE (<*) #-}-    (CrossStream s1) <* (CrossStream s2) =-        CrossStream (Stream.crossApplyFst s1 s2)-    -- (<*)  = K.crossApplyFst----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (CrossStream m) where-    return = pure--    -- Benchmarks better with StreamD bind and pure:-    -- toList, filterAllout, *>, *<, >> (~2x)-    ---    -- pure = Stream . D.fromStreamD . D.fromPure-    -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m)--    -- Benchmarks better with CPS bind and pure:-    -- Prime sieve (25x)-    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)-    ---    {-# INLINE (>>=) #-}-    (>>=) (CrossStream m) f =-        CrossStream-            (Stream.fromStreamK-                $ K.bindWith-                    K.append-                    (Stream.toStreamK m)-                    (Stream.toStreamK . unCrossStream . f))--    {-# INLINE (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- Transformers---------------------------------------------------------------------------------instance (MonadIO m) => MonadIO (CrossStream m) where-    liftIO x = CrossStream (Stream.fromEffect $ liftIO x)--instance MonadTrans CrossStream where-    {-# INLINE lift #-}-    lift x = CrossStream (Stream.fromEffect x)--instance (MonadThrow m) => MonadThrow (CrossStream m) where-    throwM = lift . throwM
src/Streamly/Internal/Data/Stream/Eliminate.hs view
@@ -1,233 +1,167 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Eliminate--- Copyright   : (c) 2017 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC------ This module contains functions ending in the shape:------ @--- Stream m a -> m b--- @------ We call them stream folding functions, they reduce a stream @Stream m a@ to--- a monadic value @m b@. +-- A few functions in this module have been adapted from the vector package+-- (c) Roman Leshchinskiy.+-- module Streamly.Internal.Data.Stream.Eliminate     (-    -- * Running Examples-    -- $setup-     -- * Running a 'Fold'-    --  See "Streamly.Internal.Data.Fold".       fold-    , foldBreak-    , foldBreak2-    , foldEither-    , foldEither2-    , foldConcat -    -- * Builders-    , foldAdd-    , foldAddLazy--    -- * Running a 'Parser'-    -- "Streamly.Internal.Data.Parser".+    -- -- * Running a 'Parser'     , parse-    --, parseK     , parseD-    --, parseBreak+    , parseBreak     , parseBreakD      -- * Stream Deconstruction-    -- | foldr and foldl do not provide the remaining stream.  'uncons' is more-    -- general, as it can be used to implement those as well.  It allows to use-    -- the stream one element at a time, and we have the remaining stream all-    -- the time.     , uncons-    , init      -- * Right Folds     , foldrM     , foldr+    , foldrMx+    , foldr1      -- * Left Folds-    -- Lazy left folds are useful only for reversing the stream-    , foldlS+    , foldlM'+    , foldl'+    , foldlMx'+    , foldlx' -    -- * Multi-Stream folds-    -- Full equivalence+    -- * Specific Fold Functions+    , drain+    , mapM_ -- Map and Fold+    , null+    , head+    , headElse+    , tail+    , last+    , elem+    , notElem+    , all+    , any+    , maximum+    , maximumBy+    , minimum+    , minimumBy+    , lookup+    , findM+    , find+    , (!!)+    , the++    -- * To containers+    , toList+    , toListRev++    -- * Multi-Stream Folds+    -- ** Comparisons+    -- | These should probably be expressed using zipping operations.     , eqBy     , cmpBy -    -- finding subsequences+    -- ** Substreams+    -- | These should probably be expressed using parsers.     , isPrefixOf     , isInfixOf     , isSuffixOf+    , isSuffixOfUnbox     , isSubsequenceOf--    -- trimming sequences     , stripPrefix-    -- , stripInfix     , stripSuffix+    , stripSuffixUnbox     ) where  #include "inline.hs" +import Control.Exception (assert) import Control.Monad.IO.Class (MonadIO(..)) import Foreign.Storable (Storable)-import Streamly.Internal.Data.Parser (Parser (..), ParseError (..))-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Stream.Type (Stream)+import GHC.Exts (SpecConstrAnnotation(..))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Parser (ParseError(..))+import Streamly.Internal.Data.SVar.Type (defState)+import Streamly.Internal.Data.Unbox (Unbox) +import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))+ import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamK as K--import Streamly.Internal.Data.Stream.Bottom-import Streamly.Internal.Data.Stream.Type hiding (Stream)+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.Parser as PRD+import qualified Streamly.Internal.Data.Stream.Generate as StreamD+import qualified Streamly.Internal.Data.Stream.Nesting as Nesting+import qualified Streamly.Internal.Data.Stream.Transform as StreamD -import Prelude hiding (foldr, init, reverse)+import Prelude hiding+       ( Foldable(..), all, any, head, last, lookup, mapM, mapM_+       , notElem, splitAt, tail, (!!))+import Data.Foldable (length)+import Streamly.Internal.Data.Stream.Type --- $setup--- >>> :m--- >>> import Streamly.Internal.Data.Stream (Stream)--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold+#include "DocTestDataStream.hs"  --------------------------------------------------------------------------------- Deconstruction+-- Elimination by Folds ------------------------------------------------------------------------------ --- | Decompose a stream into its head and tail. If the stream is empty, returns--- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is--- the head of the stream and @ma@ its tail.------ Properties:------ >>> Nothing <- Stream.uncons Stream.nil--- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil)------ This can be used to consume the stream in an imperative manner one element--- at a time, as it just breaks down the stream into individual elements and we--- can loop over them as we deem fit. For example, this can be used to convert--- a streamly stream into other stream types.------ All the folds in this module can be expressed in terms of 'uncons', however,--- this is generally less efficient than specific folds because it takes apart--- the stream one element at a time, therefore, does not take adavantage of--- stream fusion.------ 'foldBreak' is a more general way of consuming a stream piecemeal.------ >>> :{--- uncons xs = do---     r <- Stream.foldBreak Fold.one xs---     return $ case r of---         (Nothing, _) -> Nothing---         (Just h, t) -> Just (h, t)--- :}------ /CPS/----{-# INLINE uncons #-}-uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons m = fmap (fmap (fmap fromStreamK)) $ K.uncons (toStreamK m)---- | Extract all but the last element of the stream, if any.------ Note: This will end up buffering the entire stream.------ /Pre-release/-{-# INLINE init #-}-init :: Monad m => Stream m a -> m (Maybe (Stream m a))-init m = fmap (fmap fromStreamK) $ K.init $ toStreamK m- ------------------------------------------------------------------------------ -- Right Folds ------------------------------------------------------------------------------ --- | Right associative/lazy pull fold. @foldrM build final stream@ constructs--- an output structure using the step function @build@. @build@ is invoked with--- the next input element and the remaining (lazy) tail of the output--- structure. It builds a lazy output expression using the two. When the "tail--- structure" in the output expression is evaluated it calls @build@ again thus--- lazily consuming the input @stream@ until either the output expression built--- by @build@ is free of the "tail" or the input is exhausted in which case--- @final@ is used as the terminating case for the output structure. For more--- details see the description in the previous section.------ Example, determine if any element is 'odd' in a stream:------ >>> s = Stream.fromList (2:4:5:undefined)--- >>> step x xs = if odd x then return True else xs--- >>> Stream.foldrM step (return False) s--- True----{-# INLINE foldrM #-}-foldrM ::  Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-foldrM step acc m = D.foldrM step acc $ toStreamD m---- | Right fold, lazy for lazy monads and pure streams, and strict for strict--- monads.------ Please avoid using this routine in strict monads like IO unless you need a--- strict right fold. This is provided only for use in lazy monads (e.g.--- Identity) or pure streams. Note that with this signature it is not possible--- to implement a lazy foldr when the monad @m@ is strict. In that case it--- would be strict in its accumulator and therefore would necessarily consume--- all its input.------ >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z)----{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr f z = foldrM (\a b -> f a <$> b) (return z)+{-# INLINE_NORMAL foldr1 #-}+foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)+foldr1 f m = do+     r <- uncons m+     case r of+         Nothing   -> return Nothing+         Just (h, t) -> fmap Just (foldr f h t)  --------------------------------------------------------------------------------- Left Folds+-- Parsers ------------------------------------------------------------------------------ --- | Lazy left fold to a stream.-{-# INLINE foldlS #-}-foldlS ::-    (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b-foldlS f z =-    fromStreamK-        . K.foldlS-            (\xs x -> toStreamK $ f (fromStreamK xs) x)-            (toStreamK z)-        . toStreamK+-- Inlined definition. Without the inline "serially/parser/take" benchmark+-- degrades and parseMany does not fuse. Even using "inline" at the callsite+-- does not help.+{-# INLINE splitAt #-}+splitAt :: Int -> [a] -> ([a],[a])+splitAt n ls+  | n <= 0 = ([], ls)+  | otherwise          = splitAt' n ls+    where+        splitAt' :: Int -> [a] -> ([a], [a])+        splitAt' _  []     = ([], [])+        splitAt' 1  (x:xs) = ([x], xs)+        splitAt' m  (x:xs) = (x:xs', xs'')+          where+            (xs', xs'') = splitAt' (m - 1) xs ---------------------------------------------------------------------------------- Running a Parser-------------------------------------------------------------------------------+-- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need+-- to make a newtype.+{-# ANN type List NoSpecConstr #-}+newtype List a = List {getList :: [a]} --- | Parse a stream using the supplied ParserD 'PRD.Parser'.------ /Internal/---+-- | Run a 'Parse' over a stream. {-# INLINE_NORMAL parseD #-}-parseD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b)-parseD p = D.parseD p . toStreamD---- XXX Drive directly as parserK rather than converting to parserD first.---- | Parse a stream using the supplied ParserK 'PRK.Parser'.------ /Internal/---{-# INLINE parseK #-}---parseK :: Monad m => PRK.Parser a m b -> Stream m a -> m (Either ParseError b)---parseK = parse+parseD+    :: Monad m+    => PRD.Parser a m b+    -> Stream m a+    -> m (Either ParseError b)+parseD parser strm = do+    (b, _) <- parseBreakD parser strm+    return b  -- | Parse a stream using the supplied 'Parser'. --@@ -242,25 +176,486 @@ -- Note: @parse p@ is not the same as  @head . parseMany p@ on an empty stream. -- {-# INLINE [3] parse #-}-parse :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)+parse :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b) parse = parseD +-- XXX It may be a good idea to use constant sized chunks for backtracking. We+-- can take a byte stream but when we have to backtrack we create constant+-- sized chunks. We maintain one forward list and one backward list of constant+-- sized chunks, and a last backtracking offset. That way we just need lists of+-- contents and no need to maintain start/end pointers for individual arrays,+-- reducing bookkeeping work.++-- | Run a 'Parse' over a stream and return rest of the Stream. {-# INLINE_NORMAL parseBreakD #-}-parseBreakD :: Monad m =>-    PRD.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)-parseBreakD parser strm = do-    (b, strmD) <- D.parseBreakD parser (toStreamD strm)-    return $! (b, fromStreamD strmD)+parseBreakD+    :: Monad m+    => PRD.Parser a m b+    -> Stream m a+    -> m (Either ParseError b, Stream m a)+parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do+    res <- initial+    case res of+        PRD.IPartial s -> go SPEC state (List []) s+        PRD.IDone b -> return (Right b, stream)+        PRD.IError err -> return (Left (ParseError err), stream) +    where++    -- "buf" 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 !_ st buf !pst = do+        r <- step defState st+        case r of+            Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.Partial 0 pst1 -> go SPEC s (List []) pst1+                    PR.Partial 1 pst1 -> go1 SPEC s x pst1+                    PR.Partial n pst1 -> do+                        assert (n <= length (x:getList buf)) (return ())+                        let src0 = Prelude.take n (x:getList buf)+                            src  = Prelude.reverse src0+                        gobuf SPEC s (List []) (List src) pst1+                    PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1+                    PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1+                    PR.Continue n pst1 -> do+                        assert (n <= length (x:getList buf)) (return ())+                        let (src0, buf1) = splitAt n (x:getList buf)+                            src  = Prelude.reverse src0+                        gobuf SPEC s (List buf1) (List src) pst1+                    PR.Done 0 b -> return (Right b, Stream step s)+                    PR.Done n b -> do+                        assert (n <= length (x:getList buf)) (return ())+                        let src0 = Prelude.take n (x:getList buf)+                            src  = Prelude.reverse src0+                        -- XXX This would make it quadratic. We should probably+                        -- use StreamK if we have to append many times.+                        return+                            ( Right b,+                              Nesting.append (fromList src) (Stream step s))+                    PR.Error err -> do+                        let src = Prelude.reverse $ x:getList buf+                        return+                            ( Left (ParseError err)+                            , Nesting.append (fromList src) (Stream step s)+                            )++            Skip s -> go SPEC s buf pst+            Stop -> goStop SPEC buf pst++    go1 _ s x !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                go SPEC s (List []) pst1+            PR.Partial 1 pst1 -> do+                go1 SPEC s x pst1+            PR.Partial n _ ->+                error $ "parseBreak: parser bug, go1: Partial n = " ++ show n+            PR.Continue 0 pst1 ->+                go SPEC s (List [x]) pst1+            PR.Continue 1 pst1 ->+                go1 SPEC s x pst1+            PR.Continue n _ -> do+                error $ "parseBreak: parser bug, go1: Continue n = " ++ show n+            PR.Done 0 b -> do+                return (Right b, Stream step s)+            PR.Done 1 b -> do+                return (Right b, StreamD.cons x (Stream step s))+            PR.Done n _ -> do+                error $ "parseBreak: parser bug, go1: Done n = " ++ show n+            PR.Error err ->+                return+                    ( Left (ParseError err)+                    , Nesting.append (fromPure x) (Stream step s)+                    )++    gobuf !_ s buf (List []) !pst = go SPEC s buf pst+    gobuf !_ s buf (List (x:xs)) !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                gobuf SPEC s (List []) (List xs) pst1+            PR.Partial n pst1 -> do+                assert (n <= length (x:getList buf)) (return ())+                let src0 = Prelude.take n (x:getList buf)+                    src  = Prelude.reverse src0 ++ xs+                gobuf SPEC s (List []) (List src) pst1+            PR.Continue 0 pst1 ->+                gobuf SPEC s (List (x:getList buf)) (List xs) pst1+            PR.Continue 1 pst1 ->+                gobuf SPEC s buf (List (x:xs)) pst1+            PR.Continue n pst1 -> do+                assert (n <= length (x:getList buf)) (return ())+                let (src0, buf1) = splitAt n (x:getList buf)+                    src  = Prelude.reverse src0 ++ xs+                gobuf SPEC s (List buf1) (List src) pst1+            PR.Done n b -> do+                assert (n <= length (x:getList buf)) (return ())+                let src0 = Prelude.take n (x:getList buf)+                    src  = Prelude.reverse src0+                return (Right b, Nesting.append (fromList src) (Stream step s))+            PR.Error err -> do+                let src = (Prelude.reverse $ getList buf) ++ x:xs+                return+                    ( Left (ParseError err)+                    , Nesting.append (fromList src) (Stream step s)+                    )++    -- This is simplified gobuf+    goExtract !_ buf (List []) !pst = goStop SPEC buf pst+    goExtract !_ buf (List (x:xs)) !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                goExtract SPEC (List []) (List xs) pst1+            PR.Partial n pst1 -> do+                assert (n <= length (x:getList buf)) (return ())+                let src0 = Prelude.take n (x:getList buf)+                    src  = Prelude.reverse src0 ++ xs+                goExtract SPEC (List []) (List src) pst1+            PR.Continue 0 pst1 ->+                goExtract SPEC (List (x:getList buf)) (List xs) pst1+            PR.Continue 1 pst1 ->+                goExtract SPEC buf (List (x:xs)) pst1+            PR.Continue n pst1 -> do+                assert (n <= length (x:getList buf)) (return ())+                let (src0, buf1) = splitAt n (x:getList buf)+                    src  = Prelude.reverse src0 ++ xs+                goExtract SPEC (List buf1) (List src) pst1+            PR.Done n b -> do+                assert (n <= length (x:getList buf)) (return ())+                let src0 = Prelude.take n (x:getList buf)+                    src  = Prelude.reverse src0+                return (Right b, fromList src)+            PR.Error err -> do+                let src = (Prelude.reverse $ getList buf) ++ x:xs+                return (Left (ParseError err), fromList src)++    -- This is simplified goExtract+    -- XXX Use SPEC?+    {-# INLINE goStop #-}+    goStop _ buf pst = do+        pRes <- extract pst+        case pRes of+            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"+            PR.Continue 0 pst1 -> goStop SPEC buf pst1+            PR.Continue n pst1 -> do+                assert (n <= length (getList buf)) (return ())+                let (src0, buf1) = splitAt n (getList buf)+                    src = Prelude.reverse src0+                goExtract SPEC (List buf1) (List src) pst1+            PR.Done 0 b -> return (Right b, StreamD.nil)+            PR.Done n b -> do+                assert (n <= length (getList buf)) (return ())+                let src0 = Prelude.take n (getList buf)+                    src  = Prelude.reverse src0+                return (Right b, fromList src)+            PR.Error err -> do+                let src  = Prelude.reverse $ getList buf+                return (Left (ParseError err), fromList src)+ -- | Parse a stream using the supplied 'Parser'. ----- /CPS/------{-# INLINE parseBreak #-}---parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)---parseBreak p strm = D.parseBreak p strm+{-# INLINE parseBreak #-}+parseBreak :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+parseBreak = parseBreakD  ------------------------------------------------------------------------------+-- Specialized Folds+------------------------------------------------------------------------------++-- benchmark after dropping 1 item from stream or using unfolds+{-# INLINE_NORMAL null #-}+null :: Monad m => Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+null = fold Fold.null+#else+null = foldrM (\_ _ -> return False) (return True)+#endif++{-# INLINE_NORMAL head #-}+head :: Monad m => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+head = fold Fold.one+#else+head = foldrM (\x _ -> return (Just x)) (return Nothing)+#endif++{-# INLINE_NORMAL headElse #-}+headElse :: Monad m => a -> Stream m a -> m a+headElse a = foldrM (\x _ -> return x) (return a)++-- Does not fuse, has the same performance as the StreamK version.+{-# INLINE_NORMAL tail #-}+tail :: Monad m => Stream m a -> m (Maybe (Stream m a))+tail (UnStream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield _ s -> return (Just $ Stream step s)+            Skip  s   -> go SPEC s+            Stop      -> return Nothing++-- XXX will it fuse? need custom impl?+{-# INLINE_NORMAL last #-}+last :: Monad m => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+last = fold Fold.last+#else+last = foldl' (\_ y -> Just y) Nothing+#endif++-- XXX Use the foldrM based impl instead+{-# INLINE_NORMAL elem #-}+elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+elem e = fold (Fold.elem e)+#else+-- elem e m = foldrM (\x xs -> if x == e then return True else xs) (return False) m+elem e (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s+              | x == e -> return True+              | otherwise -> go SPEC s+            Skip s -> go SPEC s+            Stop   -> return False+#endif++{-# INLINE_NORMAL notElem #-}+notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+notElem e s = fmap not (elem e s)++{-# INLINE_NORMAL all #-}+all :: Monad m => (a -> Bool) -> Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+all p = fold (Fold.all p)+#else+-- all p m = foldrM (\x xs -> if p x then xs else return False) (return True) m+all p (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s+              | p x -> go SPEC s+              | otherwise -> return False+            Skip s -> go SPEC s+            Stop   -> return True+#endif++{-# INLINE_NORMAL any #-}+any :: Monad m => (a -> Bool) -> Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+any p = fold (Fold.any p)+#else+-- any p m = foldrM (\x xs -> if p x then return True else xs) (return False) m+any p (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s+              | p x -> return True+              | otherwise -> go SPEC s+            Skip s -> go SPEC s+            Stop   -> return False+#endif++{-# INLINE_NORMAL maximum #-}+maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+maximum = fold Fold.maximum+#else+maximum (Stream step state) = go SPEC Nothing' state+  where+    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s+              | acc <= x  -> go SPEC (Just' x) s+              | otherwise -> go SPEC (Just' acc) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+maximumBy cmp = fold (Fold.maximumBy cmp)+#else+maximumBy cmp (Stream step state) = go SPEC Nothing' state+  where+    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s -> case cmp acc x of+                GT -> go SPEC (Just' acc) s+                _  -> go SPEC (Just' x) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL minimum #-}+minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+minimum = fold Fold.minimum+#else+minimum (Stream step state) = go SPEC Nothing' state++    where++    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s+              | acc <= x  -> go SPEC (Just' acc) s+              | otherwise -> go SPEC (Just' x) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+minimumBy cmp = fold (Fold.minimumBy cmp)+#else+minimumBy cmp (Stream step state) = go SPEC Nothing' state++    where++    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s -> case cmp acc x of+                GT -> go SPEC (Just' x) s+                _  -> go SPEC (Just' acc) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL (!!) #-}+(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+stream !! i = fold (Fold.index i) stream+#else+(Stream step state) !! i = go SPEC i state++    where++    go !_ !n st = do+        r <- step defState st+        case r of+            Yield x s | n < 0 -> return Nothing+                      | n == 0 -> return $ Just x+                      | otherwise -> go SPEC (n - 1) s+            Skip s -> go SPEC n s+            Stop   -> return Nothing+#endif++{-# INLINE_NORMAL lookup #-}+lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)+#ifdef USE_FOLDS_EVERYWHERE+lookup e = fold (Fold.lookup e)+#else+lookup e = foldrM (\(a, b) xs -> if e == a then return (Just b) else xs)+                   (return Nothing)+#endif++{-# INLINE_NORMAL findM #-}+findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+findM p = fold (Fold.findM p)+#else+findM p = foldrM (\x xs -> p x >>= \r -> if r then return (Just x) else xs)+                   (return Nothing)+#endif++{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+find p = findM (return . p)++{-# INLINE toListRev #-}+toListRev :: Monad m => Stream m a -> m [a]+#ifdef USE_FOLDS_EVERYWHERE+toListRev = fold Fold.toListRev+#else+toListRev = foldl' (flip (:)) []+#endif++------------------------------------------------------------------------------+-- Transformation comprehensions+------------------------------------------------------------------------------++{-# INLINE_NORMAL the #-}+the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+the = fold Fold.the+#else+the (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s -> go' SPEC x s+            Skip s    -> go SPEC s+            Stop      -> return Nothing+    go' !_ n st = do+        r <- step defState st+        case r of+            Yield x s | x == n -> go' SPEC n s+                      | otherwise -> return Nothing+            Skip s -> go' SPEC n s+            Stop   -> return (Just n)+#endif++------------------------------------------------------------------------------+-- Map and Fold+------------------------------------------------------------------------------++-- | Execute a monadic action for each element of the 'Stream'+{-# INLINE_NORMAL mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()+#ifdef USE_FOLDS_EVERYWHERE+mapM_ f = fold (Fold.drainBy f)+#else+mapM_ m = drain . mapM m+#endif++------------------------------------------------------------------------------ -- Multi-stream folds ------------------------------------------------------------------------------ @@ -270,10 +665,91 @@ -- >>> Stream.isPrefixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char) -- True ---{-# INLINE isPrefixOf #-}+{-# INLINE_NORMAL isPrefixOf #-} isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)+isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb +    where++    go !_ Nothing' sa sb = do+        r <- stepa defState sa+        case r of+            Yield x sa' -> go SPEC (Just' x) sa' sb+            Skip sa'    -> go SPEC Nothing' sa' sb+            Stop        -> return True++    go !_ (Just' x) sa sb = do+        r <- stepb defState sb+        case r of+            Yield y sb' ->+                if x == y+                    then go SPEC Nothing' sa sb'+                    else return False+            Skip sb' -> go SPEC (Just' x) sa sb'+            Stop     -> return False++-- | Returns 'True' if all the elements of the first stream occur, in order, in+-- the second stream. The elements do not have to occur consecutively. A stream+-- is a subsequence of itself.+--+-- >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char)+-- True+--+{-# INLINE_NORMAL isSubsequenceOf #-}+isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb++    where++    go !_ Nothing' sa sb = do+        r <- stepa defState sa+        case r of+            Yield x sa' -> go SPEC (Just' x) sa' sb+            Skip sa' -> go SPEC Nothing' sa' sb+            Stop -> return True++    go !_ (Just' x) sa sb = do+        r <- stepb defState sb+        case r of+            Yield y sb' ->+                if x == y+                    then go SPEC Nothing' sa sb'+                    else go SPEC (Just' x) sa sb'+            Skip sb' -> go SPEC (Just' x) sa sb'+            Stop -> return False++-- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@+-- stream if it is a prefix of input. Returns 'Nothing' if the input does not+-- start with the given prefix, stripped input otherwise. Returns @Just nil@+-- when the prefix is the same as the input stream.+--+-- Space: @O(1)@+--+{-# INLINE_NORMAL stripPrefix #-}+stripPrefix+    :: (Monad m, Eq a)+    => Stream m a -> Stream m a -> m (Maybe (Stream m a))+stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb++    where++    go !_ Nothing' sa sb = do+        r <- stepa defState sa+        case r of+            Yield x sa' -> go SPEC (Just' x) sa' sb+            Skip sa'    -> go SPEC Nothing' sa' sb+            Stop        -> return $ Just (Stream stepb sb)++    go !_ (Just' x) sa sb = do+        r <- stepb defState sb+        case r of+            Yield y sb' ->+                if x == y+                    then go SPEC Nothing' sa sb'+                    else return Nothing+            Skip sb' -> go SPEC (Just' x) sa sb'+            Stop     -> return Nothing+ -- | Returns 'True' if the first stream is an infix of the second. A stream is -- considered an infix of itself. --@@ -293,7 +769,7 @@ isInfixOf infx stream = do     arr <- fold Array.write infx     -- XXX can use breakOnSeq instead (when available)-    r <- D.null $ D.drop 1 $ D.splitOnSeq arr Fold.drain $ toStreamD stream+    r <- null $ StreamD.drop 1 $ Nesting.splitOnSeq arr Fold.drain stream     return (not r)  -- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf@@ -326,36 +802,15 @@ -- {-# INLINE isSuffixOf #-} isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSuffixOf suffix stream = reverse suffix `isPrefixOf` reverse stream---- | Returns 'True' if all the elements of the first stream occur, in order, in--- the second stream. The elements do not have to occur consecutively. A stream--- is a subsequence of itself.------ >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char)--- True----{-# INLINE isSubsequenceOf #-}-isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSubsequenceOf m1 m2 = D.isSubsequenceOf (toStreamD m1) (toStreamD m2)---- Note: If we want to return a Maybe value to know whether the--- suffix/infix was present or not along with the stripped stream then--- we need to buffer the whole input stream.+isSuffixOf suffix stream =+    StreamD.reverse suffix `isPrefixOf` StreamD.reverse stream --- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@--- stream if it is a prefix of input. Returns 'Nothing' if the input does not--- start with the given prefix, stripped input otherwise. Returns @Just nil@--- when the prefix is the same as the input stream.------ Space: @O(1)@----{-# INLINE stripPrefix #-}-stripPrefix-    :: (Monad m, Eq a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripPrefix m1 m2 = fmap fromStreamD <$>-    D.stripPrefix (toStreamD m1) (toStreamD m2)+-- | Much faster than 'isSuffixOf'.+{-# INLINE isSuffixOfUnbox #-}+isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) =>+    Stream m a -> Stream m a -> m Bool+isSuffixOfUnbox suffix stream =+    StreamD.reverseUnbox suffix `isPrefixOf` StreamD.reverseUnbox stream  -- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does -- not end with the given suffix. Returns @Just nil@ when the suffix is the@@ -365,8 +820,6 @@ -- stripSuffix on that especially if the elements have a Storable or Prim -- instance. ----- See also "Streamly.Internal.Data.Stream.Reduce.dropSuffix".--- -- Space: @O(n)@, buffers the entire input stream as well as the suffix -- -- /Pre-release/@@ -374,4 +827,15 @@ stripSuffix     :: (Monad m, Eq a)     => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripSuffix m1 m2 = fmap reverse <$> stripPrefix (reverse m1) (reverse m2)+stripSuffix m1 m2 =+    fmap StreamD.reverse+        <$> stripPrefix (StreamD.reverse m1) (StreamD.reverse m2)++-- | Much faster than 'stripSuffix'.+{-# INLINE stripSuffixUnbox #-}+stripSuffixUnbox+    :: (MonadIO m, Eq a, Unbox a)+    => Stream m a -> Stream m a -> m (Maybe (Stream m a))+stripSuffixUnbox m1 m2 =+    fmap StreamD.reverseUnbox+        <$> stripPrefix (StreamD.reverseUnbox m1) (StreamD.reverseUnbox m2)
− src/Streamly/Internal/Data/Stream/Enumerate.hs 
@@ -1,560 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Enumerate--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ The functions defined in this module should be rarely needed for direct use,--- try to use the operations from the 'Enumerable' type class--- instances instead.------ This module provides an 'Enumerable' type class to enumerate 'Enum' types--- into a stream. The operations in this type class correspond to similar--- perations in the 'Enum' type class, the only difference is that they produce--- a stream instead of a list. These operations cannot be defined generically--- based on the 'Enum' type class. We provide instances for commonly used--- types. If instances for other types are needed convenience functions defined--- in this module can be used to define them. Alternatively, these functions--- can be used directly.---- XXX The Unfold.Enumeration module is more modular, check the differences and--- reconcile the two.--module Streamly.Internal.Data.Stream.Enumerate-    (-      Enumerable (..)--    -- ** Enumerating 'Bounded' 'Enum' Types-    , enumerate-    , enumerateTo-    , enumerateFromBounded--    -- ** Enumerating 'Enum' Types not larger than 'Int'-    , enumerateFromToSmall-    , enumerateFromThenToSmall-    , enumerateFromThenSmallBounded--    -- ** Enumerating 'Bounded' 'Integral' Types-    , enumerateFromIntegral-    , enumerateFromThenIntegral--    -- ** Enumerating 'Integral' Types-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    -- ** Enumerating unbounded 'Integral' Types-    , enumerateFromStepIntegral--    -- ** Enumerating 'Fractional' Types-    , enumerateFromFractional-    , enumerateFromToFractional-    , enumerateFromThenFractional-    , enumerateFromThenToFractional-    )-where--import Data.Fixed-import Data.Int-import Data.Ratio-import Data.Word-import Numeric.Natural-import Data.Functor.Identity (Identity(..))--import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD)--import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D---- $setup--- >>> import Streamly.Data.Fold as Fold--- >>> import Streamly.Internal.Data.Stream as Stream--- >>> import Streamly.Internal.Data.Stream.Enumerate as Stream------------------------------------------------------------------------------------ Enumeration of Integral types-------------------------------------------------------------------------------------- | @enumerateFromStepIntegral from step@ generates an infinite stream whose--- first element is @from@ and the successive elements are in increments of--- @step@.------ CAUTION: This function is not safe for finite integral types. It does not--- check for overflow, underflow or bounds.------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)--- [0,-2,-4]------ @----{-# INLINE enumerateFromStepIntegral #-}-enumerateFromStepIntegral-    :: (Monad m, Integral a)-    => a -> a -> Stream m a-enumerateFromStepIntegral from stride =-    fromStreamD $ D.enumerateFromStepIntegral from stride---- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a--- stream whose first element is @from@ and the successive elements are in--- increments of @1@. The stream is bounded by the size of the 'Integral' type.------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)--- [0,1,2,3]------ @----{-# INLINE enumerateFromIntegral #-}-enumerateFromIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> Stream m a-enumerateFromIntegral from = fromStreamD $ D.enumerateFromIntegral from---- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from--- then@ generates a stream whose first element is @from@, the second element--- is @then@ and the successive elements are in increments of @then - from@.--- The stream is bounded by the size of the 'Integral' type.------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)--- [0,-2,-4,-6]------ @----{-# INLINE enumerateFromThenIntegral #-}-enumerateFromThenIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenIntegral from next =-    fromStreamD $ D.enumerateFromThenIntegral from next---- | Enumerate an 'Integral' type up to a given limit.--- @enumerateFromToIntegral from to@ generates a finite stream whose first--- element is @from@ and successive elements are in increments of @1@ up to--- @to@.------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromToIntegral 0 4--- [0,1,2,3,4]------ @----{-# INLINE enumerateFromToIntegral #-}-enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a-enumerateFromToIntegral from to =-    fromStreamD $ D.enumerateFromToIntegral from to---- | Enumerate an 'Integral' type in steps up to a given limit.--- @enumerateFromThenToIntegral from then to@ generates a finite stream whose--- first element is @from@, the second element is @then@ and the successive--- elements are in increments of @then - from@ up to @to@.------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 2 6--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)--- [0,-2,-4,-6]------ @----{-# INLINE enumerateFromThenToIntegral #-}-enumerateFromThenToIntegral-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegral from next to =-    fromStreamD $ D.enumerateFromThenToIntegral from next to------------------------------------------------------------------------------------ Enumeration of Fractional types-------------------------------------------------------------------------------------- Even though the underlying implementation of enumerateFromFractional and--- enumerateFromThenFractional works for any 'Num' we have restricted these to--- 'Fractional' because these do not perform any bounds check, in contrast to--- integral versions and are therefore not equivalent substitutes for those.------ | Numerically stable enumeration from a 'Fractional' number in steps of size--- @1@. @enumerateFromFractional from@ generates a stream whose first element--- is @from@ and the successive elements are in increments of @1@.  No overflow--- or underflow checks are performed.------ This is the equivalent to 'enumFrom' for 'Fractional' types. For example:------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1--- [1.1,2.1,3.1,4.1]------ @-------{-# INLINE enumerateFromFractional #-}-enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a-enumerateFromFractional from = fromStreamD $ D.enumerateFromNum from---- | Numerically stable enumeration from a 'Fractional' number in steps.--- @enumerateFromThenFractional from then@ generates a stream whose first--- element is @from@, the second element is @then@ and the successive elements--- are in increments of @then - from@.  No overflow or underflow checks are--- performed.------ This is the equivalent of 'enumFromThen' for 'Fractional' types. For--- example:------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)--- [1.1,-2.1,-5.300000000000001,-8.500000000000002]------ @----{-# INLINE enumerateFromThenFractional #-}-enumerateFromThenFractional-    :: (Monad m, Fractional a)-    => a -> a -> Stream m a-enumerateFromThenFractional from next = fromStreamD $ D.enumerateFromThenNum from next---- | Numerically stable enumeration from a 'Fractional' number to a given--- limit.  @enumerateFromToFractional from to@ generates a finite stream whose--- first element is @from@ and successive elements are in increments of @1@ up--- to @to@.------ This is the equivalent of 'enumFromTo' for 'Fractional' types. For--- example:------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4.6--- [1.1,2.1,3.1,4.1,5.1]------ @------ Notice that the last element is equal to the specified @to@ value after--- rounding to the nearest integer.----{-# INLINE enumerateFromToFractional #-}-enumerateFromToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> Stream m a-enumerateFromToFractional from to =-    fromStreamD $ D.enumerateFromToFractional from to---- | Numerically stable enumeration from a 'Fractional' number in steps up to a--- given limit.  @enumerateFromThenToFractional from then to@ generates a--- finite stream whose first element is @from@, the second element is @then@--- and the successive elements are in increments of @then - from@ up to @to@.------ This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For--- example:------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 2 6--- [0.1,2.0,3.9,5.799999999999999]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)--- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]------ @-------{-# INLINE enumerateFromThenToFractional #-}-enumerateFromThenToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> a -> Stream m a-enumerateFromThenToFractional from next to =-    fromStreamD $ D.enumerateFromThenToFractional from next to------------------------------------------------------------------------------------ Enumeration of Enum types not larger than Int-------------------------------------------------------------------------------------- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromToSmall #-}-enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a-enumerateFromToSmall from to =-      fmap toEnum-    $ enumerateFromToIntegral (fromEnum from) (fromEnum to)---- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromThenToSmall #-}-enumerateFromThenToSmall :: (Monad m, Enum a)-    => a -> a -> a -> Stream m a-enumerateFromThenToSmall from next to =-          fmap toEnum-        $ enumerateFromThenToIntegral-            (fromEnum from) (fromEnum next) (fromEnum to)---- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.------ Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a--- type is bounded but does not have a 'Bounded' instance then we can go on--- enumerating it beyond the legal values of the type, resulting in the failure--- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'--- instance for this function to be safely used.----{-# INLINE enumerateFromThenSmallBounded #-}-enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenSmallBounded from next =-    if fromEnum next >= fromEnum from-    then enumerateFromThenTo from next maxBound-    else enumerateFromThenTo from next minBound------------------------------------------------------------------------------------ Enumerable type class-------------------------------------------------------------------------------------- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream--- enumerations like this:------ {-# RULES "fromList enumFrom" [1]---     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}------ But this does not work because enumFrom is a class method and GHC rewrites--- it quickly, so we do not get a chance to have our rule fired.---- | Types that can be enumerated as a stream. The operations in this type--- class are equivalent to those in the 'Enum' type class, except that these--- generate a stream instead of a list. Use the functions in--- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.----class Enum a => Enumerable a where-    -- | @enumerateFrom from@ generates a stream starting with the element-    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or-    -- generating an infinite stream when the type is not 'Bounded'.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)-    -- [0,1,2,3]-    ---    -- @-    ---    -- For 'Fractional' types, enumeration is numerically stable. However, no-    -- overflow or underflow checks are performed.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1-    -- [1.1,2.1,3.1,4.1]-    ---    -- @-    ---    enumerateFrom :: (Monad m) => a -> Stream m a--    -- | Generate a finite stream starting with the element @from@, enumerating-    -- the type up to the value @to@. If @to@ is smaller than @from@ then an-    -- empty stream is returned.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 0 4-    -- [0,1,2,3,4]-    ---    -- @-    ---    -- For 'Fractional' types, the last element is equal to the specified @to@-    -- value after rounding to the nearest integral value.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4-    -- [1.1,2.1,3.1,4.1]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4.6-    -- [1.1,2.1,3.1,4.1,5.1]-    ---    -- @-    ---    enumerateFromTo :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThen from then@ generates a stream whose first element-    -- is @from@, the second element is @then@ and the successive elements are-    -- in increments of @then - from@.  Enumeration can occur downwards or-    -- upwards depending on whether @then@ comes before or after @from@. For-    -- 'Bounded' types the stream ends when 'maxBound' is reached, for-    -- unbounded types it keeps enumerating infinitely.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)-    -- [0,-2,-4,-6]-    ---    -- @-    ---    enumerateFromThen :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThenTo from then to@ generates a finite stream whose-    -- first element is @from@, the second element is @then@ and the successive-    -- elements are in increments of @then - from@ up to @to@. Enumeration can-    -- occur downwards or upwards depending on whether @then@ comes before or-    -- after @from@.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 2 6-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)-    -- [0,-2,-4,-6]-    ---    -- @-    ---    enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a---- MAYBE: Sometimes it is more convenient to know the count rather then the--- ending or starting element. For those cases we can define the folllowing--- APIs. All of these will work only for bounded types if we represent the--- count by Int.------ enumerateN--- enumerateFromN--- enumerateToN--- enumerateFromStep--- enumerateFromStepN------------------------------------------------------------------------------------ Convenient functions for bounded types-------------------------------------------------------------------------------------- |--- > enumerate = enumerateFrom minBound------ Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'----{-# INLINE enumerate #-}-enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a-enumerate = enumerateFrom minBound---- |--- > enumerateTo = enumerateFromTo minBound------ Enumerate a 'Bounded' type from its 'minBound' to specified value.----{-# INLINE enumerateTo #-}-enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a-enumerateTo = enumerateFromTo minBound---- |--- > enumerateFromBounded = enumerateFromTo from maxBound------ 'enumerateFrom' for 'Bounded' 'Enum' types.----{-# INLINE enumerateFromBounded #-}-enumerateFromBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> Stream m a-enumerateFromBounded from = enumerateFromTo from maxBound------------------------------------------------------------------------------------ Enumerable Instances-------------------------------------------------------------------------------------- For Enum types smaller than or equal to Int size.-#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \-instance Enumerable SMALL_TYPE where {                 \-    {-# INLINE enumerateFrom #-};                      \-    enumerateFrom = enumerateFromBounded;              \-    {-# INLINE enumerateFromThen #-};                  \-    enumerateFromThen = enumerateFromThenSmallBounded; \-    {-# INLINE enumerateFromTo #-};                    \-    enumerateFromTo = enumerateFromToSmall;            \-    {-# INLINE enumerateFromThenTo #-};                \-    enumerateFromThenTo = enumerateFromThenToSmall }---ENUMERABLE_BOUNDED_SMALL(())-ENUMERABLE_BOUNDED_SMALL(Bool)-ENUMERABLE_BOUNDED_SMALL(Ordering)-ENUMERABLE_BOUNDED_SMALL(Char)---- For bounded Integral Enum types, may be larger than Int.-#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \-instance Enumerable INTEGRAL_TYPE where {           \-    {-# INLINE enumerateFrom #-};                   \-    enumerateFrom = enumerateFromIntegral;          \-    {-# INLINE enumerateFromThen #-};               \-    enumerateFromThen = enumerateFromThenIntegral;  \-    {-# INLINE enumerateFromTo #-};                 \-    enumerateFromTo = enumerateFromToIntegral;      \-    {-# INLINE enumerateFromThenTo #-};             \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_BOUNDED_INTEGRAL(Int)-ENUMERABLE_BOUNDED_INTEGRAL(Int8)-ENUMERABLE_BOUNDED_INTEGRAL(Int16)-ENUMERABLE_BOUNDED_INTEGRAL(Int32)-ENUMERABLE_BOUNDED_INTEGRAL(Int64)-ENUMERABLE_BOUNDED_INTEGRAL(Word)-ENUMERABLE_BOUNDED_INTEGRAL(Word8)-ENUMERABLE_BOUNDED_INTEGRAL(Word16)-ENUMERABLE_BOUNDED_INTEGRAL(Word32)-ENUMERABLE_BOUNDED_INTEGRAL(Word64)---- For unbounded Integral Enum types.-#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \-instance Enumerable INTEGRAL_TYPE where {                         \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom from = enumerateFromStepIntegral from 1;        \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen from next =                                 \-        enumerateFromStepIntegral from (next - from);             \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToIntegral;                    \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)-ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)--#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \-instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom = enumerateFromFractional;                      \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen = enumerateFromThenFractional;              \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToFractional;                  \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToFractional }--ENUMERABLE_FRACTIONAL(Float,)-ENUMERABLE_FRACTIONAL(Double,)-ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)-ENUMERABLE_FRACTIONAL((Ratio a),Integral a)--instance Enumerable a => Enumerable (Identity a) where-    {-# INLINE enumerateFrom #-}-    enumerateFrom (Identity from) =-        fmap Identity $ enumerateFrom from-    {-# INLINE enumerateFromThen #-}-    enumerateFromThen (Identity from) (Identity next) =-        fmap Identity $ enumerateFromThen from next-    {-# INLINE enumerateFromTo #-}-    enumerateFromTo (Identity from) (Identity to) =-        fmap Identity $ enumerateFromTo from to-    {-# INLINE enumerateFromThenTo #-}-    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =-          fmap Identity-        $ enumerateFromThenTo from next to---- TODO-{--instance Enumerable a => Enumerable (Last a)-instance Enumerable a => Enumerable (First a)-instance Enumerable a => Enumerable (Max a)-instance Enumerable a => Enumerable (Min a)-instance Enumerable a => Enumerable (Const a b)-instance Enumerable (f a) => Enumerable (Alt f a)-instance Enumerable (f a) => Enumerable (Ap f a)--}
src/Streamly/Internal/Data/Stream/Exception.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Exception--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2020 Composewell Technologies and Contributors -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental@@ -8,12 +9,14 @@  module Streamly.Internal.Data.Stream.Exception     (-      before+      gbracket_+    , gbracket+    , before     , afterUnsafe     , afterIO     , bracketUnsafe-    , bracketIO     , bracketIO3+    , bracketIO     , onException     , finallyUnsafe     , finallyIO@@ -22,21 +25,154 @@     ) where -import Control.Exception (Exception)+#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Control.Exception (Exception, SomeException, mask_) import Control.Monad.Catch (MonadCatch)-import Control.Monad.IO.Class (MonadIO)-import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)+import GHC.Exts (inline)+import Streamly.Internal.Data.IOFinalizer+    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer) -import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Control.Monad.Catch as MC --- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Stream as Stream+import Streamly.Internal.Data.Stream.Type ---------------------------------------------------------------------------------- Exceptions-------------------------------------------------------------------------------+#include "DocTestDataStream.hs" +data GbracketState s1 s2 v+    = GBracketInit+    | GBracketNormal s1 v+    | GBracketException s2++-- | Like 'gbracket' but with following differences:+--+-- * alloc action @m c@ runs with async exceptions enabled+-- * cleanup action @c -> m d@ won't run if the stream is garbage collected+--   after partial evaluation.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+--+{-# INLINE_NORMAL gbracket_ #-}+gbracket_+    :: Monad m+    => m c                                  -- ^ before+    -> (c -> m d)                           -- ^ after, on normal stop+    -> (c -> e -> Stream m b -> m (Stream m b)) -- ^ on exception+    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)+    -> (c -> Stream m b)                    -- ^ stream generator+    -> Stream m b+gbracket_ bef aft onExc ftry action =+    Stream step GBracketInit++    where++    {-# INLINE_LATE step #-}+    step _ GBracketInit = do+        r <- bef+        return $ Skip $ GBracketNormal (action r) r++    step gst (GBracketNormal (UnStream step1 st) v) = do+        res <- ftry $ step1 gst st+        case res of+            Right r -> case r of+                Yield x s ->+                    return $ Yield x (GBracketNormal (Stream step1 s) v)+                Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)+                Stop -> aft v >> return Stop+            -- XXX Do not handle async exceptions, just rethrow them.+            Left e -> do+                strm <- onExc v e (UnStream step1 st)+                return $ Skip (GBracketException strm)+    step gst (GBracketException (UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s -> return $ Yield x (GBracketException (Stream step1 s))+            Skip s    -> return $ Skip (GBracketException (Stream step1 s))+            Stop      -> return Stop++data GbracketIOState s1 s2 v wref+    = GBracketIOInit+    | GBracketIONormal s1 v wref+    | GBracketIOException s2++-- | Run the alloc action @m c@ with async exceptions disabled but keeping+-- blocking operations interruptible (see 'Control.Exception.mask').  Use the+-- output @c@ as input to @c -> Stream m b@ to generate an output stream. When+-- generating the stream use the supplied @try@ operation @forall s. m s -> m+-- (Either e s)@ to catch synchronous exceptions. If an exception occurs run+-- the exception handler @c -> e -> Stream m b -> m (Stream m b)@. Note that+-- 'gbracket' does not rethrow the exception, it has to be done by the+-- exception handler if desired.+--+-- The cleanup action @c -> m d@, runs whenever the stream ends normally, due+-- to a sync or async exception or if it gets garbage collected after a partial+-- lazy evaluation.  See 'bracket' for the semantics of the cleanup action.+--+-- 'gbracket' can express all other exception handling combinators.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL gbracket #-}+gbracket+    :: MonadIO m+    => IO c -- ^ before+    -> (c -> IO d1) -- ^ on normal stop+    -> (c -> e -> Stream m b -> IO (Stream m b)) -- ^ on exception+    -> (c -> IO d2) -- ^ on GC without normal stop or exception+    -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)+    -> (c -> Stream m b) -- ^ stream generator+    -> Stream m b+gbracket bef aft onExc onGC ftry action =+    Stream step GBracketIOInit++    where++    -- If the stream is never evaluated the "aft" action will never be+    -- called. For that to occur we will need the user of this API to pass a+    -- weak pointer to us.+    {-# INLINE_LATE step #-}+    step _ GBracketIOInit = do+        -- We mask asynchronous exceptions to make the execution+        -- of 'bef' and the registration of 'aft' atomic.+        -- A similar thing is done in the resourcet package: https://git.io/JvKV3+        -- Tutorial: https://markkarpov.com/tutorial/exceptions.html+        (r, ref) <- liftIO $ mask_ $ do+            r <- bef+            ref <- newIOFinalizer (onGC r)+            return (r, ref)+        return $ Skip $ GBracketIONormal (action r) r ref++    step gst (GBracketIONormal (UnStream step1 st) v ref) = do+        res <- ftry $ step1 gst st+        case res of+            Right r -> case r of+                Yield x s ->+                    return $ Yield x (GBracketIONormal (Stream step1 s) v ref)+                Skip s ->+                    return $ Skip (GBracketIONormal (Stream step1 s) v ref)+                Stop ->+                    liftIO (clearingIOFinalizer ref (aft v)) >> return Stop+            -- XXX Do not handle async exceptions, just rethrow them.+            Left e -> do+                -- Clearing of finalizer and running of exception handler must+                -- be atomic wrt async exceptions. Otherwise if we have cleared+                -- the finalizer and have not run the exception handler then we+                -- may leak the resource.+                stream <-+                    liftIO (clearingIOFinalizer ref (onExc v e (UnStream step1 st)))+                return $ Skip (GBracketIOException stream)+    step gst (GBracketIOException (UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s ->+                return $ Yield x (GBracketIOException (Stream step1 s))+            Skip s    -> return $ Skip (GBracketIOException (Stream step1 s))+            Stop      -> return Stop+ -- | Run the action @m b@ before the stream yields its first element. -- -- Same as the following but more efficient due to fusion:@@ -44,10 +180,22 @@ -- >>> before action xs = Stream.nilM action <> xs -- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action) ---{-# INLINE before #-}+{-# INLINE_NORMAL before #-} before :: Monad m => m b -> Stream m a -> Stream m a-before action xs = fromStreamD $ D.before action $ toStreamD xs+before action (Stream step state) = Stream step' Nothing +    where++    {-# INLINE_LATE step' #-}+    step' _ Nothing = action >> return (Skip (Just state))++    step' gst (Just st) = do+        res <- step gst st+        case res of+            Yield x s -> return $ Yield x (Just s)+            Skip s    -> return $ Skip (Just s)+            Stop      -> return Stop+ -- | Like 'after', with following differences: -- -- * action @m b@ won't run if the stream is garbage collected@@ -61,10 +209,20 @@ -- -- /Pre-release/ ---{-# INLINE afterUnsafe #-}+{-# INLINE_NORMAL afterUnsafe #-} afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a-afterUnsafe action xs = fromStreamD $ D.afterUnsafe action $ toStreamD xs+afterUnsafe action (Stream step state) = Stream step' state +    where++    {-# INLINE_LATE step' #-}+    step' gst st = do+        res <- step gst st+        case res of+            Yield x s -> return $ Yield x s+            Skip s    -> return $ Skip s+            Stop      -> action >> return Stop+ -- | Run the action @IO b@ whenever the stream is evaluated to completion, or -- if it is garbage collected after a partial lazy evaluation. --@@ -73,51 +231,61 @@ -- -- /See also 'afterUnsafe'/ ---{-# INLINE afterIO #-}-afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a-afterIO action xs = fromStreamD $ D.afterIO action $ toStreamD xs+{-# INLINE_NORMAL afterIO #-}+afterIO :: MonadIO m+    => IO b -> Stream m a -> Stream m a+afterIO action (Stream step state) = Stream step' Nothing +    where++    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        ref <- liftIO $ newIOFinalizer action+        return $ Skip $ Just (state, ref)+    step' gst (Just (st, ref)) = do+        res <- step gst st+        case res of+            Yield x s -> return $ Yield x (Just (s, ref))+            Skip s    -> return $ Skip (Just (s, ref))+            Stop      -> do+                runIOFinalizer ref+                return Stop++-- XXX For high performance error checks in busy streams we may need another+-- Error constructor in step.+ -- | Run the action @m b@ if the stream evaluation is aborted due to an -- exception. The exception is not caught, simply rethrown. --+-- Observes exceptions only in the stream generation, and not in stream+-- consumers.+-- -- /Inhibits stream fusion/ ---{-# INLINE onException #-}+{-# INLINE_NORMAL onException #-} onException :: MonadCatch m => m b -> Stream m a -> Stream m a-onException action xs = fromStreamD $ D.onException action $ toStreamD xs+onException action stream =+    gbracket_+        (return ()) -- before+        return      -- after+        (\_ (e :: MC.SomeException) _ -> action >> MC.throwM e)+        (inline MC.try)+        (const stream) --- | Like 'finally' with following differences:------ * action @m b@ won't run if the stream is garbage collected---   after partial evaluation.--- * has slightly better performance than 'finallyIO'.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE finallyUnsafe #-}-finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a-finallyUnsafe action xs = fromStreamD $ D.finallyUnsafe action $ toStreamD xs+{-# INLINE_NORMAL _onException #-}+_onException :: MonadCatch m => m b -> Stream m a -> Stream m a+_onException action (Stream step state) = Stream step' state --- | Run the action @IO b@ whenever the stream stream stops normally, aborts--- due to an exception or if it is garbage collected after a partial lazy--- evaluation.------ The semantics of running the action @IO b@ are similar to the cleanup action--- semantics described in 'bracketIO'.------ >>> finallyIO release = Stream.bracketIO (return ()) (const release)------ /See also 'finallyUnsafe'/------ /Inhibits stream fusion/----{-# INLINE finallyIO #-}-finallyIO :: (MonadIO m, MonadCatch m) =>-    IO b -> Stream m a -> Stream m a-finallyIO action xs = fromStreamD $ D.finallyIO action $ toStreamD xs+    where +    {-# INLINE_LATE step' #-}+    step' gst st = do+        res <- step gst st `MC.onException` action+        case res of+            Yield x s -> return $ Yield x s+            Skip s    -> return $ Skip s+            Stop      -> return Stop+ -- | Like 'bracket' but with following differences: -- -- * alloc action @m b@ runs with async exceptions enabled@@ -129,19 +297,63 @@ -- -- /Pre-release/ ---{-# INLINE bracketUnsafe #-}+{-# INLINE_NORMAL bracketUnsafe #-} bracketUnsafe :: MonadCatch m     => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-bracketUnsafe bef aft bet = fromStreamD $ D.bracketUnsafe bef aft (toStreamD . bet)+bracketUnsafe bef aft =+    gbracket_+        bef+        aft+        (\a (e :: SomeException) _ -> aft a >> MC.throwM e)+        (inline MC.try) +-- For a use case of this see the "streamly-process" package. It needs to kill+-- the process in case of exception or garbage collection, but waits for the+-- process to terminate in normal cases.++-- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the+-- mode of termination:+--+-- 1. When the stream stops normally+-- 2. When the stream is garbage collected+-- 3. When the stream encounters an exception+--+-- @bracketIO3 before onStop onGC onException action@ runs @action@ using the+-- result of @before@. If the stream stops, @onStop@ action is executed, if the+-- stream is abandoned @onGC@ is executed, if the stream encounters an+-- exception @onException@ is executed.+--+-- The exception is not caught, it is rethrown.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL bracketIO3 #-}+bracketIO3 :: (MonadIO m, MonadCatch m) =>+       IO b+    -> (b -> IO c)+    -> (b -> IO d)+    -> (b -> IO e)+    -> (b -> Stream m a)+    -> Stream m a+bracketIO3 bef aft onExc onGC =+    gbracket+        bef+        aft+        (\a (e :: SomeException) _ -> onExc a >> MC.throwM e)+        onGC+        (inline MC.try)+ -- | Run the alloc action @IO b@ with async exceptions disabled but keeping -- blocking operations interruptible (see 'Control.Exception.mask').  Use the--- output @b@ as input to @b -> Stream m a@ to generate an output stream.+-- output @b@ of the IO action as input to the function @b -> Stream m a@ to+-- generate an output stream. -- -- @b@ is usually a resource under the IO monad, e.g. a file handle, that -- requires a cleanup after use. The cleanup action @b -> IO c@, runs whenever--- the stream ends normally, due to a sync or async exception or if it gets--- garbage collected after a partial lazy evaluation.+-- (1) the stream ends normally, (2) due to a sync or async exception or, (3)+-- if it gets garbage collected after a partial lazy evaluation. The exception+-- is not caught, it is rethrown. -- -- 'bracketIO' only guarantees that the cleanup action runs, and it runs with -- async exceptions enabled. The action must ensure that it can successfully@@ -150,7 +362,13 @@ -- When the stream ends normally or on a sync exception, cleanup action runs -- immediately in the current thread context, whereas in other cases it runs in -- the GC context, therefore, cleanup may be delayed until the GC gets to run.+-- An example where GC based cleanup happens is when a stream is being folded+-- but the fold terminates without draining the entire stream or if the+-- consumer of the stream encounters an exception. --+-- Observes exceptions only in the stream generation, and not in stream+-- consumers.+-- -- /See also: 'bracketUnsafe'/ -- -- /Inhibits stream fusion/@@ -160,36 +378,64 @@     => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a bracketIO bef aft = bracketIO3 bef aft aft aft --- For a use case of this see the "streamly-process" package. It needs to kill--- the process in case of exception or garbage collection, but waits for the--- process to terminate in normal cases.+data BracketState s v = BracketInit | BracketRun s v --- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the--- mode of termination:+-- | Alternate (custom) implementation of 'bracket'. ----- 1. When the stream stops normally--- 2. When the stream is garbage collected--- 3. When the stream encounters an exception+{-# INLINE_NORMAL _bracket #-}+_bracket :: MonadCatch m+    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+_bracket bef aft bet = Stream step' BracketInit++    where++    {-# INLINE_LATE step' #-}+    step' _ BracketInit = bef >>= \x -> return (Skip (BracketRun (bet x) x))++    -- NOTE: It is important to use UnStream instead of the Stream pattern+    -- here, otherwise we get huge perf degradation, see note in concatMap.+    step' gst (BracketRun (UnStream step state) v) = do+        -- res <- step gst state `MC.onException` aft v+        res <- inline MC.try $ step gst state+        case res of+            Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop+            Right r -> case r of+                Yield x s -> return $ Yield x (BracketRun (Stream step s) v)+                Skip s    -> return $ Skip (BracketRun (Stream step s) v)+                Stop      -> aft v >> return Stop++-- | Like 'finally' with following differences: ----- @bracketIO3 before onStop onGC onException action@ runs @action@ using the--- result of @before@. If the stream stops, @onStop@ action is executed, if the--- stream is abandoned @onGC@ is executed, if the stream encounters an--- exception @onException@ is executed.+-- * action @m b@ won't run if the stream is garbage collected+--   after partial evaluation.+-- * has slightly better performance than 'finallyIO'. -- -- /Inhibits stream fusion/ -- -- /Pre-release/-{-# INLINE bracketIO3 #-}-bracketIO3 :: (MonadIO m, MonadCatch m)-    => IO b-    -> (b -> IO c)-    -> (b -> IO d)-    -> (b -> IO e)-    -> (b -> Stream m a)-    -> Stream m a-bracketIO3 bef aft gc exc bet = fromStreamD $-    D.bracketIO3 bef aft exc gc (toStreamD . bet)+--+{-# INLINE finallyUnsafe #-}+finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a+finallyUnsafe action xs = bracketUnsafe (return ()) (const action) (const xs) +-- | Run the action @IO b@ whenever the stream stream stops normally, aborts+-- due to an exception or if it is garbage collected after a partial lazy+-- evaluation.+--+-- The semantics of running the action @IO b@ are similar to the cleanup action+-- semantics described in 'bracketIO'.+--+-- >>> finallyIO release = Stream.bracketIO (return ()) (const release)+--+-- /See also 'finallyUnsafe'/+--+-- /Inhibits stream fusion/+--+{-# INLINE finallyIO #-}+finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a+finallyIO action xs = bracketIO3 (return ()) act act act (const xs)+    where act _ = action+ -- | Like 'handle' but the exception handler is also provided with the stream -- that generated the exception as input. The exception handler can thus -- re-evaluate the stream to retry the action that failed. The exception@@ -202,21 +448,51 @@ -- -- /Pre-release/ ---{-# INLINE ghandle #-}+{-# INLINE_NORMAL ghandle #-} ghandle :: (MonadCatch m, Exception e)-    => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a-ghandle handler =-      fromStreamD-    . D.ghandle (\e xs -> toStreamD $ handler e (fromStreamD xs))-    . toStreamD+    => (e -> Stream m a -> m (Stream m a)) -> Stream m a -> Stream m a+ghandle f stream =+    gbracket_ (return ()) return (const f) (inline MC.try) (const stream)  -- | When evaluating a stream if an exception occurs, stream evaluation aborts -- and the specified exception handler is run with the exception as argument.+-- The exception is caught and handled unless the handler decides to rethrow+-- it. Note that exception handling is not applied to the stream returned by+-- the exception handler. --+-- Observes exceptions only in the stream generation, and not in stream+-- consumers.+-- -- /Inhibits stream fusion/ ---{-# INLINE handle #-}+{-# INLINE_NORMAL handle #-} handle :: (MonadCatch m, Exception e)+    => (e -> m (Stream m a)) -> Stream m a -> Stream m a+handle f stream =+    gbracket_ (return ()) return (\_ e _ -> f e) (inline MC.try) (const stream)++-- | Alternate (custom) implementation of 'handle'.+--+{-# INLINE_NORMAL _handle #-}+_handle :: (MonadCatch m, Exception e)     => (e -> Stream m a) -> Stream m a -> Stream m a-handle handler xs =-    fromStreamD $ D.handle (toStreamD . handler) $ toStreamD xs+_handle f (Stream step state) = Stream step' (Left state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Left st) = do+        res <- inline MC.try $ step gst st+        case res of+            Left e -> return $ Skip $ Right (f e)+            Right r -> case r of+                Yield x s -> return $ Yield x (Left s)+                Skip s    -> return $ Skip (Left s)+                Stop      -> return Stop++    step' gst (Right (UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s -> return $ Yield x (Right (Stream step1 s))+            Skip s    -> return $ Skip (Right (Stream step1 s))+            Stop      -> return Stop
− src/Streamly/Internal/Data/Stream/Expand.hs 
@@ -1,893 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Expand--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Expand a stream by combining two or more streams or by combining streams--- with unfolds.--module Streamly.Internal.Data.Stream.Expand-    (-    -- * Binary Combinators (Linear)-    -- | Functions ending in the shape:-    ---    -- @Stream m a -> Stream m a -> Stream m a@.-    ---    -- The functions in this section have a linear or flat n-ary combining-    -- characterstics. It means that when combined @n@ times (e.g. @a `serial`-    -- b `serial` c ...@) the resulting expression will have an @O(n)@-    -- complexity (instead O(n^2) for pair wise combinators described in the-    -- next section. These functions can be used efficiently with-    -- 'concatMapWith' et. al.  combinators that combine streams in a linear-    -- fashion (contrast with 'mergeMapWith' which combines streams as a-    -- binary tree).--      append-    -- * Binary Combinators (Pair Wise)-    -- | Like the functions in the section above these functions also combine-    -- two streams into a single stream but when used @n@ times linearly they-    -- exhibit O(n^2) complexity. They are best combined in a binary tree-    -- fashion using 'mergeMapWith' giving a @n * log n@ complexity.  Avoid-    -- using these with 'concatMapWith' when combining a large or infinite-    -- number of streams.--    -- ** Append-    , append2--    -- ** Interleave-    , interleave-    , interleave2-    , interleaveFst-    , interleaveFst2-    , interleaveFstSuffix2-    , interleaveMin-    , interleaveMin2--    -- ** Round Robin-    , roundrobin--    -- ** Merge-    , mergeBy-    , mergeByM-    , mergeByM2-    , mergeMinBy-    , mergeFstBy--    -- ** Zip-    , zipWith-    , zipWithM--    -- * Combine Streams and Unfolds-    -- |-    -- Expand a stream by repeatedly using an unfold and merging the resulting-    -- streams.  Functions generally ending in the shape:-    ---    -- @Unfold m a b -> Stream m a -> Stream m b@--    -- ** Unfold and combine streams-    -- | Unfold and flatten streams.-    , unfoldMany -- XXX Rename to unfoldAppend-    , unfoldInterleave-    , unfoldRoundRobin--    -- ** Interpose-    -- | Insert effects between streams. Like unfoldMany but intersperses an-    -- effect between the streams. A special case of gintercalate.-    , interpose-    , interposeSuffix-    -- , interposeBy--    -- ** Intercalate-    -- | Insert Streams between Streams.-    -- Like unfoldMany but intersperses streams from another source between-    -- the streams from the first source.-    , intercalate-    , intercalateSuffix-    , gintercalate-    , gintercalateSuffix--    -- * Combine Streams of Streams-    -- | Map and serially append streams. 'concatMapM' is a generalization of-    -- the binary append operation to append many streams.-    , concatMapM-    , concatMap-    , concatEffect-    , concat--    -- * ConcatMapWith-    -- | Map and flatten a stream like 'concatMap' but using a custom binary-    -- stream merging combinator instead of just appending the streams.  The-    -- merging occurs sequentially, it works efficiently for 'serial', 'async',-    -- 'ahead' like merge operations where we consume one stream before the-    -- next or in case of 'wAsync' or 'parallel' where we consume all streams-    -- simultaneously anyway.-    ---    -- However, in cases where the merging consumes streams in a round robin-    -- fashion, a pair wise merging using 'mergeMapWith' would be more-    -- efficient. These cases include operations like 'mergeBy' or 'zipWith'.--    , concatMapWith-    , bindWith-    , concatSmapMWith--    -- * MergeMapWith-    -- | See the notes about suitable merge functions in the 'concatMapWith'-    -- section.-    , mergeMapWith--    -- * Iterate-    -- | Map and flatten Trees of Streams-    , unfoldIterateDfs-    , unfoldIterateBfs-    , unfoldIterateBfsRev--    , concatIterateWith-    , mergeIterateWith--    , concatIterateDfs-    , concatIterateBfs--    -- More experimental ops-    , concatIterateBfsRev-    , concatIterateLeftsWith-    , concatIterateScanWith-    , concatIterateScan-    )-where--#include "inline.hs"--import Streamly.Internal.Data.Stream.Bottom-    ( concatEffect, concatMapM, concatMap, smapM, zipWith, zipWithM)-import Streamly.Internal.Data.Stream.Type-    ( Stream, fromStreamD, fromStreamK, toStreamD, toStreamK-    , bindWith, concatMapWith, cons, nil)-import Streamly.Internal.Data.Unfold.Type (Unfold)--import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K (mergeBy, mergeByM)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import Prelude hiding (concat, concatMap, zipWith)---- $setup--- >>> :m--- >>> import Data.Either (either)--- >>> import Data.IORef--- >>> import Streamly.Internal.Data.Stream (Stream)--- >>> import Prelude hiding (zipWith, concatMap, concat)--- >>> import qualified Streamly.Data.Array as Array--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir-------------------------------------------------------------------------------------- Appending---------------------------------------------------------------------------------infixr 6 `append2`---- | This is fused version of 'append'. It could be up to 100x faster than--- 'append' when combining two fusible streams. However, it slows down--- quadratically with the number of streams being appended. Therefore, it is--- suitable for ad-hoc append of a few streams, and should not be used with--- 'concatMapWith' or 'mergeMapWith'.------ /Fused/----{-# INLINE append2 #-}-append2 ::Monad m => Stream m b -> Stream m b -> Stream m b-append2 m1 m2 = fromStreamD $ D.append (toStreamD m1) (toStreamD m2)--infixr 6 `append`---- | Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ >>> s1 = Stream.fromList [1,2]--- >>> s2 = Stream.fromList [3,4]--- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2--- [1,2,3,4]------ This has O(n) append performance where @n@ is the number of streams. It can--- be used to efficiently fold an infinite lazy container of streams--- 'concatMapWith' et. al.------ See 'append2' for a fusible alternative.------ /CPS/-{-# INLINE append #-}-append :: Stream m a -> Stream m a -> Stream m a-append = (<>)----------------------------------------------------------------------------------- Interleaving---------------------------------------------------------------------------------infixr 6 `interleave`---- | Interleaves two streams, yielding one element from each stream--- alternately.  When one stream stops the rest of the other stream is used in--- the output stream.------ When joining many streams in a left associative manner earlier streams will--- get exponential priority than the ones joining later. Because of exponential--- weighting it can be used with 'concatMapWith' even on a large number of--- streams.------ See 'interleave2' for a fusible alternative.------ /CPS/-{-# INLINE interleave #-}-interleave :: Stream m a -> Stream m a -> Stream m a-interleave s1 s2 = fromStreamK $ K.interleave (toStreamK s1) (toStreamK s2)--{-# INLINE interleave2 #-}-interleave2 :: Monad m => Stream m a -> Stream m a -> Stream m a-interleave2 s1 s2 = fromStreamD $ D.interleave (toStreamD s1) (toStreamD s2)---- | Like `interleave` but stops interleaving as soon as the first stream--- stops.------ See 'interleaveFst2' for a fusible alternative.------ /CPS/-{-# INLINE interleaveFst #-}-interleaveFst :: Stream m a -> Stream m a -> Stream m a-interleaveFst s1 s2 =-    fromStreamK $ K.interleaveFst (toStreamK s1) (toStreamK s2)---- | Like `interleave` but stops interleaving as soon as any of the two streams--- stops.------ See 'interleaveMin2' for a fusible alternative.------ /CPS/-{-# INLINE interleaveMin #-}-interleaveMin :: Stream m a -> Stream m a -> Stream m a-interleaveMin s1 s2 =-    fromStreamK $ K.interleaveMin (toStreamK s1) (toStreamK s2)--{-# INLINE interleaveMin2 #-}-interleaveMin2 :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveMin2 s1 s2 =-    fromStreamD $ D.interleaveMin (toStreamD s1) (toStreamD s2)---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream. As soon as the first stream--- finishes, the output stops, discarding the remaining part of the second--- stream. In this case, the last element in the resulting stream would be from--- the second stream. If the second stream finishes early then the first stream--- still continues to yield elements until it finishes.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFstSuffix2 "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c,"--- >>> Stream.interleaveFstSuffix2 "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFstSuffix2' is a dual of 'interleaveFst2'.------ Do not use at scale in concatMapWith.------ /Pre-release/-{-# INLINE interleaveFstSuffix2 #-}-interleaveFstSuffix2 :: Monad m => Stream m b -> Stream m b -> Stream m b-interleaveFstSuffix2 m1 m2 =-    fromStreamD $ D.interleaveFstSuffix (toStreamD m1) (toStreamD m2)---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream and ending at the first stream.--- If the second stream is longer than the first, elements from the second--- stream are infixed with elements from the first stream. If the first stream--- is longer then it continues yielding elements even after the second stream--- has finished.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFst2 "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c"--- >>> Stream.interleaveFst2 "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFst2' is a dual of 'interleaveFstSuffix2'.------ Do not use at scale in concatMapWith.------ /Pre-release/-{-# INLINE interleaveFst2 #-}-interleaveFst2 :: Monad m => Stream m b -> Stream m b -> Stream m b-interleaveFst2 m1 m2 =-    fromStreamD $ D.interleaveFst (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Scheduling----------------------------------------------------------------------------------- | Schedule the execution of two streams in a fair round-robin manner,--- executing each stream once, alternately. Execution of a stream may not--- necessarily result in an output, a stream may chose to @Skip@ producing an--- element until later giving the other stream a chance to run. Therefore, this--- combinator fairly interleaves the execution of two streams rather than--- fairly interleaving the output of the two streams. This can be useful in--- co-operative multitasking without using explicit threads. This can be used--- as an alternative to `async`.------ Do not use at scale in concatMapWith.------ /Pre-release/-{-# INLINE roundrobin #-}-roundrobin :: Monad m => Stream m b -> Stream m b -> Stream m b-roundrobin m1 m2 = fromStreamD $ D.roundRobin (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Merging (sorted streams)----------------------------------------------------------------------------------- | Merge two streams using a comparison function. The head elements of both--- the streams are compared and the smaller of the two elements is emitted, if--- both elements are equal then the element from the first stream is used--- first.------ If the streams are sorted in ascending order, the resulting stream would--- also remain sorted in ascending order.------ >>> s1 = Stream.fromList [1,3,5]--- >>> s2 = Stream.fromList [2,4,6,8]--- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2--- [1,2,3,4,5,6,8]------ See 'mergeByM2' for a fusible alternative.------ /CPS/-{-# INLINE mergeBy #-}-mergeBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeBy f m1 m2 = fromStreamK $ K.mergeBy f (toStreamK m1) (toStreamK m2)---- | Like 'mergeBy' but with a monadic comparison function.------ Merge two streams randomly:------ @--- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT--- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])--- [2,1,2,2,2,1,1,1]--- @------ Merge two streams in a proportion of 2:1:------ >>> :{--- do---  let s1 = Stream.fromList [1,1,1,1,1,1]---      s2 = Stream.fromList [2,2,2]---  let proportionately m n = do---       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]---       return $ \_ _ -> do---          r <- readIORef ref---          writeIORef ref $ Prelude.tail r---          return $ Prelude.head r---  f <- proportionately 2 1---  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2---  print xs--- :}--- [1,1,2,1,1,2,1,1,2]------ See 'mergeByM2' for a fusible alternative.------ /CPS/-{-# INLINE mergeByM #-}-mergeByM-    :: Monad m-    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeByM f m1 m2 = fromStreamK $ K.mergeByM f (toStreamK m1) (toStreamK m2)---- | Like 'mergeByM' but much faster, works best when merging statically known--- number of streams. When merging more than two streams try to merge pairs and--- pair of pairs in a tree like structure.'mergeByM' works better with variable--- number of streams being merged using 'mergeMapWith'.------ /Internal/-{-# INLINE mergeByM2 #-}-mergeByM2-    :: Monad m-    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeByM2 f m1 m2 =-    fromStreamD $ D.mergeByM f (toStreamD m1) (toStreamD m2)---- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.------ /Unimplemented/-{-# INLINABLE mergeMinBy #-}-mergeMinBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeMinBy _f _m1 _m2 = undefined-    -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)---- | Like 'mergeByM' but stops merging as soon as the first stream stops.------ /Unimplemented/-{-# INLINABLE mergeFstBy #-}-mergeFstBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeFstBy _f _m1 _m2 = undefined-    -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Combine N Streams - unfoldMany----------------------------------------------------------------------------------- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike--- 'concatMap' this can fuse the 'Unfold' code with the inner loop and--- therefore provide many times better performance.----{-# INLINE unfoldMany #-}-unfoldMany ::Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldMany u m = fromStreamD $ D.unfoldMany u (toStreamD m)---- | This does not pair streams like mergeMapWith, instead, it goes through--- each stream one by one and yields one element from each stream. After it--- goes to the last stream it reverses the traversal to come back to the first--- stream yielding elements from each stream on its way back to the first--- stream and so on.------ >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]--- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists--- >>> Stream.fold Fold.toList interleaved--- [1,2,3,4,5,5,4,3,2,1]------ Note that this is order of magnitude more efficient than "mergeMapWith--- wSerial" because of fusion.------ /Fused/-{-# INLINE unfoldInterleave #-}-unfoldInterleave ::Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldInterleave u m =-    fromStreamD $ D.unfoldInterleave u (toStreamD m)---- | 'unfoldInterleave' switches to the next stream whenever a value from a--- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps--- skipping for long time other streams won't get a chance to run.--- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each--- stream fairly irrespective of whether it produces a value or not.----{-# INLINE unfoldRoundRobin #-}-unfoldRoundRobin ::Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldRoundRobin u m =-    fromStreamD $ D.unfoldRoundRobin u (toStreamD m)----------------------------------------------------------------------------------- Combine N Streams - interpose----------------------------------------------------------------------------------- > interpose x unf str = gintercalate unf str UF.identity (repeat x)---- | Unfold the elements of a stream, intersperse the given element between the--- unfolded streams and then concat them into a single stream.------ >>> unwords = Stream.interpose ' '------ /Pre-release/-{-# INLINE interpose #-}-interpose :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interpose x unf str =-    fromStreamD $ D.interpose x unf (toStreamD str)---- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)---- | Unfold the elements of a stream, append the given element after each--- unfolded stream and then concat them into a single stream.------ >>> unlines = Stream.interposeSuffix '\n'------ /Pre-release/-{-# INLINE interposeSuffix #-}-interposeSuffix :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffix x unf str =-    fromStreamD $ D.interposeSuffix x unf (toStreamD str)----------------------------------------------------------------------------------- Combine N Streams - intercalate----------------------------------------------------------------------------------- XXX we can swap the order of arguments to gintercalate so that the--- definition of unfoldMany becomes simpler? The first stream should be--- infixed inside the second one. However, if we change the order in--- "interleave" as well similarly, then that will make it a bit unintuitive.------ > unfoldMany unf str =--- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())---- | 'interleaveFst' followed by unfold and concat.------ /Pre-release/-{-# INLINE gintercalate #-}-gintercalate-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalate unf1 str1 unf2 str2 =-    fromStreamD $ D.gintercalate-        unf1 (toStreamD str1)-        unf2 (toStreamD str2)---- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)---- | 'intersperse' followed by unfold and concat.------ >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a--- >>> intersperse = Stream.intercalate Unfold.identity--- >>> unwords = Stream.intercalate Unfold.fromList " "------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input--- "abc def ghi"----{-# INLINE intercalate #-}-intercalate :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalate unf seed str = fromStreamD $-    D.unfoldMany unf $ D.intersperse seed (toStreamD str)---- | 'interleaveFstSuffix2' followed by unfold and concat.------ /Pre-release/-{-# INLINE gintercalateSuffix #-}-gintercalateSuffix-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalateSuffix unf1 str1 unf2 str2 =-    fromStreamD $ D.gintercalateSuffix-        unf1 (toStreamD str1)-        unf2 (toStreamD str2)---- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)---- | 'intersperseMSuffix' followed by unfold and concat.------ >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a--- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity--- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input--- "abc\ndef\nghi\n"----{-# INLINE intercalateSuffix #-}-intercalateSuffix :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalateSuffix unf seed =-    fromStreamD . D.intercalateSuffix unf seed . toStreamD----------------------------------------------------------------------------------- Combine N Streams - concatMap----------------------------------------------------------------------------------- | Flatten a stream of streams to a single stream.------ >>> concat = Stream.concatMap id------ /Pre-release/-{-# INLINE concat #-}-concat :: Monad m => Stream m (Stream m a) -> Stream m a-concat = concatMap id----------------------------------------------------------------------------------- Combine N Streams - concatMap----------------------------------------------------------------------------------- | Like 'concatMapWith' but carries a state which can be used to share--- information across multiple steps of concat.------ >>> concatSmapMWith combine f initial = Stream.concatMapWith combine id . Stream.smapM f initial------ /Pre-release/----{-# INLINE concatSmapMWith #-}-concatSmapMWith-    :: Monad m-    => (Stream m b -> Stream m b -> Stream m b)-    -> (s -> a -> m (s, Stream m b))-    -> m s-    -> Stream m a-    -> Stream m b-concatSmapMWith combine f initial =-    concatMapWith combine id . smapM f initial---- XXX Implement a StreamD version for fusion.---- | Combine streams in pairs using a binary combinator, the resulting streams--- are then combined again in pairs recursively until we get to a single--- combined stream. The composition would thus form a binary tree.------ For example, you can sort a stream using merge sort like this:------ >>> s = Stream.fromList [5,1,7,9,2]--- >>> generate = Stream.fromPure--- >>> combine = Stream.mergeBy compare--- >>> Stream.fold Fold.toList $ Stream.mergeMapWith combine generate s--- [1,2,5,7,9]------ Note that if the stream length is not a power of 2, the binary tree composed--- by mergeMapWith would not be balanced, which may or may not be important--- depending on what you are trying to achieve.------ /Caution: the stream of streams must be finite/------ /CPS/------ /Pre-release/----{-# INLINE mergeMapWith #-}-mergeMapWith ::-       (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m a-    -> Stream m b-mergeMapWith par f m =-    fromStreamK-        $ K.mergeMapWith-            (\s1 s2 -> toStreamK $ fromStreamK s1 `par` fromStreamK s2)-            (toStreamK . f)-            (toStreamK m)----------------------------------------------------------------------------------- concatIterate - Map and flatten Trees of Streams----------------------------------------------------------------------------------- | Yield an input element in the output stream, map a stream generator on it--- and repeat the process on the resulting stream. Resulting streams are--- flattened using the 'concatMapWith' combinator. This can be used for a depth--- first style (DFS) traversal of a tree like structure.------ Example, list a directory tree using DFS:------ >>> f = either Dir.readEitherPaths (const Stream.nil)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateWith Stream.append f input------ Note that 'iterateM' is a special case of 'concatIterateWith':------ >>> iterateM f = Stream.concatIterateWith Stream.append (Stream.fromEffect . f) . Stream.fromEffect------ /CPS/------ /Pre-release/----{-# INLINE concatIterateWith #-}-concatIterateWith ::-       (Stream m a -> Stream m a -> Stream m a)-    -> (a -> Stream m a)-    -> Stream m a-    -> Stream m a-concatIterateWith combine f = iterateStream--    where--    iterateStream = concatMapWith combine generate--    generate x = x `cons` iterateStream (f x)---- | Traverse the stream in depth first style (DFS). Map each element in the--- input stream to a stream and flatten, recursively map the resulting elements--- as well to a stream and flatten until no more streams are generated.------ Example, list a directory tree using DFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateDfs f input------ This is equivalent to using @concatIterateWith Stream.append@.------ /Pre-release/-{-# INLINE concatIterateDfs #-}-concatIterateDfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateDfs f stream =-    fromStreamD-        $ D.concatIterateDfs (fmap toStreamD . f ) (toStreamD stream)---- | Similar to 'concatIterateDfs' except that it traverses the stream in--- breadth first style (BFS). First, all the elements in the input stream are--- emitted, and then their traversals are emitted.------ Example, list a directory tree using BFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateBfs f input------ /Pre-release/-{-# INLINE concatIterateBfs #-}-concatIterateBfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfs f stream =-    fromStreamD-        $ D.concatIterateBfs (fmap toStreamD . f ) (toStreamD stream)---- | Same as 'concatIterateBfs' except that the traversal of the last--- element on a level is emitted first and then going backwards up to the first--- element (reversed ordering). This may be slightly faster than--- 'concatIterateBfs'.----{-# INLINE concatIterateBfsRev #-}-concatIterateBfsRev :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfsRev f stream =-    fromStreamD-        $ D.concatIterateBfsRev (fmap toStreamD . f ) (toStreamD stream)---- | Like 'concatIterateWith' but uses the pairwise flattening combinator--- 'mergeMapWith' for flattening the resulting streams. This can be used for a--- balanced traversal of a tree like structure.------ Example, list a directory tree using balanced traversal:------ >>> f = either Dir.readEitherPaths (const Stream.nil)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.mergeIterateWith Stream.interleave f input------ /CPS/------ /Pre-release/----{-# INLINE mergeIterateWith #-}-mergeIterateWith ::-       (Stream m a -> Stream m a -> Stream m a)-    -> (a -> Stream m a)-    -> Stream m a-    -> Stream m a-mergeIterateWith combine f = iterateStream--    where--    iterateStream = mergeMapWith combine generate--    generate x = x `cons` iterateStream (f x)---- | Same as @concatIterateDfs@ but more efficient due to stream fusion.------ Example, list a directory tree using DFS:------ >>> f = Unfold.either Dir.eitherReaderPaths Unfold.nil--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.unfoldIterateDfs f input------ /Pre-release/-{-# INLINE unfoldIterateDfs #-}-unfoldIterateDfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a-unfoldIterateDfs u = fromStreamD . D.unfoldIterateDfs u . toStreamD---- | Like 'unfoldIterateDfs' but uses breadth first style traversal.------ /Pre-release/-{-# INLINE unfoldIterateBfs #-}-unfoldIterateBfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a-unfoldIterateBfs u = fromStreamD . D.unfoldIterateBfs u . toStreamD---- | Like 'unfoldIterateBfs' but processes the children in reverse order,--- therefore, may be slightly faster.------ /Pre-release/-{-# INLINE unfoldIterateBfsRev #-}-unfoldIterateBfsRev :: Monad m => Unfold m a a -> Stream m a -> Stream m a-unfoldIterateBfsRev u =-    fromStreamD . D.unfoldIterateBfsRev u . toStreamD----------------------------------------------------------------------------------- Flattening Graphs----------------------------------------------------------------------------------- To traverse graphs we need a state to be carried around in the traversal.--- For example, we can use a hashmap to store the visited status of nodes.---- | Like 'iterateMap' but carries a state in the stream generation function.--- This can be used to traverse graph like structures, we can remember the--- visited nodes in the state to avoid cycles.------ Note that a combination of 'iterateMap' and 'usingState' can also be used to--- traverse graphs. However, this function provides a more localized state--- instead of using a global state.------ See also: 'mfix'------ /Pre-release/----{-# INLINE concatIterateScanWith #-}-concatIterateScanWith-    :: Monad m-    => (Stream m a -> Stream m a -> Stream m a)-    -> (b -> a -> m (b, Stream m a))-    -> m b-    -> Stream m a-    -> Stream m a-concatIterateScanWith combine f initial stream =-    concatEffect $ do-        b <- initial-        iterateStream (b, stream)--    where--    iterateStream (b, s) = pure $ concatMapWith combine (generate b) s--    generate b a = a `cons` feedback b a--    feedback b a = concatEffect $ f b a >>= iterateStream---- Next stream is to be generated by the return value of the previous stream. A--- general intuitive way of doing that could be to use an appending monad--- instance for streams where the result of the previous stream is used to--- generate the next one. In the first pass we can just emit the values in the--- stream and keep building a buffered list/stream, once done we can then--- process the buffered stream.--{-# INLINE concatIterateScan #-}-concatIterateScan-    :: Monad m-    => (b -> a -> m b)-    -> (b -> m (Maybe (b, Stream m a)))-    -> b-    -> Stream m a-concatIterateScan scanner generate initial =-    fromStreamD-        $ D.concatIterateScan-            scanner (fmap (fmap (fmap toStreamD)) . generate) initial----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- Keep concating either streams as long as rights are generated, stop as soon--- as a left is generated and concat the left stream.------ See also: 'handle'------ /Unimplemented/----{--concatMapEitherWith-    :: (forall x. t m x -> t m x -> t m x)-    -> (a -> t m (Either (Stream m b) b))-    -> Stream m a-    -> Stream m b-concatMapEitherWith = undefined--}---- XXX We should prefer using the Maybe stream returning signatures over this.--- This API should perhaps be removed in favor of those.---- | In an 'Either' stream iterate on 'Left's.  This is a special case of--- 'concatIterateWith':------ >>> concatIterateLeftsWith combine f = Stream.concatIterateWith combine (either f (const Stream.nil))------ To traverse a directory tree:------ >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateLeftsWith Stream.append Dir.readEither input------ /Pre-release/----{-# INLINE concatIterateLeftsWith #-}-concatIterateLeftsWith-    :: (b ~ Either a c)-    => (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m b-    -> Stream m b-concatIterateLeftsWith combine f =-    concatIterateWith combine (either f (const nil))
src/Streamly/Internal/Data/Stream/Generate.hs view
@@ -1,460 +1,1201 @@-{-# OPTIONS_GHC -Wno-orphans #-}---- |--- Module      : Streamly.Internal.Data.Stream.Generate--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Generate-    (-    -- * Primitives-      Stream.nil-    , Stream.nilM-    , Stream.cons-    , Stream.consM--    -- * From 'Unfold'-    , unfold--    -- * Unfolding-    , unfoldr-    , unfoldrM--    -- * From Values-    , Stream.fromPure-    , Stream.fromEffect-    , repeat-    , repeatM-    , replicate-    , replicateM--    -- * Enumeration-    , Enumerable (..)-    , enumerate-    , enumerateTo--    -- * Time Enumeration-    , times-    , timesWith-    , absTimes-    , absTimesWith-    , relTimes-    , relTimesWith-    , durations-    , timeout--    -- * Iteration-    , iterate-    , iterateM--    -- * Cyclic Elements-    , mfix--    -- * From Containers-    , Bottom.fromList-    , fromFoldable--    -- * From memory-    , fromPtr-    , fromPtrN-    , fromByteStr#- -- , fromByteArray#-    , fromUnboxedIORef-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO)-import Data.Word (Word8)-import Foreign.Storable (Storable)-import GHC.Exts (Addr#, Ptr (Ptr))-import Streamly.Internal.Data.Stream.Bottom-    (absTimesWith, relTimesWith, timesWith)-import Streamly.Internal.Data.Stream.Enumerate-    (Enumerable(..), enumerate, enumerateTo)-import Streamly.Internal.Data.Stream.Type-    (Stream, fromStreamD, fromStreamK, toStreamK)-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Unfold.Type (Unfold)--import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed-import qualified Streamly.Internal.Data.Stream.Bottom as Bottom-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.Type as Stream-import qualified Streamly.Internal.Data.Stream.Transform as Stream (sequence)--import Prelude hiding (iterate, replicate, repeat, take)---- $setup--- >>> :m--- >>> import Control.Concurrent (threadDelay)--- >>> import Data.Function (fix, (&))--- >>> import Data.Semigroup (cycle1)--- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import GHC.Exts (Ptr (Ptr))----------------------------------------------------------------------------------- From Unfold----------------------------------------------------------------------------------- | Convert an 'Unfold' into a stream by supplying it an input seed.------ >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello")--- >>> Stream.fold Fold.drain s--- hello--- hello--- hello----{-# INLINE unfold #-}-unfold :: Monad m => Unfold m a b -> a -> Stream m b-unfold unf = Stream.fromStreamD . D.unfold unf----------------------------------------------------------------------------------- Generation by Unfolding----------------------------------------------------------------------------------- |--- >>> :{--- unfoldr step s =---     case step s of---         Nothing -> Stream.nil---         Just (a, b) -> a `Stream.cons` unfoldr step b--- :}------ Build a stream by unfolding a /pure/ step function @step@ starting from a--- seed @s@.  The step function returns the next element in the stream and the--- next seed value. When it is done it returns 'Nothing' and the stream ends.--- For example,------ >>> :{--- let f b =---         if b > 2---         then Nothing---         else Just (b, b + 1)--- in Stream.fold Fold.toList $ Stream.unfoldr f 0--- :}--- [0,1,2]----{-# INLINE_EARLY unfoldr #-}-unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a-unfoldr step seed = fromStreamD (D.unfoldr step seed)-{-# RULES "unfoldr fallback to StreamK" [1]-    forall a b. D.toStreamK (D.unfoldr a b) = K.unfoldr a b #-}---- | Build a stream by unfolding a /monadic/ step function starting from a--- seed.  The step function returns the next element in the stream and the next--- seed value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ >>> :{--- let f b =---         if b > 2---         then return Nothing---         else return (Just (b, b + 1))--- in Stream.fold Fold.toList $ Stream.unfoldrM f 0--- :}--- [0,1,2]----{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> Stream m a-unfoldrM step = fromStreamD . D.unfoldrM step----------------------------------------------------------------------------------- From Values----------------------------------------------------------------------------------- |--- Generate an infinite stream by repeating a pure value.----{-# INLINE_NORMAL repeat #-}-repeat :: Monad m => a -> Stream m a-repeat = fromStreamD . D.repeat---- |--- >>> repeatM = Stream.sequence . Stream.repeat--- >>> repeatM = fix . Stream.consM--- >>> repeatM = cycle1 . Stream.fromEffect------ Generate a stream by repeatedly executing a monadic action forever.------ >>> :{--- repeatAction =---        Stream.repeatM (threadDelay 1000000 >> print 1)---      & Stream.take 10---      & Stream.fold Fold.drain--- :}----{-# INLINE_NORMAL repeatM #-}-repeatM :: Monad m => m a -> Stream m a-repeatM = Stream.sequence . repeat---- |--- >>> replicate n = Stream.take n . Stream.repeat------ Generate a stream of length @n@ by repeating a value @n@ times.----{-# INLINE_NORMAL replicate #-}-replicate :: Monad m => Int -> a -> Stream m a-replicate n = fromStreamD . D.replicate n---- |--- >>> replicateM n = Stream.sequence . Stream.replicate n------ Generate a stream by performing a monadic action @n@ times.-{-# INLINE_NORMAL replicateM #-}-replicateM :: Monad m => Int -> m a -> Stream m a-replicateM n = Stream.sequence . replicate n----------------------------------------------------------------------------------- Time Enumeration----------------------------------------------------------------------------------- | @times@ returns a stream of time value tuples with clock of 10 ms--- granularity. The first component of the tuple is an absolute time reference--- (epoch) denoting the start of the stream and the second component is a time--- relative to the reference.------ >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.times--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE times #-}-times :: MonadIO m => Stream m (AbsTime, RelTime64)-times = timesWith 0.01---- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms--- granularity.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimes #-}-absTimes :: MonadIO m => Stream m AbsTime-absTimes = fmap (uncurry addToAbsTime64) times---- | @relTimes@ returns a stream of relative time values starting from 0,--- using a clock of granularity 10 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimes #-}-relTimes ::  MonadIO m => Stream m RelTime64-relTimes = fmap snd times---- | @durations g@ returns a stream of relative time values measuring the time--- elapsed since the immediate predecessor element of the stream was generated.--- The first element of the stream is always 0. @durations@ uses a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.--- Durations lower than 1 ms will be 0.------ Note: This API is not safe on 32-bit machines.------ /Unimplemented/----{-# INLINE durations #-}-durations :: -- Monad m =>-    Double -> t m RelTime64-durations = undefined---- | Generate a singleton event at or after the specified absolute time. Note--- that this is different from a threadDelay, a threadDelay starts from the--- time when the action is evaluated, whereas if we use AbsTime based timeout--- it will immediately expire if the action is evaluated too late.------ /Unimplemented/----{-# INLINE timeout #-}-timeout :: -- Monad m =>-    AbsTime -> t m ()-timeout = undefined----------------------------------------------------------------------------------- Iterating functions----------------------------------------------------------------------------------- |--- >>> iterate f x = x `Stream.cons` iterate f x------ Generate an infinite stream with @x@ as the first element and each--- successive element derived by applying the function @f@ on the previous--- element.------ >>> Stream.fold Fold.toList $ Stream.take 5 $ Stream.iterate (+1) 1--- [1,2,3,4,5]----{-# INLINE_NORMAL iterate #-}-iterate :: Monad m => (a -> a) -> a -> Stream m a-iterate step = fromStreamD . D.iterate step---- |--- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a)------ Generate an infinite stream with the first element generated by the action--- @m@ and each successive element derived by applying the monadic function--- @f@ on the previous element.------ >>> :{--- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0)---     & Stream.take 3---     & Stream.fold Fold.toList--- :}--- 0--- 1--- [0,1,2]----{-# INLINE iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> Stream m a-iterateM step = fromStreamD . D.iterateM step---- | We can define cyclic structures using @let@:------ >>> let (a, b) = ([1, b], head a) in (a, b)--- ([1,1],1)------ The function @fix@ defined as:------ >>> fix f = let x = f x in x------ ensures that the argument of a function and its output refer to the same--- lazy value @x@ i.e.  the same location in memory.  Thus @x@ can be defined--- in terms of itself, creating structures with cyclic references.------ >>> f ~(a, b) = ([1, b], head a)--- >>> fix f--- ([1,1],1)------ 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic--- values.------ Using 'mfix' for streams we can construct a stream in which each element of--- the stream is defined in a cyclic fashion. The argument of the function--- being fixed represents the current element of the stream which is being--- returned by the stream monad. Thus, we can use the argument to construct--- itself.------ In the following example, the argument @action@ of the function @f@--- represents the tuple @(x,y)@ returned by it in a given iteration. We define--- the first element of the tuple in terms of the second.------ >>> import Streamly.Internal.Data.Stream as Stream--- >>> import System.IO.Unsafe (unsafeInterleaveIO)------ >>> :{--- main = Stream.fold (Fold.drainMapM print) $ Stream.mfix f---     where---     f action = unCrossStream $ do---         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act---         x <- CrossStream (Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action])---         y <- CrossStream (Stream.fromList [4,5])---         return (x, y)--- :}------ Note: you cannot achieve this by just changing the order of the monad--- statements because that would change the order in which the stream elements--- are generated.------ Note that the function @f@ must be lazy in its argument, that's why we use--- 'unsafeInterleaveIO' on @action@ because IO monad is strict.------ /CPS/------ /Pre-release/-{-# INLINE mfix #-}-mfix :: Monad m => (m a -> Stream m a) -> Stream m a-mfix f = fromStreamK $ K.mfix (toStreamK . f)----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- |--- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil------ Construct a stream from a 'Foldable' containing pure values:------ /CPS/----{-# INLINE fromFoldable #-}-fromFoldable :: Foldable f => f a -> Stream m a-fromFoldable = fromStreamK . K.fromFoldable----------------------------------------------------------------------------------- From pointers----------------------------------------------------------------------------------- | Keep reading 'Storable' elements from 'Ptr' onwards.------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtr #-}-fromPtr :: (MonadIO m, Storable a) => Ptr a -> Stream m a-fromPtr = Stream.fromStreamD . D.fromPtr---- | Take @n@ 'Storable' elements starting from 'Ptr' onwards.------ >>> fromPtrN n = Stream.take n . Stream.fromPtr------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtrN #-}-fromPtrN :: (MonadIO m, Storable a) => Int -> Ptr a -> Stream m a-fromPtrN n = Stream.fromStreamD . D.take n . D.fromPtr---- | Read bytes from an 'Addr#' until a 0 byte is encountered, the 0 byte is--- not included in the stream.------ >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr------ /Unsafe:/ The caller is responsible for safe addressing.------ Note that this is completely safe when reading from Haskell string--- literals because they are guaranteed to be NULL terminated:------ >>> Stream.fold Fold.toList $ Stream.fromByteStr# "\1\2\3\0"#--- [1,2,3]----{-# INLINE fromByteStr# #-}-fromByteStr# :: MonadIO m => Addr# -> Stream m Word8-fromByteStr# addr =-    Stream.fromStreamD $ D.takeWhile (/= 0) $ D.fromPtr $ Ptr addr---- | Construct a stream by reading an 'Unboxed' 'IORef' repeatedly.------ /Pre-release/----{-# INLINE fromUnboxedIORef #-}-fromUnboxedIORef :: (MonadIO m, Unbox a) => Unboxed.IORef a -> Stream m a-fromUnboxedIORef = fromStreamD . Unboxed.toStreamD+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Generate+-- Copyright   : (c) 2020 Composewell Technologies and Contributors+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++-- A few combinators in this module have been adapted from the vector package+-- (c) Roman Leshchinskiy. See the notes in specific combinators.+--+module Streamly.Internal.Data.Stream.Generate+  (+    -- * Primitives+      nil+    , nilM+    , cons+    , consM++    -- * From 'Unfold'+    , unfold++    -- * Unfolding+    , unfoldr+    , unfoldrM++    -- * From Values+    , fromPure+    , fromEffect+    , repeat+    , repeatM+    , replicate+    , replicateM++    -- * Enumeration+    -- ** Enumerating 'Num' Types+    , enumerateFromStepNum+    , enumerateFromNum+    , enumerateFromThenNum++    -- ** Enumerating 'Bounded' 'Enum' Types+    , enumerate+    , enumerateTo+    , enumerateFromBounded++    -- ** Enumerating 'Enum' Types not larger than 'Int'+    , enumerateFromToSmall+    , enumerateFromThenToSmall+    , enumerateFromThenSmallBounded++    -- ** Enumerating 'Bounded' 'Integral' Types+    , enumerateFromIntegral+    , enumerateFromThenIntegral++    -- ** Enumerating 'Integral' Types+    , enumerateFromToIntegral+    , enumerateFromThenToIntegral++    -- ** Enumerating unbounded 'Integral' Types+    , enumerateFromStepIntegral++    -- ** Enumerating 'Fractional' Types+    , enumerateFromFractional+    , enumerateFromToFractional+    , enumerateFromThenFractional+    , enumerateFromThenToFractional++    -- ** Enumerable Type Class+    , Enumerable(..)++    -- * Time Enumeration+    , times+    , timesWith+    , absTimes+    , absTimesWith+    , relTimes+    , relTimesWith+    , durations+    , timeout++    -- * From Generators+    -- | Generate a monadic stream from a seed.+    , fromIndices+    , fromIndicesM+    , generate+    , generateM++    -- * Iteration+    , iterate+    , iterateM++    -- * From Containers+    -- | Transform an input structure into a stream.++    , fromList+    , fromListM+    , fromFoldable+    , fromFoldableM++    -- * From Pointers+    , fromPtr+    , fromPtrN+    , fromByteStr#++    -- * Conversions+    , fromStreamK+    , toStreamK+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (Storable (peek), sizeOf)+import GHC.Exts (Addr#, Ptr (Ptr))+import Streamly.Internal.Data.Time.Clock+    (Clock(Monotonic), asyncClock, readClock)+import Streamly.Internal.Data.Time.Units+    (toAbsTime, AbsTime, toRelTime64, RelTime64, addToAbsTime64)+import Streamly.Internal.System.IO (unsafeInlineIO)++#ifdef USE_UNFOLDS_EVERYWHERE+import qualified Streamly.Internal.Data.Unfold as Unfold+#endif++import Data.Fixed+import Data.Int+import Data.Ratio+import Data.Word+import Numeric.Natural+import Prelude hiding (iterate, repeat, replicate, take, takeWhile)+import Streamly.Internal.Data.Stream.Type++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Primitives+------------------------------------------------------------------------------++-- XXX implement in terms of nilM?++-- | A stream that terminates without producing any output or side effect.+--+-- >>> Stream.toList Stream.nil+-- []+--+{-# INLINE_NORMAL nil #-}+nil :: Applicative m => Stream m a+nil = Stream (\_ _ -> pure Stop) ()++-- XXX implement in terms of consM?+-- cons x = consM (return x)+-- From an implementation perspective, StreamK.cons translates into a+-- functional call whereas fused cons translates into a conditional branch+-- (jump). However, the overhead of the function call in StreamK.cons only+-- occurs once, while the overhead of the conditional branch in fused cons is+-- incurred for each subsequent element in the stream. As a result,+-- StreamK.cons has a time complexity of O(n), while fused cons has a time+-- complexity of O(n^2), where @n@ represents the number of 'cons' used.++-- When composing a few elements together statically, a balanced tree composed+-- using 'cons' and 'append' is more efficient than a right associated one+-- composed using 'cons':+--+-- >>> s1 = 1 `Stream.cons` 2 `Stream.cons` Stream.nil+-- >>> s2 = 2 `Stream.cons` 3 `Stream.cons` Stream.nil+-- >>> s = s1 `Stream.append` s2+--+-- However, generating a stream using a case statement or indexing into a+-- static literal array would be the best. Check if the case statement+-- translates to a look up table or a binary search.++-- | WARNING! O(n^2) time complexity wrt number of elements. Use the O(n)+-- complexity StreamK.'Streamly.Data.StreamK.cons' unless you want to+-- statically fuse just a few elements.+--+-- Fuse a pure value at the head of an existing stream::+--+-- >>> s = 1 `Stream.cons` Stream.fromList [2,3]+-- >>> Stream.toList s+-- [1,2,3]+--+-- Definition:+--+-- >>> cons x xs = return x `Stream.consM` xs+--+{-# INLINE_NORMAL cons #-}+cons :: Applicative m => a -> Stream m a -> Stream m a+cons x (Stream step state) = Stream step1 Nothing+    where+    {-# INLINE_LATE step1 #-}+    step1 _ Nothing = pure $ Yield x (Just state)+    step1 gst (Just st) = do+          (\case+            Yield a s -> Yield a (Just s)+            Skip  s   -> Skip (Just s)+            Stop      -> Stop) <$> step gst st++------------------------------------------------------------------------------+-- Unfolding+------------------------------------------------------------------------------++-- Adapted from vector package++-- | Build a stream by unfolding a /monadic/ step function starting from a+-- seed.  The step function returns the next element in the stream and the next+-- seed value. When it is done it returns 'Nothing' and the stream ends. For+-- example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then return Nothing+--         else return (Just (b, b + 1))+-- in Stream.toList $ Stream.unfoldrM f 0+-- :}+-- [0,1,2]+--+{-# INLINE_NORMAL unfoldrM #-}+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+unfoldrM next = unfold (Unfold.unfoldrM next)+#else+unfoldrM next = Stream step+  where+    {-# INLINE_LATE step #-}+    step _ st = do+        r <- next st+        return $ case r of+            Just (x, s) -> Yield x s+            Nothing     -> Stop+#endif++-- | Build a stream by unfolding a /pure/ step function @step@ starting from a+-- seed @s@.  The step function returns the next element in the stream and the+-- next seed value. When it is done it returns 'Nothing' and the stream ends.+-- For example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then Nothing+--         else Just (b, b + 1)+-- in Stream.toList $ Stream.unfoldr f 0+-- :}+-- [0,1,2]+--+{-# INLINE_LATE unfoldr #-}+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a+unfoldr f = unfoldrM (return . f)++------------------------------------------------------------------------------+-- From values+------------------------------------------------------------------------------++-- |+-- >>> repeatM = Stream.sequence . Stream.repeat+--+-- Generate a stream by repeatedly executing a monadic action forever.+--+-- >>> :{+-- repeatAction =+--        Stream.repeatM (threadDelay 1000000 >> print 1)+--      & Stream.take 10+--      & Stream.fold Fold.drain+-- :}+--+{-# INLINE_NORMAL repeatM #-}+repeatM :: Monad m => m a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+repeatM = unfold Unfold.repeatM+#else+repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) ()+#endif++-- |+-- Generate an infinite stream by repeating a pure value.+--+-- >>> repeat x = Stream.repeatM (pure x)+--+{-# INLINE_NORMAL repeat #-}+repeat :: Monad m => a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+repeat x = repeatM (pure x)+#else+repeat x = Stream (\_ _ -> return $ Yield x ()) ()+#endif++-- Adapted from the vector package++-- |+-- >>> replicateM n = Stream.sequence . Stream.replicate n+--+-- Generate a stream by performing a monadic action @n@ times.+{-# INLINE_NORMAL replicateM #-}+replicateM :: Monad m => Int -> m a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+replicateM n p = unfold Unfold.replicateM (n, p)+#else+replicateM n p = Stream step n+  where+    {-# INLINE_LATE step #-}+    step _ (i :: Int)+      | i <= 0    = return Stop+      | otherwise = do+          x <- p+          return $ Yield x (i - 1)+#endif++-- |+-- >>> replicate n = Stream.take n . Stream.repeat+-- >>> replicate n x = Stream.replicateM n (pure x)+--+-- Generate a stream of length @n@ by repeating a value @n@ times.+--+{-# INLINE_NORMAL replicate #-}+replicate :: Monad m => Int -> a -> Stream m a+replicate n x = replicateM n (return x)++------------------------------------------------------------------------------+-- Enumeration of Num+------------------------------------------------------------------------------++-- | For floating point numbers if the increment is less than the precision then+-- it just gets lost. Therefore we cannot always increment it correctly by just+-- repeated addition.+-- 9007199254740992 + 1 + 1 :: Double => 9.007199254740992e15+-- 9007199254740992 + 2     :: Double => 9.007199254740994e15+--+-- Instead we accumulate the increment counter and compute the increment+-- every time before adding it to the starting number.+--+-- This works for Integrals as well as floating point numbers, but+-- enumerateFromStepIntegral is faster for integrals.+{-# INLINE_NORMAL enumerateFromStepNum #-}+enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromStepNum from stride =+    unfold Unfold.enumerateFromStepNum (from, stride)+#else+enumerateFromStepNum from stride = Stream step 0+    where+    {-# INLINE_LATE step #-}+    step _ !i = return $ (Yield $! (from + i * stride)) $! (i + 1)+#endif++{-# INLINE_NORMAL enumerateFromNum #-}+enumerateFromNum :: (Monad m, Num a) => a -> Stream m a+enumerateFromNum from = enumerateFromStepNum from 1++{-# INLINE_NORMAL enumerateFromThenNum #-}+enumerateFromThenNum :: (Monad m, Num a) => a -> a -> Stream m a+enumerateFromThenNum from next = enumerateFromStepNum from (next - from)++------------------------------------------------------------------------------+-- Enumeration of Integrals+------------------------------------------------------------------------------++#ifndef USE_UNFOLDS_EVERYWHERE+data EnumState a = EnumInit | EnumYield a a a | EnumStop++{-# INLINE_NORMAL enumerateFromThenToIntegralUp #-}+enumerateFromThenToIntegralUp+    :: (Monad m, Integral a)+    => a -> a -> a -> Stream m a+enumerateFromThenToIntegralUp from next to = Stream step EnumInit+    where+    {-# INLINE_LATE step #-}+    step _ EnumInit =+        return $+            if to < next+            then if to < from+                 then Stop+                 else Yield from EnumStop+            else -- from <= next <= to+                let stride = next - from+                in Skip $ EnumYield from stride (to - stride)++    step _ (EnumYield x stride toMinus) =+        return $+            if x > toMinus+            then Yield x EnumStop+            else Yield x $ EnumYield (x + stride) stride toMinus++    step _ EnumStop = return Stop++{-# INLINE_NORMAL enumerateFromThenToIntegralDn #-}+enumerateFromThenToIntegralDn+    :: (Monad m, Integral a)+    => a -> a -> a -> Stream m a+enumerateFromThenToIntegralDn from next to = Stream step EnumInit+    where+    {-# INLINE_LATE step #-}+    step _ EnumInit =+        return $ if to > next+            then if to > from+                 then Stop+                 else Yield from EnumStop+            else -- from >= next >= to+                let stride = next - from+                in Skip $ EnumYield from stride (to - stride)++    step _ (EnumYield x stride toMinus) =+        return $+            if x < toMinus+            then Yield x EnumStop+            else Yield x $ EnumYield (x + stride) stride toMinus++    step _ EnumStop = return Stop+#endif++-- XXX This can perhaps be simplified and written in terms of+-- enumeratFromStepIntegral as we have done in unfolds.++-- | Enumerate an 'Integral' type in steps up to a given limit.+-- @enumerateFromThenToIntegral from then to@ generates a finite stream whose+-- first element is @from@, the second element is @then@ and the successive+-- elements are in increments of @then - from@ up to @to@.+--+-- >>> Stream.toList $ Stream.enumerateFromThenToIntegral 0 2 6+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)+-- [0,-2,-4,-6]+--+{-# INLINE_NORMAL enumerateFromThenToIntegral #-}+enumerateFromThenToIntegral+    :: (Monad m, Integral a)+    => a -> a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromThenToIntegral from next to =+    unfold Unfold.enumerateFromThenToIntegral (from, next, to)+#else+enumerateFromThenToIntegral from next to+    | next >= from = enumerateFromThenToIntegralUp from next to+    | otherwise    = enumerateFromThenToIntegralDn from next to+#endif++-- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from+-- then@ generates a stream whose first element is @from@, the second element+-- is @then@ and the successive elements are in increments of @then - from@.+-- The stream is bounded by the size of the 'Integral' type.+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)+-- [0,-2,-4,-6]+--+{-# INLINE_NORMAL enumerateFromThenIntegral #-}+enumerateFromThenIntegral+    :: (Monad m, Integral a, Bounded a)+    => a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromThenIntegral from next =+    unfold Unfold.enumerateFromThenIntegralBounded (from, next)+#else+enumerateFromThenIntegral from next =+    if next > from+    then enumerateFromThenToIntegralUp from next maxBound+    else enumerateFromThenToIntegralDn from next minBound+#endif++-- | @enumerateFromStepIntegral from step@ generates an infinite stream whose+-- first element is @from@ and the successive elements are in increments of+-- @step@.+--+-- CAUTION: This function is not safe for finite integral types. It does not+-- check for overflow, underflow or bounds.+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)+-- [0,-2,-4]+--+{-# INLINE_NORMAL enumerateFromStepIntegral #-}+enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromStepIntegral from stride =+    unfold Unfold.enumerateFromStepIntegral (from, stride)+#else+enumerateFromStepIntegral from stride =+    from `seq` stride `seq` Stream step from+    where+        {-# INLINE_LATE step #-}+        step _ !x = return $ Yield x $! (x + stride)+#endif++-- | Enumerate an 'Integral' type up to a given limit.+-- @enumerateFromToIntegral from to@ generates a finite stream whose first+-- element is @from@ and successive elements are in increments of @1@ up to+-- @to@.+--+-- >>> Stream.toList $ Stream.enumerateFromToIntegral 0 4+-- [0,1,2,3,4]+--+{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a+enumerateFromToIntegral from to =+    takeWhile (<= to) $ enumerateFromStepIntegral from 1++-- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a+-- stream whose first element is @from@ and the successive elements are in+-- increments of @1@. The stream is bounded by the size of the 'Integral' type.+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)+-- [0,1,2,3]+--+{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a+enumerateFromIntegral from = enumerateFromToIntegral from maxBound++------------------------------------------------------------------------------+-- Enumeration of Fractionals+------------------------------------------------------------------------------++-- We cannot write a general function for Num.  The only way to write code+-- portable between the two is to use a 'Real' constraint and convert between+-- Fractional and Integral using fromRational which is horribly slow.++-- Even though the underlying implementation of enumerateFromFractional and+-- enumerateFromThenFractional works for any 'Num' we have restricted these to+-- 'Fractional' because these do not perform any bounds check, in contrast to+-- integral versions and are therefore not equivalent substitutes for those.++-- | Numerically stable enumeration from a 'Fractional' number in steps of size+-- @1@. @enumerateFromFractional from@ generates a stream whose first element+-- is @from@ and the successive elements are in increments of @1@.  No overflow+-- or underflow checks are performed.+--+-- This is the equivalent to 'enumFrom' for 'Fractional' types. For example:+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1+-- [1.1,2.1,3.1,4.1]+--+{-# INLINE enumerateFromFractional #-}+enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a+enumerateFromFractional = enumerateFromNum++-- | Numerically stable enumeration from a 'Fractional' number in steps.+-- @enumerateFromThenFractional from then@ generates a stream whose first+-- element is @from@, the second element is @then@ and the successive elements+-- are in increments of @then - from@.  No overflow or underflow checks are+-- performed.+--+-- This is the equivalent of 'enumFromThen' for 'Fractional' types. For+-- example:+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1+-- [1.1,2.1,3.1,4.1]+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)+-- [1.1,-2.1,-5.300000000000001,-8.500000000000002]+--+{-# INLINE enumerateFromThenFractional #-}+enumerateFromThenFractional+    :: (Monad m, Fractional a)+    => a -> a -> Stream m a+enumerateFromThenFractional = enumerateFromThenNum++-- | Numerically stable enumeration from a 'Fractional' number to a given+-- limit.  @enumerateFromToFractional from to@ generates a finite stream whose+-- first element is @from@ and successive elements are in increments of @1@ up+-- to @to@.+--+-- This is the equivalent of 'enumFromTo' for 'Fractional' types. For+-- example:+--+-- >>> Stream.toList $ Stream.enumerateFromToFractional 1.1 4+-- [1.1,2.1,3.1,4.1]+--+-- >>> Stream.toList $ Stream.enumerateFromToFractional 1.1 4.6+-- [1.1,2.1,3.1,4.1,5.1]+--+-- Notice that the last element is equal to the specified @to@ value after+-- rounding to the nearest integer.+--+{-# INLINE_NORMAL enumerateFromToFractional #-}+enumerateFromToFractional+    :: (Monad m, Fractional a, Ord a)+    => a -> a -> Stream m a+enumerateFromToFractional from to =+    takeWhile (<= to + 1 / 2) $ enumerateFromStepNum from 1++-- | Numerically stable enumeration from a 'Fractional' number in steps up to a+-- given limit.  @enumerateFromThenToFractional from then to@ generates a+-- finite stream whose first element is @from@, the second element is @then@+-- and the successive elements are in increments of @then - from@ up to @to@.+--+-- This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For+-- example:+--+-- >>> Stream.toList $ Stream.enumerateFromThenToFractional 0.1 2 6+-- [0.1,2.0,3.9,5.799999999999999]+--+-- >>> Stream.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)+-- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]+--+{-# INLINE_NORMAL enumerateFromThenToFractional #-}+enumerateFromThenToFractional+    :: (Monad m, Fractional a, Ord a)+    => a -> a -> a -> Stream m a+enumerateFromThenToFractional from next to =+    takeWhile predicate $ enumerateFromThenFractional from next+    where+    mid = (next - from) / 2+    predicate | next >= from  = (<= to + mid)+              | otherwise     = (>= to + mid)++-------------------------------------------------------------------------------+-- Enumeration of Enum types not larger than Int+-------------------------------------------------------------------------------+--+-- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.+--+{-# INLINE enumerateFromToSmall #-}+enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a+enumerateFromToSmall from to =+      fmap toEnum+    $ enumerateFromToIntegral (fromEnum from) (fromEnum to)++-- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.+--+{-# INLINE enumerateFromThenToSmall #-}+enumerateFromThenToSmall :: (Monad m, Enum a)+    => a -> a -> a -> Stream m a+enumerateFromThenToSmall from next to =+          fmap toEnum+        $ enumerateFromThenToIntegral+            (fromEnum from) (fromEnum next) (fromEnum to)++-- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.+--+-- Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a+-- type is bounded but does not have a 'Bounded' instance then we can go on+-- enumerating it beyond the legal values of the type, resulting in the failure+-- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'+-- instance for this function to be safely used.+--+{-# INLINE enumerateFromThenSmallBounded #-}+enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a)+    => a -> a -> Stream m a+enumerateFromThenSmallBounded from next =+    if fromEnum next >= fromEnum from+    then enumerateFromThenTo from next maxBound+    else enumerateFromThenTo from next minBound++-------------------------------------------------------------------------------+-- Enumerable type class+-------------------------------------------------------------------------------+--+-- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream+-- enumerations like this:+--+-- {-# RULES "fromList enumFrom" [1]+--     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}+--+-- But this does not work because enumFrom is a class method and GHC rewrites+-- it quickly, so we do not get a chance to have our rule fired.++-- | Types that can be enumerated as a stream. The operations in this type+-- class are equivalent to those in the 'Enum' type class, except that these+-- generate a stream instead of a list. Use the functions in+-- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.+--+class Enum a => Enumerable a where+    -- | @enumerateFrom from@ generates a stream starting with the element+    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or+    -- generating an infinite stream when the type is not 'Bounded'.+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)+    -- [0,1,2,3]+    --+    -- For 'Fractional' types, enumeration is numerically stable. However, no+    -- overflow or underflow checks are performed.+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1+    -- [1.1,2.1,3.1,4.1]+    --+    enumerateFrom :: (Monad m) => a -> Stream m a++    -- | Generate a finite stream starting with the element @from@, enumerating+    -- the type up to the value @to@. If @to@ is smaller than @from@ then an+    -- empty stream is returned.+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 0 4+    -- [0,1,2,3,4]+    --+    -- For 'Fractional' types, the last element is equal to the specified @to@+    -- value after rounding to the nearest integral value.+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 1.1 4+    -- [1.1,2.1,3.1,4.1]+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 1.1 4.6+    -- [1.1,2.1,3.1,4.1,5.1]+    --+    enumerateFromTo :: (Monad m) => a -> a -> Stream m a++    -- | @enumerateFromThen from then@ generates a stream whose first element+    -- is @from@, the second element is @then@ and the successive elements are+    -- in increments of @then - from@.  Enumeration can occur downwards or+    -- upwards depending on whether @then@ comes before or after @from@. For+    -- 'Bounded' types the stream ends when 'maxBound' is reached, for+    -- unbounded types it keeps enumerating infinitely.+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2+    -- [0,2,4,6]+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)+    -- [0,-2,-4,-6]+    --+    enumerateFromThen :: (Monad m) => a -> a -> Stream m a++    -- | @enumerateFromThenTo from then to@ generates a finite stream whose+    -- first element is @from@, the second element is @then@ and the successive+    -- elements are in increments of @then - from@ up to @to@. Enumeration can+    -- occur downwards or upwards depending on whether @then@ comes before or+    -- after @from@.+    --+    -- >>> Stream.toList $ Stream.enumerateFromThenTo 0 2 6+    -- [0,2,4,6]+    --+    -- >>> Stream.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)+    -- [0,-2,-4,-6]+    --+    enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a++-- MAYBE: Sometimes it is more convenient to know the count rather then the+-- ending or starting element. For those cases we can define the folllowing+-- APIs. All of these will work only for bounded types if we represent the+-- count by Int.+--+-- enumerateN+-- enumerateFromN+-- enumerateToN+-- enumerateFromStep+-- enumerateFromStepN++-------------------------------------------------------------------------------+-- Convenient functions for bounded types+-------------------------------------------------------------------------------+--+-- |+-- > enumerate = enumerateFrom minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'+--+{-# INLINE enumerate #-}+enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a+enumerate = enumerateFrom minBound++-- |+-- >>> enumerateTo = Stream.enumerateFromTo minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to specified value.+--+{-# INLINE enumerateTo #-}+enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a+enumerateTo = enumerateFromTo minBound++-- |+-- >>> enumerateFromBounded from = Stream.enumerateFromTo from maxBound+--+-- 'enumerateFrom' for 'Bounded' 'Enum' types.+--+{-# INLINE enumerateFromBounded #-}+enumerateFromBounded :: (Monad m, Enumerable a, Bounded a)+    => a -> Stream m a+enumerateFromBounded from = enumerateFromTo from maxBound++-------------------------------------------------------------------------------+-- Enumerable Instances+-------------------------------------------------------------------------------+--+-- For Enum types smaller than or equal to Int size.+#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \+instance Enumerable SMALL_TYPE where {                 \+    {-# INLINE enumerateFrom #-};                      \+    enumerateFrom = enumerateFromBounded;              \+    {-# INLINE enumerateFromThen #-};                  \+    enumerateFromThen = enumerateFromThenSmallBounded; \+    {-# INLINE enumerateFromTo #-};                    \+    enumerateFromTo = enumerateFromToSmall;            \+    {-# INLINE enumerateFromThenTo #-};                \+    enumerateFromThenTo = enumerateFromThenToSmall }++ENUMERABLE_BOUNDED_SMALL(())+ENUMERABLE_BOUNDED_SMALL(Bool)+ENUMERABLE_BOUNDED_SMALL(Ordering)+ENUMERABLE_BOUNDED_SMALL(Char)++-- For bounded Integral Enum types, may be larger than Int.+#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \+instance Enumerable INTEGRAL_TYPE where {           \+    {-# INLINE enumerateFrom #-};                   \+    enumerateFrom = enumerateFromIntegral;          \+    {-# INLINE enumerateFromThen #-};               \+    enumerateFromThen = enumerateFromThenIntegral;  \+    {-# INLINE enumerateFromTo #-};                 \+    enumerateFromTo = enumerateFromToIntegral;      \+    {-# INLINE enumerateFromThenTo #-};             \+    enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_BOUNDED_INTEGRAL(Int)+ENUMERABLE_BOUNDED_INTEGRAL(Int8)+ENUMERABLE_BOUNDED_INTEGRAL(Int16)+ENUMERABLE_BOUNDED_INTEGRAL(Int32)+ENUMERABLE_BOUNDED_INTEGRAL(Int64)+ENUMERABLE_BOUNDED_INTEGRAL(Word)+ENUMERABLE_BOUNDED_INTEGRAL(Word8)+ENUMERABLE_BOUNDED_INTEGRAL(Word16)+ENUMERABLE_BOUNDED_INTEGRAL(Word32)+ENUMERABLE_BOUNDED_INTEGRAL(Word64)++-- For unbounded Integral Enum types.+#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \+instance Enumerable INTEGRAL_TYPE where {                         \+    {-# INLINE enumerateFrom #-};                                 \+    enumerateFrom from = enumerateFromStepIntegral from 1;        \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen from next =                                 \+        enumerateFromStepIntegral from (next - from);             \+    {-# INLINE enumerateFromTo #-};                               \+    enumerateFromTo = enumerateFromToIntegral;                    \+    {-# INLINE enumerateFromThenTo #-};                           \+    enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)+ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)++#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \+instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \+    {-# INLINE enumerateFrom #-};                                 \+    enumerateFrom = enumerateFromFractional;                      \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen = enumerateFromThenFractional;              \+    {-# INLINE enumerateFromTo #-};                               \+    enumerateFromTo = enumerateFromToFractional;                  \+    {-# INLINE enumerateFromThenTo #-};                           \+    enumerateFromThenTo = enumerateFromThenToFractional }++ENUMERABLE_FRACTIONAL(Float,)+ENUMERABLE_FRACTIONAL(Double,)+ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)+ENUMERABLE_FRACTIONAL((Ratio a),Integral a)++instance Enumerable a => Enumerable (Identity a) where+    {-# INLINE enumerateFrom #-}+    enumerateFrom (Identity from) =+        fmap Identity $ enumerateFrom from+    {-# INLINE enumerateFromThen #-}+    enumerateFromThen (Identity from) (Identity next) =+        fmap Identity $ enumerateFromThen from next+    {-# INLINE enumerateFromTo #-}+    enumerateFromTo (Identity from) (Identity to) =+        fmap Identity $ enumerateFromTo from to+    {-# INLINE enumerateFromThenTo #-}+    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =+          fmap Identity+        $ enumerateFromThenTo from next to++-- TODO+{-+instance Enumerable a => Enumerable (Last a)+instance Enumerable a => Enumerable (First a)+instance Enumerable a => Enumerable (Max a)+instance Enumerable a => Enumerable (Min a)+instance Enumerable a => Enumerable (Const a b)+instance Enumerable (f a) => Enumerable (Alt f a)+instance Enumerable (f a) => Enumerable (Ap f a)+-}+------------------------------------------------------------------------------+-- Time Enumeration+------------------------------------------------------------------------------++-- | @timesWith g@ returns a stream of time value tuples. The first component+-- of the tuple is an absolute time reference (epoch) denoting the start of the+-- stream and the second component is a time relative to the reference.+--+-- The argument @g@ specifies the granularity of the relative time in seconds.+-- A lower granularity clock gives higher precision but is more expensive in+-- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.+--+-- >>> import Control.Concurrent (threadDelay)+-- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)+-- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE_NORMAL timesWith #-}+timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)+timesWith g = Stream step Nothing++    where++    {-# INLINE_LATE step #-}+    step _ Nothing = do+        clock <- liftIO $ asyncClock Monotonic g+        a <- liftIO $ readClock clock+        return $ Skip $ Just (clock, a)++    step _ s@(Just (clock, t0)) = do+        a <- liftIO $ readClock clock+        -- XXX we can perhaps use an AbsTime64 using a 64 bit Int for+        -- efficiency.  or maybe we can use a representation using Double for+        -- floating precision time+        return $ Yield (toAbsTime t0, toRelTime64 (a - t0)) s++-- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of+-- granularity @g@ specified in seconds. A low granularity clock is more+-- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated+-- as 1 ms.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE absTimesWith #-}+absTimesWith :: MonadIO m => Double -> Stream m AbsTime+absTimesWith = fmap (uncurry addToAbsTime64) . timesWith++-- | @relTimesWith g@ returns a stream of relative time values starting from 0,+-- using a clock of granularity @g@ specified in seconds. A low granularity+-- clock is more expensive in terms of CPU usage.  Any granularity lower than 1+-- ms is treated as 1 ms.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE relTimesWith #-}+relTimesWith :: MonadIO m => Double -> Stream m RelTime64+relTimesWith = fmap snd . timesWith++-- | @times@ returns a stream of time value tuples with clock of 10 ms+-- granularity. The first component of the tuple is an absolute time reference+-- (epoch) denoting the start of the stream and the second component is a time+-- relative to the reference.+--+-- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)+-- >>> Stream.fold f $ Stream.take 3 $ Stream.times+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE times #-}+times :: MonadIO m => Stream m (AbsTime, RelTime64)+times = timesWith 0.01++-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms+-- granularity.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE absTimes #-}+absTimes :: MonadIO m => Stream m AbsTime+absTimes = fmap (uncurry addToAbsTime64) times++-- | @relTimes@ returns a stream of relative time values starting from 0,+-- using a clock of granularity 10 ms.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE relTimes #-}+relTimes ::  MonadIO m => Stream m RelTime64+relTimes = fmap snd times++-- | @durations g@ returns a stream of relative time values measuring the time+-- elapsed since the immediate predecessor element of the stream was generated.+-- The first element of the stream is always 0. @durations@ uses a clock of+-- granularity @g@ specified in seconds. A low granularity clock is more+-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.+-- Durations lower than 1 ms will be 0.+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Unimplemented/+--+{-# INLINE durations #-}+durations :: -- Monad m =>+    Double -> t m RelTime64+durations = undefined++-- | Generate a singleton event at or after the specified absolute time. Note+-- that this is different from a threadDelay, a threadDelay starts from the+-- time when the action is evaluated, whereas if we use AbsTime based timeout+-- it will immediately expire if the action is evaluated too late.+--+-- /Unimplemented/+--+{-# INLINE timeout #-}+timeout :: -- Monad m =>+    AbsTime -> t m ()+timeout = undefined++-------------------------------------------------------------------------------+-- From Generators+-------------------------------------------------------------------------------++{-# INLINE_NORMAL fromIndicesM #-}+fromIndicesM :: Monad m => (Int -> m a) -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+fromIndicesM gen = unfold (Unfold.fromIndicesM gen) 0+#else+fromIndicesM gen = Stream step 0+  where+    {-# INLINE_LATE step #-}+    step _ i = do+       x <- gen i+       return $ Yield x (i + 1)+#endif++{-# INLINE fromIndices #-}+fromIndices :: Monad m => (Int -> a) -> Stream m a+fromIndices gen = fromIndicesM (return . gen)++-- Adapted from the vector package+{-# INLINE_NORMAL generateM #-}+generateM :: Monad m => Int -> (Int -> m a) -> Stream m a+generateM n gen = n `seq` Stream step 0+  where+    {-# INLINE_LATE step #-}+    step _ i | i < n     = do+                           x <- gen i+                           return $ Yield x (i + 1)+             | otherwise = return Stop++{-# INLINE generate #-}+generate :: Monad m => Int -> (Int -> a) -> Stream m a+generate n gen = generateM n (return . gen)++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++-- | Generate an infinite stream with the first element generated by the action+-- @m@ and each successive element derived by applying the monadic function @f@+-- on the previous element.+--+-- >>> :{+-- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0)+--     & Stream.take 3+--     & Stream.toList+-- :}+-- 0+-- 1+-- [0,1,2]+--+{-# INLINE_NORMAL iterateM #-}+iterateM :: Monad m => (a -> m a) -> m a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+iterateM step = unfold (Unfold.iterateM step)+#else+iterateM step = Stream (\_ st -> st >>= \(!x) -> return $ Yield x (step x))+#endif++-- | Generate an infinite stream with @x@ as the first element and each+-- successive element derived by applying the function @f@ on the previous+-- element.+--+-- >>> Stream.toList $ Stream.take 5 $ Stream.iterate (+1) 1+-- [1,2,3,4,5]+--+{-# INLINE_NORMAL iterate #-}+iterate :: Monad m => (a -> a) -> a -> Stream m a+iterate step st = iterateM (return . step) (return st)++-------------------------------------------------------------------------------+-- From containers+-------------------------------------------------------------------------------++-- | Convert a list of monadic actions to a 'Stream'+{-# INLINE_LATE fromListM #-}+fromListM :: Monad m => [m a] -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+fromListM = unfold Unfold.fromListM+#else+fromListM = Stream step+  where+    {-# INLINE_LATE step #-}+    step _ (m:ms) = m >>= \x -> return $ Yield x ms+    step _ []     = return Stop+#endif++-- |+-- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil+--+-- Construct a stream from a 'Foldable' containing pure values:+--+-- /WARNING: O(n^2), suitable only for a small number of+-- elements in the stream/+--+{-# INLINE fromFoldable #-}+fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a+fromFoldable = Prelude.foldr cons nil++-- |+-- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil+--+-- Construct a stream from a 'Foldable' containing pure values:+--+-- /WARNING: O(n^2), suitable only for a small number of+-- elements in the stream/+--+{-# INLINE fromFoldableM #-}+fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a+fromFoldableM = Prelude.foldr consM nil++-------------------------------------------------------------------------------+-- From pointers+-------------------------------------------------------------------------------++-- | Keep reading 'Storable' elements from an immutable 'Ptr' onwards.+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- /Pre-release/+{-# INLINE fromPtr #-}+fromPtr :: forall m a. (Monad m, Storable a) => Ptr a -> Stream m a+fromPtr = Stream step++    where++    {-# INLINE_LATE step #-}+    step _ p = do+        let !x = unsafeInlineIO $ peek p+        return $ Yield x (PTR_NEXT(p, a))++-- | Take @n@ 'Storable' elements starting from an immutable 'Ptr' onwards.+--+-- >>> fromPtrN n = Stream.take n . Stream.fromPtr+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- /Pre-release/+{-# INLINE fromPtrN #-}+fromPtrN :: (Monad m, Storable a) => Int -> Ptr a -> Stream m a+fromPtrN n = take n . fromPtr++-- | Read bytes from an immutable 'Addr#' until a 0 byte is encountered, the 0+-- byte is not included in the stream.+--+-- >>> :set -XMagicHash+-- >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- Note that this is completely safe when reading from Haskell string+-- literals because they are guaranteed to be NULL terminated:+--+-- >>> Stream.toList $ Stream.fromByteStr# "\1\2\3\0"#+-- [1,2,3]+--+{-# INLINE fromByteStr# #-}+fromByteStr# :: Monad m => Addr# -> Stream m Word8+fromByteStr# addr = takeWhile (/= 0) $ fromPtr $ Ptr addr
src/Streamly/Internal/Data/Stream/Lift.hs view
@@ -1,10 +1,13 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Lift--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC+--+-- Transform the underlying monad of a stream.  module Streamly.Internal.Data.Stream.Lift     (@@ -19,22 +22,19 @@     ) where -import Data.Functor.Identity (Identity (..))-import Streamly.Internal.Data.Stream.Type-    (Stream, fromStreamD, toStreamD, fromStreamK, toStreamK)+#include "inline.hs" -import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K+import Data.Functor.Identity (Identity(..))+import Streamly.Internal.Data.SVar.Type (adaptState) --- $setup--- >>> :m--- >>> import Data.Functor.Identity (runIdentity)--- >>> import Streamly.Internal.Data.Stream as Stream+import Streamly.Internal.Data.Stream.Type ---------------------------------------------------------------------------------- Generalize the underlying monad-------------------------------------------------------------------------------+#include "DocTestDataStream.hs" +-------------------------------------------------------------------------------+-- Generalize Inner Monad+-------------------------------------------------------------------------------+ -- | Transform the inner monad of a stream using a natural transformation. -- -- Example, generalize the inner monad from Identity to any other:@@ -43,11 +43,17 @@ -- -- Also known as hoist. ----- /CPS/-{-# INLINE morphInner #-}-morphInner :: (Monad m, Monad n)-    => (forall x. m x -> n x) -> Stream m a -> Stream n a-morphInner f xs = fromStreamK $ K.hoist f (toStreamK xs)+{-# INLINE_NORMAL morphInner #-}+morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a+morphInner f (Stream step state) = Stream step' state+    where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- f $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip  s   -> Skip s+            Stop      -> Stop  -- | Generalize the inner monad of the stream from 'Identity' to any monad. --@@ -55,41 +61,69 @@ -- -- >>> generalizeInner = Stream.morphInner (return . runIdentity) ----- /CPS/--- {-# INLINE generalizeInner #-} generalizeInner :: Monad m => Stream Identity a -> Stream m a generalizeInner = morphInner (return . runIdentity)-    -- fromStreamK $ K.hoist (return . runIdentity) (toStreamK xs) ---------------------------------------------------------------------------------- Add and remove a monad transformer-------------------------------------------------------------------------------+-------------------------------------------------------------------------------+-- Transform Inner Monad+-------------------------------------------------------------------------------  -- | Lift the inner monad @m@ of a stream @Stream m a@ to @t m@ using the -- supplied lift function. ---{-# INLINE liftInnerWith #-}-liftInnerWith :: (Monad m, Monad (t m))-    => (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a-liftInnerWith lift xs = fromStreamD $ D.liftInnerWith lift (toStreamD xs)+{-# INLINE_NORMAL liftInnerWith #-}+liftInnerWith :: (Monad (t m)) =>+    (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a+liftInnerWith lift (Stream step state) = Stream step1 state +    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- lift $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip s    -> Skip s+            Stop      -> Stop+ -- | Evaluate the inner monad of a stream using the supplied runner function. ---{-# INLINE runInnerWith #-}-runInnerWith :: (Monad m, Applicative (t m)) =>+{-# INLINE_NORMAL runInnerWith #-}+runInnerWith :: Monad m =>     (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a-runInnerWith run xs = fromStreamD $ D.runInnerWith run (toStreamD xs)+runInnerWith run (Stream step state) = Stream step1 state +    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- run $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip s -> Skip s+            Stop -> Stop+ -- | Evaluate the inner monad of a stream using the supplied stateful runner -- function and the initial state. The state returned by an invocation of the -- runner is supplied as input state to the next invocation. ---{-# INLINE runInnerWithState #-}-runInnerWithState :: (Monad m, Applicative (t m)) =>-       (forall b. s -> t m b -> m (b, s))+{-# INLINE_NORMAL runInnerWithState #-}+runInnerWithState :: Monad m =>+    (forall b. s -> t m b -> m (b, s))     -> m s     -> Stream (t m) a     -> Stream m (s, a)-runInnerWithState run initial xs =-    fromStreamD $ D.runInnerWithState run initial (toStreamD xs)+runInnerWithState run initial (Stream step state) =+    Stream step1 (state, initial)++    where++    {-# INLINE_LATE step1 #-}+    step1 gst (st, action) = do+        sv <- action+        (r, !sv1) <- run sv (step (adaptState gst) st)+        return $ case r of+            Yield x s -> Yield (sv1, x) (s, return sv1)+            Skip s -> Skip (s, return sv1)+            Stop -> Stop
+ src/Streamly/Internal/Data/Stream/Nesting.hs view
@@ -0,0 +1,3151 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Nesting+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- This module contains transformations involving multiple streams, unfolds or+-- folds. There are two types of transformations generational or eliminational.+-- Generational transformations are like the "Generate" module but they+-- generate a stream by combining streams instead of elements. Eliminational+-- transformations are like the "Eliminate" module but they transform a stream+-- by eliminating parts of the stream instead of eliminating the whole stream.+--+-- These combinators involve transformation, generation, elimination so can be+-- classified under any of those.+--+-- Ultimately these operations should be supported by Unfolds, Pipes and Folds,+-- and this module may become redundant.++-- The zipWithM combinator in this module has been adapted from the vector+-- package (c) Roman Leshchinskiy.+--+module Streamly.Internal.Data.Stream.Nesting+    (+    -- * Generate+    -- | Combining streams to generate streams.++    -- ** Combine Two Streams+    -- | Functions ending in the shape:+    --+    -- @t m a -> t m a -> t m a@.++    -- *** Appending+    -- | Append a stream after another. A special case of concatMap or+    -- unfoldMany.+      AppendState(..)+    , append++    -- *** Interleaving+    -- | Interleave elements from two streams alternately. A special case of+    -- unfoldInterleave.+    , InterleaveState(..)+    , interleave+    , interleaveMin+    , interleaveFst+    , interleaveFstSuffix++    -- *** Scheduling+    -- | Execute streams alternately irrespective of whether they generate+    -- elements or not. Note 'interleave' would execute a stream until it+    -- yields an element. A special case of unfoldRoundRobin.+    , roundRobin -- interleaveFair?/ParallelFair++    -- *** Zipping+    -- | Zip corresponding elements of two streams.+    , zipWith+    , zipWithM++    -- *** Merging+    -- | Interleave elements from two streams based on a condition.+    , mergeBy+    , mergeByM+    , mergeMinBy+    , mergeFstBy++    -- ** Combine N Streams+    -- | Functions generally ending in these shapes:+    --+    -- @+    -- concat: f (t m a) -> t m a+    -- concatMap: (a -> t m b) -> t m a -> t m b+    -- unfoldMany: Unfold m a b -> t m a -> t m b+    -- @++    -- *** ConcatMap+    -- | Generate streams by mapping a stream generator on each element of an+    -- input stream, append the resulting streams and flatten.+    , concatMap+    , concatMapM++    -- *** ConcatUnfold+    -- | Generate streams by using an unfold on each element of an input+    -- stream, append the resulting streams and flatten. A special case of+    -- gintercalate.+    , unfoldMany+    , ConcatUnfoldInterleaveState (..)+    , unfoldInterleave+    , unfoldRoundRobin++    -- *** Interpose+    -- | Like unfoldMany but intersperses an effect between the streams. A+    -- special case of gintercalate.+    , interpose+    , interposeM+    , interposeSuffix+    , interposeSuffixM++    -- *** Intercalate+    -- | Like unfoldMany but intersperses streams from another source between+    -- the streams from the first source.+    , gintercalate+    , gintercalateSuffix+    , intercalate+    , intercalateSuffix++    -- * Eliminate+    -- | Folding and Parsing chunks of streams to eliminate nested streams.+    -- Functions generally ending in these shapes:+    --+    -- @+    -- f (Fold m a b) -> t m a -> t m b+    -- f (Parser a m b) -> t m a -> t m b+    -- @++    -- ** Folding+    -- | Apply folds on a stream.+    , foldMany+    , refoldMany+    , foldSequence+    , foldIterateM+    , refoldIterateM++    -- ** Parsing+    -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or+    -- unfoldMany. concatMap generates a stream from single values in a+    -- stream and flattens, parseMany does the opposite of flattening by+    -- splitting the stream and then folds each such split to single value in+    -- the output stream.+    , parseMany+    , parseManyD+    , parseSequence+    , parseManyTill+    , parseIterate+    , parseIterateD++    -- ** Grouping+    -- | Group segments of a stream and fold. Special case of parsing.+    , groupsOf+    , groupsBy+    , groupsWhile+    , groupsRollingBy++    -- ** Splitting+    -- | A special case of parsing.+    , wordsBy+    , splitOnSeq+    , splitOnSuffixSeq+    , sliceOnSuffix++    -- XXX Implement these as folds or parsers instead.+    , splitOnSuffixSeqAny+    , splitOnPrefix+    , splitOnAny++    -- * Transform (Nested Containers)+    -- | Opposite to compact in ArrayStream+    , splitInnerBy+    , splitInnerBySuffix+    , intersectBySorted++    -- * Reduce By Streams+    , dropPrefix+    , dropInfix+    , dropSuffix+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bits (shiftR, shiftL, (.|.), (.&.))+import Data.Proxy (Proxy(..))+import Data.Word (Word32)+import Foreign.Storable (Storable, peek)+import Fusion.Plugin.Types (Fuse(..))+import GHC.Types (SPEC(..))++import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Step (Step(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Parser (ParseError(..))+import Streamly.Internal.Data.Refold.Type (Refold(..))+import Streamly.Internal.Data.SVar.Type (adaptState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Unbox (Unbox, sizeOf)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Array.Type as A+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.Parser as PRD+import qualified Streamly.Internal.Data.Ring as RB++import Streamly.Internal.Data.Stream.Transform+    (intersperse, intersperseMSuffix)+import Streamly.Internal.Data.Stream.Type++import Prelude hiding (concatMap, mapM, zipWith)++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Appending+------------------------------------------------------------------------------++data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2++-- From an implementation perspective, StreamK.'Streamly.Data.StreamK.append'+-- translates into a function call whereas Stream.'append' translates into a+-- conditional branch (jump). However, the overhead of the function call in+-- StreamK.append is incurred only once, while the overhead of the conditional+-- branch in fused append is incurred for each element in the stream. As a+-- result, StreamK.append has a linear time complexity of O(n), while fused+-- append has a quadratic time complexity of O(n^2), where @n@ represents the+-- number of 'append's used.++-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for+-- statically fusing a small number of streams. Use the O(n) complexity+-- StreamK.'Streamly.Data.StreamK.append' otherwise.+--+-- Fuses two streams sequentially, yielding all elements from the first+-- stream, and then all elements from the second stream.+--+-- >>> s1 = Stream.fromList [1,2]+-- >>> s2 = Stream.fromList [3,4]+-- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2+-- [1,2,3,4]+--+{-# INLINE_NORMAL append #-}+append :: Monad m => Stream m a -> Stream m a -> Stream m a+append (Stream step1 state1) (Stream step2 state2) =+    Stream step (AppendFirst state1)++    where++    {-# INLINE_LATE step #-}+    step gst (AppendFirst st) = do+        r <- step1 gst st+        return $ case r of+            Yield a s -> Yield a (AppendFirst s)+            Skip s -> Skip (AppendFirst s)+            Stop -> Skip (AppendSecond state2)++    step gst (AppendSecond st) = do+        r <- step2 gst st+        return $ case r of+            Yield a s -> Yield a (AppendSecond s)+            Skip s -> Skip (AppendSecond s)+            Stop -> Stop++------------------------------------------------------------------------------+-- Interleaving+------------------------------------------------------------------------------++data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2+    | InterleaveSecondOnly s2 | InterleaveFirstOnly s1++-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for+-- statically fusing a small number of streams. Use the O(n) complexity+-- StreamK.'Streamly.Data.StreamK.interleave' otherwise.+--+-- Interleaves two streams, yielding one element from each stream alternately.+-- When one stream stops the rest of the other stream is used in the output+-- stream.+--+{-# INLINE_NORMAL interleave #-}+interleave :: Monad m => Stream m a -> Stream m a -> Stream m a+interleave (Stream step1 state1) (Stream step2 state2) =+    Stream step (InterleaveFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (InterleaveFirst st1 st2) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveSecond s st2)+            Skip s -> Skip (InterleaveFirst s st2)+            Stop -> Skip (InterleaveSecondOnly st2)++    step gst (InterleaveSecond st1 st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Yield a (InterleaveFirst st1 s)+            Skip s -> Skip (InterleaveSecond st1 s)+            Stop -> Skip (InterleaveFirstOnly st1)++    step gst (InterleaveFirstOnly st1) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveFirstOnly s)+            Skip s -> Skip (InterleaveFirstOnly s)+            Stop -> Stop++    step gst (InterleaveSecondOnly st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Yield a (InterleaveSecondOnly s)+            Skip s -> Skip (InterleaveSecondOnly s)+            Stop -> Stop++-- | Like `interleave` but stops interleaving as soon as any of the two streams+-- stops.+--+{-# INLINE_NORMAL interleaveMin #-}+interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveMin (Stream step1 state1) (Stream step2 state2) =+    Stream step (InterleaveFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (InterleaveFirst st1 st2) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveSecond s st2)+            Skip s -> Skip (InterleaveFirst s st2)+            Stop -> Stop++    step gst (InterleaveSecond st1 st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Yield a (InterleaveFirst st1 s)+            Skip s -> Skip (InterleaveSecond st1 s)+            Stop -> Stop++    step _ (InterleaveFirstOnly _) =  undefined+    step _ (InterleaveSecondOnly _) =  undefined++-- | Interleaves the outputs of two streams, yielding elements from each stream+-- alternately, starting from the first stream. As soon as the first stream+-- finishes, the output stops, discarding the remaining part of the second+-- stream. In this case, the last element in the resulting stream would be from+-- the second stream. If the second stream finishes early then the first stream+-- still continues to yield elements until it finishes.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Functor.Identity (Identity)+-- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char+-- fromList "a,b,c,"+-- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char+-- fromList "a,bc"+--+-- 'interleaveFstSuffix' is a dual of 'interleaveFst'.+--+-- Do not use dynamically.+--+-- /Pre-release/+{-# INLINE_NORMAL interleaveFstSuffix #-}+interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =+    Stream step (InterleaveFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (InterleaveFirst st1 st2) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveSecond s st2)+            Skip s -> Skip (InterleaveFirst s st2)+            Stop -> Stop++    step gst (InterleaveSecond st1 st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Yield a (InterleaveFirst st1 s)+            Skip s -> Skip (InterleaveSecond st1 s)+            Stop -> Skip (InterleaveFirstOnly st1)++    step gst (InterleaveFirstOnly st1) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveFirstOnly s)+            Skip s -> Skip (InterleaveFirstOnly s)+            Stop -> Stop++    step _ (InterleaveSecondOnly _) =  undefined++data InterleaveInfixState s1 s2 a+    = InterleaveInfixFirst s1 s2+    | InterleaveInfixSecondBuf s1 s2+    | InterleaveInfixSecondYield s1 s2 a+    | InterleaveInfixFirstYield s1 s2 a+    | InterleaveInfixFirstOnly s1++-- | Interleaves the outputs of two streams, yielding elements from each stream+-- alternately, starting from the first stream and ending at the first stream.+-- If the second stream is longer than the first, elements from the second+-- stream are infixed with elements from the first stream. If the first stream+-- is longer then it continues yielding elements even after the second stream+-- has finished.+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Functor.Identity (Identity)+-- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char+-- fromList "a,b,c"+-- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char+-- fromList "a,bc"+--+-- 'interleaveFst' is a dual of 'interleaveFstSuffix'.+--+-- Do not use dynamically.+--+-- /Pre-release/+{-# INLINE_NORMAL interleaveFst #-}+interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveFst (Stream step1 state1) (Stream step2 state2) =+    Stream step (InterleaveInfixFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (InterleaveInfixFirst st1 st2) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)+            Skip s -> Skip (InterleaveInfixFirst s st2)+            Stop -> Stop++    step gst (InterleaveInfixSecondBuf st1 st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)+            Skip s -> Skip (InterleaveInfixSecondBuf st1 s)+            Stop -> Skip (InterleaveInfixFirstOnly st1)++    step gst (InterleaveInfixSecondYield st1 st2 x) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)+            Skip s -> Skip (InterleaveInfixSecondYield s st2 x)+            Stop -> Stop++    step _ (InterleaveInfixFirstYield st1 st2 x) = do+        return $ Yield x (InterleaveInfixSecondBuf st1 st2)++    step gst (InterleaveInfixFirstOnly st1) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveInfixFirstOnly s)+            Skip s -> Skip (InterleaveInfixFirstOnly s)+            Stop -> Stop++------------------------------------------------------------------------------+-- Scheduling+------------------------------------------------------------------------------++-- | Schedule the execution of two streams in a fair round-robin manner,+-- executing each stream once, alternately. Execution of a stream may not+-- necessarily result in an output, a stream may choose to @Skip@ producing an+-- element until later giving the other stream a chance to run. Therefore, this+-- combinator fairly interleaves the execution of two streams rather than+-- fairly interleaving the output of the two streams. This can be useful in+-- co-operative multitasking without using explicit threads. This can be used+-- as an alternative to `async`.+--+-- Do not use dynamically.+--+-- /Pre-release/+{-# INLINE_NORMAL roundRobin #-}+roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a+roundRobin (Stream step1 state1) (Stream step2 state2) =+    Stream step (InterleaveFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (InterleaveFirst st1 st2) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveSecond s st2)+            Skip s -> Skip (InterleaveSecond s st2)+            Stop -> Skip (InterleaveSecondOnly st2)++    step gst (InterleaveSecond st1 st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Yield a (InterleaveFirst st1 s)+            Skip s -> Skip (InterleaveFirst st1 s)+            Stop -> Skip (InterleaveFirstOnly st1)++    step gst (InterleaveSecondOnly st2) = do+        r <- step2 gst st2+        return $ case r of+            Yield a s -> Yield a (InterleaveSecondOnly s)+            Skip s -> Skip (InterleaveSecondOnly s)+            Stop -> Stop++    step gst (InterleaveFirstOnly st1) = do+        r <- step1 gst st1+        return $ case r of+            Yield a s -> Yield a (InterleaveFirstOnly s)+            Skip s -> Skip (InterleaveFirstOnly s)+            Stop -> Stop++------------------------------------------------------------------------------+-- Merging+------------------------------------------------------------------------------++-- | Like 'mergeBy' but with a monadic comparison function.+--+-- Example, to merge two streams randomly:+--+-- @+-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT+-- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])+-- [2,1,2,2,2,1,1,1]+-- @+--+-- Example, merge two streams in a proportion of 2:1:+--+-- >>> :{+-- do+--  let s1 = Stream.fromList [1,1,1,1,1,1]+--      s2 = Stream.fromList [2,2,2]+--  let proportionately m n = do+--       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]+--       return $ \_ _ -> do+--          r <- readIORef ref+--          writeIORef ref $ Prelude.tail r+--          return $ Prelude.head r+--  f <- proportionately 2 1+--  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2+--  print xs+-- :}+-- [1,1,2,1,1,2,1,1,2]+--+{-# INLINE_NORMAL mergeByM #-}+mergeByM+    :: (Monad m)+    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeByM cmp (Stream stepa ta) (Stream stepb tb) =+    Stream step (Just ta, Just tb, Nothing, Nothing)+  where+    {-# INLINE_LATE step #-}++    -- one of the values is missing, and the corresponding stream is running+    step gst (Just sa, sb, Nothing, b) = do+        r <- stepa gst sa+        return $ case r of+            Yield a sa' -> Skip (Just sa', sb, Just a, b)+            Skip sa'    -> Skip (Just sa', sb, Nothing, b)+            Stop        -> Skip (Nothing, sb, Nothing, b)++    step gst (sa, Just sb, a, Nothing) = do+        r <- stepb gst sb+        return $ case r of+            Yield b sb' -> Skip (sa, Just sb', a, Just b)+            Skip sb'    -> Skip (sa, Just sb', a, Nothing)+            Stop        -> Skip (sa, Nothing, a, Nothing)++    -- both the values are available+    step _ (sa, sb, Just a, Just b) = do+        res <- cmp a b+        return $ case res of+            GT -> Yield b (sa, sb, Just a, Nothing)+            _  -> Yield a (sa, sb, Nothing, Just b)++    -- one of the values is missing, corresponding stream is done+    step _ (Nothing, sb, Nothing, Just b) =+            return $ Yield b (Nothing, sb, Nothing, Nothing)++    step _ (sa, Nothing, Just a, Nothing) =+            return $ Yield a (sa, Nothing, Nothing, Nothing)++    step _ (Nothing, Nothing, Nothing, Nothing) = return Stop++-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for+-- statically fusing a small number of streams. Use the O(n) complexity+-- StreamK.'Streamly.Data.StreamK.mergeBy' otherwise.+--+-- Merge two streams using a comparison function. The head elements of both+-- the streams are compared and the smaller of the two elements is emitted, if+-- both elements are equal then the element from the first stream is used+-- first.+--+-- If the streams are sorted in ascending order, the resulting stream would+-- also remain sorted in ascending order.+--+-- >>> s1 = Stream.fromList [1,3,5]+-- >>> s2 = Stream.fromList [2,4,6,8]+-- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2+-- [1,2,3,4,5,6,8]+--+{-# INLINE mergeBy #-}+mergeBy+    :: (Monad m)+    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeBy cmp = mergeByM (\a b -> return $ cmp a b)++-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.+--+-- /Unimplemented/+{-# INLINABLE mergeMinBy #-}+mergeMinBy :: -- Monad m =>+    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeMinBy _f _m1 _m2 = undefined+    -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)++-- | Like 'mergeByM' but stops merging as soon as the first stream stops.+--+-- /Unimplemented/+{-# INLINABLE mergeFstBy #-}+mergeFstBy :: -- Monad m =>+    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeFstBy _f _m1 _m2 = undefined+    -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)++-------------------------------------------------------------------------------+-- Intersection of sorted streams+-------------------------------------------------------------------------------++-- Assuming the streams are sorted in ascending order+{-# INLINE_NORMAL intersectBySorted #-}+intersectBySorted :: Monad m+    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+intersectBySorted cmp (Stream stepa ta) (Stream stepb tb) =+    Stream step+        ( ta -- left stream state+        , tb -- right stream state+        , Nothing -- left value+        , Nothing -- right value+        )++    where++    {-# INLINE_LATE step #-}+    -- step 1, fetch the first value+    step gst (sa, sb, Nothing, b) = do+        r <- stepa gst sa+        return $ case r of+            Yield a sa' -> Skip (sa', sb, Just a, b) -- step 2/3+            Skip sa'    -> Skip (sa', sb, Nothing, b)+            Stop        -> Stop++    -- step 2, fetch the second value+    step gst (sa, sb, a@(Just _), Nothing) = do+        r <- stepb gst sb+        return $ case r of+            Yield b sb' -> Skip (sa, sb', a, Just b) -- step 3+            Skip sb'    -> Skip (sa, sb', a, Nothing)+            Stop        -> Stop++    -- step 3, compare the two values+    step _ (sa, sb, Just a, Just b) = do+        let res = cmp a b+        return $ case res of+            GT -> Skip (sa, sb, Just a, Nothing) -- step 2+            LT -> Skip (sa, sb, Nothing, Just b) -- step 1+            EQ -> Yield a (sa, sb, Nothing, Just b) -- step 1++------------------------------------------------------------------------------+-- Combine N Streams - unfoldMany+------------------------------------------------------------------------------++data ConcatUnfoldInterleaveState o i =+      ConcatUnfoldInterleaveOuter o [i]+    | ConcatUnfoldInterleaveInner o [i]+    | ConcatUnfoldInterleaveInnerL [i] [i]+    | ConcatUnfoldInterleaveInnerR [i] [i]++-- XXX use arrays to store state instead of lists?+--+-- XXX In general we can use different scheduling strategies e.g. how to+-- schedule the outer vs inner loop or assigning weights to different streams+-- or outer and inner loops.++-- After a yield, switch to the next stream. Do not switch streams on Skip.+-- Yield from outer stream switches to the inner stream.+--+-- There are two choices here, (1) exhaust the outer stream first and then+-- start yielding from the inner streams, this is much simpler to implement,+-- (2) yield at least one element from an inner stream before going back to+-- outer stream and opening the next stream from it.+--+-- Ideally, we need some scheduling bias to inner streams vs outer stream.+-- Maybe we can configure the behavior.+--+-- XXX Instead of using "concatPairsWith wSerial" we can implement an N-way+-- interleaving CPS combinator which behaves like unfoldInterleave. Instead+-- of pairing up the streams we just need to go yielding one element from each+-- stream and storing the remaining streams and then keep doing rounds through+-- those in a round robin fashion. This would be much like wAsync.++-- | This does not pair streams like mergeMapWith, instead, it goes through+-- each stream one by one and yields one element from each stream. After it+-- goes to the last stream it reverses the traversal to come back to the first+-- stream yielding elements from each stream on its way back to the first+-- stream and so on.+--+-- >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]+-- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists+-- >>> Stream.fold Fold.toList interleaved+-- [1,2,3,4,5,5,4,3,2,1]+--+-- Note that this is order of magnitude more efficient than "mergeMapWith+-- interleave" because of fusion.+--+{-# INLINE_NORMAL unfoldInterleave #-}+unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b+unfoldInterleave (Unfold istep inject) (Stream ostep ost) =+    Stream step (ConcatUnfoldInterleaveOuter ost [])++    where++    {-# INLINE_LATE step #-}+    step gst (ConcatUnfoldInterleaveOuter o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))+            Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)+            Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])++    step _ (ConcatUnfoldInterleaveInner _ []) = undefined+    step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))+            Skip s    -> Skip (ConcatUnfoldInterleaveInner o (s:ls))+            Stop      -> Skip (ConcatUnfoldInterleaveOuter o ls)++    step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop+    step _ (ConcatUnfoldInterleaveInnerL [] rs) =+        return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)++    step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))+            Skip s    -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)+            Stop      -> Skip (ConcatUnfoldInterleaveInnerL ls rs)++    step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop+    step _ (ConcatUnfoldInterleaveInnerR ls []) =+        return $ Skip (ConcatUnfoldInterleaveInnerL ls [])++    step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)+            Skip s    -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))+            Stop      -> Skip (ConcatUnfoldInterleaveInnerR ls rs)++-- XXX In general we can use different scheduling strategies e.g. how to+-- schedule the outer vs inner loop or assigning weights to different streams+-- or outer and inner loops.+--+-- This could be inefficient if the tasks are too small.+--+-- Compared to unfoldInterleave this one switches streams on Skips.++-- | 'unfoldInterleave' switches to the next stream whenever a value from a+-- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps+-- skipping for long time other streams won't get a chance to run.+-- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each+-- stream fairly irrespective of whether it produces a value or not.+--+{-# INLINE_NORMAL unfoldRoundRobin #-}+unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b+unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =+    Stream step (ConcatUnfoldInterleaveOuter ost [])+  where+    {-# INLINE_LATE step #-}+    step gst (ConcatUnfoldInterleaveOuter o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))+            Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)+            Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])++    step _ (ConcatUnfoldInterleaveInner o []) =+            return $ Skip (ConcatUnfoldInterleaveOuter o [])++    step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))+            Skip s    -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))+            Stop      -> Skip (ConcatUnfoldInterleaveOuter o ls)++    step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop+    step _ (ConcatUnfoldInterleaveInnerL [] rs) =+        return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)++    step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))+            Skip s    -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))+            Stop      -> Skip (ConcatUnfoldInterleaveInnerL ls rs)++    step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop+    step _ (ConcatUnfoldInterleaveInnerR ls []) =+        return $ Skip (ConcatUnfoldInterleaveInnerL ls [])++    step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)+            Skip s    -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)+            Stop      -> Skip (ConcatUnfoldInterleaveInnerR ls rs)++------------------------------------------------------------------------------+-- Combine N Streams - interpose+------------------------------------------------------------------------------++{-# ANN type InterposeSuffixState Fuse #-}+data InterposeSuffixState s1 i1 =+      InterposeSuffixFirst s1+    -- | InterposeSuffixFirstYield s1 i1+    | InterposeSuffixFirstInner s1 i1+    | InterposeSuffixSecond s1++-- Note that if an unfolded layer turns out to be nil we still emit the+-- separator effect. An alternate behavior could be to emit the separator+-- effect only if at least one element has been yielded by the unfolding.+-- However, that becomes a bit complicated, so we have chosen the former+-- behvaior for now.+{-# INLINE_NORMAL interposeSuffixM #-}+interposeSuffixM+    :: Monad m+    => m c -> Unfold m b c -> Stream m b -> Stream m c+interposeSuffixM+    action+    (Unfold istep1 inject1) (Stream step1 state1) =+    Stream step (InterposeSuffixFirst state1)++    where++    {-# INLINE_LATE step #-}+    step gst (InterposeSuffixFirst s1) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (InterposeSuffixFirstInner s i))+                -- i `seq` return (Skip (InterposeSuffixFirstYield s i))+            Skip s -> return $ Skip (InterposeSuffixFirst s)+            Stop -> return Stop++    {-+    step _ (InterposeSuffixFirstYield s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')+            Skip i'    -> Skip (InterposeSuffixFirstYield s1 i')+            Stop       -> Skip (InterposeSuffixFirst s1)+    -}++    step _ (InterposeSuffixFirstInner s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')+            Skip i'    -> Skip (InterposeSuffixFirstInner s1 i')+            Stop       -> Skip (InterposeSuffixSecond s1)++    step _ (InterposeSuffixSecond s1) = do+        r <- action+        return $ Yield r (InterposeSuffixFirst s1)++-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)++-- | Unfold the elements of a stream, append the given element after each+-- unfolded stream and then concat them into a single stream.+--+-- >>> unlines = Stream.interposeSuffix '\n'+--+-- /Pre-release/+{-# INLINE interposeSuffix #-}+interposeSuffix :: Monad m+    => c -> Unfold m b c -> Stream m b -> Stream m c+interposeSuffix x = interposeSuffixM (return x)++{-# ANN type InterposeState Fuse #-}+data InterposeState s1 i1 a =+      InterposeFirst s1+    -- | InterposeFirstYield s1 i1+    | InterposeFirstInner s1 i1+    | InterposeFirstInject s1+    -- | InterposeFirstBuf s1 i1+    | InterposeSecondYield s1 i1+    -- -- | InterposeSecondYield s1 i1 a+    -- -- | InterposeFirstResume s1 i1 a++-- Note that this only interposes the pure values, we may run many effects to+-- generate those values as some effects may not generate anything (Skip).+{-# INLINE_NORMAL interposeM #-}+interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+interposeM+    action+    (Unfold istep1 inject1) (Stream step1 state1) =+    Stream step (InterposeFirst state1)++    where++    {-# INLINE_LATE step #-}+    step gst (InterposeFirst s1) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (InterposeFirstInner s i))+                -- i `seq` return (Skip (InterposeFirstYield s i))+            Skip s -> return $ Skip (InterposeFirst s)+            Stop -> return Stop++    {-+    step _ (InterposeFirstYield s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (InterposeFirstInner s1 i')+            Skip i'    -> Skip (InterposeFirstYield s1 i')+            Stop       -> Skip (InterposeFirst s1)+    -}++    step _ (InterposeFirstInner s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (InterposeFirstInner s1 i')+            Skip i'    -> Skip (InterposeFirstInner s1 i')+            Stop       -> Skip (InterposeFirstInject s1)++    step gst (InterposeFirstInject s1) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                -- i `seq` return (Skip (InterposeFirstBuf s i))+                i `seq` return (Skip (InterposeSecondYield s i))+            Skip s -> return $ Skip (InterposeFirstInject s)+            Stop -> return Stop++    {-+    step _ (InterposeFirstBuf s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Skip (InterposeSecondYield s1 i' x)+            Skip i'    -> Skip (InterposeFirstBuf s1 i')+            Stop       -> Stop+    -}++    {-+    step _ (InterposeSecondYield s1 i1 v) = do+        r <- action+        return $ Yield r (InterposeFirstResume s1 i1 v)+    -}+    step _ (InterposeSecondYield s1 i1) = do+        r <- action+        return $ Yield r (InterposeFirstInner s1 i1)++    {-+    step _ (InterposeFirstResume s1 i1 v) = do+        return $ Yield v (InterposeFirstInner s1 i1)+    -}++-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)++-- | Unfold the elements of a stream, intersperse the given element between the+-- unfolded streams and then concat them into a single stream.+--+-- >>> unwords = Stream.interpose ' '+--+-- /Pre-release/+{-# INLINE interpose #-}+interpose :: Monad m+    => c -> Unfold m b c -> Stream m b -> Stream m c+interpose x = interposeM (return x)++------------------------------------------------------------------------------+-- Combine N Streams - intercalate+------------------------------------------------------------------------------++data ICUState s1 s2 i1 i2 =+      ICUFirst s1 s2+    | ICUSecond s1 s2+    | ICUSecondOnly s2+    | ICUFirstOnly s1+    | ICUFirstInner s1 s2 i1+    | ICUSecondInner s1 s2 i2+    | ICUFirstOnlyInner s1 i1+    | ICUSecondOnlyInner s2 i2++-- | 'interleaveFstSuffix' followed by unfold and concat.+--+-- /Pre-release/+{-# INLINE_NORMAL gintercalateSuffix #-}+gintercalateSuffix+    :: Monad m+    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+gintercalateSuffix+    (Unfold istep1 inject1) (Stream step1 state1)+    (Unfold istep2 inject2) (Stream step2 state2) =+    Stream step (ICUFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (ICUFirst s1 s2) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (ICUFirstInner s s2 i))+            Skip s -> return $ Skip (ICUFirst s s2)+            Stop -> return Stop++    step gst (ICUFirstOnly s1) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (ICUFirstOnlyInner s i))+            Skip s -> return $ Skip (ICUFirstOnly s)+            Stop -> return Stop++    step _ (ICUFirstInner s1 s2 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (ICUFirstInner s1 s2 i')+            Skip i'    -> Skip (ICUFirstInner s1 s2 i')+            Stop       -> Skip (ICUSecond s1 s2)++    step _ (ICUFirstOnlyInner s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')+            Skip i'    -> Skip (ICUFirstOnlyInner s1 i')+            Stop       -> Skip (ICUFirstOnly s1)++    step gst (ICUSecond s1 s2) = do+        r <- step2 (adaptState gst) s2+        case r of+            Yield a s -> do+                i <- inject2 a+                i `seq` return (Skip (ICUSecondInner s1 s i))+            Skip s -> return $ Skip (ICUSecond s1 s)+            Stop -> return $ Skip (ICUFirstOnly s1)++    step _ (ICUSecondInner s1 s2 i2) = do+        r <- istep2 i2+        return $ case r of+            Yield x i' -> Yield x (ICUSecondInner s1 s2 i')+            Skip i'    -> Skip (ICUSecondInner s1 s2 i')+            Stop       -> Skip (ICUFirst s1 s2)++    step _ (ICUSecondOnly _s2) = undefined+    step _ (ICUSecondOnlyInner _s2 _i2) = undefined++data ICALState s1 s2 i1 i2 a =+      ICALFirst s1 s2+    -- | ICALFirstYield s1 s2 i1+    | ICALFirstInner s1 s2 i1+    | ICALFirstOnly s1+    | ICALFirstOnlyInner s1 i1+    | ICALSecondInject s1 s2+    | ICALFirstInject s1 s2 i2+    -- | ICALFirstBuf s1 s2 i1 i2+    | ICALSecondInner s1 s2 i1 i2+    -- -- | ICALSecondInner s1 s2 i1 i2 a+    -- -- | ICALFirstResume s1 s2 i1 i2 a++-- XXX we can swap the order of arguments to gintercalate so that the+-- definition of unfoldMany becomes simpler? The first stream should be+-- infixed inside the second one. However, if we change the order in+-- "interleave" as well similarly, then that will make it a bit unintuitive.+--+-- > unfoldMany unf str =+-- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())++-- | 'interleaveFst' followed by unfold and concat.+--+-- /Pre-release/+{-# INLINE_NORMAL gintercalate #-}+gintercalate+    :: Monad m+    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+gintercalate+    (Unfold istep1 inject1) (Stream step1 state1)+    (Unfold istep2 inject2) (Stream step2 state2) =+    Stream step (ICALFirst state1 state2)++    where++    {-# INLINE_LATE step #-}+    step gst (ICALFirst s1 s2) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (ICALFirstInner s s2 i))+                -- i `seq` return (Skip (ICALFirstYield s s2 i))+            Skip s -> return $ Skip (ICALFirst s s2)+            Stop -> return Stop++    {-+    step _ (ICALFirstYield s1 s2 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')+            Skip i'    -> Skip (ICALFirstYield s1 s2 i')+            Stop       -> Skip (ICALFirst s1 s2)+    -}++    step _ (ICALFirstInner s1 s2 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')+            Skip i'    -> Skip (ICALFirstInner s1 s2 i')+            Stop       -> Skip (ICALSecondInject s1 s2)++    step gst (ICALFirstOnly s1) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (ICALFirstOnlyInner s i))+            Skip s -> return $ Skip (ICALFirstOnly s)+            Stop -> return Stop++    step _ (ICALFirstOnlyInner s1 i1) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')+            Skip i'    -> Skip (ICALFirstOnlyInner s1 i')+            Stop       -> Skip (ICALFirstOnly s1)++    -- We inject the second stream even before checking if the first stream+    -- would yield any more elements. There is no clear choice whether we+    -- should do this before or after that. Doing it after may make the state+    -- machine a bit simpler though.+    step gst (ICALSecondInject s1 s2) = do+        r <- step2 (adaptState gst) s2+        case r of+            Yield a s -> do+                i <- inject2 a+                i `seq` return (Skip (ICALFirstInject s1 s i))+            Skip s -> return $ Skip (ICALSecondInject s1 s)+            Stop -> return $ Skip (ICALFirstOnly s1)++    step gst (ICALFirstInject s1 s2 i2) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield a s -> do+                i <- inject1 a+                i `seq` return (Skip (ICALSecondInner s s2 i i2))+                -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))+            Skip s -> return $ Skip (ICALFirstInject s s2 i2)+            Stop -> return Stop++    {-+    step _ (ICALFirstBuf s1 s2 i1 i2) = do+        r <- istep1 i1+        return $ case r of+            Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)+            Skip i'    -> Skip (ICALFirstBuf s1 s2 i' i2)+            Stop       -> Stop++    step _ (ICALSecondInner s1 s2 i1 i2 v) = do+        r <- istep2 i2+        return $ case r of+            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)+            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i' v)+            Stop       -> Skip (ICALFirstResume s1 s2 i1 i2 v)+    -}++    step _ (ICALSecondInner s1 s2 i1 i2) = do+        r <- istep2 i2+        return $ case r of+            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')+            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i')+            Stop       -> Skip (ICALFirstInner s1 s2 i1)+            -- Stop       -> Skip (ICALFirstResume s1 s2 i1 i2)++    {-+    step _ (ICALFirstResume s1 s2 i1 i2 x) = do+        return $ Yield x (ICALFirstInner s1 s2 i1 i2)+    -}++-- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)++-- | 'intersperseMSuffix' followed by unfold and concat.+--+-- >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a+-- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity+-- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"+--+-- >>> input = Stream.fromList ["abc", "def", "ghi"]+-- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input+-- "abc\ndef\nghi\n"+--+{-# INLINE intercalateSuffix #-}+intercalateSuffix :: Monad m+    => Unfold m b c -> b -> Stream m b -> Stream m c+intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)++-- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)++-- | 'intersperse' followed by unfold and concat.+--+-- >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a+-- >>> intersperse = Stream.intercalate Unfold.identity+-- >>> unwords = Stream.intercalate Unfold.fromList " "+--+-- >>> input = Stream.fromList ["abc", "def", "ghi"]+-- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input+-- "abc def ghi"+--+{-# INLINE intercalate #-}+intercalate :: Monad m+    => Unfold m b c -> b -> Stream m b -> Stream m c+intercalate unf seed str = unfoldMany unf $ intersperse seed str++------------------------------------------------------------------------------+-- Folding+------------------------------------------------------------------------------++-- | Apply a stream of folds to an input stream and emit the results in the+-- output stream.+--+-- /Unimplemented/+--+{-# INLINE foldSequence #-}+foldSequence+       :: -- Monad m =>+       Stream m (Fold m a b)+    -> Stream m a+    -> Stream m b+foldSequence _f _m = undefined++{-# ANN type FIterState Fuse #-}+data FIterState s f m a b+    = FIterInit s f+    | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)+        (fs -> m b)+    | FIterYield b (FIterState s f m a b)+    | FIterStop++-- | Iterate a fold generator on a stream. The initial value @b@ is used to+-- generate the first fold, the fold is applied on the stream and the result of+-- the fold is used to generate the next fold and so on.+--+-- >>> import Data.Monoid (Sum(..))+-- >>> f x = return (Fold.take 2 (Fold.sconcat x))+-- >>> s = fmap Sum $ Stream.fromList [1..10]+-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s+-- [3,10,21,36,55,55]+--+-- This is the streaming equivalent of monad like sequenced application of+-- folds where next fold is dependent on the previous fold.+--+-- /Pre-release/+--+{-# INLINE_NORMAL foldIterateM #-}+foldIterateM ::+       Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b+foldIterateM func seed0 (Stream step state) =+    Stream stepOuter (FIterInit state seed0)++    where++    {-# INLINE iterStep #-}+    iterStep from st fstep extract final = do+        res <- from+        return+            $ Skip+            $ case res of+                  FL.Partial fs -> FIterStream st fstep fs extract final+                  FL.Done fb -> FIterYield fb $ FIterInit st (return fb)++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (FIterInit st seed) = do+        (FL.Fold fstep initial extract final) <- seed >>= func+        iterStep initial st fstep extract final+    stepOuter gst (FIterStream st fstep fs extract final) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                iterStep (fstep fs x) s fstep extract final+            Skip s -> return $ Skip $ FIterStream s fstep fs extract final+            Stop -> do+                b <- final fs+                return $ Skip $ FIterYield b FIterStop+    stepOuter _ (FIterYield a next) = return $ Yield a next+    stepOuter _ FIterStop = return Stop++{-# ANN type CIterState Fuse #-}+data CIterState s f fs b+    = CIterInit s f+    | CIterConsume s fs+    | CIterYield b (CIterState s f fs b)+    | CIterStop++-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be+-- much more efficient due to stream fusion.+--+-- /Internal/+{-# INLINE_NORMAL refoldIterateM #-}+refoldIterateM ::+       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b+refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =+    Stream stepOuter (CIterInit state initial)++    where++    {-# INLINE iterStep #-}+    iterStep st action = do+        res <- action+        return+            $ Skip+            $ case res of+                  FL.Partial fs -> CIterConsume st fs+                  FL.Done fb -> CIterYield fb $ CIterInit st (return fb)++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (CIterInit st action) = do+        iterStep st (action >>= finject)+    stepOuter gst (CIterConsume st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> iterStep s (fstep fs x)+            Skip s -> return $ Skip $ CIterConsume s fs+            Stop -> do+                b <- fextract fs+                return $ Skip $ CIterYield b CIterStop+    stepOuter _ (CIterYield a next) = return $ Yield a next+    stepOuter _ CIterStop = return Stop++-- "n" elements at the end are dropped by the fold.+{-# INLINE sliceBy #-}+sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)+sliceBy (Fold step1 initial1 extract1 _final) n = Refold step inject extract++    where++    inject (i, len) = do+        r <- initial1+        return $ case r of+            Partial s -> Partial $ Tuple' (i + len + n) s+            Done l -> Done (i, l)++    step (Tuple' i s) x = do+        r <- step1 s x+        return $ case r of+            Partial s1 -> Partial $ Tuple' i s1+            Done len -> Done (i, len)++    extract (Tuple' i s) = (i,) <$> extract1 s++{-# INLINE sliceOnSuffix #-}+sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+sliceOnSuffix predicate =+    -- Scan the stream with the given refold+    refoldIterateM+        (sliceBy (FL.takeEndBy_ predicate FL.length) 1)+        (return (-1, 0))++------------------------------------------------------------------------------+-- Parsing+------------------------------------------------------------------------------++{-# ANN type ParseChunksState Fuse #-}+data ParseChunksState x inpBuf st pst =+      ParseChunksInit inpBuf st+    | ParseChunksInitBuf inpBuf+    | ParseChunksInitLeftOver inpBuf+    | ParseChunksStream st inpBuf !pst+    | ParseChunksStop inpBuf !pst+    | ParseChunksBuf inpBuf st inpBuf !pst+    | ParseChunksExtract inpBuf inpBuf !pst+    | ParseChunksYield x (ParseChunksState x inpBuf st pst)++-- XXX return the remaining stream as part of the error.+-- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as+-- well?+{-# INLINE_NORMAL parseManyD #-}+parseManyD+    :: Monad m+    => PRD.Parser a m b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseManyD (PRD.Parser pstep initial extract) (Stream step state) =+    Stream stepOuter (ParseChunksInit [] 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 gst (ParseChunksInit [] st) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                res <- initial+                case res of+                    PRD.IPartial ps ->+                        return $ Skip $ ParseChunksBuf [x] s [] ps+                    PRD.IDone pb ->+                        let next = ParseChunksInit [x] s+                         in return $ Skip $ ParseChunksYield (Right pb) next+                    PRD.IError err ->+                        return+                            $ Skip+                            $ ParseChunksYield+                                (Left (ParseError err))+                                (ParseChunksInitLeftOver [])+            Skip s -> return $ Skip $ ParseChunksInit [] s+            Stop   -> return Stop++    -- Buffer is not empty, go to buffered processing loop+    stepOuter _ (ParseChunksInit src st) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ParseChunksBuf src st [] ps+            PRD.IDone pb ->+                let next = ParseChunksInit src st+                 in return $ Skip $ ParseChunksYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (ParseError err))+                        (ParseChunksInitLeftOver [])++    -- This is simplified ParseChunksInit+    stepOuter _ (ParseChunksInitBuf src) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ParseChunksExtract src [] ps+            PRD.IDone pb ->+                let next = ParseChunksInitBuf src+                 in return $ Skip $ ParseChunksYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (ParseError err))+                        (ParseChunksInitLeftOver [])++    -- XXX we just discard any leftover input at the end+    stepOuter _ (ParseChunksInitLeftOver _) = return Stop++    -- Buffer is empty, process elements from the stream+    stepOuter gst (ParseChunksStream st buf pst) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.Partial 0 pst1 ->+                        return $ Skip $ ParseChunksStream s [] pst1+                    PR.Partial n pst1 -> do+                        assert (n <= length (x:buf)) (return ())+                        let src0 = Prelude.take n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip $ ParseChunksBuf src s [] pst1+                    PR.Continue 0 pst1 ->+                        return $ Skip $ ParseChunksStream s (x:buf) pst1+                    PR.Continue n pst1 -> do+                        assert (n <= length (x:buf)) (return ())+                        let (src0, buf1) = splitAt n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip $ ParseChunksBuf src s buf1 pst1+                    PR.Done 0 b -> do+                        return $ Skip $+                            ParseChunksYield (Right b) (ParseChunksInit [] s)+                    PR.Done n b -> do+                        assert (n <= length (x:buf)) (return ())+                        let src = Prelude.reverse (Prelude.take n (x:buf))+                        return $ Skip $+                            ParseChunksYield (Right b) (ParseChunksInit src s)+                    PR.Error err ->+                        return+                            $ Skip+                            $ ParseChunksYield+                                (Left (ParseError err))+                                (ParseChunksInitLeftOver [])+            Skip s -> return $ Skip $ ParseChunksStream s buf pst+            Stop -> return $ Skip $ ParseChunksStop buf pst++    -- go back to stream processing mode+    stepOuter _ (ParseChunksBuf [] s buf pst) =+        return $ Skip $ ParseChunksStream s buf pst++    -- buffered processing loop+    stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ Skip $ ParseChunksBuf xs s [] pst1+            PR.Partial n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksBuf src s [] pst1+            PR.Continue 0 pst1 ->+                return $ Skip $ ParseChunksBuf xs s (x:buf) pst1+            PR.Continue n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksBuf src s buf1 pst1+            PR.Done 0 b ->+                return+                    $ Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)+            PR.Done n b -> do+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return $ Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit src s)+            PR.Error err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (ParseError err))+                        (ParseChunksInitLeftOver [])++    -- This is simplified ParseChunksBuf+    stepOuter _ (ParseChunksExtract [] buf pst) =+        return $ Skip $ ParseChunksStop buf pst++    stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ Skip $ ParseChunksExtract xs [] pst1+            PR.Partial n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksExtract src [] pst1+            PR.Continue 0 pst1 ->+                return $ Skip $ ParseChunksExtract xs (x:buf) pst1+            PR.Continue n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksExtract src buf1 pst1+            PR.Done 0 b ->+                return+                    $ Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)+            PR.Done n b -> do+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return+                    $ Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)+            PR.Error err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (ParseError err))+                        (ParseChunksInitLeftOver [])++    -- This is simplified ParseChunksExtract+    stepOuter _ (ParseChunksStop buf pst) = do+        pRes <- extract pst+        case pRes of+            PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"+            PR.Continue 0 pst1 ->+                return $ Skip $ ParseChunksStop buf pst1+            PR.Continue n pst1 -> do+                assert (n <= length buf) (return ())+                let (src0, buf1) = splitAt n buf+                    src  = Prelude.reverse src0+                return $ Skip $ ParseChunksExtract src buf1 pst1+            PR.Done 0 b -> do+                return $ Skip $+                    ParseChunksYield (Right b) (ParseChunksInitLeftOver [])+            PR.Done n b -> do+                assert (n <= length buf) (return ())+                let src = Prelude.reverse (Prelude.take n buf)+                return $ Skip $+                    ParseChunksYield (Right b) (ParseChunksInitBuf src)+            PR.Error err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (ParseError err))+                        (ParseChunksInitLeftOver [])++    stepOuter _ (ParseChunksYield a next) = return $ Yield a next++-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the+-- output stream.+--+-- Example:+--+-- >>> s = Stream.fromList [1..10]+-- >>> parser = Parser.takeBetween 0 2 Fold.sum+-- >>> Stream.fold Fold.toList $ Stream.parseMany parser s+-- [Right 3,Right 7,Right 11,Right 15,Right 19]+--+-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse+-- combinator.+--+-- Known Issues: When the parser fails there is no way to get the remaining+-- stream.+--+{-# INLINE parseMany #-}+parseMany+    :: Monad m+    => PR.Parser a m b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseMany = parseManyD++-- | Apply a stream of parsers to an input stream and emit the results in the+-- output stream.+--+-- /Unimplemented/+--+{-# INLINE parseSequence #-}+parseSequence+       :: -- Monad m =>+       Stream m (PR.Parser a m b)+    -> Stream m a+    -> Stream m b+parseSequence _f _m = undefined++-- XXX Change the parser arguments' order++-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,+-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds+-- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The+-- output of @test@ is discarded and the output of @collect@ is emitted in the+-- output stream. The parser fails if @collect@ fails.+--+-- /Unimplemented/+--+{-# INLINE parseManyTill #-}+parseManyTill ::+    -- MonadThrow m =>+       PR.Parser a m b+    -> PR.Parser a m x+    -> Stream m a+    -> Stream m b+parseManyTill = undefined++{-# ANN type ConcatParseState Fuse #-}+data ConcatParseState c b inpBuf st p m a =+      ConcatParseInit inpBuf st p+    | ConcatParseInitBuf inpBuf p+    | ConcatParseInitLeftOver inpBuf+    | forall s. ConcatParseStop+        inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))+    | forall s. ConcatParseStream+        st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))+    | forall s. ConcatParseBuf+        inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))+    | forall s. ConcatParseExtract+        inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))+    | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)++-- XXX Review the changes+{-# INLINE_NORMAL parseIterateD #-}+parseIterateD+    :: Monad m+    => (b -> PRD.Parser a m b)+    -> b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseIterateD func seed (Stream step state) =+    Stream stepOuter (ConcatParseInit [] state (func seed))++    where++    {-# INLINE_LATE stepOuter #-}+    -- Buffer is empty, go to stream processing loop+    stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ConcatParseStream st [] pstep ps extract+            PRD.IDone pb ->+                let next = ConcatParseInit [] st (func pb)+                 in return $ Skip $ ConcatParseYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (ParseError err))+                        (ConcatParseInitLeftOver [])++    -- Buffer is not empty, go to buffered processing loop+    stepOuter _ (ConcatParseInit src st+                    (PRD.Parser pstep initial extract)) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ConcatParseBuf src st [] pstep ps extract+            PRD.IDone pb ->+                let next = ConcatParseInit src st (func pb)+                 in return $ Skip $ ConcatParseYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (ParseError err))+                        (ConcatParseInitLeftOver [])++    -- This is simplified ConcatParseInit+    stepOuter _ (ConcatParseInitBuf src+                    (PRD.Parser pstep initial extract)) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ConcatParseExtract src [] pstep ps extract+            PRD.IDone pb ->+                let next = ConcatParseInitBuf src (func pb)+                 in return $ Skip $ ConcatParseYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (ParseError err))+                        (ConcatParseInitLeftOver [])++    -- XXX we just discard any leftover input at the end+    stepOuter _ (ConcatParseInitLeftOver _) = return Stop++    -- Buffer is empty process elements from the stream+    stepOuter gst (ConcatParseStream st buf pstep pst extract) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.Partial 0 pst1 ->+                        return $ Skip $ ConcatParseStream s [] pstep pst1 extract+                    PR.Partial n pst1 -> do+                        assert (n <= length (x:buf)) (return ())+                        let src0 = Prelude.take n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract+                    -- PR.Continue 0 pst1 ->+                    --     return $ Skip $ ConcatParseStream s (x:buf) pst1+                    PR.Continue n pst1 -> do+                        assert (n <= length (x:buf)) (return ())+                        let (src0, buf1) = splitAt n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract+                    -- XXX Specialize for Stop 0 common case?+                    PR.Done n b -> do+                        assert (n <= length (x:buf)) (return ())+                        let src = Prelude.reverse (Prelude.take n (x:buf))+                        return $ Skip $+                            ConcatParseYield (Right b) (ConcatParseInit src s (func b))+                    PR.Error err ->+                        return+                            $ Skip+                            $ ConcatParseYield+                                (Left (ParseError err))+                                (ConcatParseInitLeftOver [])+            Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract+            Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract++    -- go back to stream processing mode+    stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =+        return $ Skip $ ConcatParseStream s buf pstep ps extract++    -- buffered processing loop+    stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract+            PR.Partial n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract+         -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1+            PR.Continue n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract+            -- XXX Specialize for Stop 0 common case?+            PR.Done n b -> do+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return $ Skip $ ConcatParseYield (Right b)+                                    (ConcatParseInit src s (func b))+            PR.Error err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (ParseError err))+                        (ConcatParseInitLeftOver [])++    -- This is simplified ConcatParseBuf+    stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =+        return $ Skip $ ConcatParseStop buf pstep pst extract++    stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract+            PR.Partial n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ConcatParseExtract src [] pstep pst1 extract+            PR.Continue 0 pst1 ->+                return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract+            PR.Continue n pst1 -> do+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract+            PR.Done 0 b ->+                 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))+            PR.Done n b -> do+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))+            PR.Error err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (ParseError err))+                        (ConcatParseInitLeftOver [])++    -- This is simplified ConcatParseExtract+    stepOuter _ (ConcatParseStop buf pstep pst extract) = do+        pRes <- extract pst+        case pRes of+            PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"+            PR.Continue 0 pst1 ->+                return $ Skip $ ConcatParseStop buf pstep pst1 extract+            PR.Continue n pst1 -> do+                assert (n <= length buf) (return ())+                let (src0, buf1) = splitAt n buf+                    src  = Prelude.reverse src0+                return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract+            PR.Done 0 b -> do+                return $ Skip $+                    ConcatParseYield (Right b) (ConcatParseInitLeftOver [])+            PR.Done n b -> do+                assert (n <= length buf) (return ())+                let src = Prelude.reverse (Prelude.take n buf)+                return $ Skip $+                    ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))+            PR.Error err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (ParseError err))+                        (ConcatParseInitLeftOver [])++    stepOuter _ (ConcatParseYield a next) = return $ Yield a next++-- | Iterate a parser generating function on a stream. The initial value @b@ is+-- used to generate the first parser, the parser is applied on the stream and+-- the result is used to generate the next parser and so on.+--+-- >>> import Data.Monoid (Sum(..))+-- >>> s = Stream.fromList [1..10]+-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s+-- [3,10,21,36,55,55]+--+-- This is the streaming equivalent of monad like sequenced application of+-- parsers where next parser is dependent on the previous parser.+--+-- /Pre-release/+--+{-# INLINE parseIterate #-}+parseIterate+    :: Monad m+    => (b -> PR.Parser a m b)+    -> b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseIterate = parseIterateD++------------------------------------------------------------------------------+-- Grouping+------------------------------------------------------------------------------++data GroupByState st fs a b+    = GroupingInit st+    | GroupingDo st !fs+    | GroupingInitWith st !a+    | GroupingDoWith st !fs !a+    | GroupingYield !b (GroupByState st fs a b)+    | GroupingDone++-- | The argument order of the comparison function in `groupsWhile` is+-- different than that of `groupsBy`.+--+-- In `groupsBy` the comparison function takes the next element as the first+-- argument and the previous element as the second argument. In `groupsWhile`+-- the first argument is the previous element and second argument is the next+-- element.+{-# INLINE_NORMAL groupsWhile #-}+groupsWhile :: Monad m+    => (a -> a -> Bool)+    -> Fold m a b+    -> Stream m a+    -> Stream m b+{-+groupsWhile eq fld = parseMany (PRD.groupBy eq fld)+-}+groupsWhile cmp (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter (GroupingInit state)++    where++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (GroupingInit st) = do+        -- XXX Note that if the stream stops without yielding a single element+        -- in the group we discard the "initial" effect.+        res <- initial+        return+            $ case res of+                  FL.Partial s -> Skip $ GroupingDo st s+                  FL.Done b -> Yield b $ GroupingInit st+    stepOuter gst (GroupingDo st fs) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                r <- fstep fs x+                case r of+                    FL.Partial fs1 -> go SPEC x s fs1+                    FL.Done b -> return $ Yield b (GroupingInit s)+            Skip s -> return $ Skip $ GroupingDo s fs+            Stop -> final fs >> return Stop++        where++        go !_ prev stt !acc = do+            res <- step (adaptState gst) stt+            case res of+                Yield x s -> do+                    if cmp prev x+                    then do+                        r <- fstep acc x+                        case r of+                            FL.Partial fs1 -> go SPEC prev s fs1+                            FL.Done b -> return $ Yield b (GroupingInit s)+                    else do+                        r <- final acc+                        return $ Yield r (GroupingInitWith s x)+                Skip s -> go SPEC prev s acc+                Stop -> do+                    r <- final acc+                    return $ Yield r GroupingDone+    stepOuter _ (GroupingInitWith st x) = do+        res <- initial+        return+            $ case res of+                  FL.Partial s -> Skip $ GroupingDoWith st s x+                  FL.Done b -> Yield b $ GroupingInitWith st x+    stepOuter gst (GroupingDoWith st fs prev) = do+        res <- fstep fs prev+        case res of+            FL.Partial fs1 -> go SPEC st fs1+            FL.Done b -> return $ Yield b (GroupingInit st)++        where++        -- XXX code duplicated from the previous equation+        go !_ stt !acc = do+            res <- step (adaptState gst) stt+            case res of+                Yield x s -> do+                    if cmp prev x+                    then do+                        r <- fstep acc x+                        case r of+                            FL.Partial fs1 -> go SPEC s fs1+                            FL.Done b -> return $ Yield b (GroupingInit s)+                    else do+                        r <- final acc+                        return $ Yield r (GroupingInitWith s x)+                Skip s -> go SPEC s acc+                Stop -> do+                    r <- final acc+                    return $ Yield r GroupingDone+    stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"+    stepOuter _ GroupingDone = return Stop++{-# DEPRECATED groupsBy "Please use groupsWhile instead. Please note the change in the argument order of the comparison function." #-}+{-# INLINE_NORMAL groupsBy #-}+groupsBy :: Monad m+    => (a -> a -> Bool)+    -> Fold m a b+    -> Stream m a+    -> Stream m b+groupsBy cmp = groupsWhile (flip cmp)++{-# INLINE_NORMAL groupsRollingBy #-}+groupsRollingBy :: Monad m+    => (a -> a -> Bool)+    -> Fold m a b+    -> Stream m a+    -> Stream m b+{-+groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)+-}+groupsRollingBy cmp (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter (GroupingInit state)++    where++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (GroupingInit st) = do+        -- XXX Note that if the stream stops without yielding a single element+        -- in the group we discard the "initial" effect.+        res <- initial+        return+            $ case res of+                  FL.Partial fs -> Skip $ GroupingDo st fs+                  FL.Done fb -> Yield fb $ GroupingInit st+    stepOuter gst (GroupingDo st fs) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                r <- fstep fs x+                case r of+                    FL.Partial fs1 -> go SPEC x s fs1+                    FL.Done fb -> return $ Yield fb (GroupingInit s)+            Skip s -> return $ Skip $ GroupingDo s fs+            Stop -> final fs >> return Stop++        where++        go !_ prev stt !acc = do+            res <- step (adaptState gst) stt+            case res of+                Yield x s -> do+                    if cmp prev x+                    then do+                        r <- fstep acc x+                        case r of+                            FL.Partial fs1 -> go SPEC x s fs1+                            FL.Done b -> return $ Yield b (GroupingInit s)+                    else do+                        r <- final acc+                        return $ Yield r (GroupingInitWith s x)+                Skip s -> go SPEC prev s acc+                Stop -> do+                    r <- final acc+                    return $ Yield r GroupingDone+    stepOuter _ (GroupingInitWith st x) = do+        res <- initial+        return+            $ case res of+                  FL.Partial s -> Skip $ GroupingDoWith st s x+                  FL.Done b -> Yield b $ GroupingInitWith st x+    stepOuter gst (GroupingDoWith st fs previous) = do+        res <- fstep fs previous+        case res of+            FL.Partial s -> go SPEC previous st s+            FL.Done b -> return $ Yield b (GroupingInit st)++        where++        -- XXX GHC: groupsWhile has one less parameter in this go loop and it+        -- fuses. However, groupsRollingBy does not fuse, removing the prev+        -- parameter makes it fuse. Something needs to be fixed in GHC. The+        -- workaround for this is noted in the comments below.+        go !_ prev !stt !acc = do+            res <- step (adaptState gst) stt+            case res of+                Yield x s -> do+                    if cmp prev x+                    then do+                        r <- fstep acc x+                        case r of+                            FL.Partial fs1 -> go SPEC x s fs1+                            FL.Done b -> return $ Yield b (GroupingInit st)+                    else do+                        {-+                        r <- final acc+                        return $ Yield r (GroupingInitWith s x)+                        -}+                        -- The code above does not let groupBy fuse. We use the+                        -- alternative code below instead.  Instead of jumping+                        -- to GroupingInitWith state, we unroll the code of+                        -- GroupingInitWith state here to help GHC with stream+                        -- fusion.+                        result <- initial+                        r <- final acc+                        return+                            $ Yield r+                            $ case result of+                                  FL.Partial fsi -> GroupingDoWith s fsi x+                                  FL.Done b -> GroupingYield b (GroupingInit s)+                Skip s -> go SPEC prev s acc+                Stop -> do+                    r <- final acc+                    return $ Yield r GroupingDone+    stepOuter _ (GroupingYield r next) = return $ Yield r next+    stepOuter _ GroupingDone = return Stop++------------------------------------------------------------------------------+-- Splitting - by a predicate+------------------------------------------------------------------------------++data WordsByState st fs b+    = WordsByInit st+    | WordsByDo st !fs+    | WordsByDone+    | WordsByYield !b (WordsByState st fs b)++-- | Split the stream after stripping leading, trailing, and repeated separators+-- as per the fold supplied.+-- Therefore, @".a..b."@ with '.' as the separator would be parsed as+-- @["a","b"]@.  In other words, its like parsing words from whitespace+-- separated text.++{-# INLINE_NORMAL wordsBy #-}+wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+wordsBy predicate (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter (WordsByInit state)++    where++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (WordsByInit st) = do+        res <- initial+        return+            $ case res of+                  FL.Partial s -> Skip $ WordsByDo st s+                  FL.Done b -> Yield b (WordsByInit st)++    stepOuter gst (WordsByDo st fs) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                if predicate x+                then do+                    resi <- initial+                    return+                        $ case resi of+                              FL.Partial fs1 -> Skip $ WordsByDo s fs1+                              FL.Done b -> Yield b (WordsByInit s)+                else do+                    r <- fstep fs x+                    case r of+                        FL.Partial fs1 -> go SPEC s fs1+                        FL.Done b -> return $ Yield b (WordsByInit s)+            Skip s    -> return $ Skip $ WordsByDo s fs+            Stop      -> final fs >> return Stop++        where++        go !_ stt !acc = do+            res <- step (adaptState gst) stt+            case res of+                Yield x s -> do+                    if predicate x+                    then do+                        {-+                        r <- final acc+                        return $ Yield r (WordsByInit s)+                        -}+                        -- The above code does not fuse well. Need to check why+                        -- GHC is not able to simplify it well.  Using the code+                        -- below, instead of jumping through the WordsByInit+                        -- state always, we directly go to WordsByDo state in+                        -- the common case of Partial.+                        resi <- initial+                        r <- final acc+                        return+                            $ Yield r+                            $ case resi of+                                  FL.Partial fs1 -> WordsByDo s fs1+                                  FL.Done b -> WordsByYield b (WordsByInit s)+                    else do+                        r <- fstep acc x+                        case r of+                            FL.Partial fs1 -> go SPEC s fs1+                            FL.Done b -> return $ Yield b (WordsByInit s)+                Skip s -> go SPEC s acc+                Stop -> do+                    r <- final acc+                    return $ Yield r WordsByDone++    stepOuter _ WordsByDone = return Stop++    stepOuter _ (WordsByYield b next) = return $ Yield b next++------------------------------------------------------------------------------+-- Splitting on a sequence+------------------------------------------------------------------------------++-- String search algorithms:+-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html++{-+-- TODO can we unify the splitting operations using a splitting configuration+-- like in the split package.+--+data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)+data SplitOptions = SplitOptions+    { style    :: SplitStyle+    , withSep  :: Bool  -- ^ keep the separators in output+    -- , compact  :: Bool  -- ^ treat multiple consecutive separators as one+    -- , trimHead :: Bool  -- ^ drop blank at head+    -- , trimTail :: Bool  -- ^ drop blank at tail+    }+-}++-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,+-- because we can use the constructor directly without having to create "jump"+-- functions.+{-# ANN type SplitOnSeqState Fuse #-}+data SplitOnSeqState rb rh ck w fs s b x =+      SplitOnSeqInit+    | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)+    | SplitOnSeqDone++    | SplitOnSeqEmpty !fs s++    | SplitOnSeqSingle !fs s x++    | SplitOnSeqWordInit !fs s+    | SplitOnSeqWordLoop !w s !fs+    | SplitOnSeqWordDone Int !fs !w++    | SplitOnSeqKRInit Int !fs s rb !rh+    | SplitOnSeqKRLoop fs s rb !rh !ck+    | SplitOnSeqKRCheck fs s rb !rh+    | SplitOnSeqKRDone Int !fs rb !rh++    | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)++{-# INLINE_NORMAL splitOnSeq #-}+splitOnSeq+    :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)+    => Array a+    -> Fold m a b+    -> Stream m a+    -> Stream m b+splitOnSeq patArr (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter SplitOnSeqInit++    where++    patLen = A.length patArr+    maxIndex = patLen - 1+    elemBits = SIZE_OF(a) * 8++    -- For word pattern case+    wordMask :: Word+    wordMask = (1 `shiftL` (elemBits * patLen)) - 1++    elemMask :: Word+    elemMask = (1 `shiftL` elemBits) - 1++    wordPat :: Word+    wordPat = wordMask .&. A.foldl' addToWord 0 patArr++    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)++    -- For Rabin-Karp search+    k = 2891336453 :: Word32+    coeff = k ^ patLen++    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)++    deltaCksum cksum old new =+        addCksum cksum new - coeff * fromIntegral (fromEnum old)++    -- XXX shall we use a random starting hash or 1 instead of 0?+    patHash = A.foldl' addCksum 0 patArr++    skip = return . Skip++    nextAfterInit nextGen stepRes =+        case stepRes of+            FL.Partial s -> nextGen s+            FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)++    {-# INLINE yieldProceed #-}+    yieldProceed nextGen fs =+        initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ SplitOnSeqInit = do+        res <- initial+        case res of+            FL.Partial acc ->+                if patLen == 0+                then return $ Skip $ SplitOnSeqEmpty acc state+                else if patLen == 1+                     then do+                         pat <- liftIO $ A.unsafeIndexIO 0 patArr+                         return $ Skip $ SplitOnSeqSingle acc state pat+                     else if SIZE_OF(a) * patLen+                               <= sizeOf (Proxy :: Proxy Word)+                          then return $ Skip $ SplitOnSeqWordInit acc state+                          else do+                              (rb, rhead) <- liftIO $ RB.new patLen+                              skip $ SplitOnSeqKRInit 0 acc state rb rhead+            FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit++    stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next++    ---------------------------+    -- Checkpoint+    ---------------------------++    stepOuter _ (SplitOnSeqReinit nextGen) =+        initial >>= skip . nextAfterInit nextGen++    ---------------------------+    -- Empty pattern+    ---------------------------++    stepOuter gst (SplitOnSeqEmpty acc st) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                r <- fstep acc x+                b1 <-+                    case r of+                        FL.Partial acc1 -> final acc1+                        FL.Done b -> return b+                let jump c = SplitOnSeqEmpty c s+                 in yieldProceed jump b1+            Skip s -> skip (SplitOnSeqEmpty acc s)+            Stop -> final acc >> return Stop++    -----------------+    -- Done+    -----------------++    stepOuter _ SplitOnSeqDone = return Stop++    -----------------+    -- Single Pattern+    -----------------++    stepOuter gst (SplitOnSeqSingle fs st pat) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                let jump c = SplitOnSeqSingle c s pat+                if pat == x+                then final fs >>= yieldProceed jump+                else do+                    r <- fstep fs x+                    case r of+                        FL.Partial fs1 -> skip $ jump fs1+                        FL.Done b -> yieldProceed jump b+            Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat+            Stop -> do+                r <- final fs+                return $ Skip $ SplitOnSeqYield r SplitOnSeqDone++    ---------------------------+    -- Short Pattern - Shift Or+    ---------------------------++    stepOuter _ (SplitOnSeqWordDone 0 fs _) = do+        r <- final fs+        skip $ SplitOnSeqYield r SplitOnSeqDone+    stepOuter _ (SplitOnSeqWordDone n fs wrd) = do+        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))+        r <- fstep fs (toEnum $ fromIntegral old)+        case r of+            FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd+            FL.Done b -> do+                 let jump c = SplitOnSeqWordDone (n - 1) c wrd+                 yieldProceed jump b++    stepOuter gst (SplitOnSeqWordInit fs st0) =+        go SPEC 0 0 st0++        where++        {-# INLINE go #-}+        go !_ !idx !wrd !st = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    let wrd1 = addToWord wrd x+                    if idx == maxIndex+                    then do+                        if wrd1 .&. wordMask == wordPat+                        then do+                            let jump c = SplitOnSeqWordInit c s+                            final fs >>= yieldProceed jump+                        else skip $ SplitOnSeqWordLoop wrd1 s fs+                    else go SPEC (idx + 1) wrd1 s+                Skip s -> go SPEC idx wrd s+                Stop -> do+                    if idx /= 0+                    then skip $ SplitOnSeqWordDone idx fs wrd+                    else do+                        r <- final fs+                        skip $ SplitOnSeqYield r SplitOnSeqDone++    stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =+        go SPEC wrd0 st0 fs0++        where++        {-# INLINE go #-}+        go !_ !wrd !st !fs = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    let jump c = SplitOnSeqWordInit c s+                        wrd1 = addToWord wrd x+                        old = (wordMask .&. wrd)+                                `shiftR` (elemBits * (patLen - 1))+                    r <- fstep fs (toEnum $ fromIntegral old)+                    case r of+                        FL.Partial fs1 -> do+                            if wrd1 .&. wordMask == wordPat+                            then final fs1 >>= yieldProceed jump+                            else go SPEC wrd1 s fs1+                        FL.Done b -> yieldProceed jump b+                Skip s -> go SPEC wrd s fs+                Stop -> skip $ SplitOnSeqWordDone patLen fs wrd++    -------------------------------+    -- General Pattern - Karp Rabin+    -------------------------------++    stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                rh1 <- liftIO $ RB.unsafeInsert rb rh x+                if idx == maxIndex+                then do+                    let fld = RB.unsafeFoldRing (RB.ringBound rb)+                    let !ringHash = fld addCksum 0 rb+                    if ringHash == patHash+                    then skip $ SplitOnSeqKRCheck fs s rb rh1+                    else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash+                else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1+            Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh+            Stop -> do+                skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)++    -- XXX The recursive "go" is more efficient than the state based recursion+    -- code commented out below. Perhaps its more efficient because of+    -- factoring out "rb" outside the loop.+    --+    stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =+        go SPEC fs0 st0 rh0 cksum0++        where++        go !_ !fs !st !rh !cksum = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    old <- liftIO $ peek rh+                    let cksum1 = deltaCksum cksum old x+                    r <- fstep fs old+                    case r of+                        FL.Partial fs1 -> do+                            rh1 <- liftIO (RB.unsafeInsert rb rh x)+                            if cksum1 == patHash+                            then skip $ SplitOnSeqKRCheck fs1 s rb rh1+                            else go SPEC fs1 s rh1 cksum1+                        FL.Done b -> do+                            let rst = RB.startOf rb+                                jump c = SplitOnSeqKRInit 0 c s rb rst+                            yieldProceed jump b+                Skip s -> go SPEC fs s rh cksum+                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh++    -- XXX The following code is 5 times slower compared to the recursive loop+    -- based code above. Need to investigate why. One possibility is that the+    -- go loop above does not thread around the ring buffer (rb). This code may+    -- be causing the state to bloat and getting allocated on each iteration.+    -- We can check the cmm/asm code to confirm.  If so a good GHC solution to+    -- such problem is needed. One way to avoid this could be to use unboxed+    -- mutable state?+    {-+    stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    old <- liftIO $ peek rh+                    let cksum1 = deltaCksum cksum old x+                    fs1 <- fstep fs old+                    if (cksum1 == patHash)+                    then do+                        r <- done fs1+                        skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh+                    else do+                        rh1 <- liftIO (RB.unsafeInsert rb rh x)+                        skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1+                Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum+                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh+    -}++    stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do+        if RB.unsafeEqArray rb rh patArr+        then do+            r <- final fs+            let rst = RB.startOf rb+                jump c = SplitOnSeqKRInit 0 c st rb rst+            yieldProceed jump r+        else skip $ SplitOnSeqKRLoop fs st rb rh patHash++    stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do+        r <- final fs+        skip $ SplitOnSeqYield r SplitOnSeqDone+    stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do+        old <- liftIO $ peek rh+        let rh1 = RB.advance rb rh+        r <- fstep fs old+        case r of+            FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1+            FL.Done b -> do+                 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1+                 yieldProceed jump b++{-# ANN type SplitOnSuffixSeqState Fuse #-}+data SplitOnSuffixSeqState rb rh ck w fs s b x =+      SplitOnSuffixSeqInit+    | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)+    | SplitOnSuffixSeqDone++    | SplitOnSuffixSeqEmpty !fs s++    | SplitOnSuffixSeqSingleInit !fs s x+    | SplitOnSuffixSeqSingle !fs s x++    | SplitOnSuffixSeqWordInit !fs s+    | SplitOnSuffixSeqWordLoop !w s !fs+    | SplitOnSuffixSeqWordDone Int !fs !w++    | SplitOnSuffixSeqKRInit Int !fs s rb !rh+    | SplitOnSuffixSeqKRInit1 !fs s rb !rh+    | SplitOnSuffixSeqKRLoop fs s rb !rh !ck+    | SplitOnSuffixSeqKRCheck fs s rb !rh+    | SplitOnSuffixSeqKRDone Int !fs rb !rh++    | SplitOnSuffixSeqReinit+          (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)++{-# INLINE_NORMAL splitOnSuffixSeq #-}+splitOnSuffixSeq+    :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)+    => Bool+    -> Array a+    -> Fold m a b+    -> Stream m a+    -> Stream m b+splitOnSuffixSeq withSep patArr (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter SplitOnSuffixSeqInit++    where++    patLen = A.length patArr+    maxIndex = patLen - 1+    elemBits = SIZE_OF(a) * 8++    -- For word pattern case+    wordMask :: Word+    wordMask = (1 `shiftL` (elemBits * patLen)) - 1++    elemMask :: Word+    elemMask = (1 `shiftL` elemBits) - 1++    wordPat :: Word+    wordPat = wordMask .&. A.foldl' addToWord 0 patArr++    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)++    nextAfterInit nextGen stepRes =+        case stepRes of+            FL.Partial s -> nextGen s+            FL.Done b ->+                SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)++    {-# INLINE yieldProceed #-}+    yieldProceed nextGen fs =+        initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen++    -- For single element pattern case+    {-# INLINE processYieldSingle #-}+    processYieldSingle pat x s fs = do+        let jump c = SplitOnSuffixSeqSingleInit c s pat+        if pat == x+        then do+            r <- if withSep then fstep fs x else return $ FL.Partial fs+            b1 <-+                case r of+                    FL.Partial fs1 -> final fs1+                    FL.Done b -> return b+            yieldProceed jump b1+        else do+            r <- fstep fs x+            case r of+                FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat+                FL.Done b -> yieldProceed jump b++    -- For Rabin-Karp search+    k = 2891336453 :: Word32+    coeff = k ^ patLen++    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)++    deltaCksum cksum old new =+        addCksum cksum new - coeff * fromIntegral (fromEnum old)++    -- XXX shall we use a random starting hash or 1 instead of 0?+    patHash = A.foldl' addCksum 0 patArr++    skip = return . Skip++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ SplitOnSuffixSeqInit = do+        res <- initial+        case res of+            FL.Partial fs ->+                if patLen == 0+                then skip $ SplitOnSuffixSeqEmpty fs state+                else if patLen == 1+                     then do+                         pat <- liftIO $ A.unsafeIndexIO 0 patArr+                         skip $ SplitOnSuffixSeqSingleInit fs state pat+                     else if SIZE_OF(a) * patLen+                               <= sizeOf (Proxy :: Proxy Word)+                          then skip $ SplitOnSuffixSeqWordInit fs state+                          else do+                              (rb, rhead) <- liftIO $ RB.new patLen+                              skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead+            FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit++    stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next++    ---------------------------+    -- Reinit+    ---------------------------++    stepOuter _ (SplitOnSuffixSeqReinit nextGen) =+        initial >>= skip . nextAfterInit nextGen++    ---------------------------+    -- Empty pattern+    ---------------------------++    stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                let jump c = SplitOnSuffixSeqEmpty c s+                r <- fstep acc x+                b1 <-+                    case r of+                        FL.Partial fs -> final fs+                        FL.Done b -> return b+                yieldProceed jump b1+            Skip s -> skip (SplitOnSuffixSeqEmpty acc s)+            Stop -> final acc >> return Stop++    -----------------+    -- Done+    -----------------++    stepOuter _ SplitOnSuffixSeqDone = return Stop++    -----------------+    -- Single Pattern+    -----------------++    stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> processYieldSingle pat x s fs+            Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat+            Stop -> final fs >> return Stop++    stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> processYieldSingle pat x s fs+            Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat+            Stop -> do+                r <- final fs+                skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone++    ---------------------------+    -- Short Pattern - Shift Or+    ---------------------------++    stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do+        r <- final fs+        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+    stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do+        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))+        r <- fstep fs (toEnum $ fromIntegral old)+        case r of+            FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd+            FL.Done b -> do+                let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd+                yieldProceed jump b++    stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do+        res <- step (adaptState gst) st0+        case res of+            Yield x s -> do+                let wrd = addToWord 0 x+                r <- if withSep then fstep fs0 x else return $ FL.Partial fs0+                case r of+                    FL.Partial fs1 -> go SPEC 1 wrd s fs1+                    FL.Done b -> do+                        let jump c = SplitOnSuffixSeqWordInit c s+                        yieldProceed jump b+            Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)+            Stop -> final fs0 >> return Stop++        where++        {-# INLINE go #-}+        go !_ !idx !wrd !st !fs = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    let jump c = SplitOnSuffixSeqWordInit c s+                    let wrd1 = addToWord wrd x+                    r <- if withSep then fstep fs x else return $ FL.Partial fs+                    case r of+                        FL.Partial fs1 ->+                            if idx /= maxIndex+                            then go SPEC (idx + 1) wrd1 s fs1+                            else if wrd1 .&. wordMask /= wordPat+                            then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1+                            else do final fs >>= yieldProceed jump+                        FL.Done b -> yieldProceed jump b+                Skip s -> go SPEC idx wrd s fs+                Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd++    stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =+        go SPEC wrd0 st0 fs0++        where++        {-# INLINE go #-}+        go !_ !wrd !st !fs = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    let jump c = SplitOnSuffixSeqWordInit c s+                        wrd1 = addToWord wrd x+                        old = (wordMask .&. wrd)+                                `shiftR` (elemBits * (patLen - 1))+                    r <-+                        if withSep+                        then fstep fs x+                        else fstep fs (toEnum $ fromIntegral old)+                    case r of+                        FL.Partial fs1 ->+                            if wrd1 .&. wordMask == wordPat+                            then final fs1 >>= yieldProceed jump+                            else go SPEC wrd1 s fs1+                        FL.Done b -> yieldProceed jump b+                Skip s -> go SPEC wrd s fs+                Stop ->+                    if wrd .&. wordMask == wordPat+                    then final fs >> return Stop+                    else if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else skip $ SplitOnSuffixSeqWordDone patLen fs wrd++    -------------------------------+    -- General Pattern - Karp Rabin+    -------------------------------++    stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do+        res <- step (adaptState gst) st0+        case res of+            Yield x s -> do+                rh1 <- liftIO $ RB.unsafeInsert rb rh0 x+                r <- if withSep then fstep fs x else return $ FL.Partial fs+                case r of+                    FL.Partial fs1 ->+                        skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1+                    FL.Done b -> do+                        let rst = RB.startOf rb+                            jump c = SplitOnSuffixSeqKRInit 0 c s rb rst+                        yieldProceed jump b+            Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0+            Stop -> final fs >> return Stop++    stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do+        go SPEC 1 rh0 st0 fs0++        where++        go !_ !idx !rh st !fs = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    rh1 <- liftIO (RB.unsafeInsert rb rh x)+                    r <- if withSep then fstep fs x else return $ FL.Partial fs+                    case r of+                        FL.Partial fs1 ->+                            if idx /= maxIndex+                            then go SPEC (idx + 1) rh1 s fs1+                            else skip $+                                let fld = RB.unsafeFoldRing (RB.ringBound rb)+                                    !ringHash = fld addCksum 0 rb+                                 in if ringHash == patHash+                                    then SplitOnSuffixSeqKRCheck fs1 s rb rh1+                                    else SplitOnSuffixSeqKRLoop+                                            fs1 s rb rh1 ringHash+                        FL.Done b -> do+                            let rst = RB.startOf rb+                                jump c = SplitOnSuffixSeqKRInit 0 c s rb rst+                            yieldProceed jump b+                Skip s -> go SPEC idx rh s fs+                Stop -> do+                    -- do not issue a blank segment when we end at pattern+                    if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr+                    then final fs >> return Stop+                    else if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)++    stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =+        go SPEC fs0 st0 rh0 cksum0++        where++        go !_ !fs !st !rh !cksum = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    old <- liftIO $ peek rh+                    rh1 <- liftIO (RB.unsafeInsert rb rh x)+                    let cksum1 = deltaCksum cksum old x+                    r <- if withSep then fstep fs x else fstep fs old+                    case r of+                        FL.Partial fs1 ->+                            if cksum1 /= patHash+                            then go SPEC fs1 s rh1 cksum1+                            else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1+                        FL.Done b -> do+                            let rst = RB.startOf rb+                                jump c = SplitOnSuffixSeqKRInit 0 c s rb rst+                            yieldProceed jump b+                Skip s -> go SPEC fs s rh cksum+                Stop ->+                    if RB.unsafeEqArray rb rh patArr+                    then final fs >> return Stop+                    else if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh++    stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do+        if RB.unsafeEqArray rb rh patArr+        then do+            r <- final fs+            let rst = RB.startOf rb+                jump c = SplitOnSuffixSeqKRInit 0 c st rb rst+            yieldProceed jump r+        else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash++    stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do+        r <- final fs+        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+    stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do+        old <- liftIO $ peek rh+        let rh1 = RB.advance rb rh+        r <- fstep fs old+        case r of+            FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1+            FL.Done b -> do+                let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1+                yieldProceed jump b++-- Implement this as a fold or a parser instead.+-- This can be implemented easily using Rabin Karp+-- | Split post any one of the given patterns.+--+-- /Unimplemented/+{-# INLINE splitOnSuffixSeqAny #-}+splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>+    [Array a] -> Fold m a b -> Stream m a -> Stream m b+splitOnSuffixSeqAny _subseq _f _m = undefined+    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)++-- | Split on a prefixed separator element, dropping the separator.  The+-- supplied 'Fold' is applied on the split segments.+--+-- @+-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)+-- > splitOnPrefix' (== '.') ".a.b"+-- ["a","b"]+-- @+--+-- An empty stream results in an empty output stream:+-- @+-- > splitOnPrefix' (== '.') ""+-- []+-- @+--+-- An empty segment consisting of only a prefix is folded to the default output+-- of the fold:+--+-- @+-- > splitOnPrefix' (== '.') "."+-- [""]+--+-- > splitOnPrefix' (== '.') ".a.b."+-- ["a","b",""]+--+-- > splitOnPrefix' (== '.') ".a..b"+-- ["a","","b"]+--+-- @+--+-- A prefix is optional at the beginning of the stream:+--+-- @+-- > splitOnPrefix' (== '.') "a"+-- ["a"]+--+-- > splitOnPrefix' (== '.') "a.b"+-- ["a","b"]+-- @+--+-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:+--+-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id+--+-- /Unimplemented/+{-# INLINE splitOnPrefix #-}+splitOnPrefix :: -- (IsStream t, MonadCatch m) =>+    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOnPrefix _predicate _f = undefined+    -- parseMany (Parser.sliceBeginBy predicate f)++-- Int list examples for splitOn:+--+-- >>> splitList [] [1,2,3,3,4]+-- > [[1],[2],[3],[3],[4]]+--+-- >>> splitList [5] [1,2,3,3,4]+-- > [[1,2,3,3,4]]+--+-- >>> splitList [1] [1,2,3,3,4]+-- > [[],[2,3,3,4]]+--+-- >>> splitList [4] [1,2,3,3,4]+-- > [[1,2,3,3],[]]+--+-- >>> splitList [2] [1,2,3,3,4]+-- > [[1],[3,3,4]]+--+-- >>> splitList [3] [1,2,3,3,4]+-- > [[1,2],[],[4]]+--+-- >>> splitList [3,3] [1,2,3,3,4]+-- > [[1,2],[4]]+--+-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]+-- > [[],[]]++-- This can be implemented easily using Rabin Karp+-- | Split on any one of the given patterns.+--+-- /Unimplemented/+--+{-# INLINE splitOnAny #-}+splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>+    [Array a] -> Fold m a b -> Stream m a -> Stream m b+splitOnAny _subseq _f _m =+    undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)++------------------------------------------------------------------------------+-- Nested Container Transformation+------------------------------------------------------------------------------++{-# ANN type SplitState Fuse #-}+data SplitState s arr+    = SplitInitial s+    | SplitBuffering s arr+    | SplitSplitting s arr+    | SplitYielding arr (SplitState s arr)+    | SplitFinishing++-- XXX An alternative approach would be to use a partial fold (Fold m a b) to+-- split using a splitBy like combinator. The Fold would consume upto the+-- separator and return any leftover which can then be fed to the next fold.+--+-- We can revisit this once we have partial folds/parsers.+--+-- | Performs infix separator style splitting.+{-# INLINE_NORMAL splitInnerBy #-}+splitInnerBy+    :: Monad m+    => (f a -> m (f a, Maybe (f a)))  -- splitter+    -> (f a -> f a -> m (f a))        -- joiner+    -> Stream m (f a)+    -> Stream m (f a)+splitInnerBy splitter joiner (Stream step1 state1) =+    Stream step (SplitInitial state1)++    where++    {-# INLINE_LATE step #-}+    step gst (SplitInitial st) = do+        r <- step1 gst st+        case r of+            Yield x s -> do+                (x1, mx2) <- splitter x+                return $ case mx2 of+                    Nothing -> Skip (SplitBuffering s x1)+                    Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))+            Skip s -> return $ Skip (SplitInitial s)+            Stop -> return Stop++    step gst (SplitBuffering st buf) = do+        r <- step1 gst st+        case r of+            Yield x s -> do+                (x1, mx2) <- splitter x+                buf' <- joiner buf x1+                return $ case mx2 of+                    Nothing -> Skip (SplitBuffering s buf')+                    Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))+            Skip s -> return $ Skip (SplitBuffering s buf)+            Stop -> return $ Skip (SplitYielding buf SplitFinishing)++    step _ (SplitSplitting st buf) = do+        (x1, mx2) <- splitter buf+        return $ case mx2 of+                Nothing -> Skip $ SplitBuffering st x1+                Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)++    step _ (SplitYielding x next) = return $ Yield x next+    step _ SplitFinishing = return Stop++-- | Performs infix separator style splitting.+{-# INLINE_NORMAL splitInnerBySuffix #-}+splitInnerBySuffix+    :: (Monad m, Eq (f a), Monoid (f a))+    => (f a -> m (f a, Maybe (f a)))  -- splitter+    -> (f a -> f a -> m (f a))        -- joiner+    -> Stream m (f a)+    -> Stream m (f a)+splitInnerBySuffix splitter joiner (Stream step1 state1) =+    Stream step (SplitInitial state1)++    where++    {-# INLINE_LATE step #-}+    step gst (SplitInitial st) = do+        r <- step1 gst st+        case r of+            Yield x s -> do+                (x1, mx2) <- splitter x+                return $ case mx2 of+                    Nothing -> Skip (SplitBuffering s x1)+                    Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))+            Skip s -> return $ Skip (SplitInitial s)+            Stop -> return Stop++    step gst (SplitBuffering st buf) = do+        r <- step1 gst st+        case r of+            Yield x s -> do+                (x1, mx2) <- splitter x+                buf' <- joiner buf x1+                return $ case mx2 of+                    Nothing -> Skip (SplitBuffering s buf')+                    Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))+            Skip s -> return $ Skip (SplitBuffering s buf)+            Stop -> return $+                if buf == mempty+                then Stop+                else Skip (SplitYielding buf SplitFinishing)++    step _ (SplitSplitting st buf) = do+        (x1, mx2) <- splitter buf+        return $ case mx2 of+                Nothing -> Skip $ SplitBuffering st x1+                Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)++    step _ (SplitYielding x next) = return $ Yield x next+    step _ SplitFinishing = return Stop++------------------------------------------------------------------------------+-- Trimming+------------------------------------------------------------------------------++-- | Drop prefix from the input stream if present.+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE dropPrefix #-}+dropPrefix ::+    -- (Monad m, Eq a) =>+    Stream m a -> Stream m a -> Stream m a+dropPrefix = error "Not implemented yet!"++-- | Drop all matching infix from the input stream if present. Infix stream+-- may be consumed multiple times.+--+-- Space: @O(n)@ where n is the length of the infix.+--+-- /Unimplemented/+{-# INLINE dropInfix #-}+dropInfix ::+    -- (Monad m, Eq a) =>+    Stream m a -> Stream m a -> Stream m a+dropInfix = error "Not implemented yet!"++-- | Drop suffix from the input stream if present. Suffix stream may be+-- consumed multiple times.+--+-- Space: @O(n)@ where n is the length of the suffix.+--+-- /Unimplemented/+{-# INLINE dropSuffix #-}+dropSuffix ::+    -- (Monad m, Eq a) =>+    Stream m a -> Stream m a -> Stream m a+dropSuffix = error "Not implemented yet!"
− src/Streamly/Internal/Data/Stream/Reduce.hs 
@@ -1,444 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Reduce--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Reduce streams by streams, folds or parsers.--module Streamly.Internal.Data.Stream.Reduce-    (-    -- * Reduce By Streams-      dropPrefix-    , dropInfix-    , dropSuffix--    -- * Reduce By Folds-    -- |-    -- Reduce a stream by folding or parsing chunks of the stream.  Functions-    -- generally ending in these shapes:-    ---    -- @-    -- f (Fold m a b) -> Stream m a -> Stream m b-    -- f (Parser a m b) -> Stream m a -> Stream m b-    -- @--    -- ** Generic Folding-    -- | Apply folds on a stream.-    , foldMany-    , foldManyPost-    , refoldMany-    , foldSequence-    , foldIterateM-    , refoldIterateM-    , reduceIterateBfs--    -- ** Chunking-    -- | Element unaware grouping.-    , chunksOf--    -- ** Splitting-    -- XXX Implement these as folds or parsers instead.-    , splitOnSuffixSeqAny-    , splitOnPrefix-    , splitOnAny--    -- * Reduce By Parsers-    -- ** Generic Parsing-    -- | Apply parsers on a stream.-    , parseMany-    , parseManyD-    , parseManyTill-    , parseSequence-    , parseIterate--    )-where--import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Fold.Type (Fold (..))-import Streamly.Internal.Data.Parser (Parser (..))-import Streamly.Internal.Data.Parser.ParserD (ParseError)-import Streamly.Internal.Data.Refold.Type (Refold (..))-import Streamly.Internal.Data.Stream.Bottom (foldManyPost)-import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)-import Streamly.Internal.Data.Unboxed (Unbox)--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Prelude hiding (concatMap, map)---- $setup--- >>> :m--- >>> import Prelude hiding (zipWith, concatMap, concat)--- >>> import Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Data.Array as Array----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Drop prefix from the input stream if present.------ Space: @O(1)@------ /Unimplemented/-{-# INLINE dropPrefix #-}-dropPrefix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropPrefix = error "Not implemented yet!"---- | Drop all matching infix from the input stream if present. Infix stream--- may be consumed multiple times.------ Space: @O(n)@ where n is the length of the infix.------ /Unimplemented/-{-# INLINE dropInfix #-}-dropInfix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropInfix = error "Not implemented yet!"---- | Drop suffix from the input stream if present. Suffix stream may be--- consumed multiple times.------ Space: @O(n)@ where n is the length of the suffix.------ /Unimplemented/-{-# INLINE dropSuffix #-}-dropSuffix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropSuffix = error "Not implemented yet!"----------------------------------------------------------------------------------- Folding----------------------------------------------------------------------------------- | Apply a 'Fold' repeatedly on a stream and emit the results in the--- output stream. Unlike 'foldManyPost' it evaluates the fold after the stream,--- therefore, an empty input stream results in an empty output stream.------ Definition:------ >>> foldMany f = Stream.parseMany (Parser.fromFold f)------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f--- >>> fmany $ Stream.fromList []--- []------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream on a non-empty input stream.----{-# INLINE foldMany #-}-foldMany-    :: Monad m-    => Fold m a b-    -> Stream m a-    -> Stream m b-foldMany f m = fromStreamD $ D.foldMany f (toStreamD m)---- | Like 'foldMany' but using the 'Refold' type instead of 'Fold'.------ /Pre-release/-{-# INLINE refoldMany #-}-refoldMany :: Monad m =>-    Refold m c a b -> m c -> Stream m a -> Stream m b-refoldMany f action = fromStreamD . D.refoldMany f action . toStreamD---- | Apply a stream of folds to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE foldSequence #-}-foldSequence-       :: -- Monad m =>-       Stream m (Fold m a b)-    -> Stream m a-    -> Stream m b-foldSequence _f _m = undefined---- | Iterate a fold generator on a stream. The initial value @b@ is used to--- generate the first fold, the fold is applied on the stream and the result of--- the fold is used to generate the next fold and so on.------ >>> import Data.Monoid (Sum(..))--- >>> f x = return (Fold.take 2 (Fold.sconcat x))--- >>> s = fmap Sum $ Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- folds where next fold is dependent on the previous fold.------ /Pre-release/----{-# INLINE foldIterateM #-}-foldIterateM ::-       Monad m => (b -> m (Fold m a b)) -> m b -> Stream m a -> Stream m b-foldIterateM f i m = fromStreamD $ D.foldIterateM f i (toStreamD m)---- | Like 'foldIterateM' but using the 'Refold' type instead. This could be--- much more efficient due to stream fusion.------ /Internal/-{-# INLINE refoldIterateM #-}-refoldIterateM :: Monad m =>-    Refold m b a b -> m b -> Stream m a -> Stream m b-refoldIterateM c i m = fromStreamD $ D.refoldIterateM c i (toStreamD m)---- | Binary BFS style reduce, folds a level entirely using the supplied fold--- function, collecting the outputs as next level of the tree, then repeats the--- same process on the next level. The last elements of a previously folded--- level are folded first.-{-# INLINE reduceIterateBfs #-}-reduceIterateBfs :: Monad m =>-    (a -> a -> m a) -> Stream m a -> m (Maybe a)-reduceIterateBfs f stream = D.reduceIterateBfs f (toStreamD stream)----------------------------------------------------------------------------------- Splitting----------------------------------------------------------------------------------- Implement this as a fold or a parser instead.--- This can be implemented easily using Rabin Karp--- | Split post any one of the given patterns.------ /Unimplemented/-{-# INLINE splitOnSuffixSeqAny #-}-splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnSuffixSeqAny _subseq _f _m = undefined-    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)---- | Split on a prefixed separator element, dropping the separator.  The--- supplied 'Fold' is applied on the split segments.------ @--- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)--- > splitOnPrefix' (== '.') ".a.b"--- ["a","b"]--- @------ An empty stream results in an empty output stream:--- @--- > splitOnPrefix' (== '.') ""--- []--- @------ An empty segment consisting of only a prefix is folded to the default output--- of the fold:------ @--- > splitOnPrefix' (== '.') "."--- [""]------ > splitOnPrefix' (== '.') ".a.b."--- ["a","b",""]------ > splitOnPrefix' (== '.') ".a..b"--- ["a","","b"]------ @------ A prefix is optional at the beginning of the stream:------ @--- > splitOnPrefix' (== '.') "a"--- ["a"]------ > splitOnPrefix' (== '.') "a.b"--- ["a","b"]--- @------ 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:------ > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id------ Assuming the input stream does not contain the separator:------ > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id------ /Unimplemented/-{-# INLINE splitOnPrefix #-}-splitOnPrefix :: -- (IsStream t, MonadCatch m) =>-    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-splitOnPrefix _predicate _f = undefined-    -- parseMany (Parser.sliceBeginBy predicate f)---- Int list examples for splitOn:------ >>> splitList [] [1,2,3,3,4]--- > [[1],[2],[3],[3],[4]]------ >>> splitList [5] [1,2,3,3,4]--- > [[1,2,3,3,4]]------ >>> splitList [1] [1,2,3,3,4]--- > [[],[2,3,3,4]]------ >>> splitList [4] [1,2,3,3,4]--- > [[1,2,3,3],[]]------ >>> splitList [2] [1,2,3,3,4]--- > [[1],[3,3,4]]------ >>> splitList [3] [1,2,3,3,4]--- > [[1,2],[],[4]]------ >>> splitList [3,3] [1,2,3,3,4]--- > [[1,2],[4]]------ >>> splitList [1,2,3,3,4] [1,2,3,3,4]--- > [[],[]]---- This can be implemented easily using Rabin Karp--- | Split on any one of the given patterns.------ /Unimplemented/----{-# INLINE splitOnAny #-}-splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnAny _subseq _f _m =-    undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)----------------------------------------------------------------------------------- Parsing----------------------------------------------------------------------------------- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the--- output stream.------ Example:------ >>> s = Stream.fromList [1..10]--- >>> parser = Parser.takeBetween 0 2 Fold.sum--- >>> Stream.fold Fold.toList $ Stream.parseMany parser s--- [Right 3,Right 7,Right 11,Right 15,Right 19]------ This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse--- combinator.------ Known Issues: When the parser fails there is no way to get the remaining--- stream.----{-# INLINE parseMany #-}-parseMany-    :: Monad m-    => Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseMany p m =-    fromStreamD $ D.parseManyD p (toStreamD m)---- | Same as parseMany but for StreamD streams.------ /Internal/----{-# INLINE parseManyD #-}-parseManyD-    :: Monad m-    => ParserD.Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseManyD p m =-    fromStreamD $ D.parseManyD p (toStreamD m)---- | Apply a stream of parsers to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE parseSequence #-}-parseSequence-       :: -- Monad m =>-       Stream m (Parser a m b)-    -> Stream m a-    -> Stream m b-parseSequence _f _m = undefined---- XXX Change the parser arguments' order---- | @parseManyTill collect test stream@ tries the parser @test@ on the input,--- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds--- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The--- output of @test@ is discarded and the output of @collect@ is emitted in the--- output stream. The parser fails if @collect@ fails.------ /Unimplemented/----{-# INLINE parseManyTill #-}-parseManyTill ::-    -- MonadThrow m =>-       Parser a m b-    -> Parser a m x-    -> t m a-    -> t m b-parseManyTill = undefined---- | Iterate a parser generating function on a stream. The initial value @b@ is--- used to generate the first parser, the parser is applied on the stream and--- the result is used to generate the next parser and so on.------ >>> import Data.Monoid (Sum(..))--- >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- parsers where next parser is dependent on the previous parser.------ /Pre-release/----{-# INLINE parseIterate #-}-parseIterate-    :: Monad m-    => (b -> Parser a m b)-    -> b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseIterate f i m = fromStreamD $-    D.parseIterateD f i (toStreamD m)----------------------------------------------------------------------------------- Chunking----------------------------------------------------------------------------------- | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ >>> chunksOf n = Stream.foldMany (Array.writeN n)------ /Pre-release/-{-# INLINE chunksOf #-}-chunksOf :: (MonadIO m, Unbox a)-    => Int -> Stream m a -> Stream m (Array a)-chunksOf n = fromStreamD . Array.chunksOf n . toStreamD
+ src/Streamly/Internal/Data/Stream/Step.hs view
@@ -0,0 +1,39 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Step+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Step+    (+    -- * The stream type+      Step (..)+    )+where++import Fusion.Plugin.Types (Fuse(..))++-- | A stream is a succession of 'Step's. A 'Yield' produces a single value and+-- the next state of the stream. 'Stop' indicates there are no more values in+-- the stream.+{-# ANN type Step Fuse #-}+data Step s a = Yield a s | Skip s | Stop++instance Functor (Step s) where+    {-# INLINE fmap #-}+    fmap f (Yield x s) = Yield (f x) s+    fmap _ (Skip s) = Skip s+    fmap _ Stop = Stop++{-+fromPure :: Monad m => a -> s -> m (Step s a)+fromPure a = return . Yield a++skip :: Monad m => s -> m (Step s a)+skip = return . Skip++stop :: Monad m => m (Step s a)+stop = return Stop+-}
src/Streamly/Internal/Data/Stream/StreamD.hs view
@@ -5,38 +5,12 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC------ Direct style re-implementation of CPS stream in--- "Streamly.Internal.Data.Stream.StreamK".  The symbol or suffix 'D' in this--- module denotes the "Direct" style.  GHC is able to INLINE and fuse direct--- style better, providing better performance than CPS implementation.------ @--- import qualified Streamly.Internal.Data.Stream.StreamD as D--- @  module Streamly.Internal.Data.Stream.StreamD+{-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream\" instead." #-}     (-      module Streamly.Internal.Data.Stream.StreamD.Type-    , module Streamly.Internal.Data.Stream.StreamD.Generate-    , module Streamly.Internal.Data.Stream.StreamD.Eliminate-    , module Streamly.Internal.Data.Stream.StreamD.Exception-    , module Streamly.Internal.Data.Stream.StreamD.Lift-    , module Streamly.Internal.Data.Stream.StreamD.Transformer-    , module Streamly.Internal.Data.Stream.StreamD.Nesting-    , module Streamly.Internal.Data.Stream.StreamD.Transform-    , module Streamly.Internal.Data.Stream.StreamD.Top-    , module Streamly.Internal.Data.Stream.StreamD.Container+      module Streamly.Internal.Data.Stream     ) where -import Streamly.Internal.Data.Stream.StreamD.Type-import Streamly.Internal.Data.Stream.StreamD.Generate-import Streamly.Internal.Data.Stream.StreamD.Eliminate-import Streamly.Internal.Data.Stream.StreamD.Exception-import Streamly.Internal.Data.Stream.StreamD.Lift-import Streamly.Internal.Data.Stream.StreamD.Transformer-import Streamly.Internal.Data.Stream.StreamD.Nesting-import Streamly.Internal.Data.Stream.StreamD.Transform-import Streamly.Internal.Data.Stream.StreamD.Top-import Streamly.Internal.Data.Stream.StreamD.Container+import Streamly.Internal.Data.Stream
− src/Streamly/Internal/Data/Stream/StreamD/Container.hs 
@@ -1,302 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Container--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Stream operations that require transformers or containers like Set or Map.--module Streamly.Internal.Data.Stream.StreamD.Container-    (-      nub--    -- * Joins for unconstrained types-    , joinLeftGeneric-    , joinOuterGeneric--    -- * Joins with Ord constraint-    , joinInner-    , joinLeft-    , joinOuter-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.State.Strict (get, put)-import Data.Function ((&))-import Data.Maybe (isJust)-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))-import Streamly.Internal.Data.Stream.StreamD.Type-    (Stream(..), mkCross, unCross)--import qualified Data.Map.Strict as Map-import qualified Data.Set as Set-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.Data.Array.Generic as Array-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as Stream--#include "DocTestDataStream.hs"---- | The memory used is proportional to the number of unique elements in the--- stream. If we want to limit the memory we can just use "take" to limit the--- uniq elements in the stream.-{-# INLINE_NORMAL nub #-}-nub :: (Monad m, Ord a) => Stream m a -> Stream m a-nub (Stream step1 state1) = Stream step (Set.empty, state1)--    where--    step gst (set, st) = do-        r <- step1 gst st-        return-            $ case r of-                Yield x s ->-                    if Set.member x set-                    then Skip (set, s)-                    else Yield x (Set.insert x set, s)-                Skip s -> Skip (set, s)-                Stop -> Stop---- XXX Generate error if a duplicate insertion is attempted?-toMap ::  (Monad m, Ord k) => Stream m (k, v) -> m (Map.Map k v)-toMap =-    let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty-     in Stream.fold f---- If the second stream is too big it can be partitioned based on hashes and--- then we can process one parition at a time.------ XXX An IntMap may be faster when the keys are Int.--- XXX Use hashmap instead of map?------ | Like 'joinInner' but uses a 'Map' for efficiency.------ If the input streams have duplicate keys, the behavior is undefined.------ For space efficiency use the smaller stream as the second stream.------ Space: O(n)------ Time: O(m + n)------ /Pre-release/-{-# INLINE joinInner #-}-joinInner :: (Monad m, Ord k) =>-    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)-joinInner s1 s2 =-    Stream.concatEffect $ do-        km <- toMap s2-        pure $ Stream.mapMaybe (joinAB km) s1--    where--    joinAB kvm (k, a) =-        case k `Map.lookup` kvm of-            Just b -> Just (k, a, b)-            Nothing -> Nothing---- XXX We can do this concurrently.--- XXX If the second stream is sorted and passed as an Array or a seek capable--- stream then we could use binary search if we have an Ord instance or--- Ordering returning function. The time complexity would then become (m x log--- n).---- XXX Check performance of StreamD vs StreamK---- | Like 'joinInner' but emit @(a, Just b)@, and additionally, for those @a@'s--- that are not equal to any @b@ emit @(a, Nothing)@.------ The second stream is evaluated multiple times. If the stream is a--- consume-once stream then the caller should cache it in an 'Data.Array.Array'--- before calling this function. Caching may also improve performance if the--- stream is expensive to evaluate.------ >>> joinRightGeneric eq = flip (Stream.joinLeftGeneric eq)------ Space: O(n) assuming the second stream is cached in memory.------ Time: O(m x n)------ /Unimplemented/-{-# INLINE joinLeftGeneric #-}-joinLeftGeneric :: Monad m =>-    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)-joinLeftGeneric eq s1 s2 = Stream.evalStateT (return False) $ unCross $ do-    a <- mkCross (Stream.liftInner s1)-    -- XXX should we use StreamD monad here?-    -- XXX Is there a better way to perform some action at the end of a loop-    -- iteration?-    mkCross (Stream.fromEffect $ put False)-    let final = Stream.concatEffect $ do-            r <- get-            if r-            then pure Stream.nil-            else pure (Stream.fromPure Nothing)-    b <- mkCross (fmap Just (Stream.liftInner s2) `Stream.append` final)-    case b of-        Just b1 ->-            if a `eq` b1-            then do-                mkCross (Stream.fromEffect $ put True)-                return (a, Just b1)-            else mkCross Stream.nil-        Nothing -> return (a, Nothing)---- XXX rename to joinLeftOrd?---- | A more efficient 'joinLeft' using a hashmap for efficiency.------ Space: O(n)------ Time: O(m + n)------ /Pre-release/-{-# INLINE joinLeft #-}-joinLeft :: (Ord k, Monad m) =>-    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)-joinLeft s1 s2 =-    Stream.concatEffect $ do-        km <- toMap s2-        return $ fmap (joinAB km) s1--            where--            joinAB km (k, a) =-                case k `Map.lookup` km of-                    Just b -> (k, a, Just b)-                    Nothing -> (k, a, Nothing)---- XXX We can do this concurrently.---- XXX Check performance of StreamD vs StreamK---- | Like 'joinLeft' but emits a @(Just a, Just b)@. Like 'joinLeft', for those--- @a@'s that are not equal to any @b@ emit @(Just a, Nothing)@, but--- additionally, for those @b@'s that are not equal to any @a@ emit @(Nothing,--- Just b)@.------ For space efficiency use the smaller stream as the second stream.------ Space: O(n)------ Time: O(m x n)------ /Pre-release/-{-# INLINE joinOuterGeneric #-}-joinOuterGeneric :: MonadIO m =>-       (a -> b -> Bool)-    -> Stream m a-    -> Stream m b-    -> Stream m (Maybe a, Maybe b)-joinOuterGeneric eq s1 s =-    Stream.concatEffect $ do-        inputArr <- Array.fromStream s-        let len = Array.length inputArr-        foundArr <--            Stream.fold-            (MA.writeN len)-            (Stream.fromList (Prelude.replicate len False))-        return $ go inputArr foundArr `Stream.append` leftOver inputArr foundArr--    where--    leftOver inputArr foundArr =-            let stream1 = Array.read inputArr-                stream2 = Stream.unfold MA.reader foundArr-            in Stream.filter-                    isJust-                    ( Stream.zipWith (\x y ->-                        if y-                        then Nothing-                        else Just (Nothing, Just x)-                        ) stream1 stream2-                    ) & Stream.catMaybes--    evalState = Stream.evalStateT (return False) . unCross--    go inputArr foundArr = evalState $ do-        a <- mkCross (Stream.liftInner s1)-        -- XXX should we use StreamD monad here?-        -- XXX Is there a better way to perform some action at the end of a loop-        -- iteration?-        mkCross (Stream.fromEffect $ put False)-        let final = Stream.concatEffect $ do-                r <- get-                if r-                then pure Stream.nil-                else pure (Stream.fromPure Nothing)-        (i, b) <--            let stream = Array.read inputArr-             in mkCross-                (Stream.indexed $ fmap Just (Stream.liftInner stream) `Stream.append` final)--        case b of-            Just b1 ->-                if a `eq` b1-                then do-                    mkCross (Stream.fromEffect $ put True)-                    MA.putIndex i foundArr True-                    return (Just a, Just b1)-                else mkCross Stream.nil-            Nothing -> return (Just a, Nothing)---- Put the b's that have been paired, in another hash or mutate the hash to set--- a flag. At the end go through @Stream m b@ and find those that are not in that--- hash to return (Nothing, b).---- | Like 'joinOuter' but uses a 'Map' for efficiency.------ Space: O(m + n)------ Time: O(m + n)------ /Pre-release/-{-# INLINE joinOuter #-}-joinOuter ::-    (Ord k, MonadIO m) =>-    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)-joinOuter s1 s2 =-    Stream.concatEffect $ do-        km1 <- kvFold s1-        km2 <- kvFold s2--        -- XXX Not sure if toList/fromList would fuse optimally. We may have to-        -- create a fused Map.toStream function.-        let res1 = fmap (joinAB km2)-                        $ Stream.fromList $ Map.toList km1-                    where-                    joinAB km (k, a) =-                        case k `Map.lookup` km of-                            Just b -> (k, Just a, Just b)-                            Nothing -> (k, Just a, Nothing)--        -- XXX We can take advantage of the lookups in the first pass above to-        -- reduce the number of lookups in this pass. If we keep mutable cells-        -- in the second Map, we can flag it in the first pass and not do any-        -- lookup in the second pass if it is flagged.-        let res2 = Stream.mapMaybe (joinAB km1)-                        $ Stream.fromList $ Map.toList km2-                    where-                    joinAB km (k, b) =-                        case k `Map.lookup` km of-                            Just _ -> Nothing-                            Nothing -> Just (k, Nothing, Just b)--        return $ Stream.append res1 res2--        where--        -- XXX Generate error if a duplicate insertion is attempted?-        kvFold =-            let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty-             in Stream.fold f
− src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs 
@@ -1,833 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Eliminate--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC---- A few functions in this module have been adapted from the vector package--- (c) Roman Leshchinskiy.----module Streamly.Internal.Data.Stream.StreamD.Eliminate-    (-    -- * Running a 'Fold'-      fold--    -- -- * Running a 'Parser'-    , parse-    , parseD-    , parseBreak-    , parseBreakD--    -- * Stream Deconstruction-    , uncons--    -- * Right Folds-    , foldrM-    , foldr-    , foldrMx-    , foldr1--    -- * Left Folds-    , foldlM'-    , foldl'-    , foldlMx'-    , foldlx'--    -- * Specific Fold Functions-    , drain-    , mapM_ -- Map and Fold-    , null-    , head-    , headElse-    , tail-    , last-    , elem-    , notElem-    , all-    , any-    , maximum-    , maximumBy-    , minimum-    , minimumBy-    , lookup-    , findM-    , find-    , (!!)-    , the--    -- * To containers-    , toList-    , toListRev--    -- * Multi-Stream Folds-    -- ** Comparisons-    -- | These should probably be expressed using zipping operations.-    , eqBy-    , cmpBy--    -- ** Substreams-    -- | These should probably be expressed using parsers.-    , isPrefixOf-    , isInfixOf-    , isSuffixOf-    , isSuffixOfUnbox-    , isSubsequenceOf-    , stripPrefix-    , stripSuffix-    , stripSuffixUnbox-    )-where--#include "inline.hs"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Foreign.Storable (Storable)-import GHC.Exts (SpecConstrAnnotation(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.SVar.Type (defState)-import Streamly.Internal.Data.Unboxed (Unbox)--import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as StreamD-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as StreamD--import Prelude hiding-       ( all, any, elem, foldr, foldr1, head, last, lookup, mapM, mapM_-       , maximum, minimum, notElem, null, splitAt, tail, (!!))-import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Elimination by Folds------------------------------------------------------------------------------------------------------------------------------------------------------------------ Right Folds---------------------------------------------------------------------------------{-# INLINE_NORMAL foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)-foldr1 f m = do-     r <- uncons m-     case r of-         Nothing   -> return Nothing-         Just (h, t) -> fmap Just (foldr f h t)----------------------------------------------------------------------------------- Parsers----------------------------------------------------------------------------------- Inlined definition. Without the inline "serially/parser/take" benchmark--- degrades and parseMany does not fuse. Even using "inline" at the callsite--- does not help.-{-# INLINE splitAt #-}-splitAt :: Int -> [a] -> ([a],[a])-splitAt n ls-  | n <= 0 = ([], ls)-  | otherwise          = splitAt' n ls-    where-        splitAt' :: Int -> [a] -> ([a], [a])-        splitAt' _  []     = ([], [])-        splitAt' 1  (x:xs) = ([x], xs)-        splitAt' m  (x:xs) = (x:xs', xs'')-          where-            (xs', xs'') = splitAt' (m - 1) xs---- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need--- to make a newtype.-{-# ANN type List NoSpecConstr #-}-newtype List a = List {getList :: [a]}---- | Run a 'Parse' over a stream.-{-# INLINE_NORMAL parseD #-}-parseD-    :: Monad m-    => PRD.Parser a m b-    -> Stream m a-    -> m (Either ParseError b)-parseD parser strm = do-    (b, _) <- parseBreakD parser strm-    return b---- | Parse a stream using the supplied 'Parser'.------ Parsers (See "Streamly.Internal.Data.Parser") are more powerful folds that--- add backtracking and error functionality to terminating folds. Unlike folds,--- parsers may not always result in a valid output, they may result in an--- error.  For example:------ >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil--- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0")------ Note: @parse p@ is not the same as  @head . parseMany p@ on an empty stream.----{-# INLINE [3] parse #-}-parse :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b)-parse = parseD---- XXX It may be a good idea to use constant sized chunks for backtracking. We--- can take a byte stream but when we have to backtrack we create constant--- sized chunks. We maintain one forward list and one backward list of constant--- sized chunks, and a last backtracking offset. That way we just need lists of--- contents and no need to maintain start/end pointers for individual arrays,--- reducing bookkeeping work.---- | Run a 'Parse' over a stream and return rest of the Stream.-{-# INLINE_NORMAL parseBreakD #-}-parseBreakD-    :: Monad m-    => PRD.Parser a m b-    -> Stream m a-    -> m (Either ParseError b, Stream m a)-parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do-    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    where--    -- "buf" 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 !_ st buf !pst = do-        r <- step defState st-        case r of-            Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 -> go SPEC s (List []) pst1-                    PR.Partial 1 pst1 -> go1 SPEC s x pst1-                    PR.Partial n pst1 -> do-                        assert (n <= length (x:getList buf)) (return ())-                        let src0 = Prelude.take n (x:getList buf)-                            src  = Prelude.reverse src0-                        gobuf SPEC s (List []) (List src) pst1-                    PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1-                    PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1-                    PR.Continue n pst1 -> do-                        assert (n <= length (x:getList buf)) (return ())-                        let (src0, buf1) = splitAt n (x:getList buf)-                            src  = Prelude.reverse src0-                        gobuf SPEC s (List buf1) (List src) pst1-                    PR.Done 0 b -> return (Right b, Stream step s)-                    PR.Done n b -> do-                        assert (n <= length (x:getList buf)) (return ())-                        let src0 = Prelude.take n (x:getList buf)-                            src  = Prelude.reverse src0-                        -- XXX This would make it quadratic. We should probably-                        -- use StreamK if we have to append many times.-                        return-                            ( Right b,-                              Nesting.append (fromList src) (Stream step s))-                    PR.Error err ->-                        return (Left (ParseError err), Stream step s)-            Skip s -> go SPEC s buf pst-            Stop -> goStop SPEC buf pst--    go1 _ s x !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                go SPEC s (List []) pst1-            PR.Partial 1 pst1 -> do-                go1 SPEC s x pst1-            PR.Partial n _ ->-                error $ "parseBreak: parser bug, go1: Partial n = " ++ show n-            PR.Continue 0 pst1 ->-                go SPEC s (List [x]) pst1-            PR.Continue 1 pst1 ->-                go1 SPEC s x pst1-            PR.Continue n _ -> do-                error $ "parseBreak: parser bug, go1: Continue n = " ++ show n-            PR.Done 0 b -> do-                return (Right b, Stream step s)-            PR.Done 1 b -> do-                return (Right b, StreamD.cons x (Stream step s))-            PR.Done n _ -> do-                error $ "parseBreak: parser bug, go1: Done n = " ++ show n-            PR.Error err ->-                return-                    ( Left (ParseError err)-                    , Nesting.append (fromPure x) (Stream step s)-                    )--    gobuf !_ s buf (List []) !pst = go SPEC s buf pst-    gobuf !_ s buf (List (x:xs)) !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                gobuf SPEC s (List []) (List xs) pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC s (List []) (List src) pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC s (List (x:getList buf)) (List xs) pst1-            PR.Continue 1 pst1 ->-                gobuf SPEC s buf (List (x:xs)) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let (src0, buf1) = splitAt n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC s (List buf1) (List src) pst1-            PR.Done n b -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0-                return (Right b, Nesting.append (fromList src) (Stream step s))-            PR.Error err ->-                return-                    ( Left (ParseError err)-                    , Nesting.append (fromList (x:xs)) (Stream step s)-                    )--    -- This is simplified gobuf-    goExtract !_ buf (List []) !pst = goStop SPEC buf pst-    goExtract !_ buf (List (x:xs)) !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                goExtract SPEC (List []) (List xs) pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC (List []) (List src) pst1-            PR.Continue 0 pst1 ->-                goExtract SPEC (List (x:getList buf)) (List xs) pst1-            PR.Continue 1 pst1 ->-                goExtract SPEC buf (List (x:xs)) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let (src0, buf1) = splitAt n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC (List buf1) (List src) pst1-            PR.Done n b -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0-                return (Right b, fromList src)-            PR.Error err -> return (Left (ParseError err), fromList (x:xs))--    -- This is simplified goExtract-    -- XXX Use SPEC?-    {-# INLINE goStop #-}-    goStop _ buf pst = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-            PR.Continue 0 pst1 -> goStop SPEC buf pst1-            PR.Continue n pst1 -> do-                assert (n <= length (getList buf)) (return ())-                let (src0, buf1) = splitAt n (getList buf)-                    src = Prelude.reverse src0-                goExtract SPEC (List buf1) (List src) pst1-            PR.Done 0 b -> return (Right b, StreamD.nil)-            PR.Done n b -> do-                assert (n <= length (getList buf)) (return ())-                let src0 = Prelude.take n (getList buf)-                    src  = Prelude.reverse src0-                return (Right b, fromList src)-            PR.Error err ->-                return (Left (ParseError err), StreamD.nil)---- | Parse a stream using the supplied 'Parser'.----{-# INLINE parseBreak #-}-parseBreak :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)-parseBreak = parseBreakD----------------------------------------------------------------------------------- Specialized Folds----------------------------------------------------------------------------------- benchmark after dropping 1 item from stream or using unfolds-{-# INLINE_NORMAL null #-}-null :: Monad m => Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-null = fold Fold.null-#else-null = foldrM (\_ _ -> return False) (return True)-#endif--{-# INLINE_NORMAL head #-}-head :: Monad m => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-head = fold Fold.one-#else-head = foldrM (\x _ -> return (Just x)) (return Nothing)-#endif--{-# INLINE_NORMAL headElse #-}-headElse :: Monad m => a -> Stream m a -> m a-headElse a = foldrM (\x _ -> return x) (return a)---- Does not fuse, has the same performance as the StreamK version.-{-# INLINE_NORMAL tail #-}-tail :: Monad m => Stream m a -> m (Maybe (Stream m a))-tail (UnStream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield _ s -> return (Just $ Stream step s)-            Skip  s   -> go SPEC s-            Stop      -> return Nothing---- XXX will it fuse? need custom impl?-{-# INLINE_NORMAL last #-}-last :: Monad m => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-last = fold Fold.last-#else-last = foldl' (\_ y -> Just y) Nothing-#endif---- XXX Use the foldrM based impl instead-{-# INLINE_NORMAL elem #-}-elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-elem e = fold (Fold.elem e)-#else--- elem e m = foldrM (\x xs -> if x == e then return True else xs) (return False) m-elem e (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s-              | x == e -> return True-              | otherwise -> go SPEC s-            Skip s -> go SPEC s-            Stop   -> return False-#endif--{-# INLINE_NORMAL notElem #-}-notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-notElem e s = fmap not (elem e s)--{-# INLINE_NORMAL all #-}-all :: Monad m => (a -> Bool) -> Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-all p = fold (Fold.all p)-#else--- all p m = foldrM (\x xs -> if p x then xs else return False) (return True) m-all p (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s-              | p x -> go SPEC s-              | otherwise -> return False-            Skip s -> go SPEC s-            Stop   -> return True-#endif--{-# INLINE_NORMAL any #-}-any :: Monad m => (a -> Bool) -> Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-any p = fold (Fold.any p)-#else--- any p m = foldrM (\x xs -> if p x then return True else xs) (return False) m-any p (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s-              | p x -> return True-              | otherwise -> go SPEC s-            Skip s -> go SPEC s-            Stop   -> return False-#endif--{-# INLINE_NORMAL maximum #-}-maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-maximum = fold Fold.maximum-#else-maximum (Stream step state) = go SPEC Nothing' state-  where-    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s-              | acc <= x  -> go SPEC (Just' x) s-              | otherwise -> go SPEC (Just' acc) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-maximumBy cmp = fold (Fold.maximumBy cmp)-#else-maximumBy cmp (Stream step state) = go SPEC Nothing' state-  where-    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s -> case cmp acc x of-                GT -> go SPEC (Just' acc) s-                _  -> go SPEC (Just' x) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL minimum #-}-minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-minimum = fold Fold.minimum-#else-minimum (Stream step state) = go SPEC Nothing' state--    where--    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s-              | acc <= x  -> go SPEC (Just' acc) s-              | otherwise -> go SPEC (Just' x) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL minimumBy #-}-minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-minimumBy cmp = fold (Fold.minimumBy cmp)-#else-minimumBy cmp (Stream step state) = go SPEC Nothing' state--    where--    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s -> case cmp acc x of-                GT -> go SPEC (Just' x) s-                _  -> go SPEC (Just' acc) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL (!!) #-}-(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-stream !! i = fold (Fold.index i) stream-#else-(Stream step state) !! i = go SPEC i state--    where--    go !_ !n st = do-        r <- step defState st-        case r of-            Yield x s | n < 0 -> return Nothing-                      | n == 0 -> return $ Just x-                      | otherwise -> go SPEC (n - 1) s-            Skip s -> go SPEC n s-            Stop   -> return Nothing-#endif--{-# INLINE_NORMAL lookup #-}-lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)-#ifdef USE_FOLDS_EVERYWHERE-lookup e = fold (Fold.lookup e)-#else-lookup e = foldrM (\(a, b) xs -> if e == a then return (Just b) else xs)-                   (return Nothing)-#endif--{-# INLINE_NORMAL findM #-}-findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-findM p = fold (Fold.findM p)-#else-findM p = foldrM (\x xs -> p x >>= \r -> if r then return (Just x) else xs)-                   (return Nothing)-#endif--{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)-find p = findM (return . p)--{-# INLINE toListRev #-}-toListRev :: Monad m => Stream m a -> m [a]-#ifdef USE_FOLDS_EVERYWHERE-toListRev = fold Fold.toListRev-#else-toListRev = foldl' (flip (:)) []-#endif----------------------------------------------------------------------------------- Transformation comprehensions---------------------------------------------------------------------------------{-# INLINE_NORMAL the #-}-the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-the = fold Fold.the-#else-the (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s -> go' SPEC x s-            Skip s    -> go SPEC s-            Stop      -> return Nothing-    go' !_ n st = do-        r <- step defState st-        case r of-            Yield x s | x == n -> go' SPEC n s-                      | otherwise -> return Nothing-            Skip s -> go' SPEC n s-            Stop   -> return (Just n)-#endif----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- | Execute a monadic action for each element of the 'Stream'-{-# INLINE_NORMAL mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()-#ifdef USE_FOLDS_EVERYWHERE-mapM_ f = fold (Fold.drainBy f)-#else-mapM_ m = drain . mapM m-#endif----------------------------------------------------------------------------------- Multi-stream folds----------------------------------------------------------------------------------- | Returns 'True' if the first stream is the same as or a prefix of the--- second. A stream is a prefix of itself.------ >>> Stream.isPrefixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char)--- True----{-# INLINE_NORMAL isPrefixOf #-}-isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb--    where--    go !_ Nothing' sa sb = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go SPEC (Just' x) sa' sb-            Skip sa'    -> go SPEC Nothing' sa' sb-            Stop        -> return True--    go !_ (Just' x) sa sb = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go SPEC Nothing' sa sb'-                    else return False-            Skip sb' -> go SPEC (Just' x) sa sb'-            Stop     -> return False---- | Returns 'True' if all the elements of the first stream occur, in order, in--- the second stream. The elements do not have to occur consecutively. A stream--- is a subsequence of itself.------ >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char)--- True----{-# INLINE_NORMAL isSubsequenceOf #-}-isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb--    where--    go !_ Nothing' sa sb = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go SPEC (Just' x) sa' sb-            Skip sa' -> go SPEC Nothing' sa' sb-            Stop -> return True--    go !_ (Just' x) sa sb = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go SPEC Nothing' sa sb'-                    else go SPEC (Just' x) sa sb'-            Skip sb' -> go SPEC (Just' x) sa sb'-            Stop -> return False---- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@--- stream if it is a prefix of input. Returns 'Nothing' if the input does not--- start with the given prefix, stripped input otherwise. Returns @Just nil@--- when the prefix is the same as the input stream.------ Space: @O(1)@----{-# INLINE_NORMAL stripPrefix #-}-stripPrefix-    :: (Monad m, Eq a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb--    where--    go !_ Nothing' sa sb = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go SPEC (Just' x) sa' sb-            Skip sa'    -> go SPEC Nothing' sa' sb-            Stop        -> return $ Just (Stream stepb sb)--    go !_ (Just' x) sa sb = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go SPEC Nothing' sa sb'-                    else return Nothing-            Skip sb' -> go SPEC (Just' x) sa sb'-            Stop     -> return Nothing---- | Returns 'True' if the first stream is an infix of the second. A stream is--- considered an infix of itself.------ >>> s = Stream.fromList "hello" :: Stream IO Char--- >>> Stream.isInfixOf s s--- True------ Space: @O(n)@ worst case where @n@ is the length of the infix.------ /Pre-release/------ /Requires 'Storable' constraint/----{-# INLINE isInfixOf #-}-isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)-    => Stream m a -> Stream m a -> m Bool-isInfixOf infx stream = do-    arr <- fold Array.write infx-    -- XXX can use breakOnSeq instead (when available)-    r <- null $ StreamD.drop 1 $ Nesting.splitOnSeq arr Fold.drain stream-    return (not r)---- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf--- may use the suffix stream many times. To run in optimal memory we do not--- want to buffer the suffix stream in memory therefore  we need an ability to--- clone (or consume it multiple times) the suffix stream without any side--- effects so that multiple potential suffix matches can proceed in parallel--- without buffering the suffix stream. For example, we may create the suffix--- stream from a file handle, however, if we evaluate the stream multiple--- times, once for each match, we will need a different file handle each time--- which may exhaust the file descriptors. Instead, we want to share the same--- underlying file descriptor, use pread on it to generate the stream and clone--- the stream for each match. Therefore the suffix stream should be built in--- such a way that it can be consumed multiple times without any problems.---- XXX Can be implemented with better space/time complexity.--- Space: @O(n)@ worst case where @n@ is the length of the suffix.---- | Returns 'True' if the first stream is a suffix of the second. A stream is--- considered a suffix of itself.------ >>> Stream.isSuffixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char)--- True------ Space: @O(n)@, buffers entire input stream and the suffix.------ /Pre-release/------ /Suboptimal/ - Help wanted.----{-# INLINE isSuffixOf #-}-isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSuffixOf suffix stream =-    StreamD.reverse suffix `isPrefixOf` StreamD.reverse stream---- | Much faster than 'isSuffixOf'.-{-# INLINE isSuffixOfUnbox #-}-isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) =>-    Stream m a -> Stream m a -> m Bool-isSuffixOfUnbox suffix stream =-    StreamD.reverseUnbox suffix `isPrefixOf` StreamD.reverseUnbox stream---- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does--- not end with the given suffix. Returns @Just nil@ when the suffix is the--- same as the stream.------ It may be more efficient to convert the stream to an Array and use--- stripSuffix on that especially if the elements have a Storable or Prim--- instance.------ See also "Streamly.Internal.Data.Stream.Reduce.dropSuffix".------ Space: @O(n)@, buffers the entire input stream as well as the suffix------ /Pre-release/-{-# INLINE stripSuffix #-}-stripSuffix-    :: (Monad m, Eq a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripSuffix m1 m2 =-    fmap StreamD.reverse-        <$> stripPrefix (StreamD.reverse m1) (StreamD.reverse m2)---- | Much faster than 'stripSuffix'.-{-# INLINE stripSuffixUnbox #-}-stripSuffixUnbox-    :: (MonadIO m, Eq a, Unbox a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripSuffixUnbox m1 m2 =-    fmap StreamD.reverseUnbox-        <$> stripPrefix (StreamD.reverseUnbox m1) (StreamD.reverseUnbox m2)
− src/Streamly/Internal/Data/Stream/StreamD/Exception.hs 
@@ -1,479 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Exception--- Copyright   : (c) 2020 Composewell Technologies and Contributors--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.StreamD.Exception-    (-      gbracket_-    , gbracket-    , before-    , afterUnsafe-    , afterIO-    , bracketUnsafe-    , bracketIO3-    , bracketIO-    , onException-    , finallyUnsafe-    , finallyIO-    , ghandle-    , handle-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Control.Exception (Exception, SomeException, mask_)-import Control.Monad.Catch (MonadCatch)-import GHC.Exts (inline)-import Streamly.Internal.Data.IOFinalizer-    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)--import qualified Control.Monad.Catch as MC--import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"--data GbracketState s1 s2 v-    = GBracketInit-    | GBracketNormal s1 v-    | GBracketException s2---- | Like 'gbracket' but with following differences:------ * alloc action @m c@ runs with async exceptions enabled--- * cleanup action @c -> m d@ won't run if the stream is garbage collected---   after partial evaluation.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL gbracket_ #-}-gbracket_-    :: Monad m-    => m c                                  -- ^ before-    -> (c -> m d)                           -- ^ after, on normal stop-    -> (c -> e -> Stream m b -> Stream m b) -- ^ on exception-    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)-    -> (c -> Stream m b)                    -- ^ stream generator-    -> Stream m b-gbracket_ bef aft onExc ftry action =-    Stream step GBracketInit--    where--    {-# INLINE_LATE step #-}-    step _ GBracketInit = do-        r <- bef-        return $ Skip $ GBracketNormal (action r) r--    step gst (GBracketNormal (UnStream step1 st) v) = do-        res <- ftry $ step1 gst st-        case res of-            Right r -> case r of-                Yield x s ->-                    return $ Yield x (GBracketNormal (Stream step1 s) v)-                Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)-                Stop -> aft v >> return Stop-            -- XXX Do not handle async exceptions, just rethrow them.-            Left e ->-                return-                    $ Skip (GBracketException (onExc v e (UnStream step1 st)))-    step gst (GBracketException (UnStream step1 st)) = do-        res <- step1 gst st-        case res of-            Yield x s -> return $ Yield x (GBracketException (Stream step1 s))-            Skip s    -> return $ Skip (GBracketException (Stream step1 s))-            Stop      -> return Stop--data GbracketIOState s1 s2 v wref-    = GBracketIOInit-    | GBracketIONormal s1 v wref-    | GBracketIOException s2---- | Run the alloc action @m c@ with async exceptions disabled but keeping--- blocking operations interruptible (see 'Control.Exception.mask').  Use the--- output @c@ as input to @c -> Stream m b@ to generate an output stream. When--- generating the stream use the supplied @try@ operation @forall s. m s -> m--- (Either e s)@ to catch synchronous exceptions. If an exception occurs run--- the exception handler @c -> e -> Stream m b -> m (Stream m b)@. Note that--- 'gbracket' does not rethrow the exception, it has to be done by the--- exception handler if desired.------ The cleanup action @c -> m d@, runs whenever the stream ends normally, due--- to a sync or async exception or if it gets garbage collected after a partial--- lazy evaluation.  See 'bracket' for the semantics of the cleanup action.------ 'gbracket' can express all other exception handling combinators.------ /Inhibits stream fusion/------ /Pre-release/-{-# INLINE_NORMAL gbracket #-}-gbracket-    :: MonadIO m-    => IO c -- ^ before-    -> (c -> IO d1) -- ^ on normal stop-    -> (c -> e -> Stream m b -> IO (Stream m b)) -- ^ on exception-    -> (c -> IO d2) -- ^ on GC without normal stop or exception-    -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)-    -> (c -> Stream m b) -- ^ stream generator-    -> Stream m b-gbracket bef aft onExc onGC ftry action =-    Stream step GBracketIOInit--    where--    -- If the stream is never evaluated the "aft" action will never be-    -- called. For that to occur we will need the user of this API to pass a-    -- weak pointer to us.-    {-# INLINE_LATE step #-}-    step _ GBracketIOInit = do-        -- We mask asynchronous exceptions to make the execution-        -- of 'bef' and the registration of 'aft' atomic.-        -- A similar thing is done in the resourcet package: https://git.io/JvKV3-        -- Tutorial: https://markkarpov.com/tutorial/exceptions.html-        (r, ref) <- liftIO $ mask_ $ do-            r <- bef-            ref <- newIOFinalizer (onGC r)-            return (r, ref)-        return $ Skip $ GBracketIONormal (action r) r ref--    step gst (GBracketIONormal (UnStream step1 st) v ref) = do-        res <- ftry $ step1 gst st-        case res of-            Right r -> case r of-                Yield x s ->-                    return $ Yield x (GBracketIONormal (Stream step1 s) v ref)-                Skip s ->-                    return $ Skip (GBracketIONormal (Stream step1 s) v ref)-                Stop ->-                    liftIO (clearingIOFinalizer ref (aft v)) >> return Stop-            -- XXX Do not handle async exceptions, just rethrow them.-            Left e -> do-                -- Clearing of finalizer and running of exception handler must-                -- be atomic wrt async exceptions. Otherwise if we have cleared-                -- the finalizer and have not run the exception handler then we-                -- may leak the resource.-                stream <--                    liftIO (clearingIOFinalizer ref (onExc v e (UnStream step1 st)))-                return $ Skip (GBracketIOException stream)-    step gst (GBracketIOException (UnStream step1 st)) = do-        res <- step1 gst st-        case res of-            Yield x s ->-                return $ Yield x (GBracketIOException (Stream step1 s))-            Skip s    -> return $ Skip (GBracketIOException (Stream step1 s))-            Stop      -> return Stop---- | Run the action @m b@ before the stream yields its first element.------ Same as the following but more efficient due to fusion:------ >>> before action xs = Stream.nilM action <> xs--- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action)----{-# INLINE_NORMAL before #-}-before :: Monad m => m b -> Stream m a -> Stream m a-before action (Stream step state) = Stream step' Nothing--    where--    {-# INLINE_LATE step' #-}-    step' _ Nothing = action >> return (Skip (Just state))--    step' gst (Just st) = do-        res <- step gst st-        case res of-            Yield x s -> return $ Yield x (Just s)-            Skip s    -> return $ Skip (Just s)-            Stop      -> return Stop---- | Like 'after', with following differences:------ * action @m b@ won't run if the stream is garbage collected---   after partial evaluation.--- * Monad @m@ does not require any other constraints.--- * has slightly better performance than 'after'.------ Same as the following, but with stream fusion:------ >>> afterUnsafe action xs = xs <> Stream.nilM action------ /Pre-release/----{-# INLINE_NORMAL afterUnsafe #-}-afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a-afterUnsafe action (Stream step state) = Stream step' state--    where--    {-# INLINE_LATE step' #-}-    step' gst st = do-        res <- step gst st-        case res of-            Yield x s -> return $ Yield x s-            Skip s    -> return $ Skip s-            Stop      -> action >> return Stop---- | Run the action @IO b@ whenever the stream is evaluated to completion, or--- if it is garbage collected after a partial lazy evaluation.------ The semantics of the action @IO b@ are similar to the semantics of cleanup--- action in 'bracketIO'.------ /See also 'afterUnsafe'/----{-# INLINE_NORMAL afterIO #-}-afterIO :: MonadIO m-    => IO b -> Stream m a -> Stream m a-afterIO action (Stream step state) = Stream step' Nothing--    where--    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        ref <- liftIO $ newIOFinalizer action-        return $ Skip $ Just (state, ref)-    step' gst (Just (st, ref)) = do-        res <- step gst st-        case res of-            Yield x s -> return $ Yield x (Just (s, ref))-            Skip s    -> return $ Skip (Just (s, ref))-            Stop      -> do-                runIOFinalizer ref-                return Stop---- XXX For high performance error checks in busy streams we may need another--- Error constructor in step.---- | Run the action @m b@ if the stream evaluation is aborted due to an--- exception. The exception is not caught, simply rethrown.------ /Inhibits stream fusion/----{-# INLINE_NORMAL onException #-}-onException :: MonadCatch m => m b -> Stream m a -> Stream m a-onException action stream =-    gbracket_-        (return ()) -- before-        return      -- after-        (\_ (e :: MC.SomeException) _ -> nilM (action >> MC.throwM e))-        (inline MC.try)-        (const stream)--{-# INLINE_NORMAL _onException #-}-_onException :: MonadCatch m => m b -> Stream m a -> Stream m a-_onException action (Stream step state) = Stream step' state--    where--    {-# INLINE_LATE step' #-}-    step' gst st = do-        res <- step gst st `MC.onException` action-        case res of-            Yield x s -> return $ Yield x s-            Skip s    -> return $ Skip s-            Stop      -> return Stop---- | Like 'bracket' but with following differences:------ * alloc action @m b@ runs with async exceptions enabled--- * cleanup action @b -> m c@ won't run if the stream is garbage collected---   after partial evaluation.--- * has slightly better performance than 'bracketIO'.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL bracketUnsafe #-}-bracketUnsafe :: MonadCatch m-    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-bracketUnsafe bef aft =-    gbracket_-        bef-        aft-        (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e))-        (inline MC.try)---- For a use case of this see the "streamly-process" package. It needs to kill--- the process in case of exception or garbage collection, but waits for the--- process to terminate in normal cases.---- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the--- mode of termination:------ 1. When the stream stops normally--- 2. When the stream is garbage collected--- 3. When the stream encounters an exception------ @bracketIO3 before onStop onGC onException action@ runs @action@ using the--- result of @before@. If the stream stops, @onStop@ action is executed, if the--- stream is abandoned @onGC@ is executed, if the stream encounters an--- exception @onException@ is executed.------ /Inhibits stream fusion/------ /Pre-release/-{-# INLINE_NORMAL bracketIO3 #-}-bracketIO3 :: (MonadIO m, MonadCatch m) =>-       IO b-    -> (b -> IO c)-    -> (b -> IO d)-    -> (b -> IO e)-    -> (b -> Stream m a)-    -> Stream m a-bracketIO3 bef aft onExc onGC =-    gbracket-        bef-        aft-        (\a (e :: SomeException) _ -> onExc a >> return (nilM (MC.throwM e)))-        onGC-        (inline MC.try)---- | Run the alloc action @IO b@ with async exceptions disabled but keeping--- blocking operations interruptible (see 'Control.Exception.mask').  Use the--- output @b@ as input to @b -> Stream m a@ to generate an output stream.------ @b@ is usually a resource under the IO monad, e.g. a file handle, that--- requires a cleanup after use. The cleanup action @b -> IO c@, runs whenever--- the stream ends normally, due to a sync or async exception or if it gets--- garbage collected after a partial lazy evaluation.------ 'bracketIO' only guarantees that the cleanup action runs, and it runs with--- async exceptions enabled. The action must ensure that it can successfully--- cleanup the resource in the face of sync or async exceptions.------ When the stream ends normally or on a sync exception, cleanup action runs--- immediately in the current thread context, whereas in other cases it runs in--- the GC context, therefore, cleanup may be delayed until the GC gets to run.------ /See also: 'bracketUnsafe'/------ /Inhibits stream fusion/----{-# INLINE bracketIO #-}-bracketIO :: (MonadIO m, MonadCatch m)-    => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a-bracketIO bef aft = bracketIO3 bef aft aft aft--data BracketState s v = BracketInit | BracketRun s v---- | Alternate (custom) implementation of 'bracket'.----{-# INLINE_NORMAL _bracket #-}-_bracket :: MonadCatch m-    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-_bracket bef aft bet = Stream step' BracketInit--    where--    {-# INLINE_LATE step' #-}-    step' _ BracketInit = bef >>= \x -> return (Skip (BracketRun (bet x) x))--    -- NOTE: It is important to use UnStream instead of the Stream pattern-    -- here, otherwise we get huge perf degradation, see note in concatMap.-    step' gst (BracketRun (UnStream step state) v) = do-        -- res <- step gst state `MC.onException` aft v-        res <- inline MC.try $ step gst state-        case res of-            Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop-            Right r -> case r of-                Yield x s -> return $ Yield x (BracketRun (Stream step s) v)-                Skip s    -> return $ Skip (BracketRun (Stream step s) v)-                Stop      -> aft v >> return Stop---- | Like 'finally' with following differences:------ * action @m b@ won't run if the stream is garbage collected---   after partial evaluation.--- * has slightly better performance than 'finallyIO'.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE finallyUnsafe #-}-finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a-finallyUnsafe action xs = bracketUnsafe (return ()) (const action) (const xs)---- | Run the action @IO b@ whenever the stream stream stops normally, aborts--- due to an exception or if it is garbage collected after a partial lazy--- evaluation.------ The semantics of running the action @IO b@ are similar to the cleanup action--- semantics described in 'bracketIO'.------ >>> finallyIO release = Stream.bracketIO (return ()) (const release)------ /See also 'finallyUnsafe'/------ /Inhibits stream fusion/----{-# INLINE finallyIO #-}-finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a-finallyIO action xs = bracketIO3 (return ()) act act act (const xs)-    where act _ = action---- | Like 'handle' but the exception handler is also provided with the stream--- that generated the exception as input. The exception handler can thus--- re-evaluate the stream to retry the action that failed. The exception--- handler can again call 'ghandle' on it to retry the action multiple times.------ This is highly experimental. In a stream of actions we can map the stream--- with a retry combinator to retry each action on failure.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL ghandle #-}-ghandle :: (MonadCatch m, Exception e)-    => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a-ghandle f stream =-    gbracket_ (return ()) return (const f) (inline MC.try) (const stream)---- | When evaluating a stream if an exception occurs, stream evaluation aborts--- and the specified exception handler is run with the exception as argument.------ /Inhibits stream fusion/----{-# INLINE_NORMAL handle #-}-handle :: (MonadCatch m, Exception e)-    => (e -> Stream m a) -> Stream m a -> Stream m a-handle f stream =-    gbracket_ (return ()) return (\_ e _ -> f e) (inline MC.try) (const stream)---- | Alternate (custom) implementation of 'handle'.----{-# INLINE_NORMAL _handle #-}-_handle :: (MonadCatch m, Exception e)-    => (e -> Stream m a) -> Stream m a -> Stream m a-_handle f (Stream step state) = Stream step' (Left state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Left st) = do-        res <- inline MC.try $ step gst st-        case res of-            Left e -> return $ Skip $ Right (f e)-            Right r -> case r of-                Yield x s -> return $ Yield x (Left s)-                Skip s    -> return $ Skip (Left s)-                Stop      -> return Stop--    step' gst (Right (UnStream step1 st)) = do-        res <- step1 gst st-        case res of-            Yield x s -> return $ Yield x (Right (Stream step1 s))-            Skip s    -> return $ Skip (Right (Stream step1 s))-            Stop      -> return Stop
− src/Streamly/Internal/Data/Stream/StreamD/Generate.hs 
@@ -1,1205 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Generate--- Copyright   : (c) 2020 Composewell Technologies and Contributors---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------- A few combinators in this module have been adapted from the vector package--- (c) Roman Leshchinskiy. See the notes in specific combinators.----module Streamly.Internal.Data.Stream.StreamD.Generate-  (-    -- * Primitives-      nil-    , nilM-    , cons-    , consM--    -- * From 'Unfold'-    , unfold--    -- * Unfolding-    , unfoldr-    , unfoldrM--    -- * From Values-    , fromPure-    , fromEffect-    , repeat-    , repeatM-    , replicate-    , replicateM--    -- * Enumeration-    -- ** Enumerating 'Num' Types-    , enumerateFromStepNum-    , enumerateFromNum-    , enumerateFromThenNum--    -- ** Enumerating 'Bounded' 'Enum' Types-    , enumerate-    , enumerateTo-    , enumerateFromBounded--    -- ** Enumerating 'Enum' Types not larger than 'Int'-    , enumerateFromToSmall-    , enumerateFromThenToSmall-    , enumerateFromThenSmallBounded--    -- ** Enumerating 'Bounded' 'Integral' Types-    , enumerateFromIntegral-    , enumerateFromThenIntegral--    -- ** Enumerating 'Integral' Types-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    -- ** Enumerating unbounded 'Integral' Types-    , enumerateFromStepIntegral--    -- ** Enumerating 'Fractional' Types-    , enumerateFromFractional-    , enumerateFromToFractional-    , enumerateFromThenFractional-    , enumerateFromThenToFractional--    -- ** Enumerable Type Class-    , Enumerable(..)--    -- * Time Enumeration-    , times-    , timesWith-    , absTimes-    , absTimesWith-    , relTimes-    , relTimesWith-    , durations-    , timeout--    -- * From Generators-    -- | Generate a monadic stream from a seed.-    , fromIndices-    , fromIndicesM-    , generate-    , generateM--    -- * Iteration-    , iterate-    , iterateM--    -- * From Containers-    -- | Transform an input structure into a stream.--    , fromList-    , fromListM-    , fromFoldable-    , fromFoldableM--    -- * From Pointers-    , fromPtr-    , fromPtrN-    , fromByteStr#--    -- * Conversions-    , fromStreamK-    , toStreamK-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity(..))-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (Storable (peek), sizeOf)-import GHC.Exts (Addr#, Ptr (Ptr))-import Streamly.Internal.Data.Time.Clock-    (Clock(Monotonic), asyncClock, readClock)-import Streamly.Internal.Data.Time.Units-    (toAbsTime, AbsTime, toRelTime64, RelTime64, addToAbsTime64)--#ifdef USE_UNFOLDS_EVERYWHERE-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Streamly.Internal.Data.Unfold.Enumeration as Unfold-#endif--import Data.Fixed-import Data.Int-import Data.Ratio-import Data.Word-import Numeric.Natural-import Prelude hiding (iterate, repeat, replicate, take, takeWhile)-import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Primitives----------------------------------------------------------------------------------- XXX implement in terms of nilM?---- | A stream that terminates without producing any output or side effect.------ >>> Stream.fold Fold.toList Stream.nil--- []----{-# INLINE_NORMAL nil #-}-nil :: Applicative m => Stream m a-nil = Stream (\_ _ -> pure Stop) ()---- XXX implement in terms of consM?--- cons x = consM (return x)---- | Fuse a pure value at the head of an existing stream::------ >>> s = 1 `Stream.cons` Stream.fromList [2,3]--- >>> Stream.fold Fold.toList s--- [1,2,3]------ This function should not be used to dynamically construct a stream. If a--- stream is constructed by successive use of this function it would take--- O(n^2) time to consume the stream.------ This function should only be used to statically fuse an element with a--- stream. Do not use this recursively or where it cannot be inlined.------ See "Streamly.Data.StreamK" for a 'cons' that can be used to--- construct a stream recursively.------ Definition:------ >>> cons x xs = return x `Stream.consM` xs----{-# INLINE_NORMAL cons #-}-cons :: Applicative m => a -> Stream m a -> Stream m a-cons x (Stream step state) = Stream step1 Nothing-    where-    {-# INLINE_LATE step1 #-}-    step1 _ Nothing = pure $ Yield x (Just state)-    step1 gst (Just st) = do-          (\case-            Yield a s -> Yield a (Just s)-            Skip  s   -> Skip (Just s)-            Stop      -> Stop) <$> step gst st----------------------------------------------------------------------------------- Unfolding----------------------------------------------------------------------------------- Adapted from vector package---- | Build a stream by unfolding a /monadic/ step function starting from a--- seed.  The step function returns the next element in the stream and the next--- seed value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ >>> :{--- let f b =---         if b > 2---         then return Nothing---         else return (Just (b, b + 1))--- in Stream.fold Fold.toList $ Stream.unfoldrM f 0--- :}--- [0,1,2]----{-# INLINE_NORMAL unfoldrM #-}-unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-unfoldrM next = unfold (Unfold.unfoldrM next)-#else-unfoldrM next = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ st = do-        r <- next st-        return $ case r of-            Just (x, s) -> Yield x s-            Nothing     -> Stop-#endif---- |--- >>> :{--- unfoldr step s =---     case step s of---         Nothing -> Stream.nil---         Just (a, b) -> a `Stream.cons` unfoldr step b--- :}------ Build a stream by unfolding a /pure/ step function @step@ starting from a--- seed @s@.  The step function returns the next element in the stream and the--- next seed value. When it is done it returns 'Nothing' and the stream ends.--- For example,------ >>> :{--- let f b =---         if b > 2---         then Nothing---         else Just (b, b + 1)--- in Stream.fold Fold.toList $ Stream.unfoldr f 0--- :}--- [0,1,2]----{-# INLINE_LATE unfoldr #-}-unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a-unfoldr f = unfoldrM (return . f)----------------------------------------------------------------------------------- From values----------------------------------------------------------------------------------- |--- >>> repeatM = Stream.sequence . Stream.repeat--- >>> repeatM = fix . Stream.consM--- >>> repeatM = cycle1 . Stream.fromEffect------ Generate a stream by repeatedly executing a monadic action forever.------ >>> :{--- repeatAction =---        Stream.repeatM (threadDelay 1000000 >> print 1)---      & Stream.take 10---      & Stream.fold Fold.drain--- :}----{-# INLINE_NORMAL repeatM #-}-repeatM :: Monad m => m a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-repeatM = unfold Unfold.repeatM-#else-repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) ()-#endif---- |--- Generate an infinite stream by repeating a pure value.------ >>> repeat x = Stream.repeatM (pure x)----{-# INLINE_NORMAL repeat #-}-repeat :: Monad m => a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-repeat x = repeatM (pure x)-#else-repeat x = Stream (\_ _ -> return $ Yield x ()) ()-#endif---- Adapted from the vector package---- |--- >>> replicateM n = Stream.sequence . Stream.replicate n------ Generate a stream by performing a monadic action @n@ times.-{-# INLINE_NORMAL replicateM #-}-replicateM :: Monad m => Int -> m a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-replicateM n p = unfold Unfold.replicateM (n, p)-#else-replicateM n p = Stream step n-  where-    {-# INLINE_LATE step #-}-    step _ (i :: Int)-      | i <= 0    = return Stop-      | otherwise = do-          x <- p-          return $ Yield x (i - 1)-#endif---- |--- >>> replicate n = Stream.take n . Stream.repeat--- >>> replicate n x = Stream.replicateM n (pure x)------ Generate a stream of length @n@ by repeating a value @n@ times.----{-# INLINE_NORMAL replicate #-}-replicate :: Monad m => Int -> a -> Stream m a-replicate n x = replicateM n (return x)----------------------------------------------------------------------------------- Enumeration of Num----------------------------------------------------------------------------------- | For floating point numbers if the increment is less than the precision then--- it just gets lost. Therefore we cannot always increment it correctly by just--- repeated addition.--- 9007199254740992 + 1 + 1 :: Double => 9.007199254740992e15--- 9007199254740992 + 2     :: Double => 9.007199254740994e15------ Instead we accumulate the increment counter and compute the increment--- every time before adding it to the starting number.------ This works for Integrals as well as floating point numbers, but--- enumerateFromStepIntegral is faster for integrals.-{-# INLINE_NORMAL enumerateFromStepNum #-}-enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromStepNum from stride =-    unfold Unfold.enumerateFromStepNum (from, stride)-#else-enumerateFromStepNum from stride = Stream step 0-    where-    {-# INLINE_LATE step #-}-    step _ !i = return $ (Yield $! (from + i * stride)) $! (i + 1)-#endif--{-# INLINE_NORMAL enumerateFromNum #-}-enumerateFromNum :: (Monad m, Num a) => a -> Stream m a-enumerateFromNum from = enumerateFromStepNum from 1--{-# INLINE_NORMAL enumerateFromThenNum #-}-enumerateFromThenNum :: (Monad m, Num a) => a -> a -> Stream m a-enumerateFromThenNum from next = enumerateFromStepNum from (next - from)----------------------------------------------------------------------------------- Enumeration of Integrals---------------------------------------------------------------------------------#ifndef USE_UNFOLDS_EVERYWHERE-data EnumState a = EnumInit | EnumYield a a a | EnumStop--{-# INLINE_NORMAL enumerateFromThenToIntegralUp #-}-enumerateFromThenToIntegralUp-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegralUp from next to = Stream step EnumInit-    where-    {-# INLINE_LATE step #-}-    step _ EnumInit =-        return $-            if to < next-            then if to < from-                 then Stop-                 else Yield from EnumStop-            else -- from <= next <= to-                let stride = next - from-                in Skip $ EnumYield from stride (to - stride)--    step _ (EnumYield x stride toMinus) =-        return $-            if x > toMinus-            then Yield x EnumStop-            else Yield x $ EnumYield (x + stride) stride toMinus--    step _ EnumStop = return Stop--{-# INLINE_NORMAL enumerateFromThenToIntegralDn #-}-enumerateFromThenToIntegralDn-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegralDn from next to = Stream step EnumInit-    where-    {-# INLINE_LATE step #-}-    step _ EnumInit =-        return $ if to > next-            then if to > from-                 then Stop-                 else Yield from EnumStop-            else -- from >= next >= to-                let stride = next - from-                in Skip $ EnumYield from stride (to - stride)--    step _ (EnumYield x stride toMinus) =-        return $-            if x < toMinus-            then Yield x EnumStop-            else Yield x $ EnumYield (x + stride) stride toMinus--    step _ EnumStop = return Stop-#endif---- XXX This can perhaps be simplified and written in terms of--- enumeratFromStepIntegral as we have done in unfolds.---- | Enumerate an 'Integral' type in steps up to a given limit.--- @enumerateFromThenToIntegral from then to@ generates a finite stream whose--- first element is @from@, the second element is @then@ and the successive--- elements are in increments of @then - from@ up to @to@.------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 2 6--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)--- [0,-2,-4,-6]----{-# INLINE_NORMAL enumerateFromThenToIntegral #-}-enumerateFromThenToIntegral-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromThenToIntegral from next to =-    unfold Unfold.enumerateFromThenToIntegral (from, next, to)-#else-enumerateFromThenToIntegral from next to-    | next >= from = enumerateFromThenToIntegralUp from next to-    | otherwise    = enumerateFromThenToIntegralDn from next to-#endif---- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from--- then@ generates a stream whose first element is @from@, the second element--- is @then@ and the successive elements are in increments of @then - from@.--- The stream is bounded by the size of the 'Integral' type.------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)--- [0,-2,-4,-6]----{-# INLINE_NORMAL enumerateFromThenIntegral #-}-enumerateFromThenIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromThenIntegral from next =-    unfold Unfold.enumerateFromThenIntegralBounded (from, next)-#else-enumerateFromThenIntegral from next =-    if next > from-    then enumerateFromThenToIntegralUp from next maxBound-    else enumerateFromThenToIntegralDn from next minBound-#endif---- | @enumerateFromStepIntegral from step@ generates an infinite stream whose--- first element is @from@ and the successive elements are in increments of--- @step@.------ CAUTION: This function is not safe for finite integral types. It does not--- check for overflow, underflow or bounds.------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)--- [0,-2,-4]----{-# INLINE_NORMAL enumerateFromStepIntegral #-}-enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromStepIntegral from stride =-    unfold Unfold.enumerateFromStepIntegral (from, stride)-#else-enumerateFromStepIntegral from stride =-    from `seq` stride `seq` Stream step from-    where-        {-# INLINE_LATE step #-}-        step _ !x = return $ Yield x $! (x + stride)-#endif---- | Enumerate an 'Integral' type up to a given limit.--- @enumerateFromToIntegral from to@ generates a finite stream whose first--- element is @from@ and successive elements are in increments of @1@ up to--- @to@.------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToIntegral 0 4--- [0,1,2,3,4]----{-# INLINE enumerateFromToIntegral #-}-enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a-enumerateFromToIntegral from to =-    takeWhile (<= to) $ enumerateFromStepIntegral from 1---- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a--- stream whose first element is @from@ and the successive elements are in--- increments of @1@. The stream is bounded by the size of the 'Integral' type.------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)--- [0,1,2,3]----{-# INLINE enumerateFromIntegral #-}-enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a-enumerateFromIntegral from = enumerateFromToIntegral from maxBound----------------------------------------------------------------------------------- Enumeration of Fractionals----------------------------------------------------------------------------------- We cannot write a general function for Num.  The only way to write code--- portable between the two is to use a 'Real' constraint and convert between--- Fractional and Integral using fromRational which is horribly slow.---- Even though the underlying implementation of enumerateFromFractional and--- enumerateFromThenFractional works for any 'Num' we have restricted these to--- 'Fractional' because these do not perform any bounds check, in contrast to--- integral versions and are therefore not equivalent substitutes for those.---- | Numerically stable enumeration from a 'Fractional' number in steps of size--- @1@. @enumerateFromFractional from@ generates a stream whose first element--- is @from@ and the successive elements are in increments of @1@.  No overflow--- or underflow checks are performed.------ This is the equivalent to 'enumFrom' for 'Fractional' types. For example:------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1--- [1.1,2.1,3.1,4.1]----{-# INLINE enumerateFromFractional #-}-enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a-enumerateFromFractional = enumerateFromNum---- | Numerically stable enumeration from a 'Fractional' number in steps.--- @enumerateFromThenFractional from then@ generates a stream whose first--- element is @from@, the second element is @then@ and the successive elements--- are in increments of @then - from@.  No overflow or underflow checks are--- performed.------ This is the equivalent of 'enumFromThen' for 'Fractional' types. For--- example:------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)--- [1.1,-2.1,-5.300000000000001,-8.500000000000002]----{-# INLINE enumerateFromThenFractional #-}-enumerateFromThenFractional-    :: (Monad m, Fractional a)-    => a -> a -> Stream m a-enumerateFromThenFractional = enumerateFromThenNum---- | Numerically stable enumeration from a 'Fractional' number to a given--- limit.  @enumerateFromToFractional from to@ generates a finite stream whose--- first element is @from@ and successive elements are in increments of @1@ up--- to @to@.------ This is the equivalent of 'enumFromTo' for 'Fractional' types. For--- example:------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4.6--- [1.1,2.1,3.1,4.1,5.1]------ Notice that the last element is equal to the specified @to@ value after--- rounding to the nearest integer.----{-# INLINE_NORMAL enumerateFromToFractional #-}-enumerateFromToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> Stream m a-enumerateFromToFractional from to =-    takeWhile (<= to + 1 / 2) $ enumerateFromStepNum from 1---- | Numerically stable enumeration from a 'Fractional' number in steps up to a--- given limit.  @enumerateFromThenToFractional from then to@ generates a--- finite stream whose first element is @from@, the second element is @then@--- and the successive elements are in increments of @then - from@ up to @to@.------ This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For--- example:------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 2 6--- [0.1,2.0,3.9,5.799999999999999]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)--- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]----{-# INLINE_NORMAL enumerateFromThenToFractional #-}-enumerateFromThenToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> a -> Stream m a-enumerateFromThenToFractional from next to =-    takeWhile predicate $ enumerateFromThenFractional from next-    where-    mid = (next - from) / 2-    predicate | next >= from  = (<= to + mid)-              | otherwise     = (>= to + mid)------------------------------------------------------------------------------------ Enumeration of Enum types not larger than Int-------------------------------------------------------------------------------------- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromToSmall #-}-enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a-enumerateFromToSmall from to =-      fmap toEnum-    $ enumerateFromToIntegral (fromEnum from) (fromEnum to)---- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromThenToSmall #-}-enumerateFromThenToSmall :: (Monad m, Enum a)-    => a -> a -> a -> Stream m a-enumerateFromThenToSmall from next to =-          fmap toEnum-        $ enumerateFromThenToIntegral-            (fromEnum from) (fromEnum next) (fromEnum to)---- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.------ Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a--- type is bounded but does not have a 'Bounded' instance then we can go on--- enumerating it beyond the legal values of the type, resulting in the failure--- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'--- instance for this function to be safely used.----{-# INLINE enumerateFromThenSmallBounded #-}-enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenSmallBounded from next =-    if fromEnum next >= fromEnum from-    then enumerateFromThenTo from next maxBound-    else enumerateFromThenTo from next minBound------------------------------------------------------------------------------------ Enumerable type class-------------------------------------------------------------------------------------- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream--- enumerations like this:------ {-# RULES "fromList enumFrom" [1]---     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}------ But this does not work because enumFrom is a class method and GHC rewrites--- it quickly, so we do not get a chance to have our rule fired.---- | Types that can be enumerated as a stream. The operations in this type--- class are equivalent to those in the 'Enum' type class, except that these--- generate a stream instead of a list. Use the functions in--- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.----class Enum a => Enumerable a where-    -- | @enumerateFrom from@ generates a stream starting with the element-    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or-    -- generating an infinite stream when the type is not 'Bounded'.-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)-    -- [0,1,2,3]-    ---    -- For 'Fractional' types, enumeration is numerically stable. However, no-    -- overflow or underflow checks are performed.-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1-    -- [1.1,2.1,3.1,4.1]-    ---    enumerateFrom :: (Monad m) => a -> Stream m a--    -- | Generate a finite stream starting with the element @from@, enumerating-    -- the type up to the value @to@. If @to@ is smaller than @from@ then an-    -- empty stream is returned.-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 0 4-    -- [0,1,2,3,4]-    ---    -- For 'Fractional' types, the last element is equal to the specified @to@-    -- value after rounding to the nearest integral value.-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4-    -- [1.1,2.1,3.1,4.1]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4.6-    -- [1.1,2.1,3.1,4.1,5.1]-    ---    enumerateFromTo :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThen from then@ generates a stream whose first element-    -- is @from@, the second element is @then@ and the successive elements are-    -- in increments of @then - from@.  Enumeration can occur downwards or-    -- upwards depending on whether @then@ comes before or after @from@. For-    -- 'Bounded' types the stream ends when 'maxBound' is reached, for-    -- unbounded types it keeps enumerating infinitely.-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)-    -- [0,-2,-4,-6]-    ---    enumerateFromThen :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThenTo from then to@ generates a finite stream whose-    -- first element is @from@, the second element is @then@ and the successive-    -- elements are in increments of @then - from@ up to @to@. Enumeration can-    -- occur downwards or upwards depending on whether @then@ comes before or-    -- after @from@.-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 2 6-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)-    -- [0,-2,-4,-6]-    ---    enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a---- MAYBE: Sometimes it is more convenient to know the count rather then the--- ending or starting element. For those cases we can define the folllowing--- APIs. All of these will work only for bounded types if we represent the--- count by Int.------ enumerateN--- enumerateFromN--- enumerateToN--- enumerateFromStep--- enumerateFromStepN------------------------------------------------------------------------------------ Convenient functions for bounded types-------------------------------------------------------------------------------------- |--- > enumerate = enumerateFrom minBound------ Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'----{-# INLINE enumerate #-}-enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a-enumerate = enumerateFrom minBound---- |--- >>> enumerateTo = Stream.enumerateFromTo minBound------ Enumerate a 'Bounded' type from its 'minBound' to specified value.----{-# INLINE enumerateTo #-}-enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a-enumerateTo = enumerateFromTo minBound---- |--- >>> enumerateFromBounded from = Stream.enumerateFromTo from maxBound------ 'enumerateFrom' for 'Bounded' 'Enum' types.----{-# INLINE enumerateFromBounded #-}-enumerateFromBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> Stream m a-enumerateFromBounded from = enumerateFromTo from maxBound------------------------------------------------------------------------------------ Enumerable Instances-------------------------------------------------------------------------------------- For Enum types smaller than or equal to Int size.-#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \-instance Enumerable SMALL_TYPE where {                 \-    {-# INLINE enumerateFrom #-};                      \-    enumerateFrom = enumerateFromBounded;              \-    {-# INLINE enumerateFromThen #-};                  \-    enumerateFromThen = enumerateFromThenSmallBounded; \-    {-# INLINE enumerateFromTo #-};                    \-    enumerateFromTo = enumerateFromToSmall;            \-    {-# INLINE enumerateFromThenTo #-};                \-    enumerateFromThenTo = enumerateFromThenToSmall }--ENUMERABLE_BOUNDED_SMALL(())-ENUMERABLE_BOUNDED_SMALL(Bool)-ENUMERABLE_BOUNDED_SMALL(Ordering)-ENUMERABLE_BOUNDED_SMALL(Char)---- For bounded Integral Enum types, may be larger than Int.-#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \-instance Enumerable INTEGRAL_TYPE where {           \-    {-# INLINE enumerateFrom #-};                   \-    enumerateFrom = enumerateFromIntegral;          \-    {-# INLINE enumerateFromThen #-};               \-    enumerateFromThen = enumerateFromThenIntegral;  \-    {-# INLINE enumerateFromTo #-};                 \-    enumerateFromTo = enumerateFromToIntegral;      \-    {-# INLINE enumerateFromThenTo #-};             \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_BOUNDED_INTEGRAL(Int)-ENUMERABLE_BOUNDED_INTEGRAL(Int8)-ENUMERABLE_BOUNDED_INTEGRAL(Int16)-ENUMERABLE_BOUNDED_INTEGRAL(Int32)-ENUMERABLE_BOUNDED_INTEGRAL(Int64)-ENUMERABLE_BOUNDED_INTEGRAL(Word)-ENUMERABLE_BOUNDED_INTEGRAL(Word8)-ENUMERABLE_BOUNDED_INTEGRAL(Word16)-ENUMERABLE_BOUNDED_INTEGRAL(Word32)-ENUMERABLE_BOUNDED_INTEGRAL(Word64)---- For unbounded Integral Enum types.-#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \-instance Enumerable INTEGRAL_TYPE where {                         \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom from = enumerateFromStepIntegral from 1;        \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen from next =                                 \-        enumerateFromStepIntegral from (next - from);             \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToIntegral;                    \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)-ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)--#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \-instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom = enumerateFromFractional;                      \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen = enumerateFromThenFractional;              \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToFractional;                  \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToFractional }--ENUMERABLE_FRACTIONAL(Float,)-ENUMERABLE_FRACTIONAL(Double,)-ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)-ENUMERABLE_FRACTIONAL((Ratio a),Integral a)--instance Enumerable a => Enumerable (Identity a) where-    {-# INLINE enumerateFrom #-}-    enumerateFrom (Identity from) =-        fmap Identity $ enumerateFrom from-    {-# INLINE enumerateFromThen #-}-    enumerateFromThen (Identity from) (Identity next) =-        fmap Identity $ enumerateFromThen from next-    {-# INLINE enumerateFromTo #-}-    enumerateFromTo (Identity from) (Identity to) =-        fmap Identity $ enumerateFromTo from to-    {-# INLINE enumerateFromThenTo #-}-    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =-          fmap Identity-        $ enumerateFromThenTo from next to---- TODO-{--instance Enumerable a => Enumerable (Last a)-instance Enumerable a => Enumerable (First a)-instance Enumerable a => Enumerable (Max a)-instance Enumerable a => Enumerable (Min a)-instance Enumerable a => Enumerable (Const a b)-instance Enumerable (f a) => Enumerable (Alt f a)-instance Enumerable (f a) => Enumerable (Ap f a)--}---------------------------------------------------------------------------------- Time Enumeration----------------------------------------------------------------------------------- | @timesWith g@ returns a stream of time value tuples. The first component--- of the tuple is an absolute time reference (epoch) denoting the start of the--- stream and the second component is a time relative to the reference.------ The argument @g@ specifies the granularity of the relative time in seconds.--- A lower granularity clock gives higher precision but is more expensive in--- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.------ >>> import Control.Concurrent (threadDelay)--- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE_NORMAL timesWith #-}-timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)-timesWith g = Stream step Nothing--    where--    {-# INLINE_LATE step #-}-    step _ Nothing = do-        clock <- liftIO $ asyncClock Monotonic g-        a <- liftIO $ readClock clock-        return $ Skip $ Just (clock, a)--    step _ s@(Just (clock, t0)) = do-        a <- liftIO $ readClock clock-        -- XXX we can perhaps use an AbsTime64 using a 64 bit Int for-        -- efficiency.  or maybe we can use a representation using Double for-        -- floating precision time-        return $ Yield (toAbsTime t0, toRelTime64 (a - t0)) s---- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated--- as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimesWith #-}-absTimesWith :: MonadIO m => Double -> Stream m AbsTime-absTimesWith = fmap (uncurry addToAbsTime64) . timesWith---- | @relTimesWith g@ returns a stream of relative time values starting from 0,--- using a clock of granularity @g@ specified in seconds. A low granularity--- clock is more expensive in terms of CPU usage.  Any granularity lower than 1--- ms is treated as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimesWith #-}-relTimesWith :: MonadIO m => Double -> Stream m RelTime64-relTimesWith = fmap snd . timesWith---- | @times@ returns a stream of time value tuples with clock of 10 ms--- granularity. The first component of the tuple is an absolute time reference--- (epoch) denoting the start of the stream and the second component is a time--- relative to the reference.------ >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.times--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE times #-}-times :: MonadIO m => Stream m (AbsTime, RelTime64)-times = timesWith 0.01---- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms--- granularity.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimes #-}-absTimes :: MonadIO m => Stream m AbsTime-absTimes = fmap (uncurry addToAbsTime64) times---- | @relTimes@ returns a stream of relative time values starting from 0,--- using a clock of granularity 10 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimes #-}-relTimes ::  MonadIO m => Stream m RelTime64-relTimes = fmap snd times---- | @durations g@ returns a stream of relative time values measuring the time--- elapsed since the immediate predecessor element of the stream was generated.--- The first element of the stream is always 0. @durations@ uses a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.--- Durations lower than 1 ms will be 0.------ Note: This API is not safe on 32-bit machines.------ /Unimplemented/----{-# INLINE durations #-}-durations :: -- Monad m =>-    Double -> t m RelTime64-durations = undefined---- | Generate a singleton event at or after the specified absolute time. Note--- that this is different from a threadDelay, a threadDelay starts from the--- time when the action is evaluated, whereas if we use AbsTime based timeout--- it will immediately expire if the action is evaluated too late.------ /Unimplemented/----{-# INLINE timeout #-}-timeout :: -- Monad m =>-    AbsTime -> t m ()-timeout = undefined------------------------------------------------------------------------------------ From Generators----------------------------------------------------------------------------------{-# INLINE_NORMAL fromIndicesM #-}-fromIndicesM :: Monad m => (Int -> m a) -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-fromIndicesM gen = unfold (Unfold.fromIndicesM gen) 0-#else-fromIndicesM gen = Stream step 0-  where-    {-# INLINE_LATE step #-}-    step _ i = do-       x <- gen i-       return $ Yield x (i + 1)-#endif--{-# INLINE fromIndices #-}-fromIndices :: Monad m => (Int -> a) -> Stream m a-fromIndices gen = fromIndicesM (return . gen)---- Adapted from the vector package-{-# INLINE_NORMAL generateM #-}-generateM :: Monad m => Int -> (Int -> m a) -> Stream m a-generateM n gen = n `seq` Stream step 0-  where-    {-# INLINE_LATE step #-}-    step _ i | i < n     = do-                           x <- gen i-                           return $ Yield x (i + 1)-             | otherwise = return Stop--{-# INLINE generate #-}-generate :: Monad m => Int -> (Int -> a) -> Stream m a-generate n gen = generateM n (return . gen)------------------------------------------------------------------------------------ Iteration------------------------------------------------------------------------------------ |--- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a)------ Generate an infinite stream with the first element generated by the action--- @m@ and each successive element derived by applying the monadic function--- @f@ on the previous element.------ >>> :{--- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0)---     & Stream.take 3---     & Stream.fold Fold.toList--- :}--- 0--- 1--- [0,1,2]----{-# INLINE_NORMAL iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-iterateM step = unfold (Unfold.iterateM step)-#else-iterateM step = Stream (\_ st -> st >>= \(!x) -> return $ Yield x (step x))-#endif---- |--- >>> iterate f x = x `Stream.cons` iterate f x------ Generate an infinite stream with @x@ as the first element and each--- successive element derived by applying the function @f@ on the previous--- element.------ >>> Stream.fold Fold.toList $ Stream.take 5 $ Stream.iterate (+1) 1--- [1,2,3,4,5]----{-# INLINE_NORMAL iterate #-}-iterate :: Monad m => (a -> a) -> a -> Stream m a-iterate step st = iterateM (return . step) (return st)------------------------------------------------------------------------------------ From containers------------------------------------------------------------------------------------ | Convert a list of monadic actions to a 'Stream'-{-# INLINE_LATE fromListM #-}-fromListM :: Monad m => [m a] -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-fromListM = unfold Unfold.fromListM-#else-fromListM = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (m:ms) = m >>= \x -> return $ Yield x ms-    step _ []     = return Stop-#endif---- |--- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil------ Construct a stream from a 'Foldable' containing pure values:------ /WARNING: O(n^2), suitable only for a small number of--- elements in the stream/----{-# INLINE fromFoldable #-}-fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a-fromFoldable = Prelude.foldr cons nil---- |--- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil------ Construct a stream from a 'Foldable' containing pure values:------ /WARNING: O(n^2), suitable only for a small number of--- elements in the stream/----{-# INLINE fromFoldableM #-}-fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a-fromFoldableM = Prelude.foldr consM nil------------------------------------------------------------------------------------ From pointers------------------------------------------------------------------------------------ | Keep reading 'Storable' elements from 'Ptr' onwards.------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtr #-}-fromPtr :: forall m a. (MonadIO m, Storable a) => Ptr a -> Stream m a-fromPtr = Stream step--    where--    {-# INLINE_LATE step #-}-    step _ p = do-        x <- liftIO $ peek p-        return $ Yield x (PTR_NEXT(p, a))---- | Take @n@ 'Storable' elements starting from 'Ptr' onwards.------ >>> fromPtrN n = Stream.take n . Stream.fromPtr------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtrN #-}-fromPtrN :: (MonadIO m, Storable a) => Int -> Ptr a -> Stream m a-fromPtrN n = take n . fromPtr---- | Read bytes from an 'Addr#' until a 0 byte is encountered, the 0 byte is--- not included in the stream.------ >>> :set -XMagicHash--- >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr------ /Unsafe:/ The caller is responsible for safe addressing.------ Note that this is completely safe when reading from Haskell string--- literals because they are guaranteed to be NULL terminated:------ >>> Stream.fold Fold.toList $ Stream.fromByteStr# "\1\2\3\0"#--- [1,2,3]----{-# INLINE fromByteStr# #-}-fromByteStr# :: MonadIO m => Addr# -> Stream m Word8-fromByteStr# addr =-    takeWhile (/= 0) $ fromPtr $ Ptr addr
− src/Streamly/Internal/Data/Stream/StreamD/Lift.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Lift--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Transform the underlying monad of a stream.--module Streamly.Internal.Data.Stream.StreamD.Lift-    (-    -- * Generalize Inner Monad-      morphInner-    , generalizeInner--    -- * Transform Inner Monad-    , liftInnerWith-    , runInnerWith-    , runInnerWithState-    )-where--#include "inline.hs"--import Data.Functor.Identity (Identity(..))-import Streamly.Internal.Data.SVar.Type (adaptState)--import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"------------------------------------------------------------------------------------ Generalize Inner Monad------------------------------------------------------------------------------------ | Transform the inner monad of a stream using a natural transformation.------ Example, generalize the inner monad from Identity to any other:------ >>> generalizeInner = Stream.morphInner (return . runIdentity)------ Also known as hoist.----{-# INLINE_NORMAL morphInner #-}-morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a-morphInner f (Stream step state) = Stream step' state-    where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- f $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip  s   -> Skip s-            Stop      -> Stop---- | Generalize the inner monad of the stream from 'Identity' to any monad.------ Definition:------ >>> generalizeInner = Stream.morphInner (return . runIdentity)----{-# INLINE generalizeInner #-}-generalizeInner :: Monad m => Stream Identity a -> Stream m a-generalizeInner = morphInner (return . runIdentity)------------------------------------------------------------------------------------ Transform Inner Monad------------------------------------------------------------------------------------ | Lift the inner monad @m@ of a stream @Stream m a@ to @t m@ using the--- supplied lift function.----{-# INLINE_NORMAL liftInnerWith #-}-liftInnerWith :: (Monad (t m)) =>-    (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a-liftInnerWith lift (Stream step state) = Stream step1 state--    where--    {-# INLINE_LATE step1 #-}-    step1 gst st = do-        r <- lift $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip s    -> Skip s-            Stop      -> Stop---- | Evaluate the inner monad of a stream using the supplied runner function.----{-# INLINE_NORMAL runInnerWith #-}-runInnerWith :: Monad m =>-    (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a-runInnerWith run (Stream step state) = Stream step1 state--    where--    {-# INLINE_LATE step1 #-}-    step1 gst st = do-        r <- run $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip s -> Skip s-            Stop -> Stop---- | Evaluate the inner monad of a stream using the supplied stateful runner--- function and the initial state. The state returned by an invocation of the--- runner is supplied as input state to the next invocation.----{-# INLINE_NORMAL runInnerWithState #-}-runInnerWithState :: Monad m =>-    (forall b. s -> t m b -> m (b, s))-    -> m s-    -> Stream (t m) a-    -> Stream m (s, a)-runInnerWithState run initial (Stream step state) =-    Stream step1 (state, initial)--    where--    {-# INLINE_LATE step1 #-}-    step1 gst (st, action) = do-        sv <- action-        (r, !sv1) <- run sv (step (adaptState gst) st)-        return $ case r of-            Yield x s -> Yield (sv1, x) (s, return sv1)-            Skip s -> Skip (s, return sv1)-            Stop -> Stop
− src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs 
@@ -1,3111 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Nesting--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ This module contains transformations involving multiple streams, unfolds or--- folds. There are two types of transformations generational or eliminational.--- Generational transformations are like the "Generate" module but they--- generate a stream by combining streams instead of elements. Eliminational--- transformations are like the "Eliminate" module but they transform a stream--- by eliminating parts of the stream instead of eliminating the whole stream.------ These combinators involve transformation, generation, elimination so can be--- classified under any of those.------ Ultimately these operations should be supported by Unfolds, Pipes and Folds,--- and this module may become redundant.---- The zipWithM combinator in this module has been adapted from the vector--- package (c) Roman Leshchinskiy.----module Streamly.Internal.Data.Stream.StreamD.Nesting-    (-    -- * Generate-    -- | Combining streams to generate streams.--    -- ** Combine Two Streams-    -- | Functions ending in the shape:-    ---    -- @t m a -> t m a -> t m a@.--    -- *** Appending-    -- | Append a stream after another. A special case of concatMap or-    -- unfoldMany.-      AppendState(..)-    , append--    -- *** Interleaving-    -- | Interleave elements from two streams alternately. A special case of-    -- unfoldInterleave.-    , InterleaveState(..)-    , interleave-    , interleaveMin-    , interleaveFst-    , interleaveFstSuffix--    -- *** Scheduling-    -- | Execute streams alternately irrespective of whether they generate-    -- elements or not. Note 'interleave' would execute a stream until it-    -- yields an element. A special case of unfoldRoundRobin.-    , roundRobin -- interleaveFair?/ParallelFair--    -- *** Zipping-    -- | Zip corresponding elements of two streams.-    , zipWith-    , zipWithM--    -- *** Merging-    -- | Interleave elements from two streams based on a condition.-    , mergeBy-    , mergeByM-    , mergeMinBy-    , mergeFstBy--    -- ** Combine N Streams-    -- | Functions generally ending in these shapes:-    ---    -- @-    -- concat: f (t m a) -> t m a-    -- concatMap: (a -> t m b) -> t m a -> t m b-    -- unfoldMany: Unfold m a b -> t m a -> t m b-    -- @--    -- *** ConcatMap-    -- | Generate streams by mapping a stream generator on each element of an-    -- input stream, append the resulting streams and flatten.-    , concatMap-    , concatMapM--    -- *** ConcatUnfold-    -- | Generate streams by using an unfold on each element of an input-    -- stream, append the resulting streams and flatten. A special case of-    -- gintercalate.-    , unfoldMany-    , ConcatUnfoldInterleaveState (..)-    , unfoldInterleave-    , unfoldRoundRobin--    -- *** Interpose-    -- | Like unfoldMany but intersperses an effect between the streams. A-    -- special case of gintercalate.-    , interpose-    , interposeM-    , interposeSuffix-    , interposeSuffixM--    -- *** Intercalate-    -- | Like unfoldMany but intersperses streams from another source between-    -- the streams from the first source.-    , gintercalate-    , gintercalateSuffix-    , intercalate-    , intercalateSuffix--    -- * Eliminate-    -- | Folding and Parsing chunks of streams to eliminate nested streams.-    -- Functions generally ending in these shapes:-    ---    -- @-    -- f (Fold m a b) -> t m a -> t m b-    -- f (Parser a m b) -> t m a -> t m b-    -- @--    -- ** Folding-    -- | Apply folds on a stream.-    , foldMany-    , refoldMany-    , foldSequence-    , foldIterateM-    , refoldIterateM--    -- ** Parsing-    -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or-    -- unfoldMany. concatMap generates a stream from single values in a-    -- stream and flattens, parseMany does the opposite of flattening by-    -- splitting the stream and then folds each such split to single value in-    -- the output stream.-    , parseMany-    , parseManyD-    , parseSequence-    , parseManyTill-    , parseIterate-    , parseIterateD--    -- ** Grouping-    -- | Group segments of a stream and fold. Special case of parsing.-    , groupsOf-    , groupsBy-    , groupsRollingBy--    -- ** Splitting-    -- | A special case of parsing.-    , wordsBy-    , splitOnSeq-    , splitOnSuffixSeq-    , sliceOnSuffix--    -- XXX Implement these as folds or parsers instead.-    , splitOnSuffixSeqAny-    , splitOnPrefix-    , splitOnAny--    -- * Transform (Nested Containers)-    -- | Opposite to compact in ArrayStream-    , splitInnerBy-    , splitInnerBySuffix-    , intersectBySorted--    -- * Reduce By Streams-    , dropPrefix-    , dropInfix-    , dropSuffix-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, shiftL, (.|.), (.&.))-import Data.Proxy (Proxy(..))-import Data.Word (Word32)-import Foreign.Storable (Storable, peek)-import Fusion.Plugin.Types (Fuse(..))-import GHC.Types (SPEC(..))--import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Fold.Step (Step(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.Refold.Type (Refold(..))-import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Ring.Unboxed as RB--import Streamly.Internal.Data.Stream.StreamD.Transform-    (intersperse, intersperseMSuffix)-import Streamly.Internal.Data.Stream.StreamD.Type--import Prelude hiding (concatMap, mapM, zipWith)--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Appending---------------------------------------------------------------------------------data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2---- | Fuses two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ >>> s1 = Stream.fromList [1,2]--- >>> s2 = Stream.fromList [3,4]--- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2--- [1,2,3,4]------ This function should not be used to dynamically construct a stream. If a--- stream is constructed by successive use of this function it would take--- quadratic time complexity to consume the stream.------ This function should only be used to statically fuse a stream with another--- stream. Do not use this recursively or where it cannot be inlined.------ See "Streamly.Data.StreamK" for an 'append' that can be used to--- construct a stream recursively.----{-# INLINE_NORMAL append #-}-append :: Monad m => Stream m a -> Stream m a -> Stream m a-append (Stream step1 state1) (Stream step2 state2) =-    Stream step (AppendFirst state1)--    where--    {-# INLINE_LATE step #-}-    step gst (AppendFirst st) = do-        r <- step1 gst st-        return $ case r of-            Yield a s -> Yield a (AppendFirst s)-            Skip s -> Skip (AppendFirst s)-            Stop -> Skip (AppendSecond state2)--    step gst (AppendSecond st) = do-        r <- step2 gst st-        return $ case r of-            Yield a s -> Yield a (AppendSecond s)-            Skip s -> Skip (AppendSecond s)-            Stop -> Stop----------------------------------------------------------------------------------- Interleaving---------------------------------------------------------------------------------data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2-    | InterleaveSecondOnly s2 | InterleaveFirstOnly s1---- | Interleaves two streams, yielding one element from each stream--- alternately.  When one stream stops the rest of the other stream is used in--- the output stream.------ When joining many streams in a left associative manner earlier streams will--- get exponential priority than the ones joining later. Because of exponential--- weighting it can be used with 'concatMapWith' even on a large number of--- streams.----{-# INLINE_NORMAL interleave #-}-interleave :: Monad m => Stream m a -> Stream m a -> Stream m a-interleave (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveFirst s st2)-            Stop -> Skip (InterleaveSecondOnly st2)--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveSecond st1 s)-            Stop -> Skip (InterleaveFirstOnly st1)--    step gst (InterleaveFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveFirstOnly s)-            Skip s -> Skip (InterleaveFirstOnly s)-            Stop -> Stop--    step gst (InterleaveSecondOnly st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveSecondOnly s)-            Skip s -> Skip (InterleaveSecondOnly s)-            Stop -> Stop---- | Like `interleave` but stops interleaving as soon as any of the two streams--- stops.----{-# INLINE_NORMAL interleaveMin #-}-interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveMin (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveFirst s st2)-            Stop -> Stop--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveSecond st1 s)-            Stop -> Stop--    step _ (InterleaveFirstOnly _) =  undefined-    step _ (InterleaveSecondOnly _) =  undefined---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream. As soon as the first stream--- finishes, the output stops, discarding the remaining part of the second--- stream. In this case, the last element in the resulting stream would be from--- the second stream. If the second stream finishes early then the first stream--- still continues to yield elements until it finishes.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c,"--- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFstSuffix' is a dual of 'interleaveFst'.------ Do not use dynamically.------ /Pre-release/-{-# INLINE_NORMAL interleaveFstSuffix #-}-interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveFirst s st2)-            Stop -> Stop--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveSecond st1 s)-            Stop -> Skip (InterleaveFirstOnly st1)--    step gst (InterleaveFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveFirstOnly s)-            Skip s -> Skip (InterleaveFirstOnly s)-            Stop -> Stop--    step _ (InterleaveSecondOnly _) =  undefined--data InterleaveInfixState s1 s2 a-    = InterleaveInfixFirst s1 s2-    | InterleaveInfixSecondBuf s1 s2-    | InterleaveInfixSecondYield s1 s2 a-    | InterleaveInfixFirstYield s1 s2 a-    | InterleaveInfixFirstOnly s1---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream and ending at the first stream.--- If the second stream is longer than the first, elements from the second--- stream are infixed with elements from the first stream. If the first stream--- is longer then it continues yielding elements even after the second stream--- has finished.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c"--- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFst' is a dual of 'interleaveFstSuffix'.------ Do not use dynamically.------ /Pre-release/-{-# INLINE_NORMAL interleaveFst #-}-interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveFst (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveInfixFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveInfixFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)-            Skip s -> Skip (InterleaveInfixFirst s st2)-            Stop -> Stop--    step gst (InterleaveInfixSecondBuf st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)-            Skip s -> Skip (InterleaveInfixSecondBuf st1 s)-            Stop -> Skip (InterleaveInfixFirstOnly st1)--    step gst (InterleaveInfixSecondYield st1 st2 x) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)-            Skip s -> Skip (InterleaveInfixSecondYield s st2 x)-            Stop -> Stop--    step _ (InterleaveInfixFirstYield st1 st2 x) = do-        return $ Yield x (InterleaveInfixSecondBuf st1 st2)--    step gst (InterleaveInfixFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveInfixFirstOnly s)-            Skip s -> Skip (InterleaveInfixFirstOnly s)-            Stop -> Stop----------------------------------------------------------------------------------- Scheduling----------------------------------------------------------------------------------- | Schedule the execution of two streams in a fair round-robin manner,--- executing each stream once, alternately. Execution of a stream may not--- necessarily result in an output, a stream may choose to @Skip@ producing an--- element until later giving the other stream a chance to run. Therefore, this--- combinator fairly interleaves the execution of two streams rather than--- fairly interleaving the output of the two streams. This can be useful in--- co-operative multitasking without using explicit threads. This can be used--- as an alternative to `async`.------ Do not use dynamically.------ /Pre-release/-{-# INLINE_NORMAL roundRobin #-}-roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a-roundRobin (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveSecond s st2)-            Stop -> Skip (InterleaveSecondOnly st2)--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveFirst st1 s)-            Stop -> Skip (InterleaveFirstOnly st1)--    step gst (InterleaveSecondOnly st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveSecondOnly s)-            Skip s -> Skip (InterleaveSecondOnly s)-            Stop -> Stop--    step gst (InterleaveFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveFirstOnly s)-            Skip s -> Skip (InterleaveFirstOnly s)-            Stop -> Stop----------------------------------------------------------------------------------- Merging----------------------------------------------------------------------------------- | Like 'mergeBy' but with a monadic comparison function.------ Merge two streams randomly:------ @--- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT--- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])--- [2,1,2,2,2,1,1,1]--- @------ Merge two streams in a proportion of 2:1:------ >>> :{--- do---  let s1 = Stream.fromList [1,1,1,1,1,1]---      s2 = Stream.fromList [2,2,2]---  let proportionately m n = do---       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]---       return $ \_ _ -> do---          r <- readIORef ref---          writeIORef ref $ Prelude.tail r---          return $ Prelude.head r---  f <- proportionately 2 1---  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2---  print xs--- :}--- [1,1,2,1,1,2,1,1,2]----{-# INLINE_NORMAL mergeByM #-}-mergeByM-    :: (Monad m)-    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeByM cmp (Stream stepa ta) (Stream stepb tb) =-    Stream step (Just ta, Just tb, Nothing, Nothing)-  where-    {-# INLINE_LATE step #-}--    -- one of the values is missing, and the corresponding stream is running-    step gst (Just sa, sb, Nothing, b) = do-        r <- stepa gst sa-        return $ case r of-            Yield a sa' -> Skip (Just sa', sb, Just a, b)-            Skip sa'    -> Skip (Just sa', sb, Nothing, b)-            Stop        -> Skip (Nothing, sb, Nothing, b)--    step gst (sa, Just sb, a, Nothing) = do-        r <- stepb gst sb-        return $ case r of-            Yield b sb' -> Skip (sa, Just sb', a, Just b)-            Skip sb'    -> Skip (sa, Just sb', a, Nothing)-            Stop        -> Skip (sa, Nothing, a, Nothing)--    -- both the values are available-    step _ (sa, sb, Just a, Just b) = do-        res <- cmp a b-        return $ case res of-            GT -> Yield b (sa, sb, Just a, Nothing)-            _  -> Yield a (sa, sb, Nothing, Just b)--    -- one of the values is missing, corresponding stream is done-    step _ (Nothing, sb, Nothing, Just b) =-            return $ Yield b (Nothing, sb, Nothing, Nothing)--    step _ (sa, Nothing, Just a, Nothing) =-            return $ Yield a (sa, Nothing, Nothing, Nothing)--    step _ (Nothing, Nothing, Nothing, Nothing) = return Stop---- | Merge two streams using a comparison function. The head elements of both--- the streams are compared and the smaller of the two elements is emitted, if--- both elements are equal then the element from the first stream is used--- first.------ If the streams are sorted in ascending order, the resulting stream would--- also remain sorted in ascending order.------ >>> s1 = Stream.fromList [1,3,5]--- >>> s2 = Stream.fromList [2,4,6,8]--- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2--- [1,2,3,4,5,6,8]----{-# INLINE mergeBy #-}-mergeBy-    :: (Monad m)-    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeBy cmp = mergeByM (\a b -> return $ cmp a b)---- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.------ /Unimplemented/-{-# INLINABLE mergeMinBy #-}-mergeMinBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeMinBy _f _m1 _m2 = undefined-    -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)---- | Like 'mergeByM' but stops merging as soon as the first stream stops.------ /Unimplemented/-{-# INLINABLE mergeFstBy #-}-mergeFstBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeFstBy _f _m1 _m2 = undefined-    -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)------------------------------------------------------------------------------------ Intersection of sorted streams------------------------------------------------------------------------------------ Assuming the streams are sorted in ascending order-{-# INLINE_NORMAL intersectBySorted #-}-intersectBySorted :: Monad m-    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-intersectBySorted cmp (Stream stepa ta) (Stream stepb tb) =-    Stream step-        ( ta -- left stream state-        , tb -- right stream state-        , Nothing -- left value-        , Nothing -- right value-        )--    where--    {-# INLINE_LATE step #-}-    -- step 1, fetch the first value-    step gst (sa, sb, Nothing, b) = do-        r <- stepa gst sa-        return $ case r of-            Yield a sa' -> Skip (sa', sb, Just a, b) -- step 2/3-            Skip sa'    -> Skip (sa', sb, Nothing, b)-            Stop        -> Stop--    -- step 2, fetch the second value-    step gst (sa, sb, a@(Just _), Nothing) = do-        r <- stepb gst sb-        return $ case r of-            Yield b sb' -> Skip (sa, sb', a, Just b) -- step 3-            Skip sb'    -> Skip (sa, sb', a, Nothing)-            Stop        -> Stop--    -- step 3, compare the two values-    step _ (sa, sb, Just a, Just b) = do-        let res = cmp a b-        return $ case res of-            GT -> Skip (sa, sb, Just a, Nothing) -- step 2-            LT -> Skip (sa, sb, Nothing, Just b) -- step 1-            EQ -> Yield a (sa, sb, Nothing, Just b) -- step 1----------------------------------------------------------------------------------- Combine N Streams - unfoldMany---------------------------------------------------------------------------------data ConcatUnfoldInterleaveState o i =-      ConcatUnfoldInterleaveOuter o [i]-    | ConcatUnfoldInterleaveInner o [i]-    | ConcatUnfoldInterleaveInnerL [i] [i]-    | ConcatUnfoldInterleaveInnerR [i] [i]---- XXX use arrays to store state instead of lists?------ XXX In general we can use different scheduling strategies e.g. how to--- schedule the outer vs inner loop or assigning weights to different streams--- or outer and inner loops.---- After a yield, switch to the next stream. Do not switch streams on Skip.--- Yield from outer stream switches to the inner stream.------ There are two choices here, (1) exhaust the outer stream first and then--- start yielding from the inner streams, this is much simpler to implement,--- (2) yield at least one element from an inner stream before going back to--- outer stream and opening the next stream from it.------ Ideally, we need some scheduling bias to inner streams vs outer stream.--- Maybe we can configure the behavior.------ XXX Instead of using "concatPairsWith wSerial" we can implement an N-way--- interleaving CPS combinator which behaves like unfoldInterleave. Instead--- of pairing up the streams we just need to go yielding one element from each--- stream and storing the remaining streams and then keep doing rounds through--- those in a round robin fashion. This would be much like wAsync.---- | This does not pair streams like mergeMapWith, instead, it goes through--- each stream one by one and yields one element from each stream. After it--- goes to the last stream it reverses the traversal to come back to the first--- stream yielding elements from each stream on its way back to the first--- stream and so on.------ >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]--- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists--- >>> Stream.fold Fold.toList interleaved--- [1,2,3,4,5,5,4,3,2,1]------ Note that this is order of magnitude more efficient than "mergeMapWith--- interleave" because of fusion.----{-# INLINE_NORMAL unfoldInterleave #-}-unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldInterleave (Unfold istep inject) (Stream ostep ost) =-    Stream step (ConcatUnfoldInterleaveOuter ost [])--    where--    {-# INLINE_LATE step #-}-    step gst (ConcatUnfoldInterleaveOuter o ls) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a o' -> do-                i <- inject a-                i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))-            Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)-            Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInner _ []) = undefined-    step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))-            Skip s    -> Skip (ConcatUnfoldInterleaveInner o (s:ls))-            Stop      -> Skip (ConcatUnfoldInterleaveOuter o ls)--    step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerL [] rs) =-        return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)--    step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)-            Stop      -> Skip (ConcatUnfoldInterleaveInnerL ls rs)--    step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerR ls []) =-        return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))-            Stop      -> Skip (ConcatUnfoldInterleaveInnerR ls rs)---- XXX In general we can use different scheduling strategies e.g. how to--- schedule the outer vs inner loop or assigning weights to different streams--- or outer and inner loops.------ This could be inefficient if the tasks are too small.------ Compared to unfoldInterleave this one switches streams on Skips.---- | 'unfoldInterleave' switches to the next stream whenever a value from a--- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps--- skipping for long time other streams won't get a chance to run.--- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each--- stream fairly irrespective of whether it produces a value or not.----{-# INLINE_NORMAL unfoldRoundRobin #-}-unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =-    Stream step (ConcatUnfoldInterleaveOuter ost [])-  where-    {-# INLINE_LATE step #-}-    step gst (ConcatUnfoldInterleaveOuter o ls) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a o' -> do-                i <- inject a-                i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))-            Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)-            Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInner o []) =-            return $ Skip (ConcatUnfoldInterleaveOuter o [])--    step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))-            Skip s    -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))-            Stop      -> Skip (ConcatUnfoldInterleaveOuter o ls)--    step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerL [] rs) =-        return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)--    step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))-            Stop      -> Skip (ConcatUnfoldInterleaveInnerL ls rs)--    step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerR ls []) =-        return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)-            Stop      -> Skip (ConcatUnfoldInterleaveInnerR ls rs)----------------------------------------------------------------------------------- Combine N Streams - interpose---------------------------------------------------------------------------------{-# ANN type InterposeSuffixState Fuse #-}-data InterposeSuffixState s1 i1 =-      InterposeSuffixFirst s1-    -- | InterposeSuffixFirstYield s1 i1-    | InterposeSuffixFirstInner s1 i1-    | InterposeSuffixSecond s1---- Note that if an unfolded layer turns out to be nil we still emit the--- separator effect. An alternate behavior could be to emit the separator--- effect only if at least one element has been yielded by the unfolding.--- However, that becomes a bit complicated, so we have chosen the former--- behvaior for now.-{-# INLINE_NORMAL interposeSuffixM #-}-interposeSuffixM-    :: Monad m-    => m c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffixM-    action-    (Unfold istep1 inject1) (Stream step1 state1) =-    Stream step (InterposeSuffixFirst state1)--    where--    {-# INLINE_LATE step #-}-    step gst (InterposeSuffixFirst s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (InterposeSuffixFirstInner s i))-                -- i `seq` return (Skip (InterposeSuffixFirstYield s i))-            Skip s -> return $ Skip (InterposeSuffixFirst s)-            Stop -> return Stop--    {--    step _ (InterposeSuffixFirstYield s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')-            Skip i'    -> Skip (InterposeSuffixFirstYield s1 i')-            Stop       -> Skip (InterposeSuffixFirst s1)-    -}--    step _ (InterposeSuffixFirstInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')-            Skip i'    -> Skip (InterposeSuffixFirstInner s1 i')-            Stop       -> Skip (InterposeSuffixSecond s1)--    step _ (InterposeSuffixSecond s1) = do-        r <- action-        return $ Yield r (InterposeSuffixFirst s1)---- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)---- | Unfold the elements of a stream, append the given element after each--- unfolded stream and then concat them into a single stream.------ >>> unlines = Stream.interposeSuffix '\n'------ /Pre-release/-{-# INLINE interposeSuffix #-}-interposeSuffix :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffix x = interposeSuffixM (return x)--{-# ANN type InterposeState Fuse #-}-data InterposeState s1 i1 a =-      InterposeFirst s1-    -- | InterposeFirstYield s1 i1-    | InterposeFirstInner s1 i1-    | InterposeFirstInject s1-    -- | InterposeFirstBuf s1 i1-    | InterposeSecondYield s1 i1-    -- -- | InterposeSecondYield s1 i1 a-    -- -- | InterposeFirstResume s1 i1 a---- Note that this only interposes the pure values, we may run many effects to--- generate those values as some effects may not generate anything (Skip).-{-# INLINE_NORMAL interposeM #-}-interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c-interposeM-    action-    (Unfold istep1 inject1) (Stream step1 state1) =-    Stream step (InterposeFirst state1)--    where--    {-# INLINE_LATE step #-}-    step gst (InterposeFirst s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (InterposeFirstInner s i))-                -- i `seq` return (Skip (InterposeFirstYield s i))-            Skip s -> return $ Skip (InterposeFirst s)-            Stop -> return Stop--    {--    step _ (InterposeFirstYield s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeFirstInner s1 i')-            Skip i'    -> Skip (InterposeFirstYield s1 i')-            Stop       -> Skip (InterposeFirst s1)-    -}--    step _ (InterposeFirstInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeFirstInner s1 i')-            Skip i'    -> Skip (InterposeFirstInner s1 i')-            Stop       -> Skip (InterposeFirstInject s1)--    step gst (InterposeFirstInject s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                -- i `seq` return (Skip (InterposeFirstBuf s i))-                i `seq` return (Skip (InterposeSecondYield s i))-            Skip s -> return $ Skip (InterposeFirstInject s)-            Stop -> return Stop--    {--    step _ (InterposeFirstBuf s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Skip (InterposeSecondYield s1 i' x)-            Skip i'    -> Skip (InterposeFirstBuf s1 i')-            Stop       -> Stop-    -}--    {--    step _ (InterposeSecondYield s1 i1 v) = do-        r <- action-        return $ Yield r (InterposeFirstResume s1 i1 v)-    -}-    step _ (InterposeSecondYield s1 i1) = do-        r <- action-        return $ Yield r (InterposeFirstInner s1 i1)--    {--    step _ (InterposeFirstResume s1 i1 v) = do-        return $ Yield v (InterposeFirstInner s1 i1)-    -}---- > interpose x unf str = gintercalate unf str UF.identity (repeat x)---- | Unfold the elements of a stream, intersperse the given element between the--- unfolded streams and then concat them into a single stream.------ >>> unwords = Stream.interpose ' '------ /Pre-release/-{-# INLINE interpose #-}-interpose :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interpose x = interposeM (return x)----------------------------------------------------------------------------------- Combine N Streams - intercalate---------------------------------------------------------------------------------data ICUState s1 s2 i1 i2 =-      ICUFirst s1 s2-    | ICUSecond s1 s2-    | ICUSecondOnly s2-    | ICUFirstOnly s1-    | ICUFirstInner s1 s2 i1-    | ICUSecondInner s1 s2 i2-    | ICUFirstOnlyInner s1 i1-    | ICUSecondOnlyInner s2 i2---- | 'interleaveFstSuffix' followed by unfold and concat.------ /Pre-release/-{-# INLINE_NORMAL gintercalateSuffix #-}-gintercalateSuffix-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalateSuffix-    (Unfold istep1 inject1) (Stream step1 state1)-    (Unfold istep2 inject2) (Stream step2 state2) =-    Stream step (ICUFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (ICUFirst s1 s2) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICUFirstInner s s2 i))-            Skip s -> return $ Skip (ICUFirst s s2)-            Stop -> return Stop--    step gst (ICUFirstOnly s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICUFirstOnlyInner s i))-            Skip s -> return $ Skip (ICUFirstOnly s)-            Stop -> return Stop--    step _ (ICUFirstInner s1 s2 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICUFirstInner s1 s2 i')-            Skip i'    -> Skip (ICUFirstInner s1 s2 i')-            Stop       -> Skip (ICUSecond s1 s2)--    step _ (ICUFirstOnlyInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')-            Skip i'    -> Skip (ICUFirstOnlyInner s1 i')-            Stop       -> Skip (ICUFirstOnly s1)--    step gst (ICUSecond s1 s2) = do-        r <- step2 (adaptState gst) s2-        case r of-            Yield a s -> do-                i <- inject2 a-                i `seq` return (Skip (ICUSecondInner s1 s i))-            Skip s -> return $ Skip (ICUSecond s1 s)-            Stop -> return $ Skip (ICUFirstOnly s1)--    step _ (ICUSecondInner s1 s2 i2) = do-        r <- istep2 i2-        return $ case r of-            Yield x i' -> Yield x (ICUSecondInner s1 s2 i')-            Skip i'    -> Skip (ICUSecondInner s1 s2 i')-            Stop       -> Skip (ICUFirst s1 s2)--    step _ (ICUSecondOnly _s2) = undefined-    step _ (ICUSecondOnlyInner _s2 _i2) = undefined--data ICALState s1 s2 i1 i2 a =-      ICALFirst s1 s2-    -- | ICALFirstYield s1 s2 i1-    | ICALFirstInner s1 s2 i1-    | ICALFirstOnly s1-    | ICALFirstOnlyInner s1 i1-    | ICALSecondInject s1 s2-    | ICALFirstInject s1 s2 i2-    -- | ICALFirstBuf s1 s2 i1 i2-    | ICALSecondInner s1 s2 i1 i2-    -- -- | ICALSecondInner s1 s2 i1 i2 a-    -- -- | ICALFirstResume s1 s2 i1 i2 a---- XXX we can swap the order of arguments to gintercalate so that the--- definition of unfoldMany becomes simpler? The first stream should be--- infixed inside the second one. However, if we change the order in--- "interleave" as well similarly, then that will make it a bit unintuitive.------ > unfoldMany unf str =--- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())---- | 'interleaveFst' followed by unfold and concat.------ /Pre-release/-{-# INLINE_NORMAL gintercalate #-}-gintercalate-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalate-    (Unfold istep1 inject1) (Stream step1 state1)-    (Unfold istep2 inject2) (Stream step2 state2) =-    Stream step (ICALFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (ICALFirst s1 s2) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICALFirstInner s s2 i))-                -- i `seq` return (Skip (ICALFirstYield s s2 i))-            Skip s -> return $ Skip (ICALFirst s s2)-            Stop -> return Stop--    {--    step _ (ICALFirstYield s1 s2 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')-            Skip i'    -> Skip (ICALFirstYield s1 s2 i')-            Stop       -> Skip (ICALFirst s1 s2)-    -}--    step _ (ICALFirstInner s1 s2 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')-            Skip i'    -> Skip (ICALFirstInner s1 s2 i')-            Stop       -> Skip (ICALSecondInject s1 s2)--    step gst (ICALFirstOnly s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICALFirstOnlyInner s i))-            Skip s -> return $ Skip (ICALFirstOnly s)-            Stop -> return Stop--    step _ (ICALFirstOnlyInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')-            Skip i'    -> Skip (ICALFirstOnlyInner s1 i')-            Stop       -> Skip (ICALFirstOnly s1)--    -- We inject the second stream even before checking if the first stream-    -- would yield any more elements. There is no clear choice whether we-    -- should do this before or after that. Doing it after may make the state-    -- machine a bit simpler though.-    step gst (ICALSecondInject s1 s2) = do-        r <- step2 (adaptState gst) s2-        case r of-            Yield a s -> do-                i <- inject2 a-                i `seq` return (Skip (ICALFirstInject s1 s i))-            Skip s -> return $ Skip (ICALSecondInject s1 s)-            Stop -> return $ Skip (ICALFirstOnly s1)--    step gst (ICALFirstInject s1 s2 i2) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICALSecondInner s s2 i i2))-                -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))-            Skip s -> return $ Skip (ICALFirstInject s s2 i2)-            Stop -> return Stop--    {--    step _ (ICALFirstBuf s1 s2 i1 i2) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)-            Skip i'    -> Skip (ICALFirstBuf s1 s2 i' i2)-            Stop       -> Stop--    step _ (ICALSecondInner s1 s2 i1 i2 v) = do-        r <- istep2 i2-        return $ case r of-            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)-            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i' v)-            Stop       -> Skip (ICALFirstResume s1 s2 i1 i2 v)-    -}--    step _ (ICALSecondInner s1 s2 i1 i2) = do-        r <- istep2 i2-        return $ case r of-            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')-            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i')-            Stop       -> Skip (ICALFirstInner s1 s2 i1)-            -- Stop       -> Skip (ICALFirstResume s1 s2 i1 i2)--    {--    step _ (ICALFirstResume s1 s2 i1 i2 x) = do-        return $ Yield x (ICALFirstInner s1 s2 i1 i2)-    -}---- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)---- | 'intersperseMSuffix' followed by unfold and concat.------ >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a--- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity--- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input--- "abc\ndef\nghi\n"----{-# INLINE intercalateSuffix #-}-intercalateSuffix :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)---- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)---- | 'intersperse' followed by unfold and concat.------ >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a--- >>> intersperse = Stream.intercalate Unfold.identity--- >>> unwords = Stream.intercalate Unfold.fromList " "------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input--- "abc def ghi"----{-# INLINE intercalate #-}-intercalate :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalate unf seed str = unfoldMany unf $ intersperse seed str----------------------------------------------------------------------------------- Folding----------------------------------------------------------------------------------- | Apply a stream of folds to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE foldSequence #-}-foldSequence-       :: -- Monad m =>-       Stream m (Fold m a b)-    -> Stream m a-    -> Stream m b-foldSequence _f _m = undefined--{-# ANN type FIterState Fuse #-}-data FIterState s f m a b-    = FIterInit s f-    | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)-    | FIterYield b (FIterState s f m a b)-    | FIterStop---- | Iterate a fold generator on a stream. The initial value @b@ is used to--- generate the first fold, the fold is applied on the stream and the result of--- the fold is used to generate the next fold and so on.------ >>> import Data.Monoid (Sum(..))--- >>> f x = return (Fold.take 2 (Fold.sconcat x))--- >>> s = fmap Sum $ Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- folds where next fold is dependent on the previous fold.------ /Pre-release/----{-# INLINE_NORMAL foldIterateM #-}-foldIterateM ::-       Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b-foldIterateM func seed0 (Stream step state) =-    Stream stepOuter (FIterInit state seed0)--    where--    {-# INLINE iterStep #-}-    iterStep from st fstep extract = do-        res <- from-        return-            $ Skip-            $ case res of-                  FL.Partial fs -> FIterStream st fstep fs extract-                  FL.Done fb -> FIterYield fb $ FIterInit st (return fb)--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (FIterInit st seed) = do-        (FL.Fold fstep initial extract) <- seed >>= func-        iterStep initial st fstep extract-    stepOuter gst (FIterStream st fstep fs extract) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                iterStep (fstep fs x) s fstep extract-            Skip s -> return $ Skip $ FIterStream s fstep fs extract-            Stop -> do-                b <- extract fs-                return $ Skip $ FIterYield b FIterStop-    stepOuter _ (FIterYield a next) = return $ Yield a next-    stepOuter _ FIterStop = return Stop--{-# ANN type CIterState Fuse #-}-data CIterState s f fs b-    = CIterInit s f-    | CIterConsume s fs-    | CIterYield b (CIterState s f fs b)-    | CIterStop---- | Like 'foldIterateM' but using the 'Refold' type instead. This could be--- much more efficient due to stream fusion.------ /Internal/-{-# INLINE_NORMAL refoldIterateM #-}-refoldIterateM ::-       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b-refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =-    Stream stepOuter (CIterInit state initial)--    where--    {-# INLINE iterStep #-}-    iterStep st action = do-        res <- action-        return-            $ Skip-            $ case res of-                  FL.Partial fs -> CIterConsume st fs-                  FL.Done fb -> CIterYield fb $ CIterInit st (return fb)--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (CIterInit st action) = do-        iterStep st (action >>= finject)-    stepOuter gst (CIterConsume st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> iterStep s (fstep fs x)-            Skip s -> return $ Skip $ CIterConsume s fs-            Stop -> do-                b <- fextract fs-                return $ Skip $ CIterYield b CIterStop-    stepOuter _ (CIterYield a next) = return $ Yield a next-    stepOuter _ CIterStop = return Stop---- "n" elements at the end are dropped by the fold.-{-# INLINE sliceBy #-}-sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)-sliceBy (Fold step1 initial1 extract1) n = Refold step inject extract--    where--    inject (i, len) = do-        r <- initial1-        return $ case r of-            Partial s -> Partial $ Tuple' (i + len + n) s-            Done l -> Done (i, l)--    step (Tuple' i s) x = do-        r <- step1 s x-        return $ case r of-            Partial s1 -> Partial $ Tuple' i s1-            Done len -> Done (i, len)--    extract (Tuple' i s) = (i,) <$> extract1 s--{-# INLINE sliceOnSuffix #-}-sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)-sliceOnSuffix predicate =-    -- Scan the stream with the given refold-    refoldIterateM-        (sliceBy (FL.takeEndBy_ predicate FL.length) 1)-        (return (-1, 0))----------------------------------------------------------------------------------- Parsing---------------------------------------------------------------------------------{-# ANN type ParseChunksState Fuse #-}-data ParseChunksState x inpBuf st pst =-      ParseChunksInit inpBuf st-    | ParseChunksInitBuf inpBuf-    | ParseChunksInitLeftOver inpBuf-    | ParseChunksStream st inpBuf !pst-    | ParseChunksStop inpBuf !pst-    | ParseChunksBuf inpBuf st inpBuf !pst-    | ParseChunksExtract inpBuf inpBuf !pst-    | ParseChunksYield x (ParseChunksState x inpBuf st pst)---- XXX return the remaining stream as part of the error.--- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as--- well?-{-# INLINE_NORMAL parseManyD #-}-parseManyD-    :: Monad m-    => PRD.Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseManyD (PRD.Parser pstep initial extract) (Stream step state) =-    Stream stepOuter (ParseChunksInit [] 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 gst (ParseChunksInit [] st) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                res <- initial-                case res of-                    PRD.IPartial ps ->-                        return $ Skip $ ParseChunksBuf [x] s [] ps-                    PRD.IDone pb ->-                        let next = ParseChunksInit [x] s-                         in return $ Skip $ ParseChunksYield (Right pb) next-                    PRD.IError err ->-                        return-                            $ Skip-                            $ ParseChunksYield-                                (Left (ParseError err))-                                (ParseChunksInitLeftOver [])-            Skip s -> return $ Skip $ ParseChunksInit [] s-            Stop   -> return Stop--    -- Buffer is not empty, go to buffered processing loop-    stepOuter _ (ParseChunksInit src st) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ParseChunksBuf src st [] ps-            PRD.IDone pb ->-                let next = ParseChunksInit src st-                 in return $ Skip $ ParseChunksYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- This is simplified ParseChunksInit-    stepOuter _ (ParseChunksInitBuf src) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ParseChunksExtract src [] ps-            PRD.IDone pb ->-                let next = ParseChunksInitBuf src-                 in return $ Skip $ ParseChunksYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- XXX we just discard any leftover input at the end-    stepOuter _ (ParseChunksInitLeftOver _) = return Stop--    -- Buffer is empty, process elements from the stream-    stepOuter gst (ParseChunksStream st buf pst) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 ->-                        return $ Skip $ ParseChunksStream s [] pst1-                    PR.Partial n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ParseChunksBuf src s [] pst1-                    PR.Continue 0 pst1 ->-                        return $ Skip $ ParseChunksStream s (x:buf) pst1-                    PR.Continue n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let (src0, buf1) = splitAt n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ParseChunksBuf src s buf1 pst1-                    PR.Done 0 b -> do-                        return $ Skip $-                            ParseChunksYield (Right b) (ParseChunksInit [] s)-                    PR.Done n b -> do-                        assert (n <= length (x:buf)) (return ())-                        let src = Prelude.reverse (Prelude.take n (x:buf))-                        return $ Skip $-                            ParseChunksYield (Right b) (ParseChunksInit src s)-                    PR.Error err ->-                        return-                            $ Skip-                            $ ParseChunksYield-                                (Left (ParseError err))-                                (ParseChunksInitLeftOver [])-            Skip s -> return $ Skip $ ParseChunksStream s buf pst-            Stop -> return $ Skip $ ParseChunksStop buf pst--    -- go back to stream processing mode-    stepOuter _ (ParseChunksBuf [] s buf pst) =-        return $ Skip $ ParseChunksStream s buf pst--    -- buffered processing loop-    stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ParseChunksBuf xs s [] pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksBuf src s [] pst1-            PR.Continue 0 pst1 ->-                return $ Skip $ ParseChunksBuf xs s (x:buf) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksBuf src s buf1 pst1-            PR.Done 0 b ->-                return-                    $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit src s)-            PR.Error err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- This is simplified ParseChunksBuf-    stepOuter _ (ParseChunksExtract [] buf pst) =-        return $ Skip $ ParseChunksStop buf pst--    stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ParseChunksExtract xs [] pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksExtract src [] pst1-            PR.Continue 0 pst1 ->-                return $ Skip $ ParseChunksExtract xs (x:buf) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b ->-                return-                    $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return-                    $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- This is simplified ParseChunksExtract-    stepOuter _ (ParseChunksStop buf pst) = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"-            PR.Continue 0 pst1 ->-                return $ Skip $ ParseChunksStop buf pst1-            PR.Continue n pst1 -> do-                assert (n <= length buf) (return ())-                let (src0, buf1) = splitAt n buf-                    src  = Prelude.reverse src0-                return $ Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b -> do-                return $ Skip $-                    ParseChunksYield (Right b) (ParseChunksInitLeftOver [])-            PR.Done n b -> do-                assert (n <= length buf) (return ())-                let src = Prelude.reverse (Prelude.take n buf)-                return $ Skip $-                    ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    stepOuter _ (ParseChunksYield a next) = return $ Yield a next---- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the--- output stream.------ Example:------ >>> s = Stream.fromList [1..10]--- >>> parser = Parser.takeBetween 0 2 Fold.sum--- >>> Stream.fold Fold.toList $ Stream.parseMany parser s--- [Right 3,Right 7,Right 11,Right 15,Right 19]------ This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse--- combinator.------ Known Issues: When the parser fails there is no way to get the remaining--- stream.----{-# INLINE parseMany #-}-parseMany-    :: Monad m-    => PR.Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseMany = parseManyD---- | Apply a stream of parsers to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE parseSequence #-}-parseSequence-       :: -- Monad m =>-       Stream m (PR.Parser a m b)-    -> Stream m a-    -> Stream m b-parseSequence _f _m = undefined---- XXX Change the parser arguments' order---- | @parseManyTill collect test stream@ tries the parser @test@ on the input,--- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds--- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The--- output of @test@ is discarded and the output of @collect@ is emitted in the--- output stream. The parser fails if @collect@ fails.------ /Unimplemented/----{-# INLINE parseManyTill #-}-parseManyTill ::-    -- MonadThrow m =>-       PR.Parser a m b-    -> PR.Parser a m x-    -> Stream m a-    -> Stream m b-parseManyTill = undefined--{-# ANN type ConcatParseState Fuse #-}-data ConcatParseState c b inpBuf st p m a =-      ConcatParseInit inpBuf st p-    | ConcatParseInitBuf inpBuf p-    | ConcatParseInitLeftOver inpBuf-    | forall s. ConcatParseStop-        inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | forall s. ConcatParseStream-        st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | forall s. ConcatParseBuf-        inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | forall s. ConcatParseExtract-        inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)---- XXX Review the changes-{-# INLINE_NORMAL parseIterateD #-}-parseIterateD-    :: Monad m-    => (b -> PRD.Parser a m b)-    -> b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseIterateD func seed (Stream step state) =-    Stream stepOuter (ConcatParseInit [] state (func seed))--    where--    {-# INLINE_LATE stepOuter #-}-    -- Buffer is empty, go to stream processing loop-    stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ConcatParseStream st [] pstep ps extract-            PRD.IDone pb ->-                let next = ConcatParseInit [] st (func pb)-                 in return $ Skip $ ConcatParseYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- Buffer is not empty, go to buffered processing loop-    stepOuter _ (ConcatParseInit src st-                    (PRD.Parser pstep initial extract)) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ConcatParseBuf src st [] pstep ps extract-            PRD.IDone pb ->-                let next = ConcatParseInit src st (func pb)-                 in return $ Skip $ ConcatParseYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- This is simplified ConcatParseInit-    stepOuter _ (ConcatParseInitBuf src-                    (PRD.Parser pstep initial extract)) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ConcatParseExtract src [] pstep ps extract-            PRD.IDone pb ->-                let next = ConcatParseInitBuf src (func pb)-                 in return $ Skip $ ConcatParseYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- XXX we just discard any leftover input at the end-    stepOuter _ (ConcatParseInitLeftOver _) = return Stop--    -- Buffer is empty process elements from the stream-    stepOuter gst (ConcatParseStream st buf pstep pst extract) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 ->-                        return $ Skip $ ConcatParseStream s [] pstep pst1 extract-                    PR.Partial n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract-                    -- PR.Continue 0 pst1 ->-                    --     return $ Skip $ ConcatParseStream s (x:buf) pst1-                    PR.Continue n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let (src0, buf1) = splitAt n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract-                    -- XXX Specialize for Stop 0 common case?-                    PR.Done n b -> do-                        assert (n <= length (x:buf)) (return ())-                        let src = Prelude.reverse (Prelude.take n (x:buf))-                        return $ Skip $-                            ConcatParseYield (Right b) (ConcatParseInit src s (func b))-                    PR.Error err ->-                        return-                            $ Skip-                            $ ConcatParseYield-                                (Left (ParseError err))-                                (ConcatParseInitLeftOver [])-            Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract-            Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract--    -- go back to stream processing mode-    stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =-        return $ Skip $ ConcatParseStream s buf pstep ps extract--    -- buffered processing loop-    stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract-         -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract-            -- XXX Specialize for Stop 0 common case?-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return $ Skip $ ConcatParseYield (Right b)-                                    (ConcatParseInit src s (func b))-            PR.Error err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- This is simplified ConcatParseBuf-    stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =-        return $ Skip $ ConcatParseStop buf pstep pst extract--    stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseExtract src [] pstep pst1 extract-            PR.Continue 0 pst1 ->-                return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract-            PR.Done 0 b ->-                 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))-            PR.Error err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- This is simplified ConcatParseExtract-    stepOuter _ (ConcatParseStop buf pstep pst extract) = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"-            PR.Continue 0 pst1 ->-                return $ Skip $ ConcatParseStop buf pstep pst1 extract-            PR.Continue n pst1 -> do-                assert (n <= length buf) (return ())-                let (src0, buf1) = splitAt n buf-                    src  = Prelude.reverse src0-                return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract-            PR.Done 0 b -> do-                return $ Skip $-                    ConcatParseYield (Right b) (ConcatParseInitLeftOver [])-            PR.Done n b -> do-                assert (n <= length buf) (return ())-                let src = Prelude.reverse (Prelude.take n buf)-                return $ Skip $-                    ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))-            PR.Error err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    stepOuter _ (ConcatParseYield a next) = return $ Yield a next---- | Iterate a parser generating function on a stream. The initial value @b@ is--- used to generate the first parser, the parser is applied on the stream and--- the result is used to generate the next parser and so on.------ >>> import Data.Monoid (Sum(..))--- >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- parsers where next parser is dependent on the previous parser.------ /Pre-release/----{-# INLINE parseIterate #-}-parseIterate-    :: Monad m-    => (b -> PR.Parser a m b)-    -> b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseIterate = parseIterateD----------------------------------------------------------------------------------- Grouping---------------------------------------------------------------------------------data GroupByState st fs a b-    = GroupingInit st-    | GroupingDo st !fs-    | GroupingInitWith st !a-    | GroupingDoWith st !fs !a-    | GroupingYield !b (GroupByState st fs a b)-    | GroupingDone--{-# INLINE_NORMAL groupsBy #-}-groupsBy :: Monad m-    => (a -> a -> Bool)-    -> Fold m a b-    -> Stream m a-    -> Stream m b-{--groupsBy eq fld = parseMany (PRD.groupBy eq fld)--}-groupsBy cmp (Fold fstep initial done) (Stream step state) =-    Stream stepOuter (GroupingInit state)--    where--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (GroupingInit st) = do-        -- XXX Note that if the stream stops without yielding a single element-        -- in the group we discard the "initial" effect.-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ GroupingDo st s-                  FL.Done b -> Yield b $ GroupingInit st-    stepOuter gst (GroupingDo st fs) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep fs x-                case r of-                    FL.Partial fs1 -> go SPEC x s fs1-                    FL.Done b -> return $ Yield b (GroupingInit s)-            Skip s -> return $ Skip $ GroupingDo s fs-            Stop -> return Stop--        where--        go !_ prev stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp x prev-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC prev s fs1-                            FL.Done b -> return $ Yield b (GroupingInit s)-                    else do-                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                Skip s -> go SPEC prev s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingInitWith st x) = do-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ GroupingDoWith st s x-                  FL.Done b -> Yield b $ GroupingInitWith st x-    stepOuter gst (GroupingDoWith st fs prev) = do-        res <- fstep fs prev-        case res of-            FL.Partial fs1 -> go SPEC st fs1-            FL.Done b -> return $ Yield b (GroupingInit st)--        where--        -- XXX code duplicated from the previous equation-        go !_ stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp x prev-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC s fs1-                            FL.Done b -> return $ Yield b (GroupingInit s)-                    else do-                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                Skip s -> go SPEC s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingYield _ _) = error "groupsBy: Unreachable"-    stepOuter _ GroupingDone = return Stop--{-# INLINE_NORMAL groupsRollingBy #-}-groupsRollingBy :: Monad m-    => (a -> a -> Bool)-    -> Fold m a b-    -> Stream m a-    -> Stream m b-{--groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)--}-groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =-    Stream stepOuter (GroupingInit state)--    where--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (GroupingInit st) = do-        -- XXX Note that if the stream stops without yielding a single element-        -- in the group we discard the "initial" effect.-        res <- initial-        return-            $ case res of-                  FL.Partial fs -> Skip $ GroupingDo st fs-                  FL.Done fb -> Yield fb $ GroupingInit st-    stepOuter gst (GroupingDo st fs) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep fs x-                case r of-                    FL.Partial fs1 -> go SPEC x s fs1-                    FL.Done fb -> return $ Yield fb (GroupingInit s)-            Skip s -> return $ Skip $ GroupingDo s fs-            Stop -> return Stop--        where--        go !_ prev stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp prev x-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC x s fs1-                            FL.Done b -> return $ Yield b (GroupingInit s)-                    else do-                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                Skip s -> go SPEC prev s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingInitWith st x) = do-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ GroupingDoWith st s x-                  FL.Done b -> Yield b $ GroupingInitWith st x-    stepOuter gst (GroupingDoWith st fs previous) = do-        res <- fstep fs previous-        case res of-            FL.Partial s -> go SPEC previous st s-            FL.Done b -> return $ Yield b (GroupingInit st)--        where--        -- XXX GHC: groupsBy has one less parameter in this go loop and it-        -- fuses. However, groupsRollingBy does not fuse, removing the prev-        -- parameter makes it fuse. Something needs to be fixed in GHC. The-        -- workaround for this is noted in the comments below.-        go !_ prev !stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp prev x-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC x s fs1-                            FL.Done b -> return $ Yield b (GroupingInit st)-                    else do-                        {--                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                        -}-                        -- The code above does not let groupBy fuse. We use the-                        -- alternative code below instead.  Instead of jumping-                        -- to GroupingInitWith state, we unroll the code of-                        -- GroupingInitWith state here to help GHC with stream-                        -- fusion.-                        result <- initial-                        r <- done acc-                        return-                            $ Yield r-                            $ case result of-                                  FL.Partial fsi -> GroupingDoWith s fsi x-                                  FL.Done b -> GroupingYield b (GroupingInit s)-                Skip s -> go SPEC prev s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingYield r next) = return $ Yield r next-    stepOuter _ GroupingDone = return Stop----------------------------------------------------------------------------------- Splitting - by a predicate---------------------------------------------------------------------------------data WordsByState st fs b-    = WordsByInit st-    | WordsByDo st !fs-    | WordsByDone-    | WordsByYield !b (WordsByState st fs b)--{-# INLINE_NORMAL wordsBy #-}-wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-wordsBy predicate (Fold fstep initial done) (Stream step state) =-    Stream stepOuter (WordsByInit state)--    where--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (WordsByInit st) = do-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ WordsByDo st s-                  FL.Done b -> Yield b (WordsByInit st)--    stepOuter gst (WordsByDo st fs) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                if predicate x-                then do-                    resi <- initial-                    return-                        $ case resi of-                              FL.Partial fs1 -> Skip $ WordsByDo s fs1-                              FL.Done b -> Yield b (WordsByInit s)-                else do-                    r <- fstep fs x-                    case r of-                        FL.Partial fs1 -> go SPEC s fs1-                        FL.Done b -> return $ Yield b (WordsByInit s)-            Skip s    -> return $ Skip $ WordsByDo s fs-            Stop      -> return Stop--        where--        go !_ stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if predicate x-                    then do-                        {--                        r <- done acc-                        return $ Yield r (WordsByInit s)-                        -}-                        -- The above code does not fuse well. Need to check why-                        -- GHC is not able to simplify it well.  Using the code-                        -- below, instead of jumping through the WordsByInit-                        -- state always, we directly go to WordsByDo state in-                        -- the common case of Partial.-                        resi <- initial-                        r <- done acc-                        return-                            $ Yield r-                            $ case resi of-                                  FL.Partial fs1 -> WordsByDo s fs1-                                  FL.Done b -> WordsByYield b (WordsByInit s)-                    else do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC s fs1-                            FL.Done b -> return $ Yield b (WordsByInit s)-                Skip s -> go SPEC s acc-                Stop -> done acc >>= \r -> return $ Yield r WordsByDone--    stepOuter _ WordsByDone = return Stop--    stepOuter _ (WordsByYield b next) = return $ Yield b next----------------------------------------------------------------------------------- Splitting on a sequence----------------------------------------------------------------------------------- String search algorithms:--- http://www-igm.univ-mlv.fr/~lecroq/string/index.html--{---- TODO can we unify the splitting operations using a splitting configuration--- like in the split package.----data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)-data SplitOptions = SplitOptions-    { style    :: SplitStyle-    , withSep  :: Bool  -- ^ keep the separators in output-    -- , compact  :: Bool  -- ^ treat multiple consecutive separators as one-    -- , trimHead :: Bool  -- ^ drop blank at head-    -- , trimTail :: Bool  -- ^ drop blank at tail-    }--}---- XXX using "fs" as the last arg in Constructors may simplify the code a bit,--- because we can use the constructor directly without having to create "jump"--- functions.-{-# ANN type SplitOnSeqState Fuse #-}-data SplitOnSeqState rb rh ck w fs s b x =-      SplitOnSeqInit-    | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)-    | SplitOnSeqDone--    | SplitOnSeqEmpty !fs s--    | SplitOnSeqSingle !fs s x--    | SplitOnSeqWordInit !fs s-    | SplitOnSeqWordLoop !w s !fs-    | SplitOnSeqWordDone Int !fs !w--    | SplitOnSeqKRInit Int !fs s rb !rh-    | SplitOnSeqKRLoop fs s rb !rh !ck-    | SplitOnSeqKRCheck fs s rb !rh-    | SplitOnSeqKRDone Int !fs rb !rh--    | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)--{-# INLINE_NORMAL splitOnSeq #-}-splitOnSeq-    :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)-    => Array a-    -> Fold m a b-    -> Stream m a-    -> Stream m b-splitOnSeq patArr (Fold fstep initial done) (Stream step state) =-    Stream stepOuter SplitOnSeqInit--    where--    patLen = A.length patArr-    maxIndex = patLen - 1-    elemBits = SIZE_OF(a) * 8--    -- For word pattern case-    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    elemMask :: Word-    elemMask = (1 `shiftL` elemBits) - 1--    wordPat :: Word-    wordPat = wordMask .&. A.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    patHash = A.foldl' addCksum 0 patArr--    skip = return . Skip--    nextAfterInit nextGen stepRes =-        case stepRes of-            FL.Partial s -> nextGen s-            FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)--    {-# INLINE yieldProceed #-}-    yieldProceed nextGen fs =-        initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ SplitOnSeqInit = do-        res <- initial-        case res of-            FL.Partial acc ->-                if patLen == 0-                then return $ Skip $ SplitOnSeqEmpty acc state-                else if patLen == 1-                     then do-                         pat <- liftIO $ A.unsafeIndexIO 0 patArr-                         return $ Skip $ SplitOnSeqSingle acc state pat-                     else if SIZE_OF(a) * patLen-                               <= sizeOf (Proxy :: Proxy Word)-                          then return $ Skip $ SplitOnSeqWordInit acc state-                          else do-                              (rb, rhead) <- liftIO $ RB.new patLen-                              skip $ SplitOnSeqKRInit 0 acc state rb rhead-            FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit--    stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next--    ----------------------------    -- Checkpoint-    -----------------------------    stepOuter _ (SplitOnSeqReinit nextGen) =-        initial >>= skip . nextAfterInit nextGen--    ----------------------------    -- Empty pattern-    -----------------------------    stepOuter gst (SplitOnSeqEmpty acc st) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep acc x-                b1 <--                    case r of-                        FL.Partial acc1 -> done acc1-                        FL.Done b -> return b-                let jump c = SplitOnSeqEmpty c s-                 in yieldProceed jump b1-            Skip s -> skip (SplitOnSeqEmpty acc s)-            Stop -> return Stop--    ------------------    -- Done-    -------------------    stepOuter _ SplitOnSeqDone = return Stop--    ------------------    -- Single Pattern-    -------------------    stepOuter gst (SplitOnSeqSingle fs st pat) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                let jump c = SplitOnSeqSingle c s pat-                if pat == x-                then done fs >>= yieldProceed jump-                else do-                    r <- fstep fs x-                    case r of-                        FL.Partial fs1 -> skip $ jump fs1-                        FL.Done b -> yieldProceed jump b-            Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat-            Stop -> do-                r <- done fs-                return $ Skip $ SplitOnSeqYield r SplitOnSeqDone--    ----------------------------    -- Short Pattern - Shift Or-    -----------------------------    stepOuter _ (SplitOnSeqWordDone 0 fs _) = do-        r <- done fs-        skip $ SplitOnSeqYield r SplitOnSeqDone-    stepOuter _ (SplitOnSeqWordDone n fs wrd) = do-        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))-        r <- fstep fs (toEnum $ fromIntegral old)-        case r of-            FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd-            FL.Done b -> do-                 let jump c = SplitOnSeqWordDone (n - 1) c wrd-                 yieldProceed jump b--    stepOuter gst (SplitOnSeqWordInit fs st0) =-        go SPEC 0 0 st0--        where--        {-# INLINE go #-}-        go !_ !idx !wrd !st = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let wrd1 = addToWord wrd x-                    if idx == maxIndex-                    then do-                        if wrd1 .&. wordMask == wordPat-                        then do-                            let jump c = SplitOnSeqWordInit c s-                            done fs >>= yieldProceed jump-                        else skip $ SplitOnSeqWordLoop wrd1 s fs-                    else go SPEC (idx + 1) wrd1 s-                Skip s -> go SPEC idx wrd s-                Stop -> do-                    if idx /= 0-                    then skip $ SplitOnSeqWordDone idx fs wrd-                    else do-                        r <- done fs-                        skip $ SplitOnSeqYield r SplitOnSeqDone--    stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =-        go SPEC wrd0 st0 fs0--        where--        {-# INLINE go #-}-        go !_ !wrd !st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let jump c = SplitOnSeqWordInit c s-                        wrd1 = addToWord wrd x-                        old = (wordMask .&. wrd)-                                `shiftR` (elemBits * (patLen - 1))-                    r <- fstep fs (toEnum $ fromIntegral old)-                    case r of-                        FL.Partial fs1 -> do-                            if wrd1 .&. wordMask == wordPat-                            then done fs1 >>= yieldProceed jump-                            else go SPEC wrd1 s fs1-                        FL.Done b -> yieldProceed jump b-                Skip s -> go SPEC wrd s fs-                Stop -> skip $ SplitOnSeqWordDone patLen fs wrd--    --------------------------------    -- General Pattern - Karp Rabin-    ---------------------------------    stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                rh1 <- liftIO $ RB.unsafeInsert rb rh x-                if idx == maxIndex-                then do-                    let fld = RB.unsafeFoldRing (RB.ringBound rb)-                    let !ringHash = fld addCksum 0 rb-                    if ringHash == patHash-                    then skip $ SplitOnSeqKRCheck fs s rb rh1-                    else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash-                else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1-            Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh-            Stop -> do-                skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)--    -- XXX The recursive "go" is more efficient than the state based recursion-    -- code commented out below. Perhaps its more efficient because of-    -- factoring out "rb" outside the loop.-    ---    stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =-        go SPEC fs0 st0 rh0 cksum0--        where--        go !_ !fs !st !rh !cksum = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    old <- liftIO $ peek rh-                    let cksum1 = deltaCksum cksum old x-                    r <- fstep fs old-                    case r of-                        FL.Partial fs1 -> do-                            rh1 <- liftIO (RB.unsafeInsert rb rh x)-                            if cksum1 == patHash-                            then skip $ SplitOnSeqKRCheck fs1 s rb rh1-                            else go SPEC fs1 s rh1 cksum1-                        FL.Done b -> do-                            let rst = RB.startOf rb-                                jump c = SplitOnSeqKRInit 0 c s rb rst-                            yieldProceed jump b-                Skip s -> go SPEC fs s rh cksum-                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh--    -- XXX The following code is 5 times slower compared to the recursive loop-    -- based code above. Need to investigate why. One possibility is that the-    -- go loop above does not thread around the ring buffer (rb). This code may-    -- be causing the state to bloat and getting allocated on each iteration.-    -- We can check the cmm/asm code to confirm.  If so a good GHC solution to-    -- such problem is needed. One way to avoid this could be to use unboxed-    -- mutable state?-    {--    stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    old <- liftIO $ peek rh-                    let cksum1 = deltaCksum cksum old x-                    fs1 <- fstep fs old-                    if (cksum1 == patHash)-                    then do-                        r <- done fs1-                        skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh-                    else do-                        rh1 <- liftIO (RB.unsafeInsert rb rh x)-                        skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1-                Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum-                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh-    -}--    stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do-        if RB.unsafeEqArray rb rh patArr-        then do-            r <- done fs-            let rst = RB.startOf rb-                jump c = SplitOnSeqKRInit 0 c st rb rst-            yieldProceed jump r-        else skip $ SplitOnSeqKRLoop fs st rb rh patHash--    stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do-        r <- done fs-        skip $ SplitOnSeqYield r SplitOnSeqDone-    stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do-        old <- liftIO $ peek rh-        let rh1 = RB.advance rb rh-        r <- fstep fs old-        case r of-            FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1-            FL.Done b -> do-                 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1-                 yieldProceed jump b--{-# ANN type SplitOnSuffixSeqState Fuse #-}-data SplitOnSuffixSeqState rb rh ck w fs s b x =-      SplitOnSuffixSeqInit-    | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)-    | SplitOnSuffixSeqDone--    | SplitOnSuffixSeqEmpty !fs s--    | SplitOnSuffixSeqSingleInit !fs s x-    | SplitOnSuffixSeqSingle !fs s x--    | SplitOnSuffixSeqWordInit !fs s-    | SplitOnSuffixSeqWordLoop !w s !fs-    | SplitOnSuffixSeqWordDone Int !fs !w--    | SplitOnSuffixSeqKRInit Int !fs s rb !rh-    | SplitOnSuffixSeqKRInit1 !fs s rb !rh-    | SplitOnSuffixSeqKRLoop fs s rb !rh !ck-    | SplitOnSuffixSeqKRCheck fs s rb !rh-    | SplitOnSuffixSeqKRDone Int !fs rb !rh--    | SplitOnSuffixSeqReinit-          (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)--{-# INLINE_NORMAL splitOnSuffixSeq #-}-splitOnSuffixSeq-    :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)-    => Bool-    -> Array a-    -> Fold m a b-    -> Stream m a-    -> Stream m b-splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =-    Stream stepOuter SplitOnSuffixSeqInit--    where--    patLen = A.length patArr-    maxIndex = patLen - 1-    elemBits = SIZE_OF(a) * 8--    -- For word pattern case-    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    elemMask :: Word-    elemMask = (1 `shiftL` elemBits) - 1--    wordPat :: Word-    wordPat = wordMask .&. A.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    nextAfterInit nextGen stepRes =-        case stepRes of-            FL.Partial s -> nextGen s-            FL.Done b ->-                SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)--    {-# INLINE yieldProceed #-}-    yieldProceed nextGen fs =-        initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen--    -- For single element pattern case-    {-# INLINE processYieldSingle #-}-    processYieldSingle pat x s fs = do-        let jump c = SplitOnSuffixSeqSingleInit c s pat-        if pat == x-        then do-            r <- if withSep then fstep fs x else return $ FL.Partial fs-            b1 <--                case r of-                    FL.Partial fs1 -> done fs1-                    FL.Done b -> return b-            yieldProceed jump b1-        else do-            r <- fstep fs x-            case r of-                FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat-                FL.Done b -> yieldProceed jump b--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    patHash = A.foldl' addCksum 0 patArr--    skip = return . Skip--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ SplitOnSuffixSeqInit = do-        res <- initial-        case res of-            FL.Partial fs ->-                if patLen == 0-                then skip $ SplitOnSuffixSeqEmpty fs state-                else if patLen == 1-                     then do-                         pat <- liftIO $ A.unsafeIndexIO 0 patArr-                         skip $ SplitOnSuffixSeqSingleInit fs state pat-                     else if SIZE_OF(a) * patLen-                               <= sizeOf (Proxy :: Proxy Word)-                          then skip $ SplitOnSuffixSeqWordInit fs state-                          else do-                              (rb, rhead) <- liftIO $ RB.new patLen-                              skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead-            FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit--    stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next--    ----------------------------    -- Reinit-    -----------------------------    stepOuter _ (SplitOnSuffixSeqReinit nextGen) =-        initial >>= skip . nextAfterInit nextGen--    ----------------------------    -- Empty pattern-    -----------------------------    stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                let jump c = SplitOnSuffixSeqEmpty c s-                r <- fstep acc x-                b1 <--                    case r of-                        FL.Partial fs -> done fs-                        FL.Done b -> return b-                yieldProceed jump b1-            Skip s -> skip (SplitOnSuffixSeqEmpty acc s)-            Stop -> return Stop--    ------------------    -- Done-    -------------------    stepOuter _ SplitOnSuffixSeqDone = return Stop--    ------------------    -- Single Pattern-    -------------------    stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> processYieldSingle pat x s fs-            Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat-            Stop -> return Stop--    stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> processYieldSingle pat x s fs-            Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat-            Stop -> do-                r <- done fs-                skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone--    ----------------------------    -- Short Pattern - Shift Or-    -----------------------------    stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do-        r <- done fs-        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-    stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do-        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))-        r <- fstep fs (toEnum $ fromIntegral old)-        case r of-            FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd-            FL.Done b -> do-                let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd-                yieldProceed jump b--    stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do-        res <- step (adaptState gst) st0-        case res of-            Yield x s -> do-                let wrd = addToWord 0 x-                r <- if withSep then fstep fs0 x else return $ FL.Partial fs0-                case r of-                    FL.Partial fs1 -> go SPEC 1 wrd s fs1-                    FL.Done b -> do-                        let jump c = SplitOnSuffixSeqWordInit c s-                        yieldProceed jump b-            Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)-            Stop -> return Stop--        where--        {-# INLINE go #-}-        go !_ !idx !wrd !st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let jump c = SplitOnSuffixSeqWordInit c s-                    let wrd1 = addToWord wrd x-                    r <- if withSep then fstep fs x else return $ FL.Partial fs-                    case r of-                        FL.Partial fs1 ->-                            if idx /= maxIndex-                            then go SPEC (idx + 1) wrd1 s fs1-                            else if wrd1 .&. wordMask /= wordPat-                            then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1-                            else do done fs >>= yieldProceed jump-                        FL.Done b -> yieldProceed jump b-                Skip s -> go SPEC idx wrd s fs-                Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd--    stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =-        go SPEC wrd0 st0 fs0--        where--        {-# INLINE go #-}-        go !_ !wrd !st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let jump c = SplitOnSuffixSeqWordInit c s-                        wrd1 = addToWord wrd x-                        old = (wordMask .&. wrd)-                                `shiftR` (elemBits * (patLen - 1))-                    r <--                        if withSep-                        then fstep fs x-                        else fstep fs (toEnum $ fromIntegral old)-                    case r of-                        FL.Partial fs1 ->-                            if wrd1 .&. wordMask == wordPat-                            then done fs1 >>= yieldProceed jump-                            else go SPEC wrd1 s fs1-                        FL.Done b -> yieldProceed jump b-                Skip s -> go SPEC wrd s fs-                Stop ->-                    if wrd .&. wordMask == wordPat-                    then return Stop-                    else if withSep-                    then do-                        r <- done fs-                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-                    else skip $ SplitOnSuffixSeqWordDone patLen fs wrd--    --------------------------------    -- General Pattern - Karp Rabin-    ---------------------------------    stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do-        res <- step (adaptState gst) st0-        case res of-            Yield x s -> do-                rh1 <- liftIO $ RB.unsafeInsert rb rh0 x-                r <- if withSep then fstep fs x else return $ FL.Partial fs-                case r of-                    FL.Partial fs1 ->-                        skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1-                    FL.Done b -> do-                        let rst = RB.startOf rb-                            jump c = SplitOnSuffixSeqKRInit 0 c s rb rst-                        yieldProceed jump b-            Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0-            Stop -> return Stop--    stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do-        go SPEC 1 rh0 st0 fs0--        where--        go !_ !idx !rh st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    rh1 <- liftIO (RB.unsafeInsert rb rh x)-                    r <- if withSep then fstep fs x else return $ FL.Partial fs-                    case r of-                        FL.Partial fs1 ->-                            if idx /= maxIndex-                            then go SPEC (idx + 1) rh1 s fs1-                            else skip $-                                let fld = RB.unsafeFoldRing (RB.ringBound rb)-                                    !ringHash = fld addCksum 0 rb-                                 in if ringHash == patHash-                                    then SplitOnSuffixSeqKRCheck fs1 s rb rh1-                                    else SplitOnSuffixSeqKRLoop-                                            fs1 s rb rh1 ringHash-                        FL.Done b -> do-                            let rst = RB.startOf rb-                                jump c = SplitOnSuffixSeqKRInit 0 c s rb rst-                            yieldProceed jump b-                Skip s -> go SPEC idx rh s fs-                Stop -> do-                    -- do not issue a blank segment when we end at pattern-                    if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr-                    then return Stop-                    else if withSep-                    then do-                        r <- done fs-                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-                    else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)--    stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =-        go SPEC fs0 st0 rh0 cksum0--        where--        go !_ !fs !st !rh !cksum = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    old <- liftIO $ peek rh-                    rh1 <- liftIO (RB.unsafeInsert rb rh x)-                    let cksum1 = deltaCksum cksum old x-                    r <- if withSep then fstep fs x else fstep fs old-                    case r of-                        FL.Partial fs1 ->-                            if cksum1 /= patHash-                            then go SPEC fs1 s rh1 cksum1-                            else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1-                        FL.Done b -> do-                            let rst = RB.startOf rb-                                jump c = SplitOnSuffixSeqKRInit 0 c s rb rst-                            yieldProceed jump b-                Skip s -> go SPEC fs s rh cksum-                Stop ->-                    if RB.unsafeEqArray rb rh patArr-                    then return Stop-                    else if withSep-                    then do-                        r <- done fs-                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-                    else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh--    stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do-        if RB.unsafeEqArray rb rh patArr-        then do-            r <- done fs-            let rst = RB.startOf rb-                jump c = SplitOnSuffixSeqKRInit 0 c st rb rst-            yieldProceed jump r-        else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash--    stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do-        r <- done fs-        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-    stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do-        old <- liftIO $ peek rh-        let rh1 = RB.advance rb rh-        r <- fstep fs old-        case r of-            FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1-            FL.Done b -> do-                let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1-                yieldProceed jump b---- Implement this as a fold or a parser instead.--- This can be implemented easily using Rabin Karp--- | Split post any one of the given patterns.------ /Unimplemented/-{-# INLINE splitOnSuffixSeqAny #-}-splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnSuffixSeqAny _subseq _f _m = undefined-    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)---- | Split on a prefixed separator element, dropping the separator.  The--- supplied 'Fold' is applied on the split segments.------ @--- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)--- > splitOnPrefix' (== '.') ".a.b"--- ["a","b"]--- @------ An empty stream results in an empty output stream:--- @--- > splitOnPrefix' (== '.') ""--- []--- @------ An empty segment consisting of only a prefix is folded to the default output--- of the fold:------ @--- > splitOnPrefix' (== '.') "."--- [""]------ > splitOnPrefix' (== '.') ".a.b."--- ["a","b",""]------ > splitOnPrefix' (== '.') ".a..b"--- ["a","","b"]------ @------ A prefix is optional at the beginning of the stream:------ @--- > splitOnPrefix' (== '.') "a"--- ["a"]------ > splitOnPrefix' (== '.') "a.b"--- ["a","b"]--- @------ 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:------ > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id------ Assuming the input stream does not contain the separator:------ > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id------ /Unimplemented/-{-# INLINE splitOnPrefix #-}-splitOnPrefix :: -- (IsStream t, MonadCatch m) =>-    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-splitOnPrefix _predicate _f = undefined-    -- parseMany (Parser.sliceBeginBy predicate f)---- Int list examples for splitOn:------ >>> splitList [] [1,2,3,3,4]--- > [[1],[2],[3],[3],[4]]------ >>> splitList [5] [1,2,3,3,4]--- > [[1,2,3,3,4]]------ >>> splitList [1] [1,2,3,3,4]--- > [[],[2,3,3,4]]------ >>> splitList [4] [1,2,3,3,4]--- > [[1,2,3,3],[]]------ >>> splitList [2] [1,2,3,3,4]--- > [[1],[3,3,4]]------ >>> splitList [3] [1,2,3,3,4]--- > [[1,2],[],[4]]------ >>> splitList [3,3] [1,2,3,3,4]--- > [[1,2],[4]]------ >>> splitList [1,2,3,3,4] [1,2,3,3,4]--- > [[],[]]---- This can be implemented easily using Rabin Karp--- | Split on any one of the given patterns.------ /Unimplemented/----{-# INLINE splitOnAny #-}-splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnAny _subseq _f _m =-    undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)----------------------------------------------------------------------------------- Nested Container Transformation---------------------------------------------------------------------------------{-# ANN type SplitState Fuse #-}-data SplitState s arr-    = SplitInitial s-    | SplitBuffering s arr-    | SplitSplitting s arr-    | SplitYielding arr (SplitState s arr)-    | SplitFinishing---- XXX An alternative approach would be to use a partial fold (Fold m a b) to--- split using a splitBy like combinator. The Fold would consume upto the--- separator and return any leftover which can then be fed to the next fold.------ We can revisit this once we have partial folds/parsers.------ | Performs infix separator style splitting.-{-# INLINE_NORMAL splitInnerBy #-}-splitInnerBy-    :: Monad m-    => (f a -> m (f a, Maybe (f a)))  -- splitter-    -> (f a -> f a -> m (f a))        -- joiner-    -> Stream m (f a)-    -> Stream m (f a)-splitInnerBy splitter joiner (Stream step1 state1) =-    Stream step (SplitInitial state1)--    where--    {-# INLINE_LATE step #-}-    step gst (SplitInitial st) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s x1)-                    Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitInitial s)-            Stop -> return Stop--    step gst (SplitBuffering st buf) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                buf' <- joiner buf x1-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s buf')-                    Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitBuffering s buf)-            Stop -> return $ Skip (SplitYielding buf SplitFinishing)--    step _ (SplitSplitting st buf) = do-        (x1, mx2) <- splitter buf-        return $ case mx2 of-                Nothing -> Skip $ SplitBuffering st x1-                Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)--    step _ (SplitYielding x next) = return $ Yield x next-    step _ SplitFinishing = return Stop---- | Performs infix separator style splitting.-{-# INLINE_NORMAL splitInnerBySuffix #-}-splitInnerBySuffix-    :: (Monad m, Eq (f a), Monoid (f a))-    => (f a -> m (f a, Maybe (f a)))  -- splitter-    -> (f a -> f a -> m (f a))        -- joiner-    -> Stream m (f a)-    -> Stream m (f a)-splitInnerBySuffix splitter joiner (Stream step1 state1) =-    Stream step (SplitInitial state1)--    where--    {-# INLINE_LATE step #-}-    step gst (SplitInitial st) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s x1)-                    Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitInitial s)-            Stop -> return Stop--    step gst (SplitBuffering st buf) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                buf' <- joiner buf x1-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s buf')-                    Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitBuffering s buf)-            Stop -> return $-                if buf == mempty-                then Stop-                else Skip (SplitYielding buf SplitFinishing)--    step _ (SplitSplitting st buf) = do-        (x1, mx2) <- splitter buf-        return $ case mx2 of-                Nothing -> Skip $ SplitBuffering st x1-                Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)--    step _ (SplitYielding x next) = return $ Yield x next-    step _ SplitFinishing = return Stop----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Drop prefix from the input stream if present.------ Space: @O(1)@------ /Unimplemented/-{-# INLINE dropPrefix #-}-dropPrefix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropPrefix = error "Not implemented yet!"---- | Drop all matching infix from the input stream if present. Infix stream--- may be consumed multiple times.------ Space: @O(n)@ where n is the length of the infix.------ /Unimplemented/-{-# INLINE dropInfix #-}-dropInfix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropInfix = error "Not implemented yet!"---- | Drop suffix from the input stream if present. Suffix stream may be--- consumed multiple times.------ Space: @O(n)@ where n is the length of the suffix.------ /Unimplemented/-{-# INLINE dropSuffix #-}-dropSuffix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropSuffix = error "Not implemented yet!"
− src/Streamly/Internal/Data/Stream/StreamD/Step.hs 
@@ -1,39 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Step--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.StreamD.Step-    (-    -- * The stream type-      Step (..)-    )-where--import Fusion.Plugin.Types (Fuse(..))---- | A stream is a succession of 'Step's. A 'Yield' produces a single value and--- the next state of the stream. 'Stop' indicates there are no more values in--- the stream.-{-# ANN type Step Fuse #-}-data Step s a = Yield a s | Skip s | Stop--instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap f (Yield x s) = Yield (f x) s-    fmap _ (Skip s) = Skip s-    fmap _ Stop = Stop--{--fromPure :: Monad m => a -> s -> m (Step s a)-fromPure a = return . Yield a--skip :: Monad m => s -> m (Step s a)-skip = return . Skip--stop :: Monad m => m (Step s a)-stop = return Stop--}
− src/Streamly/Internal/Data/Stream/StreamD/Top.hs 
@@ -1,353 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Top--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Top level module that can depend on all other lower level Stream modules.--module Streamly.Internal.Data.Stream.StreamD.Top-    (-    -- * Transformation-    -- ** Sampling-    -- | Value agnostic filtering.-      strideFromThen--    -- * Nesting-    -- ** Set like operations-    -- | These are not exactly set operations because streams are not-    -- necessarily sets, they may have duplicated elements. These operations-    -- are generic i.e. they work on streams of unconstrained types, therefore,-    -- they have quadratic performance characterstics. For better performance-    -- using Set structures see the Streamly.Internal.Data.Stream.Container-    -- module.-    , filterInStreamGenericBy-    , deleteInStreamGenericBy-    , unionWithStreamGenericBy--    -- ** Set like operations on sorted streams-    , filterInStreamAscBy-    , deleteInStreamAscBy-    , unionWithStreamAscBy--    -- ** Join operations-    , joinInnerGeneric--    -- * Joins on sorted stream-    , joinInnerAscBy-    , joinLeftAscBy-    , joinOuterAscBy-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Data.IORef (newIORef, readIORef, modifyIORef')-import Streamly.Internal.Data.Fold.Type (Fold)-import Streamly.Internal.Data.Stream.Common ()-import Streamly.Internal.Data.Stream.StreamD.Type (Stream, cross)--import qualified Data.List as List-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as Stream--import Prelude hiding (filter, zipWith, concatMap, concat)--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Sampling----------------------------------------------------------------------------------- XXX We can implement this using addition instead of "mod" to make it more--- efficient.---- | @strideFromthen offset stride@ takes the element at @offset@ index and--- then every element at strides of @stride@.------ >>> Stream.fold Fold.toList $ Stream.strideFromThen 2 3 $ Stream.enumerateFromTo 0 10--- [2,5,8]----{-# INLINE strideFromThen #-}-strideFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a-strideFromThen offset stride =-    Stream.with Stream.indexed Stream.filter-        (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0)----------------------------------------------------------------------------------- SQL Joins------------------------------------------------------------------------------------- Some references:--- * https://en.wikipedia.org/wiki/Relational_algebra--- * https://en.wikipedia.org/wiki/Join_(SQL)---- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only--- constraint, the best would be to use an Array with linear search. If the--- second stream is sorted we can also use a binary search, using Ord--- constraint or an ordering function.------ For Storables we can cache the second stream into an unboxed array for--- possibly faster access/compact representation?------ If we do not want to keep the stream in memory but always read it from the--- source (disk/network) every time we iterate through it then we can do that--- too by reading the stream every time, the stream must have immutable state--- in that case and the user is responsible for the behavior if the stream--- source changes during iterations. We can also use an Unfold instead of--- stream. We probably need a way to distinguish streams that can be read--- mutliple times without any interference (e.g. unfolding a stream using an--- immutable handle would work i.e. using pread/pwrite instead of maintaining--- an offset in the handle).---- XXX We can do this concurrently.--- XXX If the second stream is sorted and passed as an Array we could use--- binary search if we have an Ord instance or Ordering returning function. The--- time complexity would then become (m x log n).---- | Like 'cross' but emits only those tuples where @a == b@ using the--- supplied equality predicate.------ Definition:------ >>> joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ Stream.cross s1 s2------ You should almost always prefer @joinInnerOrd@ over 'joinInnerGeneric' if--- possible. @joinInnerOrd@ is an order of magnitude faster but may take more--- space for caching the second stream.------ See 'Streamly.Internal.Data.Unfold.joinInnerGeneric' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE joinInnerGeneric #-}-joinInnerGeneric :: Monad m =>-    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)-joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ cross s1 s2-{--joinInnerGeneric eq s1 s2 = do-    -- ConcatMap works faster than bind-    Stream.concatMap (\a ->-        Stream.concatMap (\b ->-            if a `eq` b-            then Stream.fromPure (a, b)-            else Stream.nil-            ) s2-        ) s1--}---- | A more efficient 'joinInner' for sorted streams.------ Space: O(1)------ Time: O(m + n)------ /Unimplemented/-{-# INLINE joinInnerAscBy #-}-joinInnerAscBy ::-    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)-joinInnerAscBy = undefined---- | A more efficient 'joinLeft' for sorted streams.------ Space: O(1)------ Time: O(m + n)------ /Unimplemented/-{-# INLINE joinLeftAscBy #-}-joinLeftAscBy :: -- Monad m =>-    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)-joinLeftAscBy _eq _s1 _s2 = undefined---- | A more efficient 'joinOuter' for sorted streams.------ Space: O(1)------ Time: O(m + n)------ /Unimplemented/-{-# INLINE joinOuterAscBy #-}-joinOuterAscBy :: -- Monad m =>-       (a -> b -> Ordering)-    -> Stream m a-    -> Stream m b-    -> Stream m (Maybe a, Maybe b)-joinOuterAscBy _eq _s1 _s2 = undefined----------------------------------------------------------------------------------- Set operations (special joins)------------------------------------------------------------------------------------- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only constraint--- the best would be to use an Array with linear search. If the second stream--- is sorted we can also use a binary search, using Ord constraint.---- | Keep only those elements in the second stream that are present in the--- first stream too. The first stream is folded to a container using the--- supplied fold and then the elements in the container are looked up using the--- supplied lookup function.------ The first stream must be finite and must not block.-{-# INLINE filterStreamWith #-}-filterStreamWith :: Monad m =>-       Fold m a (f a)-    -> (a -> f a -> Bool)-    -> Stream m a-    -> Stream m a-    -> Stream m a-filterStreamWith fld member s1 s2 =-    Stream.concatEffect-        $ do-            xs <- Stream.fold fld s1-            return $ Stream.filter (`member` xs) s2---- | 'filterInStreamGenericBy' retains only those elements in the second stream that--- are present in the first stream.------ >>> Stream.fold Fold.toList $ Stream.filterInStreamGenericBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])--- [2,1,1]------ >>> Stream.fold Fold.toList $ Stream.filterInStreamGenericBy (==) (Stream.fromList [2,1,1,3]) (Stream.fromList [1,2,2,4])--- [1,2,2]------ Similar to the list intersectBy operation but with the stream argument order--- flipped.------ The first stream must be finite and must not block. Second stream is--- processed only after the first stream is fully realized.------ Space: O(n) where @n@ is the number of elements in the second stream.------ Time: O(m x n) where @m@ is the number of elements in the first stream and--- @n@ is the number of elements in the second stream.------ /Pre-release/-{-# INLINE filterInStreamGenericBy #-}-filterInStreamGenericBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-filterInStreamGenericBy eq =-    -- XXX Use an (unboxed) array instead.-    filterStreamWith-        (Fold.scanMaybe (Fold.uniqBy eq) Fold.toListRev)-        (List.any . eq)---- | Like 'filterInStreamGenericBy' but assumes that the input streams are sorted in--- ascending order. To use it on streams sorted in descending order pass an--- inverted comparison function returning GT for less than and LT for greater--- than.------ Space: O(1)------ Time: O(m+n)------ /Pre-release/-{-# INLINE filterInStreamAscBy #-}-filterInStreamAscBy :: Monad m =>-    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-filterInStreamAscBy eq s1 s2 = Stream.intersectBySorted eq s2 s1---- | Delete all elements of the first stream from the seconds stream. If an--- element occurs multiple times in the first stream as many occurrences of it--- are deleted from the second stream.------ >>> Stream.fold Fold.toList $ Stream.deleteInStreamGenericBy (==) (Stream.fromList [1,2,3]) (Stream.fromList [1,2,2])--- [2]------ The following laws hold:------ > deleteInStreamGenericBy (==) s1 (s1 `append` s2) === s2--- > deleteInStreamGenericBy (==) s1 (s1 `interleave` s2) === s2------ Same as the list 'Data.List.//' operation but with argument order flipped.------ The first stream must be finite and must not block. Second stream is--- processed only after the first stream is fully realized.------ Space: O(m) where @m@ is the number of elements in the first stream.------ Time: O(m x n) where @m@ is the number of elements in the first stream and--- @n@ is the number of elements in the second stream.------ /Pre-release/-{-# INLINE deleteInStreamGenericBy #-}-deleteInStreamGenericBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-deleteInStreamGenericBy eq s1 s2 =-    Stream.concatEffect-        $ do-            -- This may work well if s1 is small-            -- If s1 is big we can go through s1, deleting elements from s2 and-            -- not emitting an element if it was successfully deleted from s2.-            -- we will need a deleteBy that can return whether the element was-            -- deleted or not.-            xs <- Stream.fold Fold.toList s2-            let f = Fold.foldl' (flip (List.deleteBy eq)) xs-            fmap Stream.fromList $ Stream.fold f s1---- | A more efficient 'deleteInStreamGenericBy' for streams sorted in ascending order.------ Space: O(1)------ /Unimplemented/-{-# INLINE deleteInStreamAscBy #-}-deleteInStreamAscBy :: -- (Monad m) =>-    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-deleteInStreamAscBy _eq _s1 _s2 = undefined---- XXX Remove the MonadIO constraint. We can just cache one stream and then--- implement using differenceEqBy.---- | This essentially appends to the second stream all the occurrences of--- elements in the first stream that are not already present in the second--- stream.------ Equivalent to the following except that @s2@ is evaluated only once:------ >>> unionWithStreamGenericBy eq s1 s2 = s2 `Stream.append` (Stream.deleteInStreamGenericBy eq s2 s1)------ Example:------ >>> Stream.fold Fold.toList $ Stream.unionWithStreamGenericBy (==) (Stream.fromList [1,1,2,3]) (Stream.fromList [1,2,2,4])--- [1,2,2,4,3]------ Space: O(n)------ Time: O(m x n)------ /Pre-release/-{-# INLINE unionWithStreamGenericBy #-}-unionWithStreamGenericBy :: MonadIO m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-unionWithStreamGenericBy eq s1 s2 =-    Stream.concatEffect-        $ do-            xs <- Stream.fold Fold.toList  s1-            -- XXX we can use postscanlMAfter' instead of IORef-            ref <- liftIO $ newIORef $! List.nubBy eq xs-            let f x = do-                    liftIO $ modifyIORef' ref (List.deleteBy eq x)-                    return x-                s3 = Stream.concatEffect-                        $ do-                            xs1 <- liftIO $ readIORef ref-                            return $ Stream.fromList xs1-            return $ Stream.mapM f s2 `Stream.append` s3---- | A more efficient 'unionWithStreamGenericBy' for sorted streams.------ Space: O(1)------ /Unimplemented/-{-# INLINE unionWithStreamAscBy #-}-unionWithStreamAscBy :: -- (Monad m) =>-    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-unionWithStreamAscBy _eq _s1 _s2 = undefined
− src/Streamly/Internal/Data/Stream/StreamD/Transform.hs 
@@ -1,1945 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Transform--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ "Streamly.Internal.Data.Pipe" might ultimately replace this module.---- A few functions in this module have been adapted from the vector package--- (c) Roman Leshchinskiy. See the notes in specific combinators.--module Streamly.Internal.Data.Stream.StreamD.Transform-    (-    -- * Piping-    -- | Pass through a 'Pipe'.-      transform--    -- * Mapping-    -- | Stateless one-to-one maps.-    , map-    , mapM-    , sequence--    -- * Mapping Effects-    , tap-    , tapOffsetEvery-    , trace-    , trace_--    -- * Folding-    , foldrS-    , foldlS--    -- * Scanning By 'Fold'-    , postscan-    , scan-    , scanMany--    -- * Splitting-    , splitOn--    -- * Scanning-    -- | Left scans. Stateful, mostly one-to-one maps.-    , scanlM'-    , scanlMAfter'-    , scanl'-    , scanlM-    , scanl-    , scanl1M'-    , scanl1'-    , scanl1M-    , scanl1--    , prescanl'-    , prescanlM'--    , postscanl-    , postscanlM-    , postscanl'-    , postscanlM'-    , postscanlMAfter'--    , postscanlx'-    , postscanlMx'-    , scanlMx'-    , scanlx'--    -- * Filtering-    -- | Produce a subset of the stream.-    , with-    , scanMaybe-    , filter-    , filterM-    , deleteBy-    , uniqBy-    , uniq-    , prune-    , repeated--    -- * Trimming-    -- | Produce a subset of the stream trimmed at ends.-    , take-    , takeWhile-    , takeWhileM-    , takeWhileLast-    , takeWhileAround-    , drop-    , dropWhile-    , dropWhileM-    , dropLast-    , dropWhileLast-    , dropWhileAround--    -- * Inserting Elements-    -- | Produce a superset of the stream.-    , insertBy-    , intersperse-    , intersperseM-    , intersperseMWith-    , intersperseMSuffix-    , intersperseMSuffixWith--    -- * Inserting Side Effects-    , intersperseM_-    , intersperseMSuffix_-    , intersperseMPrefix_--    , delay-    , delayPre-    , delayPost--    -- * Reordering-    -- | Produce strictly the same set but reordered.-    , reverse-    , reverseUnbox-    , reassembleBy--    -- * Position Indexing-    , indexed-    , indexedR--    -- * Time Indexing-    , timestampWith-    , timestamped-    , timeIndexWith-    , timeIndexed--    -- * Searching-    , findIndices-    , elemIndices-    , slicesBy--    -- * Rolling map-    -- | Map using the previous element.-    , rollingMap-    , rollingMapM-    , rollingMap2--    -- * Maybe Streams-    , mapMaybe-    , mapMaybeM-    , catMaybes--    -- * Either Streams-    , catLefts-    , catRights-    , catEithers-    )-where--#include "inline.hs"--import Control.Concurrent (threadDelay)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Data.Either (fromLeft, isLeft, isRight, fromRight)-import Data.Functor ((<&>))-import Data.Maybe (fromJust, isJust)-import Fusion.Plugin.Types (Fuse(..))--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Pipe.Type (Pipe(..), PipeState(..))-import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64)-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.System.IO (defaultChunkSize)---- import qualified Data.List as List-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Pipe.Type as Pipe-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import Prelude hiding-       ( drop, dropWhile, filter, map, mapM, reverse-       , scanl, scanl1, sequence, take, takeWhile, zipWith)--import Streamly.Internal.Data.Stream.StreamD.Generate-    (absTimesWith, relTimesWith)-import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Piping----------------------------------------------------------------------------------- | Use a 'Pipe' to transform a stream.------ /Pre-release/----{-# INLINE_NORMAL transform #-}-transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b-transform (Pipe pstep1 pstep2 pstate) (Stream step state) =-    Stream step' (Consume pstate, state)--  where--    {-# INLINE_LATE step' #-}--    step' gst (Consume pst, st) = pst `seq` do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                res <- pstep1 pst x-                case res of-                    Pipe.Yield b pst' -> return $ Yield b (pst', s)-                    Pipe.Continue pst' -> return $ Skip (pst', s)-            Skip s -> return $ Skip (Consume pst, s)-            Stop   -> return Stop--    step' _ (Produce pst, st) = pst `seq` do-        res <- pstep2 pst-        case res of-            Pipe.Yield b pst' -> return $ Yield b (pst', st)-            Pipe.Continue pst' -> return $ Skip (pst', st)----------------------------------------------------------------------------------- Transformation Folds----------------------------------------------------------------------------------- Note, this is going to have horrible performance, because of the nature of--- the stream type (i.e. direct stream vs CPS). Its only for reference, it is--- likely be practically unusable.-{-# INLINE_NORMAL foldlS #-}-foldlS :: Monad m-    => (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b-foldlS fstep begin (Stream step state) = Stream step' (Left (state, begin))-  where-    step' gst (Left (st, acc)) = do-        r <- step (adaptState gst) st-        return $ case r of-            Yield x s -> Skip (Left (s, fstep acc x))-            Skip s -> Skip (Left (s, acc))-            Stop   -> Skip (Right acc)--    step' gst (Right (Stream stp stt)) = do-        r <- stp (adaptState gst) stt-        return $ case r of-            Yield x s -> Yield x (Right (Stream stp s))-            Skip s -> Skip (Right (Stream stp s))-            Stop   -> Stop----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- |--- >>> sequence = Stream.mapM id------ Replace the elements of a stream of monadic actions with the outputs of--- those actions.------ >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"]--- >>> Stream.fold Fold.drain $ Stream.sequence s--- abc----{-# INLINE_NORMAL sequence #-}-sequence :: Monad m => Stream m (m a) -> Stream m a-sequence (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-         r <- step (adaptState gst) st-         case r of-             Yield x s -> x >>= \a -> return (Yield a s)-             Skip s    -> return $ Skip s-             Stop      -> return Stop----------------------------------------------------------------------------------- Mapping side effects---------------------------------------------------------------------------------data TapState fs st a-    = TapInit | Tapping !fs st | TapDone st---- XXX Multiple yield points---- | Tap the data flowing through a stream into a 'Fold'. For example, you may--- add a tap to log the contents flowing through the stream. The fold is used--- only for effects, its result is discarded.------ @---                   Fold m a b---                       |--- -----stream m a ---------------stream m a----------- @------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s--- 1--- 2------ Compare with 'trace'.----{-# INLINE tap #-}-tap :: Monad m => Fold m a b -> Stream m a -> Stream m a-tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit--    where--    step' _ TapInit = do-        res <- initial-        return-            $ Skip-            $ case res of-                  FL.Partial s -> Tapping s state-                  FL.Done _ -> TapDone state-    step' gst (Tapping acc st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                res <- fstep acc x-                return-                    $ Yield x-                    $ case res of-                          FL.Partial fs -> Tapping fs s-                          FL.Done _ -> TapDone s-            Skip s -> return $ Skip (Tapping acc s)-            Stop -> do-                void $ extract acc-                return Stop-    step' gst (TapDone st) = do-        r <- step gst st-        return-            $ case r of-                  Yield x s -> Yield x (TapDone s)-                  Skip s -> Skip (TapDone s)-                  Stop -> Stop--data TapOffState fs s a-    = TapOffInit-    | TapOffTapping !fs s Int-    | TapOffDone s---- XXX Multiple yield points-{-# INLINE_NORMAL tapOffsetEvery #-}-tapOffsetEvery :: Monad m-    => Int -> Int -> Fold m a b -> Stream m a -> Stream m a-tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =-    Stream step' TapOffInit--    where--    {-# INLINE_LATE step' #-}-    step' _ TapOffInit = do-        res <- initial-        return-            $ Skip-            $ case res of-                  FL.Partial s -> TapOffTapping s state (offset `mod` n)-                  FL.Done _ -> TapOffDone state-    step' gst (TapOffTapping acc st count) = do-        r <- step gst st-        case r of-            Yield x s -> do-                next <--                    if count <= 0-                    then do-                        res <- fstep acc x-                        return-                            $ case res of-                                  FL.Partial sres ->-                                    TapOffTapping sres s (n - 1)-                                  FL.Done _ -> TapOffDone s-                    else return $ TapOffTapping acc s (count - 1)-                return $ Yield x next-            Skip s -> return $ Skip (TapOffTapping acc s count)-            Stop -> do-                void $ extract acc-                return Stop-    step' gst (TapOffDone st) = do-        r <- step gst st-        return-            $ case r of-                  Yield x s -> Yield x (TapOffDone s)-                  Skip s -> Skip (TapOffDone s)-                  Stop -> Stop---- | Apply a monadic function to each element flowing through the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace print s--- 1--- 2------ Compare with 'tap'.----{-# INLINE trace #-}-trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a-trace f = mapM (\x -> void (f x) >> return x)---- | Perform a side effect before yielding each element of the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s--- "got here"--- "got here"------ Same as 'intersperseMPrefix_' but always serial.------ See also: 'trace'------ /Pre-release/-{-# INLINE trace_ #-}-trace_ :: Monad m => m b -> Stream m a -> Stream m a-trace_ eff = mapM (\x -> eff >> return x)----------------------------------------------------------------------------------- Scanning with a Fold---------------------------------------------------------------------------------data ScanState s f = ScanInit s | ScanDo s !f | ScanDone---- | Postscan a stream using the given monadic fold.------ The following example extracts the input stream up to a point where the--- running average of elements is no more than 10:------ >>> import Data.Maybe (fromJust)--- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> s = Stream.enumerateFromTo 1.0 100.0--- >>> :{---  Stream.fold Fold.toList---   $ fmap (fromJust . fst)---   $ Stream.takeWhile (\(_,x) -> x <= 10)---   $ Stream.postscan (Fold.tee Fold.latest avg) s--- :}--- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0]----{-# INLINE_NORMAL postscan #-}-postscan :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b-postscan (FL.Fold fstep initial extract) (Stream sstep state) =-    Stream step (ScanInit state)--    where--    {-# INLINE_LATE step #-}-    step _ (ScanInit st) = do-        res <- initial-        return-            $ case res of-                  FL.Partial fs -> Skip $ ScanDo st fs-                  FL.Done b -> Yield b ScanDone-    step gst (ScanDo st fs) = do-        res <- sstep (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep fs x-                case r of-                    FL.Partial fs1 -> do-                        !b <- extract fs1-                        return $ Yield b $ ScanDo s fs1-                    FL.Done b -> return $ Yield b ScanDone-            Skip s -> return $ Skip $ ScanDo s fs-            Stop -> return Stop-    step _ ScanDone = return Stop--{-# INLINE scanWith #-}-scanWith :: Monad m-    => Bool -> Fold m a b -> Stream m a -> Stream m b-scanWith restart (Fold fstep initial extract) (Stream sstep state) =-    Stream step (ScanInit state)--    where--    {-# INLINE runStep #-}-    runStep st action = do-        res <- action-        case res of-            FL.Partial fs -> do-                !b <- extract fs-                return $ Yield b $ ScanDo st fs-            FL.Done b ->-                let next = if restart then ScanInit st else ScanDone-                 in return $ Yield b next--    {-# INLINE_LATE step #-}-    step _ (ScanInit st) = runStep st initial-    step gst (ScanDo st fs) = do-        res <- sstep (adaptState gst) st-        case res of-            Yield x s -> runStep s (fstep fs x)-            Skip s -> return $ Skip $ ScanDo s fs-            Stop -> return Stop-    step _ ScanDone = return Stop---- XXX It may be useful to have a version of scan where we can keep the--- accumulator independent of the value emitted. So that we do not necessarily--- have to keep a value in the accumulator which we are not using. We can pass--- an extraction function that will take the accumulator and the current value--- of the element and emit the next value in the stream. That will also make it--- possible to modify the accumulator after using it. In fact, the step function--- can return new accumulator and the value to be emitted. The signature would--- be more like mapAccumL.---- | Strict left scan. Scan a stream using the given monadic fold.------ >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s--- [0,1,3,6]------ See also: 'usingStateT'------- EXPLANATION:--- >>> scanl' step z = Stream.scan (Fold.foldl' step z)------ Like 'map', 'scanl'' too is a one to one transformation,--- however it adds an extra element.------ >>> s = Stream.fromList [1,2,3,4]--- >>> Stream.fold Fold.toList $ scanl' (+) 0 s--- [0,1,3,6,10]------ >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s--- [[],[1],[2,1],[3,2,1],[4,3,2,1]]------ The output of 'scanl'' is the initial value of the accumulator followed by--- all the intermediate steps and the final result of 'foldl''.------ By streaming the accumulated state after each fold step, we can share the--- state across multiple stages of stream composition. Each stage can modify or--- extend the state, do some processing with it and emit it for the next stage,--- thus modularizing the stream processing. This can be useful in--- stateful or event-driven programming.------ Consider the following monolithic example, computing the sum and the product--- of the elements in a stream in one go using a @foldl'@:------ >>> foldl' step z = Stream.fold (Fold.foldl' step z)--- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s--- (10,24)------ Using @scanl'@ we can make it modular by computing the sum in the first--- stage and passing it down to the next stage for computing the product:------ >>> :{---   foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)---   $ scanl' (\(s, _) x -> (s + x, x)) (0,1)---   $ Stream.fromList [1,2,3,4]--- :}--- (10,24)------ IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building--- lazy expressions inside the accumulator, it is recommended that a strict--- data structure is used for accumulator.----{-# INLINE_NORMAL scan #-}-scan :: Monad m-    => FL.Fold m a b -> Stream m a -> Stream m b-scan = scanWith False---- | Like 'scan' but restarts scanning afresh when the scanning fold--- terminates.----{-# INLINE_NORMAL scanMany #-}-scanMany :: Monad m-    => FL.Fold m a b -> Stream m a -> Stream m b-scanMany = scanWith True----------------------------------------------------------------------------------- Scanning - Prescans----------------------------------------------------------------------------------- Adapted from the vector package.------ XXX Is a prescan useful, discarding the last step does not sound useful?  I--- am not sure about the utility of this function, so this is implemented but--- not exposed. We can expose it if someone provides good reasons why this is--- useful.------ XXX We have to execute the stream one step ahead to know that we are at the--- last step.  The vector implementation of prescan executes the last fold step--- but does not yield the result. This means we have executed the effect but--- discarded value. This does not sound right. In this implementation we are--- not executing the last fold step.-{-# INLINE_NORMAL prescanlM' #-}-prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-prescanlM' f mz (Stream step state) = Stream step' (state, mz)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, prev) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                acc <- prev-                return $ Yield acc (s, f acc x)-            Skip s -> return $ Skip (s, prev)-            Stop   -> return Stop--{-# INLINE prescanl' #-}-prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)----------------------------------------------------------------------------------- Monolithic postscans (postscan followed by a map)----------------------------------------------------------------------------------- The performance of a modular postscan followed by a map seems to be--- equivalent to this monolithic scan followed by map therefore we may not need--- this implementation. We just have it for performance comparison and in case--- modular version does not perform well in some situation.----{-# INLINE_NORMAL postscanlMx' #-}-postscanlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b-postscanlMx' fstep begin done (Stream step state) = do-    Stream step' (state, begin)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, acc) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                old <- acc-                y <- fstep old x-                v <- done y-                v `seq` y `seq` return (Yield v (s, return y))-            Skip s -> return $ Skip (s, acc)-            Stop   -> return Stop--{-# INLINE_NORMAL postscanlx' #-}-postscanlx' :: Monad m-    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b-postscanlx' fstep begin done =-    postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)---- XXX do we need consM strict to evaluate the begin value?-{-# INLINE scanlMx' #-}-scanlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b-scanlMx' fstep begin done s =-    (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s--{-# INLINE scanlx' #-}-scanlx' :: Monad m-    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b-scanlx' fstep begin done =-    scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)----------------------------------------------------------------------------------- postscans----------------------------------------------------------------------------------- Adapted from the vector package.-{-# INLINE_NORMAL postscanlM' #-}-postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-postscanlM' fstep begin (Stream step state) =-    Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        !x <- begin-        return $ Skip (Just (state, x))--    step' gst (Just (st, acc)) =  do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                !y <- fstep acc x-                return $ Yield y (Just (s, y))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop--{-# INLINE_NORMAL postscanl' #-}-postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a-postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)--{-# ANN type PScanAfterState Fuse #-}-data PScanAfterState m st acc =-      PScanAfterStep st (m acc)-    | PScanAfterYield acc (PScanAfterState m st acc)-    | PScanAfterStop---- We can possibly have the "done" function as a Maybe to provide an option to--- emit or not emit the accumulator when the stream stops.------ TBD: use a single Yield point----{-# INLINE_NORMAL postscanlMAfter' #-}-postscanlMAfter' :: Monad m-    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b-postscanlMAfter' fstep initial done (Stream step1 state1) = do-    Stream step (PScanAfterStep state1 initial)--    where--    {-# INLINE_LATE step #-}-    step gst (PScanAfterStep st acc) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield x s -> do-                !old <- acc-                !y <- fstep old x-                return (Skip $ PScanAfterYield y (PScanAfterStep s (return y)))-            Skip s -> return $ Skip $ PScanAfterStep s acc-            -- Strictness is important for fusion-            Stop -> do-                !v <- acc-                !res <- done v-                return (Skip $ PScanAfterYield res PScanAfterStop)-    step _ (PScanAfterYield acc next) = return $ Yield acc next-    step _ PScanAfterStop = return Stop--{-# INLINE_NORMAL postscanlM #-}-postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-postscanlM fstep begin (Stream step state) = Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        r <- begin-        return $ Skip (Just (state, r))--    step' gst (Just (st, acc)) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                y <- fstep acc x-                return (Yield y (Just (s, y)))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop--{-# INLINE_NORMAL postscanl #-}-postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a-postscanl f seed = postscanlM (\a b -> return (f a b)) (return seed)---- | Like 'scanl'' but with a monadic step function and a monadic seed.----{-# INLINE_NORMAL scanlM' #-}-scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-scanlM' fstep begin (Stream step state) = Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        !x <- begin-        return $ Yield x (Just (state, x))-    step' gst (Just (st, acc)) =  do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                !y <- fstep acc x-                return $ Yield y (Just (s, y))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop---- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except--- that it provides an additional @done@ function to be applied on the--- accumulator when the stream stops. The result of @done@ is also emitted in--- the stream.------ This function can be used to allocate a resource in the beginning of the--- scan and release it when the stream ends or to flush the internal state of--- the scan at the end.------ /Pre-release/----{-# INLINE scanlMAfter' #-}-scanlMAfter' :: Monad m-    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b-scanlMAfter' fstep initial done s =-    initial `consM` postscanlMAfter' fstep initial done s---- >>> scanl' f z xs = z `Stream.cons` postscanl' f z xs---- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,--- however it adds an extra element.------ >>> Stream.toList $ Stream.scanl' (+) 0 $ Stream.fromList [1,2,3,4]--- [0,1,3,6,10]------ >>> Stream.toList $ Stream.scanl' (flip (:)) [] $ Stream.fromList [1,2,3,4]--- [[],[1],[2,1],[3,2,1],[4,3,2,1]]------ The output of 'scanl'' is the initial value of the accumulator followed by--- all the intermediate steps and the final result of 'foldl''.------ By streaming the accumulated state after each fold step, we can share the--- state across multiple stages of stream composition. Each stage can modify or--- extend the state, do some processing with it and emit it for the next stage,--- thus modularizing the stream processing. This can be useful in--- stateful or event-driven programming.------ Consider the following monolithic example, computing the sum and the product--- of the elements in a stream in one go using a @foldl'@:------ >>> Stream.fold (Fold.foldl' (\(s, p) x -> (s + x, p * x)) (0,1)) $ Stream.fromList [1,2,3,4]--- (10,24)------ Using @scanl'@ we can make it modular by computing the sum in the first--- stage and passing it down to the next stage for computing the product:------ >>> :{---   Stream.fold (Fold.foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1))---   $ Stream.scanl' (\(s, _) x -> (s + x, x)) (0,1)---   $ Stream.fromList [1,2,3,4]--- :}--- (10,24)------ IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building--- lazy expressions inside the accumulator, it is recommended that a strict--- data structure is used for accumulator.------ >>> scanl' step z = Stream.scan (Fold.foldl' step z)--- >>> scanl' f z xs = Stream.scanlM' (\a b -> return (f a b)) (return z) xs------ See also: 'usingStateT'----{-# INLINE scanl' #-}-scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-scanl' f seed = scanlM' (\a b -> return (f a b)) (return seed)--{-# INLINE_NORMAL scanlM #-}-scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-scanlM fstep begin (Stream step state) = Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        x <- begin-        return $ Yield x (Just (state, x))-    step' gst (Just (st, acc)) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                y <- fstep acc x-                return $ Yield y (Just (s, y))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop--{-# INLINE scanl #-}-scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-scanl f seed = scanlM (\a b -> return (f a b)) (return seed)---- Adapted from the vector package-{-# INLINE_NORMAL scanl1M #-}-scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a-scanl1M fstep (Stream step state) = Stream step' (state, Nothing)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, Nothing) = do-        r <- step gst st-        case r of-            Yield x s -> return $ Yield x (s, Just x)-            Skip s -> return $ Skip (s, Nothing)-            Stop   -> return Stop--    step' gst (st, Just acc) = do-        r <- step gst st-        case r of-            Yield y s -> do-                z <- fstep acc y-                return $ Yield z (s, Just z)-            Skip s -> return $ Skip (s, Just acc)-            Stop   -> return Stop--{-# INLINE scanl1 #-}-scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a-scanl1 f = scanl1M (\x y -> return (f x y))---- Adapted from the vector package---- | Like 'scanl1'' but with a monadic step function.----{-# INLINE_NORMAL scanl1M' #-}-scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a-scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, Nothing) = do-        r <- step gst st-        case r of-            Yield x s -> x `seq` return $ Yield x (s, Just x)-            Skip s -> return $ Skip (s, Nothing)-            Stop   -> return Stop--    step' gst (st, Just acc) = acc `seq` do-        r <- step gst st-        case r of-            Yield y s -> do-                z <- fstep acc y-                z `seq` return $ Yield z (s, Just z)-            Skip s -> return $ Skip (s, Just acc)-            Stop   -> return Stop---- | Like 'scanl'' but for a non-empty stream. The first element of the stream--- is used as the initial value of the accumulator. Does nothing if the stream--- is empty.------ >>> Stream.toList $ Stream.scanl1' (+) $ Stream.fromList [1,2,3,4]--- [1,3,6,10]----{-# INLINE scanl1' #-}-scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a-scanl1' f = scanl1M' (\x y -> return (f x y))------------------------------------------------------------------------------------ Filtering------------------------------------------------------------------------------------ | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a--- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a--- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with--- index or time.------ >>> filterWithIndex = Stream.with Stream.indexed Stream.filter------ /Pre-release/-{-# INLINE with #-}-with :: Monad m =>-       (Stream m a -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m a -> Stream m a)-with f comb g = fmap snd . comb g . f---- Adapted from the vector package---- | Same as 'filter' but with a monadic predicate.------ >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing--- >>> filterM p = Stream.mapMaybeM (f p)----{-# INLINE_NORMAL filterM #-}-filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-filterM f (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                return $ if b-                         then Yield x s-                         else Skip s-            Skip s -> return $ Skip s-            Stop   -> return Stop---- | Include only those elements that pass a predicate.------ >>> filter p = Stream.filterM (return . p)--- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing)--- >>> filter p = Stream.scanMaybe (Fold.filtering p)----{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-filter f = filterM (return . f)--- filter p = scanMaybe (FL.filtering p)---- | Drop repeated elements that are adjacent to each other using the supplied--- comparison function.------ >>> uniq = Stream.uniqBy (==)------ To strip duplicate path separators:------ >>> input = Stream.fromList "//a//b"--- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.uniqBy f input--- "/a/b"------ Space: @O(1)@------ /Pre-release/----{-# INLINE uniqBy #-}-uniqBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a--- uniqBy eq = scanMaybe (FL.uniqBy eq)-uniqBy eq = catMaybes . rollingMap f--    where--    f pre curr =-        case pre of-            Nothing -> Just curr-            Just x -> if x `eq` curr then Nothing else Just curr---- Adapted from the vector package---- | Drop repeated elements that are adjacent to each other.------ >>> uniq = Stream.uniqBy (==)----{-# INLINE_NORMAL uniq #-}-uniq :: (Eq a, Monad m) => Stream m a -> Stream m a--- uniq = scanMaybe FL.uniq-uniq (Stream step state) = Stream step' (Nothing, state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (Nothing, st) = do-        r <- step gst st-        case r of-            Yield x s -> return $ Yield x (Just x, s)-            Skip  s   -> return $ Skip  (Nothing, s)-            Stop      -> return Stop-    step' gst (Just x, st)  = do-         r <- step gst st-         case r of-             Yield y s | x == y   -> return $ Skip (Just x, s)-                       | otherwise -> return $ Yield y (Just y, s)-             Skip  s   -> return $ Skip (Just x, s)-             Stop      -> return Stop---- | Deletes the first occurrence of the element in the stream that satisfies--- the given equality predicate.------ >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input--- [1,3,5]----{-# INLINE_NORMAL deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a--- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x)-deleteBy eq x (Stream step state) = Stream step' (state, False)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, False) = do-        r <- step gst st-        case r of-            Yield y s -> return $-                if eq x y then Skip (s, True) else Yield y (s, False)-            Skip s -> return $ Skip (s, False)-            Stop   -> return Stop--    step' gst (st, True) = do-        r <- step gst st-        case r of-            Yield y s -> return $ Yield y (s, True)-            Skip s -> return $ Skip (s, True)-            Stop   -> return Stop---- | Strip all leading and trailing occurrences of an element passing a--- predicate and make all other consecutive occurrences uniq.------ >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)------ @--- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")--- "hello world!"------ @------ Space: @O(1)@------ /Unimplemented/-{-# INLINE prune #-}-prune ::-    -- (Monad m, Eq a) =>-    (a -> Bool) -> Stream m a -> Stream m a-prune = error "Not implemented yet!"---- Possible implementation:--- @repeated =---      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@------ 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a--- single element.---- | Emit only repeated elements, once.------ /Unimplemented/-repeated :: -- (Monad m, Eq a) =>-    Stream m a -> Stream m a-repeated = undefined----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Take all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements taken.------ /Unimplemented/-{-# INLINE takeWhileLast #-}-takeWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m---- | Like 'takeWhile' and 'takeWhileLast' combined.------ O(n) space, where n is the number elements taken from the end.------ /Unimplemented/-{-# INLINE takeWhileAround #-}-takeWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m---- Adapted from the vector package---- | Discard first 'n' elements from the stream and take the rest.----{-# INLINE_NORMAL drop #-}-drop :: Monad m => Int -> Stream m a -> Stream m a-drop n (Stream step state) = Stream step' (state, Just n)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, Just i)-      | i > 0 = do-          r <- step gst st-          return $-            case r of-              Yield _ s -> Skip (s, Just (i - 1))-              Skip s    -> Skip (s, Just i)-              Stop      -> Stop-      | otherwise = return $ Skip (st, Nothing)--    step' gst (st, Nothing) = do-      r <- step gst st-      return $-        case r of-          Yield x s -> Yield x (s, Nothing)-          Skip  s   -> Skip (s, Nothing)-          Stop      -> Stop---- Adapted from the vector package-data DropWhileState s a-    = DropWhileDrop s-    | DropWhileYield a s-    | DropWhileNext s---- | Same as 'dropWhile' but with a monadic predicate.----{-# INLINE_NORMAL dropWhileM #-}-dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- dropWhileM p = scanMaybe (FL.droppingWhileM p)-dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (DropWhileDrop st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                if b-                then return $ Skip (DropWhileDrop s)-                else return $ Skip (DropWhileYield x s)-            Skip s -> return $ Skip (DropWhileDrop s)-            Stop -> return Stop--    step' gst (DropWhileNext st) =  do-        r <- step gst st-        case r of-            Yield x s -> return $ Skip (DropWhileYield x s)-            Skip s    -> return $ Skip (DropWhileNext s)-            Stop      -> return Stop--    step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)---- | Drop elements in the stream as long as the predicate succeeds and then--- take the rest of the stream.----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- dropWhile p = scanMaybe (FL.droppingWhile p)-dropWhile f = dropWhileM (return . f)---- | Drop @n@ elements at the end of the stream.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropLast #-}-dropLast :: -- Monad m =>-    Int -> Stream m a -> Stream m a-dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m---- | Drop all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropWhileLast #-}-dropWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m---- | Like 'dropWhile' and 'dropWhileLast' combined.------ O(n) space, where n is the number elements dropped from the end.------ /Unimplemented/-{-# INLINE dropWhileAround #-}-dropWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m----------------------------------------------------------------------------------- Inserting Elements----------------------------------------------------------------------------------- | @insertBy cmp elem stream@ inserts @elem@ before the first element in--- @stream@ that is less than @elem@ when compared using @cmp@.------ >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x)------ >>> input = Stream.fromList [1,3,5]--- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input--- [1,2,3,5]----{-# INLINE_NORMAL insertBy #-}-insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a-insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, False, _) = do-        r <- step gst st-        case r of-            Yield x s -> case cmp a x of-                GT -> return $ Yield x (s, False, Nothing)-                _  -> return $ Yield a (s, True, Just x)-            Skip s -> return $ Skip (s, False, Nothing)-            Stop   -> return $ Yield a (st, True, Nothing)--    step' _ (_, True, Nothing) = return Stop--    step' gst (st, True, Just prev) = do-        r <- step gst st-        case r of-            Yield x s -> return $ Yield prev (s, True, Just x)-            Skip s    -> return $ Skip (s, True, Just prev)-            Stop      -> return $ Yield prev (st, True, Nothing)--data LoopState x s = FirstYield s-                   | InterspersingYield s-                   | YieldAndCarry x s---- intersperseM = intersperseMWith 1---- | Insert an effect and its output before consuming an element of a stream--- except the first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') input--- h.,e.,l.,l.,o"h,e,l,l,o"------ Be careful about the order of effects. In the above example we used trace--- after the intersperse, if we use it before the intersperse the output would--- be he.l.l.o."h,e,l,l,o".------ >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input--- he.l.l.o."h,e,l,l,o"----{-# INLINE_NORMAL intersperseM #-}-intersperseM :: Monad m => m a -> Stream m a -> Stream m a-intersperseM m (Stream step state) = Stream step' (FirstYield state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (FirstYield st) = do-        r <- step gst st-        return $-            case r of-                Yield x s -> Skip (YieldAndCarry x s)-                Skip s -> Skip (FirstYield s)-                Stop -> Stop--    step' gst (InterspersingYield st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                a <- m-                return $ Yield a (YieldAndCarry x s)-            Skip s -> return $ Skip $ InterspersingYield s-            Stop -> return Stop--    step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st)---- | Insert a pure value between successive elements of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input--- "h,e,l,l,o"----{-# INLINE intersperse #-}-intersperse :: Monad m => a -> Stream m a -> Stream m a-intersperse a = intersperseM (return a)---- | Insert a side effect before consuming an element of a stream except the--- first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input--- h.e.l.l.o------ /Pre-release/-{-# INLINE_NORMAL intersperseM_ #-}-intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1))-  where-    {-# INLINE_LATE step #-}-    step gst (Left (eff, st)) = do-        r <- step1 gst st-        case r of-            Yield x s -> eff >> return (Yield x (Right s))-            Skip s -> return $ Skip (Left (eff, s))-            Stop -> return Stop--    step _ (Right st) = return $ Skip $ Left (void m, st)---- | Intersperse a monadic action into the input stream after every @n@--- elements.------ >> input = Stream.fromList "hello"--- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input--- "he,ll,o"------ /Unimplemented/-{-# INLINE intersperseMWith #-}-intersperseMWith :: -- Monad m =>-    Int -> m a -> Stream m a -> Stream m a-intersperseMWith _n _f _xs = undefined--data SuffixState s a-    = SuffixElem s-    | SuffixSuffix s-    | SuffixYield a (SuffixState s a)---- | Insert an effect and its output after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMSuffix (putChar '.' >> return ',') input--- h.,e.,l.,l.,o.,"h,e,l,l,o,"------ /Pre-release/-{-# INLINE_NORMAL intersperseMSuffix #-}-intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a-intersperseMSuffix action (Stream step state) = Stream step' (SuffixElem state)-    where-    {-# INLINE_LATE step' #-}-    step' gst (SuffixElem st) = do-        r <- step gst st-        return $ case r of-            Yield x s -> Skip (SuffixYield x (SuffixSuffix s))-            Skip s -> Skip (SuffixElem s)-            Stop -> Stop--    step' _ (SuffixSuffix st) = do-        action >>= \r -> return $ Skip (SuffixYield r (SuffixElem st))--    step' _ (SuffixYield x next) = return $ Yield x next---- | Insert a side effect after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input--- "hello"------ /Pre-release/----{-# INLINE_NORMAL intersperseMSuffix_ #-}-intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMSuffix_ m (Stream step1 state1) = Stream step (Left state1)-  where-    {-# INLINE_LATE step #-}-    step gst (Left st) = do-        r <- step1 gst st-        case r of-            Yield x s -> return $ Yield x (Right s)-            Skip s -> return $ Skip $ Left s-            Stop -> return Stop--    step _ (Right st) = m >> return (Skip (Left st))--data SuffixSpanState s a-    = SuffixSpanElem s Int-    | SuffixSpanSuffix s-    | SuffixSpanYield a (SuffixSpanState s a)-    | SuffixSpanLast-    | SuffixSpanStop---- | Like 'intersperseMSuffix' but intersperses an effectful action into the--- input stream after every @n@ elements and after the last element.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input--- "he,ll,o,"------ /Pre-release/----{-# INLINE_NORMAL intersperseMSuffixWith #-}-intersperseMSuffixWith :: forall m a. Monad m-    => Int -> m a -> Stream m a -> Stream m a-intersperseMSuffixWith n action (Stream step state) =-    Stream step' (SuffixSpanElem state n)-    where-    {-# INLINE_LATE step' #-}-    step' gst (SuffixSpanElem st i) | i > 0 = do-        r <- step gst st-        return $ case r of-            Yield x s -> Skip (SuffixSpanYield x (SuffixSpanElem s (i - 1)))-            Skip s -> Skip (SuffixSpanElem s i)-            Stop -> if i == n then Stop else Skip SuffixSpanLast-    step' _ (SuffixSpanElem st _) = return $ Skip (SuffixSpanSuffix st)--    step' _ (SuffixSpanSuffix st) = do-        action >>= \r -> return $ Skip (SuffixSpanYield r (SuffixSpanElem st n))--    step' _ SuffixSpanLast = do-        action >>= \r -> return $ Skip (SuffixSpanYield r SuffixSpanStop)--    step' _ (SuffixSpanYield x next) = return $ Yield x next--    step' _ SuffixSpanStop = return Stop---- | Insert a side effect before consuming an element of a stream.------ Definition:------ >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x)------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') input--- .h.e.l.l.o"hello"------ Same as 'trace_'.------ /Pre-release/----{-# INLINE intersperseMPrefix_ #-}-intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMPrefix_ m = mapM (\x -> void m >> return x)----------------------------------------------------------------------------------- Inserting Time----------------------------------------------------------------------------------- XXX This should be in Prelude, should we export this as a helper function?---- | Block the current thread for specified number of seconds.-{-# INLINE sleep #-}-sleep :: MonadIO m => Double -> m ()-sleep n = liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds between elements of the stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delay = Stream.intersperseM_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input--- 1--- 2--- 3----{-# INLINE delay #-}-delay :: MonadIO m => Double -> Stream m a -> Stream m a-delay = intersperseM_ . sleep---- | Introduce a delay of specified seconds after consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPost = Stream.intersperseMSuffix_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPost #-}-delayPost :: MonadIO m => Double -> Stream m a -> Stream m a-delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds before consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPre = Stream.intersperseMPrefix_. sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPre #-}-delayPre :: MonadIO m => Double -> Stream m a -> Stream m a-delayPre = intersperseMPrefix_. sleep----------------------------------------------------------------------------------- Reordering----------------------------------------------------------------------------------- | Returns the elements of the stream in reverse order.  The stream must be--- finite. Note that this necessarily buffers the entire stream in memory.------ Definition:------ >>> reverse m = Stream.concatEffect $ Stream.fold Fold.toListRev m >>= return . Stream.fromList----{-# INLINE_NORMAL reverse #-}-reverse :: Monad m => Stream m a -> Stream m a-reverse m = concatEffect $ fold FL.toListRev m <&> fromList-{--reverse m = Stream step Nothing-    where-    {-# INLINE_LATE step #-}-    step _ Nothing = do-        xs <- foldl' (flip (:)) [] m-        return $ Skip (Just xs)-    step _ (Just (x:xs)) = return $ Yield x (Just xs)-    step _ (Just []) = return Stop--}---- | Like 'reverse' but several times faster, requires an 'Unbox' instance.------ /O(n) space/------ /Pre-release/-{-# INLINE reverseUnbox #-}-reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a-reverseUnbox =-    A.flattenArraysRev -- unfoldMany A.readRev-        . fromStreamK-        . K.reverse-        . toStreamK-        . A.chunksOf defaultChunkSize---- | Buffer until the next element in sequence arrives. The function argument--- determines the difference in sequence numbers. This could be useful in--- implementing sequenced streams, for example, TCP reassembly.------ /Unimplemented/----{-# INLINE reassembleBy #-}-reassembleBy-    :: -- Monad m =>-       Fold m a b-    -> (a -> a -> Int)-    -> Stream m a-    -> Stream m b-reassembleBy = undefined----------------------------------------------------------------------------------- Position Indexing----------------------------------------------------------------------------------- Adapted from the vector package---- |--- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined)--- >>> indexed = Stream.postscan f--- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0)--- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed------ Pair each element in a stream with its index, starting from index 0.------ >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello"--- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]----{-# INLINE_NORMAL indexed #-}-indexed :: Monad m => Stream m a -> Stream m (Int, a)--- indexed = scanMaybe FL.indexing-indexed (Stream step state) = Stream step' (state, 0)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = i `seq` do-         r <- step (adaptState gst) st-         case r of-             Yield x s -> return $ Yield (i, x) (s, i+1)-             Skip    s -> return $ Skip (s, i)-             Stop      -> return Stop---- Adapted from the vector package---- |--- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)--- >>> indexedR n = Stream.postscan (f n)------ >>> s n = Stream.enumerateFromThen n (n - 1)--- >>> indexedR n = Stream.zipWith (,) (s n)------ Pair each element in a stream with its index, starting from the--- given index @n@ and counting down.------ >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello"--- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]----{-# INLINE_NORMAL indexedR #-}-indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)--- indexedR n = scanMaybe (FL.indexingRev n)-indexedR m (Stream step state) = Stream step' (state, m)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = i `seq` do-         r <- step (adaptState gst) st-         case r of-             Yield x s -> let i' = i - 1-                          in return $ Yield (i, x) (s, i')-             Skip    s -> return $ Skip (s, i)-             Stop      -> return Stop------------------------------------------------------------------------------------ Time Indexing------------------------------------------------------------------------------------ Note: The timestamp stream must be the second stream in the zip so that the--- timestamp is generated after generating the stream element and not before.--- If we do not do that then the following example will generate the same--- timestamp for first two elements:------ Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3---- | Pair each element in a stream with an absolute timestamp, using a clock of--- specified granularity.  The timestamp is generated just before the element--- is consumed.------ >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)]------ /Pre-release/----{-# INLINE timestampWith #-}-timestampWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (AbsTime, a)-timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)---- TBD: check performance vs a custom implementation without using zipWith.------ /Pre-release/----{-# INLINE timestamped #-}-timestamped :: (MonadIO m)-    => Stream m a -> Stream m (AbsTime, a)-timestamped = timestampWith 0.01---- | Pair each element in a stream with relative times starting from 0, using a--- clock with the specified granularity. The time is measured just before the--- element is consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/----{-# INLINE timeIndexWith #-}-timeIndexWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (RelTime64, a)-timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)---- | Pair each element in a stream with relative times starting from 0, using a--- 10 ms granularity clock. The time is measured just before the element is--- consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/----{-# INLINE timeIndexed #-}-timeIndexed :: (MonadIO m)-    => Stream m a -> Stream m (RelTime64, a)-timeIndexed = timeIndexWith 0.01----------------------------------------------------------------------------------- Searching----------------------------------------------------------------------------------- | Find all the indices where the element in the stream satisfies the given--- predicate.------ >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)----{-# INLINE_NORMAL findIndices #-}-findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int-findIndices p (Stream step state) = Stream step' (state, 0)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = i `seq` do-      r <- step (adaptState gst) st-      return $ case r of-          Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)-          Skip s -> Skip (s, i)-          Stop   -> Stop---- | Find all the indices where the value of the element in the stream is equal--- to the given value.------ >>> elemIndices a = Stream.findIndices (== a)----{-# INLINE elemIndices #-}-elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int-elemIndices a = findIndices (== a)--{-# INLINE_NORMAL slicesBy #-}-slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)-slicesBy p (Stream step1 state1) = Stream step (Just (state1, 0, 0))--    where--    {-# INLINE_LATE step #-}-    step gst (Just (st, i, len)) = i `seq` len `seq` do-      r <- step1 (adaptState gst) st-      return-        $ case r of-              Yield x s ->-                if p x-                then Yield (i, len + 1) (Just (s, i + len + 1, 0))-                else Skip (Just (s, i, len + 1))-              Skip s -> Skip (Just (s, i, len))-              Stop -> if len == 0 then Stop else Yield (i, len) Nothing-    step _ Nothing = return Stop----------------------------------------------------------------------------------- Rolling map---------------------------------------------------------------------------------data RollingMapState s a = RollingMapGo s a---- | Like 'rollingMap' but with an effectful map function.------ /Pre-release/----{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b--- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f)-rollingMapM f (Stream step1 state1) = Stream step (RollingMapGo state1 Nothing)--    where--    step gst (RollingMapGo s1 curr) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield x s -> do-                !res <- f curr x-                return $ Yield res $ RollingMapGo s (Just x)-            Skip s -> return $ Skip $ RollingMapGo s curr-            Stop   -> return Stop---- rollingMap is a special case of an incremental sliding fold. It can be--- written as:------ > fld f = slidingWindow 1 (Fold.foldl' (\_ (x,y) -> f y x)--- > rollingMap f = Stream.postscan (fld f) undefined---- | Apply a function on every two successive elements of a stream. The first--- argument of the map function is the previous element and the second argument--- is the current element. When the current element is the first element, the--- previous element is 'Nothing'.------ /Pre-release/----{-# INLINE rollingMap #-}-rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b--- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f)-rollingMap f = rollingMapM (\x y -> return $ f x y)---- | Like 'rollingMap' but requires at least two elements in the stream,--- returns an empty stream otherwise.------ This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.------ /Pre-release/----{-# INLINE rollingMap2 #-}-rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b-rollingMap2 f = catMaybes . rollingMap g--    where--    g Nothing _ = Nothing-    g (Just x) y = Just (f x y)----------------------------------------------------------------------------------- Maybe Streams----------------------------------------------------------------------------------- XXX Will this always fuse properly?---- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'--- elements, and return a stream of values extracted from 'Just'.------ Equivalent to:------ >>> mapMaybe f = Stream.catMaybes . fmap f----{-# INLINE_NORMAL mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b-mapMaybe f = fmap fromJust . filter isJust . map f---- | Like 'mapMaybe' but maps a monadic function.------ Equivalent to:------ >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f------ >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x)----{-# INLINE_NORMAL mapMaybeM #-}-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f---- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.------ >>> catMaybes = Stream.mapMaybe id--- >>> catMaybes = fmap fromJust . Stream.filter isJust------ /Pre-release/----{-# INLINE catMaybes #-}-catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a--- catMaybes = fmap fromJust . filter isJust-catMaybes (Stream step state) = Stream step1 state--    where--    {-# INLINE_LATE step1 #-}-    step1 gst st = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                return-                    $ case x of-                        Just a -> Yield a s-                        Nothing -> Skip s-            Skip s -> return $ Skip s-            Stop -> return Stop---- | Use a filtering fold on a stream.------ >>> scanMaybe f = Stream.catMaybes . Stream.postscan f----{-# INLINE scanMaybe #-}-scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b-scanMaybe f = catMaybes . postscan f----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.------ >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft------ /Pre-release/----{-# INLINE catLefts #-}-catLefts :: Monad m => Stream m (Either a b) -> Stream m a-catLefts = fmap (fromLeft undefined) . filter isLeft---- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.------ >>> catRights = fmap (fromRight undefined) . Stream.filter isRight------ /Pre-release/----{-# INLINE catRights #-}-catRights :: Monad m => Stream m (Either a b) -> Stream m b-catRights = fmap (fromRight undefined) . filter isRight---- | Remove the either wrapper and flatten both lefts and as well as rights in--- the output stream.------ >>> catEithers = fmap (either id id)------ /Pre-release/----{-# INLINE catEithers #-}-catEithers :: Monad m => Stream m (Either a a) -> Stream m a-catEithers = fmap (either id id)----------------------------------------------------------------------------------- Splitting----------------------------------------------------------------------------------- | Split on an infixed separator element, dropping the separator.  The--- supplied 'Fold' is applied on the split segments.  Splits the stream on--- separator elements determined by the supplied predicate, separator is--- considered as infixed between two segments:------ >>> splitOn' p xs = Stream.fold Fold.toList $ Stream.splitOn p Fold.toList (Stream.fromList xs)--- >>> splitOn' (== '.') "a.b"--- ["a","b"]------ An empty stream is folded to the default value of the fold:------ >>> splitOn' (== '.') ""--- [""]------ If one or both sides of the separator are missing then the empty segment on--- that side is folded to the default output of the fold:------ >>> splitOn' (== '.') "."--- ["",""]------ >>> splitOn' (== '.') ".a"--- ["","a"]------ >>> splitOn' (== '.') "a."--- ["a",""]------ >>> splitOn' (== '.') "a..b"--- ["a","","b"]------ splitOn is an inverse of intercalating single element:------ > Stream.intercalate (Stream.fromPure '.') Unfold.fromList . Stream.splitOn (== '.') Fold.toList === id------ Assuming the input stream does not contain the separator:------ > Stream.splitOn (== '.') Fold.toList . Stream.intercalate (Stream.fromPure '.') Unfold.fromList === id----{-# INLINE splitOn #-}-splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-splitOn predicate f =-    -- We can express the infix splitting in terms of optional suffix split-    -- fold.  After applying a suffix split fold repeatedly if the last segment-    -- ends with a suffix then we need to return the default output of the fold-    -- after that to make it an infix split.-    ---    -- Alternately, we can also express it using an optional prefix split fold.-    -- If the first segment starts with a prefix then we need to emit the-    -- default output of the fold before that to make it an infix split, and-    -- then apply prefix split fold repeatedly.-    ---    -- Since a suffix split fold can be easily expressed using a-    -- non-backtracking fold, we use that.-    foldManyPost (FL.takeEndBy_ predicate f)
− src/Streamly/Internal/Data/Stream/StreamD/Transformer.hs 
@@ -1,182 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Transformer--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Transform the underlying monad of a stream using a monad transfomer.--module Streamly.Internal.Data.Stream.StreamD.Transformer-    (-      foldlT-    , foldrT--    -- * Transform Inner Monad-    , liftInner-    , runReaderT-    , usingReaderT-    , evalStateT-    , runStateT-    , usingStateT-    )-where--#include "inline.hs"--import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Reader (ReaderT)-import Control.Monad.Trans.State.Strict (StateT)-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.SVar.Type (defState, adaptState)--import qualified Control.Monad.Trans.Reader as Reader-import qualified Control.Monad.Trans.State.Strict as State--import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"---- | Lazy left fold to a transformer monad.----{-# INLINE_NORMAL foldlT #-}-foldlT :: (Monad m, Monad (s m), MonadTrans s)-    => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b-foldlT fstep begin (Stream step state) = go SPEC begin state-  where-    go !_ acc st = do-        r <- lift $ step defState st-        case r of-            Yield x s -> go SPEC (fstep acc x) s-            Skip s -> go SPEC acc s-            Stop   -> acc---- | Right fold to a transformer monad.  This is the most general right fold--- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'--- implementation can be more efficient:------ >>> foldrS = Stream.foldrT------ >>> step f x xs = lift $ f x (runIdentityT xs)--- >>> foldrM f z s = runIdentityT $ Stream.foldrT (step f) (lift z) s------ 'foldrT' can be used to translate streamly streams to other transformer--- monads e.g.  to a different streaming type.------ /Pre-release/-{-# INLINE_NORMAL foldrT #-}-foldrT :: (Monad m, Monad (t m), MonadTrans t)-    => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b-foldrT f final (Stream step state) = go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = do-          r <- lift $ step defState st-          case r of-            Yield x s -> f x (go SPEC s)-            Skip s    -> go SPEC s-            Stop      -> final------------------------------------------------------------------------------------ Transform Inner Monad------------------------------------------------------------------------------------ | Lift the inner monad @m@ of @Stream m a@ to @t m@ where @t@ is a monad--- transformer.----{-# INLINE_NORMAL liftInner #-}-liftInner :: (Monad m, MonadTrans t, Monad (t m))-    => Stream m a -> Stream (t m) a-liftInner (Stream step state) = Stream step' state-    where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- lift $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip s    -> Skip s-            Stop      -> Stop----------------------------------------------------------------------------------- Sharing read only state in a stream----------------------------------------------------------------------------------- | Evaluate the inner monad of a stream as 'ReaderT'.----{-# INLINE_NORMAL runReaderT #-}-runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a-runReaderT env (Stream step state) = Stream step' (state, env)-    where-    {-# INLINE_LATE step' #-}-    step' gst (st, action) = do-        sv <- action-        r <- Reader.runReaderT (step (adaptState gst) st) sv-        return $ case r of-            Yield x s -> Yield x (s, return sv)-            Skip  s   -> Skip (s, return sv)-            Stop      -> Stop---- | Run a stream transformation using a given environment.----{-# INLINE usingReaderT #-}-usingReaderT-    :: Monad m-    => m r-    -> (Stream (ReaderT r m) a -> Stream (ReaderT r m) a)-    -> Stream m a-    -> Stream m a-usingReaderT r f xs = runReaderT r $ f $ liftInner xs----------------------------------------------------------------------------------- Sharing read write state in a stream----------------------------------------------------------------------------------- | Evaluate the inner monad of a stream as 'StateT'.------ >>> evalStateT s = fmap snd . Stream.runStateT s----{-# INLINE_NORMAL evalStateT #-}-evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a-evalStateT initial (Stream step state) = Stream step' (state, initial)-    where-    {-# INLINE_LATE step' #-}-    step' gst (st, action) = do-        sv <- action-        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv-        return $ case r of-            Yield x s -> Yield x (s, return sv')-            Skip  s   -> Skip (s, return sv')-            Stop      -> Stop---- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting--- state and value pair after each step.----{-# INLINE_NORMAL runStateT #-}-runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)-runStateT initial (Stream step state) = Stream step' (state, initial)-    where-    {-# INLINE_LATE step' #-}-    step' gst (st, action) = do-        sv <- action-        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv-        return $ case r of-            Yield x s -> Yield (sv', x) (s, return sv')-            Skip  s   -> Skip (s, return sv')-            Stop      -> Stop---- | Run a stateful (StateT) stream transformation using a given state.------ >>> usingStateT s f = Stream.evalStateT s . f . Stream.liftInner------ See also: 'scan'----{-# INLINE usingStateT #-}-usingStateT-    :: Monad m-    => m s-    -> (Stream (StateT s m) a -> Stream (StateT s m) a)-    -> Stream m a-    -> Stream m a-usingStateT s f = evalStateT s . f . liftInner
− src/Streamly/Internal/Data/Stream/StreamD/Type.hs 
@@ -1,2074 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Type--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC---- The stream type is inspired by the vector package.  A few functions in this--- module have been originally adapted from the vector package (c) Roman--- Leshchinskiy. See the notes in specific functions.--module Streamly.Internal.Data.Stream.StreamD.Type-    (-    -- * The stream type-      Step (..)-    -- XXX UnStream is exported to avoid a performance issue in some-    -- combinators if we use the pattern synonym "Stream".-    , Stream (Stream, UnStream)--    -- * CrossStream type wrapper-    , CrossStream-    , unCross-    , mkCross--    -- * Conversion to StreamK-    , fromStreamK-    , toStreamK--    -- * From Unfold-    , unfold--    -- * Construction-    -- ** Primitives-    , nilM-    , consM--    -- ** From Values-    , fromPure-    , fromEffect--    -- ** From Containers-    , Streamly.Internal.Data.Stream.StreamD.Type.fromList--    -- * Elimination-    -- ** Primitives-    , uncons--    -- ** Strict Left Folds-    , Streamly.Internal.Data.Stream.StreamD.Type.fold-    , foldBreak-    , foldAddLazy-    , foldAdd-    , foldEither--    , Streamly.Internal.Data.Stream.StreamD.Type.foldl'-    , foldlM'-    , foldlx'-    , foldlMx'--    -- ** Lazy Right Folds-    , foldrM-    , foldrMx-    , Streamly.Internal.Data.Stream.StreamD.Type.foldr-    , foldrS--    -- ** Specific Folds-    , drain-    , Streamly.Internal.Data.Stream.StreamD.Type.toList--    -- * Mapping-    , map-    , mapM--    -- * Stateful Filters-    , take-    , takeWhile-    , takeWhileM-    , takeEndBy-    , takeEndByM--    -- * Combining Two Streams-    -- ** Zipping-    , zipWithM-    , zipWith--    -- ** Cross Product-    , crossApply-    , crossApplyFst-    , crossApplySnd-    , crossWith-    , cross--    -- * Unfold Many-    , ConcatMapUState (..)-    , unfoldMany--    -- * Concat-    , concatEffect-    , concatMap-    , concatMapM-    , concat--    -- * Unfold Iterate-    , unfoldIterateDfs-    , unfoldIterateBfs-    , unfoldIterateBfsRev--    -- * Concat Iterate-    , concatIterateScan-    , concatIterateDfs-    , concatIterateBfs-    , concatIterateBfsRev--    -- * Fold Many-    , FoldMany (..) -- for inspection testing-    , FoldManyPost (..)-    , foldMany-    , foldManyPost-    , groupsOf-    , refoldMany--    -- * Fold Iterate-    , reduceIterateBfs-    , foldIterateBfs--    -- * Multi-stream folds-    , eqBy-    , cmpBy-    )-where--#include "inline.hs"--import Control.Applicative (liftA2)-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.IO.Class (MonadIO(..))-import Data.Foldable (Foldable(foldl'), fold, foldr)-import Data.Functor (($>))-import Data.Functor.Identity (Identity(..))-import Data.Maybe (fromMaybe)-import Data.Semigroup (Endo(..))-import Fusion.Plugin.Types (Fuse(..))-import GHC.Base (build)-import GHC.Exts (IsList(..), IsString(..), oneShot)-import GHC.Types (SPEC(..))-import Prelude hiding (map, mapM, take, concatMap, takeWhile, zipWith, concat)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import Streamly.Internal.BaseCompat ((#.))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Refold.Type (Refold(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step (..))-import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Fold.Type as FL hiding (foldr)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-#ifdef USE_UNFOLDS_EVERYWHERE-import qualified Streamly.Internal.Data.Unfold.Type as Unfold-#endif--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- The direct style stream type----------------------------------------------------------------------------------- gst = global state---- | A stream consists of a step function that generates the next step given a--- current state, and the current state.-data Stream m a =-    forall s. UnStream (State K.StreamK m a -> s -> m (Step s a)) s---- XXX This causes perf trouble when pattern matching with "Stream"  in a--- recursive way, e.g. in uncons, foldBreak, concatMap. We need to get rid of--- this.-unShare :: Stream m a -> Stream m a-unShare (UnStream step state) = UnStream step' state-    where step' gst = step (adaptState gst)--pattern Stream :: (State K.StreamK m a -> s -> m (Step s a)) -> s -> Stream m a-pattern Stream step state <- (unShare -> UnStream step state)-    where Stream = UnStream--{-# COMPLETE Stream #-}----------------------------------------------------------------------------------- Primitives----------------------------------------------------------------------------------- | A stream that terminates without producing any output, but produces a side--- effect.------ >>> Stream.fold Fold.toList (Stream.nilM (print "nil"))--- "nil"--- []------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Applicative m => m b -> Stream m a-nilM m = Stream (\_ _ -> m $> Stop) ()---- | Like 'cons' but fuses an effect instead of a pure value.-{-# INLINE_NORMAL consM #-}-consM :: Applicative m => m a -> Stream m a -> Stream m a-consM m (Stream step state) = Stream step1 Nothing--    where--    {-# INLINE_LATE step1 #-}-    step1 _ Nothing = (`Yield` Just state) <$> m-    step1 gst (Just st) = do-          (\case-            Yield a s -> Yield a (Just s)-            Skip  s   -> Skip (Just s)-            Stop      -> Stop) <$> step gst st---- | Decompose a stream into its head and tail. If the stream is empty, returns--- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is--- the head of the stream and @ma@ its tail.------ Properties:------ >>> Nothing <- Stream.uncons Stream.nil--- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil)------ This can be used to consume the stream in an imperative manner one element--- at a time, as it just breaks down the stream into individual elements and we--- can loop over them as we deem fit. For example, this can be used to convert--- a streamly stream into other stream types.------ All the folds in this module can be expressed in terms of 'uncons', however,--- this is generally less efficient than specific folds because it takes apart--- the stream one element at a time, therefore, does not take adavantage of--- stream fusion.------ 'foldBreak' is a more general way of consuming a stream piecemeal.------ >>> :{--- uncons xs = do---     r <- Stream.foldBreak Fold.one xs---     return $ case r of---         (Nothing, _) -> Nothing---         (Just h, t) -> Just (h, t)--- :}----{-# INLINE_NORMAL uncons #-}-uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons (UnStream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s -> return $ Just (x, Stream step s)-            Skip  s   -> go SPEC s-            Stop      -> return Nothing----------------------------------------------------------------------------------- From 'Unfold'---------------------------------------------------------------------------------data UnfoldState s = UnfoldNothing | UnfoldJust s---- | Convert an 'Unfold' into a stream by supplying it an input seed.------ >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello")--- >>> Stream.fold Fold.drain s--- hello--- hello--- hello----{-# INLINE_NORMAL unfold #-}-unfold :: Applicative m => Unfold m a b -> a -> Stream m b-unfold (Unfold ustep inject) seed = Stream step UnfoldNothing--    where--    {-# INLINE_LATE step #-}-    step _ UnfoldNothing = Skip . UnfoldJust <$> inject seed-    step _ (UnfoldJust st) = do-        (\case-            Yield x s -> Yield x (UnfoldJust s)-            Skip s    -> Skip (UnfoldJust s)-            Stop      -> Stop) <$> ustep st----------------------------------------------------------------------------------- From Values----------------------------------------------------------------------------------- | Create a singleton stream from a pure value.------ >>> fromPure a = a `Stream.cons` Stream.nil--- >>> fromPure = pure--- >>> fromPure = Stream.fromEffect . pure----{-# INLINE_NORMAL fromPure #-}-fromPure :: Applicative m => a -> Stream m a-fromPure x = Stream (\_ s -> pure $ step undefined s) True-  where-    {-# INLINE_LATE step #-}-    step _ True  = Yield x False-    step _ False = Stop---- | Create a singleton stream from a monadic action.------ >>> fromEffect m = m `Stream.consM` Stream.nil--- >>> fromEffect = Stream.sequence . Stream.fromPure------ >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello")--- hello----{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Applicative m => m a -> Stream m a-fromEffect m = Stream step True--    where--    {-# INLINE_LATE step #-}-    step _ True  = (`Yield` False) <$> m-    step _ False = pure Stop----------------------------------------------------------------------------------- From Containers----------------------------------------------------------------------------------- Adapted from the vector package.---- | Construct a stream from a list of pure values.-{-# INLINE_LATE fromList #-}-fromList :: Applicative m => [a] -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-fromList = unfold Unfold.fromList-#else-fromList = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (x:xs) = pure $ Yield x xs-    step _ []     = pure Stop-#endif----------------------------------------------------------------------------------- Conversions From/To----------------------------------------------------------------------------------- | Convert a CPS encoded StreamK to direct style step encoded StreamD-{-# INLINE_LATE fromStreamK #-}-fromStreamK :: Applicative m => K.StreamK m a -> Stream m a-fromStreamK = Stream step-    where-    step gst m1 =-        let stop       = pure Stop-            single a   = pure $ Yield a K.nil-            yieldk a r = pure $ Yield a r-         in K.foldStreamShared gst yieldk single stop m1---- | Convert a direct style step encoded StreamD to a CPS encoded StreamK-{-# INLINE_LATE toStreamK #-}-toStreamK :: Monad m => Stream m a -> K.StreamK m a-toStreamK (Stream step state) = go state-    where-    go st = K.MkStream $ \gst yld _ stp ->-      let go' ss = do-           r <- step gst ss-           case r of-               Yield x s -> yld x (go s)-               Skip  s   -> go' s-               Stop      -> stp-      in go' st--#ifndef DISABLE_FUSION-{-# RULES "fromStreamK/toStreamK fusion"-    forall s. toStreamK (fromStreamK s) = s #-}-{-# RULES "toStreamK/fromStreamK fusion"-    forall s. fromStreamK (toStreamK s) = s #-}-#endif----------------------------------------------------------------------------------- Running a 'Fold'----------------------------------------------------------------------------------- >>> fold f = Fold.extractM . Stream.foldAddLazy f--- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f--- >>> fold f = Fold.extractM <=< Stream.foldAdd f---- | Fold a stream using the supplied left 'Fold' and reducing the resulting--- expression strictly at each step. The behavior is similar to 'foldl''. A--- 'Fold' can terminate early without consuming the full stream. See the--- documentation of individual 'Fold's for termination behavior.------ Definitions:------ >>> fold f = fmap fst . Stream.foldBreak f--- >>> fold f = Stream.parse (Parser.fromFold f)------ Example:------ >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)--- 5050----{-# INLINE_NORMAL fold #-}-fold :: Monad m => Fold m a b -> Stream m a -> m b-fold fld strm = do-    (b, _) <- foldBreak fld strm-    return b---- | Fold resulting in either breaking the stream or continuation of the fold.--- Instead of supplying the input stream in one go we can run the fold multiple--- times, each time supplying the next segment of the input stream. If the fold--- has not yet finished it returns a fold that can be run again otherwise it--- returns the fold result and the residual stream.------ /Internal/-{-# INLINE_NORMAL foldEither #-}-foldEither :: Monad m =>-    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))-foldEither (Fold fstep begin done) (UnStream step state) = do-    res <- begin-    case res of-        FL.Partial fs -> go SPEC fs state-        FL.Done fb -> return $! Right (fb, Stream step state)--    where--    {-# INLINE go #-}-    go !_ !fs st = do-        r <- step defState st-        case r of-            Yield x s -> do-                res <- fstep fs x-                case res of-                    FL.Done b -> return $! Right (b, Stream step s)-                    FL.Partial fs1 -> go SPEC fs1 s-            Skip s -> go SPEC fs s-            Stop -> return $! Left (Fold fstep (return $ FL.Partial fs) done)---- | Like 'fold' but also returns the remaining stream. The resulting stream--- would be 'Stream.nil' if the stream finished before the fold.----{-# INLINE_NORMAL foldBreak #-}-foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-foldBreak fld strm = do-    r <- foldEither fld strm-    case r of-        Right res -> return res-        Left (Fold _ initial extract) -> do-            res <- initial-            case res of-                FL.Done _ -> error "foldBreak: unreachable state"-                FL.Partial s -> do-                    b <- extract s-                    return (b, nil)--    where--    nil = Stream (\_ _ -> return Stop) ()---- | Append a stream to a fold lazily to build an accumulator incrementally.------ Example, to continue folding a list of streams on the same sum fold:------ >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]]--- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams--- >>> Stream.fold f Stream.nil--- 55----{-# INLINE_NORMAL foldAddLazy #-}-foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b-foldAddLazy (Fold fstep finitial fextract) (Stream sstep state) =-    Fold fstep initial fextract--    where--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> go SPEC fs state-            FL.Done fb -> return $ FL.Done fb--    {-# INLINE go #-}-    go !_ !fs st = do-        r <- sstep defState st-        case r of-            Yield x s -> do-                res <- fstep fs x-                case res of-                    FL.Done b -> return $ FL.Done b-                    FL.Partial fs1 -> go SPEC fs1 s-            Skip s -> go SPEC fs s-            Stop -> return $ FL.Partial fs---- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce---- |--- >>> foldAdd = flip Fold.addStream----foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)-foldAdd f =-    Streamly.Internal.Data.Stream.StreamD.Type.fold (FL.duplicate f)----------------------------------------------------------------------------------- Right Folds----------------------------------------------------------------------------------- Adapted from the vector package.------ XXX Use of SPEC constructor in folds causes 2x performance degradation in--- one shot operations, but helps immensely in operations composed of multiple--- combinators or the same combinator many times. There seems to be an--- opportunity to optimize here, can we get both, better perf for single ops--- as well as composed ops? Without SPEC, all single operation benchmarks--- become 2x faster.---- The way we want a left fold to be strict, dually we want the right fold to--- be lazy.  The correct signature of the fold function to keep it lazy must be--- (a -> m b -> m b) instead of (a -> b -> m b). We were using the latter--- earlier, which is incorrect. In the latter signature we have to feed the--- value to the fold function after evaluating the monadic action, depending on--- the bind behavior of the monad, the action may get evaluated immediately--- introducing unnecessary strictness to the fold. If the implementation is--- lazy the following example, must work:------ S.foldrM (\x t -> if x then return t else return False) (return True)---  (S.fromList [False,undefined] :: Stream IO Bool)---- | Right associative/lazy pull fold. @foldrM build final stream@ constructs--- an output structure using the step function @build@. @build@ is invoked with--- the next input element and the remaining (lazy) tail of the output--- structure. It builds a lazy output expression using the two. When the "tail--- structure" in the output expression is evaluated it calls @build@ again thus--- lazily consuming the input @stream@ until either the output expression built--- by @build@ is free of the "tail" or the input is exhausted in which case--- @final@ is used as the terminating case for the output structure. For more--- details see the description in the previous section.------ Example, determine if any element is 'odd' in a stream:------ >>> s = Stream.fromList (2:4:5:undefined)--- >>> step x xs = if odd x then return True else xs--- >>> Stream.foldrM step (return False) s--- True----{-# INLINE_NORMAL foldrM #-}-foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-foldrM f z (Stream step state) = go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = do-          r <- step defState st-          case r of-            Yield x s -> f x (go SPEC s)-            Skip s    -> go SPEC s-            Stop      -> z--{-# INLINE_NORMAL foldrMx #-}-foldrMx :: Monad m-    => (a -> m x -> m x) -> m x -> (m x -> m b) -> Stream m a -> m b-foldrMx fstep final convert (Stream step state) = convert $ go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = do-          r <- step defState st-          case r of-            Yield x s -> fstep x (go SPEC s)-            Skip s    -> go SPEC s-            Stop      -> final---- XXX Should we make all argument strict wherever we use SPEC?---- Note that foldr works on pure values, therefore it becomes necessarily--- strict when the monad m is strict. In that case it cannot terminate early,--- it would evaluate all of its input.  Though, this should work fine with lazy--- monads. For example, if "any" is implemented using "foldr" instead of--- "foldrM" it performs the same with Identity monad but performs 1000x slower--- with IO monad.---- | Right fold, lazy for lazy monads and pure streams, and strict for strict--- monads.------ Please avoid using this routine in strict monads like IO unless you need a--- strict right fold. This is provided only for use in lazy monads (e.g.--- Identity) or pure streams. Note that with this signature it is not possible--- to implement a lazy foldr when the monad @m@ is strict. In that case it--- would be strict in its accumulator and therefore would necessarily consume--- all its input.------ >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z)------ Note: This is similar to Fold.foldr' (the right fold via left fold), but--- could be more efficient.----{-# INLINE_NORMAL foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr f z = foldrM (liftA2 f . return) (return z)---- this performs horribly, should not be used-{-# INLINE_NORMAL foldrS #-}-foldrS-    :: Monad m-    => (a -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream m b-foldrS f final (Stream step state) = go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = concatEffect $ fmap g $ step defState st--    g r =-        case r of-          Yield x s -> f x (go SPEC s)-          Skip s    -> go SPEC s-          Stop      -> final----------------------------------------------------------------------------------- Left Folds----------------------------------------------------------------------------------- XXX run begin action only if the stream is not empty.-{-# INLINE_NORMAL foldlMx' #-}-foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b-foldlMx' fstep begin done (Stream step state) =-    begin >>= \x -> go SPEC x state-  where-    -- XXX !acc?-    {-# INLINE_LATE go #-}-    go !_ acc st = acc `seq` do-        r <- step defState st-        case r of-            Yield x s -> do-                acc' <- fstep acc x-                go SPEC acc' s-            Skip s -> go SPEC acc s-            Stop   -> done acc--{-# INLINE foldlx' #-}-foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b-foldlx' fstep begin done =-    foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done)---- Adapted from the vector package.--- XXX implement in terms of foldlMx'?-{-# INLINE_NORMAL foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b-foldlM' fstep mbegin (Stream step state) = do-    begin <- mbegin-    go SPEC begin state-  where-    {-# INLINE_LATE go #-}-    go !_ acc st = acc `seq` do-        r <- step defState st-        case r of-            Yield x s -> do-                acc' <- fstep acc x-                go SPEC acc' s-            Skip s -> go SPEC acc s-            Stop   -> return acc--{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b-foldl' fstep begin = foldlM' (\b a -> return (fstep b a)) (return begin)----------------------------------------------------------------------------------- Special folds----------------------------------------------------------------------------------- >>> drain = mapM_ (\_ -> return ())---- |--- Definitions:------ >>> drain = Stream.fold Fold.drain--- >>> drain = Stream.foldrM (\_ xs -> xs) (return ())------ Run a stream, discarding the results.----{-# INLINE_LATE drain #-}-drain :: Monad m => Stream m a -> m ()--- drain = foldrM (\_ xs -> xs) (return ())-drain (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield _ s -> go SPEC s-            Skip s    -> go SPEC s-            Stop      -> return ()----------------------------------------------------------------------------------- To Containers----------------------------------------------------------------------------------- This toList impl is faster (30% on streaming-benchmarks) than the--- corresponding left fold. The left fold retains an additional argument in the--- recursive loop.------ Core for the right fold loop:------ main_$s$wgo1---   = \ sc_s3e6 sc1_s3e5 ->---       case ># sc1_s3e5 100000# of {---         __DEFAULT ->---           case main_$s$wgo1 sc_s3e6 (+# sc1_s3e5 1#) of------ Core for the left fold loop:------  main_$s$wgo1---   = \ sc_s3oT sc1_s3oS sc2_s3oR ->---       case sc2_s3oR of fs2_a2lw { __DEFAULT ->---       case ># sc1_s3oS 100000# of {---         __DEFAULT ->---           let { wild_a2og = I# sc1_s3oS } in---           main_$s$wgo1---             sc_s3oT (+# sc1_s3oS 1#) (\ x_X9 -> fs2_a2lw (: wild_a2og x_X9));---- |--- Definitions:------ >>> toList = Stream.foldr (:) []--- >>> toList = Stream.fold Fold.toList------ Convert a stream into a list in the underlying monad. The list can be--- consumed lazily in a lazy monad (e.g. 'Identity'). In a strict monad (e.g.--- IO) the whole list is generated and buffered before it can be consumed.------ /Warning!/ working on large lists accumulated as buffers in memory could be--- very inefficient, consider using "Streamly.Data.Array" instead.------ Note that this could a bit more efficient compared to @Stream.fold--- Fold.toList@, and it can fuse with pure list consumers.----{-# INLINE_NORMAL toList #-}-toList :: Monad m => Stream m a -> m [a]-toList = Streamly.Internal.Data.Stream.StreamD.Type.foldr (:) []---- Use foldr/build fusion to fuse with list consumers--- This can be useful when using the IsList instance-{-# INLINE_LATE toListFB #-}-toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b-toListFB c n (Stream step state) = go state-  where-    go st = case runIdentity (step defState st) of-             Yield x s -> x `c` go s-             Skip s    -> go s-             Stop      -> n--{-# RULES "toList Identity" Streamly.Internal.Data.Stream.StreamD.Type.toList = toListId #-}-{-# INLINE_EARLY toListId #-}-toListId :: Stream Identity a -> Identity [a]-toListId s = Identity $ build (\c n -> toListFB c n s)----------------------------------------------------------------------------------- Multi-stream folds----------------------------------------------------------------------------------- Adapted from the vector package.---- | Compare two streams for equality-{-# INLINE_NORMAL eqBy #-}-eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool-eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2-  where-    eq_loop0 !_ s1 s2 = do-      r <- step1 defState s1-      case r of-        Yield x s1' -> eq_loop1 SPEC x s1' s2-        Skip    s1' -> eq_loop0 SPEC   s1' s2-        Stop        -> eq_null s2--    eq_loop1 !_ x s1 s2 = do-      r <- step2 defState s2-      case r of-        Yield y s2'-          | eq x y    -> eq_loop0 SPEC   s1 s2'-          | otherwise -> return False-        Skip    s2'   -> eq_loop1 SPEC x s1 s2'-        Stop          -> return False--    eq_null s2 = do-      r <- step2 defState s2-      case r of-        Yield _ _ -> return False-        Skip s2'  -> eq_null s2'-        Stop      -> return True---- Adapted from the vector package.---- | Compare two streams lexicographically.-{-# INLINE_NORMAL cmpBy #-}-cmpBy-    :: Monad m-    => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering-cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2-  where-    cmp_loop0 !_ s1 s2 = do-      r <- step1 defState s1-      case r of-        Yield x s1' -> cmp_loop1 SPEC x s1' s2-        Skip    s1' -> cmp_loop0 SPEC   s1' s2-        Stop        -> cmp_null s2--    cmp_loop1 !_ x s1 s2 = do-      r <- step2 defState s2-      case r of-        Yield y s2' -> case x `cmp` y of-                         EQ -> cmp_loop0 SPEC s1 s2'-                         c  -> return c-        Skip    s2' -> cmp_loop1 SPEC x s1 s2'-        Stop        -> return GT--    cmp_null s2 = do-      r <- step2 defState s2-      case r of-        Yield _ _ -> return LT-        Skip s2'  -> cmp_null s2'-        Stop      -> return EQ----------------------------------------------------------------------------------- Transformations----------------------------------------------------------------------------------- Adapted from the vector package.---- |--- >>> mapM f = Stream.sequence . fmap f------ Apply a monadic function to each element of the stream and replace it with--- the output of the resulting action.------ >>> s = Stream.fromList ["a", "b", "c"]--- >>> Stream.fold Fold.drain $ Stream.mapM putStr s--- abc----{-# INLINE_NORMAL mapM #-}-mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-mapM f (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> f x >>= \a -> return $ Yield a s-            Skip s    -> return $ Skip s-            Stop      -> return Stop--{-# INLINE map #-}-map :: Monad m => (a -> b) -> Stream m a -> Stream m b-map f = mapM (return . f)---- (Functor m) based implementation of fmap does not fuse well in--- streaming-benchmarks. XXX need to investigate why.-instance Monad m => Functor (Stream m) where-    {-# INLINE fmap #-}-    fmap = map--    {-# INLINE (<$) #-}-    (<$) = fmap . const----------------------------------------------------------------------------------- Lists----------------------------------------------------------------------------------- XXX Show instance is 10x slower compared to read, we can do much better.--- The list show instance itself is really slow.---- XXX The default definitions of "<" in the Ord instance etc. do not perform--- well, because they do not get inlined. Need to add INLINE in Ord class in--- base?--instance IsList (Stream Identity a) where-    type (Item (Stream Identity a)) = a--    {-# INLINE fromList #-}-    fromList = Streamly.Internal.Data.Stream.StreamD.Type.fromList--    {-# INLINE toList #-}-    toList = runIdentity . Streamly.Internal.Data.Stream.StreamD.Type.toList--instance Eq a => Eq (Stream Identity a) where-    {-# INLINE (==) #-}-    (==) xs ys = runIdentity $ eqBy (==) xs ys--instance Ord a => Ord (Stream Identity a) where-    {-# INLINE compare #-}-    compare xs ys = runIdentity $ cmpBy compare xs ys--    {-# INLINE (<) #-}-    x < y =-        case compare x y of-            LT -> True-            _ -> False--    {-# INLINE (<=) #-}-    x <= y =-        case compare x y of-            GT -> False-            _ -> True--    {-# INLINE (>) #-}-    x > y =-        case compare x y of-            GT -> True-            _ -> False--    {-# INLINE (>=) #-}-    x >= y =-        case compare x y of-            LT -> False-            _ -> True--    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y--instance Show a => Show (Stream Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (GHC.Exts.toList dl)--instance Read a => Read (Stream Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        Streamly.Internal.Data.Stream.StreamD.Type.fromList <$> readPrec--    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (Stream Identity a) where-    {-# INLINE fromString #-}-    fromString = Streamly.Internal.Data.Stream.StreamD.Type.fromList------------------------------------------------------------------------------------ Foldable------------------------------------------------------------------------------------ The default Foldable instance has several issues:--- 1) several definitions do not have INLINE on them, so we provide---    re-implementations with INLINE pragmas.--- 2) the definitions of sum/product/maximum/minimum are inefficient as they---    use right folds, they cannot run in constant memory. We provide---    implementations using strict left folds here.---- There is no Traversable instance because, there is no scalable cons for--- StreamD, use toList and fromList instead.--instance (Foldable m, Monad m) => Foldable (Stream m) where--    {-# INLINE foldMap #-}-    foldMap f =-        Data.Foldable.fold-            . Streamly.Internal.Data.Stream.StreamD.Type.foldr (mappend . f) mempty--    {-# INLINE foldr #-}-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    {-# INLINE foldl' #-}-    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0-        where f' x k = oneShot $ \z -> k $! f z x--    {-# INLINE length #-}-    length = Data.Foldable.foldl' (\n _ -> n + 1) 0--    {-# INLINE elem #-}-    elem = any . (==)--    {-# INLINE maximum #-}-    maximum =-          fromMaybe (errorWithoutStackTrace "maximum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMax Nothing'--        where--        getMax Nothing' x = Just' x-        getMax (Just' mx) x = Just' $! max mx x--    {-# INLINE minimum #-}-    minimum =-          fromMaybe (errorWithoutStackTrace "minimum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMin Nothing'--        where--        getMin Nothing' x = Just' x-        getMin (Just' mn) x = Just' $! min mn x--    {-# INLINE sum #-}-    sum = Data.Foldable.foldl' (+) 0--    {-# INLINE product #-}-    product = Data.Foldable.foldl' (*) 1------------------------------------------------------------------------------------ Filtering------------------------------------------------------------------------------------ Adapted from the vector package.---- | Take first 'n' elements from the stream and discard the rest.----{-# INLINE_NORMAL take #-}-take :: Applicative m => Int -> Stream m a -> Stream m a-take n (Stream step state) = n `seq` Stream step' (state, 0)--    where--    {-# INLINE_LATE step' #-}-    step' gst (st, i) | i < n = do-        (\case-            Yield x s -> Yield x (s, i + 1)-            Skip s    -> Skip (s, i)-            Stop      -> Stop) <$> step gst st-    step' _ (_, _) = pure Stop---- Adapted from the vector package.---- | Same as 'takeWhile' but with a monadic predicate.----{-# INLINE_NORMAL takeWhileM #-}-takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x))-takeWhileM f (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                return $ if b then Yield x s else Stop-            Skip s -> return $ Skip s-            Stop   -> return Stop---- | End the stream as soon as the predicate fails on an element.----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-takeWhile f = takeWhileM (return . f)---- Like takeWhile but with an inverted condition and also taking--- the matching element.--{-# INLINE_NORMAL takeEndByM #-}-takeEndByM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-takeEndByM f (Stream step state) = Stream step' (Just state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (Just st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                return $-                    if not b-                    then Yield x (Just s)-                    else Yield x Nothing-            Skip s -> return $ Skip (Just s)-            Stop   -> return Stop--    step' _ Nothing = return Stop--{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-takeEndBy f = takeEndByM (return . f)----------------------------------------------------------------------------------- Zipping----------------------------------------------------------------------------------- | Like 'zipWith' but using a monadic zipping function.----{-# INLINE_NORMAL zipWithM #-}-zipWithM :: Monad m-    => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c-zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)-  where-    {-# INLINE_LATE step #-}-    step gst (sa, sb, Nothing) = do-        r <- stepa (adaptState gst) sa-        return $-          case r of-            Yield x sa' -> Skip (sa', sb, Just x)-            Skip sa'    -> Skip (sa', sb, Nothing)-            Stop        -> Stop--    step gst (sa, sb, Just x) = do-        r <- stepb (adaptState gst) sb-        case r of-            Yield y sb' -> do-                z <- f x y-                return $ Yield z (sa, sb', Nothing)-            Skip sb' -> return $ Skip (sa, sb', Just x)-            Stop     -> return Stop--{-# RULES "zipWithM xs xs"-    forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}---- | Stream @a@ is evaluated first, followed by stream @b@, the resulting--- elements @a@ and @b@ are then zipped using the supplied zip function and the--- result @c@ is yielded to the consumer.------ If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends--- first, the element @a@ from previous evaluation of stream @a@ is discarded.------ >>> s1 = Stream.fromList [1,2,3]--- >>> s2 = Stream.fromList [4,5,6]--- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2--- [5,7,9]----{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWith f = zipWithM (\a b -> return (f a b))----------------------------------------------------------------------------------- Combine N Streams - concatAp----------------------------------------------------------------------------------- | Apply a stream of functions to a stream of values and flatten the results.------ Note that the second stream is evaluated multiple times.------ >>> crossApply = Stream.crossWith id----{-# INLINE_NORMAL crossApply #-}-crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b-crossApply (Stream stepa statea) (Stream stepb stateb) =-    Stream step' (Left statea)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Left st) = fmap-        (\case-            Yield f s -> Skip (Right (f, s, stateb))-            Skip    s -> Skip (Left s)-            Stop      -> Stop)-        (stepa (adaptState gst) st)-    step' gst (Right (f, os, st)) = fmap-        (\case-            Yield a s -> Yield (f a) (Right (f, os, s))-            Skip s    -> Skip (Right (f,os, s))-            Stop      -> Skip (Left os))-        (stepb (adaptState gst) st)--{-# INLINE_NORMAL crossApplySnd #-}-crossApplySnd :: Functor f => Stream f a -> Stream f b -> Stream f b-crossApplySnd (Stream stepa statea) (Stream stepb stateb) =-    Stream step (Left statea)--    where--    {-# INLINE_LATE step #-}-    step gst (Left st) =-        fmap-            (\case-                 Yield _ s -> Skip (Right (s, stateb))-                 Skip s -> Skip (Left s)-                 Stop -> Stop)-            (stepa (adaptState gst) st)-    step gst (Right (ostate, st)) =-        fmap-            (\case-                 Yield b s -> Yield b (Right (ostate, s))-                 Skip s -> Skip (Right (ostate, s))-                 Stop -> Skip (Left ostate))-            (stepb gst st)--{-# INLINE_NORMAL crossApplyFst #-}-crossApplyFst :: Functor f => Stream f a -> Stream f b -> Stream f a-crossApplyFst (Stream stepa statea) (Stream stepb stateb) =-    Stream step (Left statea)--    where--    {-# INLINE_LATE step #-}-    step gst (Left st) =-        fmap-            (\case-                 Yield b s -> Skip (Right (s, stateb, b))-                 Skip s -> Skip (Left s)-                 Stop -> Stop)-            (stepa gst st)-    step gst (Right (ostate, st, b)) =-        fmap-            (\case-                 Yield _ s -> Yield b (Right (ostate, s, b))-                 Skip s -> Skip (Right (ostate, s, b))-                 Stop -> Skip (Left ostate))-            (stepb (adaptState gst) st)--{--instance Applicative f => Applicative (Stream f) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (*>) = crossApplySnd--    {-# INLINE (<*) #-}-    (<*) = crossApplyFst--}---- |--- Definition:------ >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2------ Note that the second stream is evaluated multiple times.----{-# INLINE crossWith #-}-crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-crossWith f m1 m2 = fmap f m1 `crossApply` m2---- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible--- combinations of the tuple @(a, b)@.------ Definition:------ >>> cross = Stream.crossWith (,)------ The second stream is evaluated multiple times. If that is not desired it can--- be cached in an 'Data.Array.Array' and then generated from the array before--- calling this function. Caching may also improve performance if the stream is--- expensive to evaluate.------ See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE cross #-}-cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)-cross = crossWith (,)----------------------------------------------------------------------------------- Combine N Streams - unfoldMany---------------------------------------------------------------------------------{-# ANN type ConcatMapUState Fuse #-}-data ConcatMapUState o i =-      ConcatMapUOuter o-    | ConcatMapUInner o i---- | @unfoldMany unfold stream@ uses @unfold@ to map the input stream elements--- to streams and then flattens the generated streams into a single output--- stream.---- This is like 'concatMap' but uses an unfold with an explicit state to--- generate the stream instead of a 'Stream' type generator. This allows better--- optimization via fusion.  This can be many times more efficient than--- 'concatMap'.---- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike--- 'concatMap' this can fuse the 'Unfold' code with the inner loop and--- therefore provide many times better performance.----{-# INLINE_NORMAL unfoldMany #-}-unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldMany (Unfold istep inject) (Stream ostep ost) =-    Stream step (ConcatMapUOuter ost)-  where-    {-# INLINE_LATE step #-}-    step gst (ConcatMapUOuter o) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a o' -> do-                i <- inject a-                i `seq` return (Skip (ConcatMapUInner o' i))-            Skip o' -> return $ Skip (ConcatMapUOuter o')-            Stop -> return Stop--    step _ (ConcatMapUInner o i) = do-        r <- istep i-        return $ case r of-            Yield x i' -> Yield x (ConcatMapUInner o i')-            Skip i'    -> Skip (ConcatMapUInner o i')-            Stop       -> Skip (ConcatMapUOuter o)----------------------------------------------------------------------------------- Combine N Streams - concatMap----------------------------------------------------------------------------------- Adapted from the vector package.---- | Map a stream producing monadic function on each element of the stream--- and then flatten the results into a single stream. Since the stream--- generation function is monadic, unlike 'concatMap', it can produce an--- effect at the beginning of each iteration of the inner loop.------ See 'unfoldMany' for a fusible alternative.----{-# INLINE_NORMAL concatMapM #-}-concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b-concatMapM f (Stream step state) = Stream step' (Left state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (Left st) = do-        r <- step (adaptState gst) st-        case r of-            Yield a s -> do-                b_stream <- f a-                return $ Skip (Right (b_stream, s))-            Skip s -> return $ Skip (Left s)-            Stop -> return Stop--    -- XXX flattenArrays is 5x faster than "concatMap fromArray". if somehow we-    -- can get inner_step to inline and fuse here we can perhaps get the same-    -- performance using "concatMap fromArray".-    ---    -- XXX using the pattern synonym "Stream" causes a major performance issue-    -- here even if the synonym does not include an adaptState call. Need to-    -- find out why. Is that something to be fixed in GHC?-    step' gst (Right (UnStream inner_step inner_st, st)) = do-        r <- inner_step (adaptState gst) inner_st-        case r of-            Yield b inner_s ->-                return $ Yield b (Right (Stream inner_step inner_s, st))-            Skip inner_s ->-                return $ Skip (Right (Stream inner_step inner_s, st))-            Stop -> return $ Skip (Left st)---- | Map a stream producing function on each element of the stream and then--- flatten the results into a single stream.------ >>> concatMap f = Stream.concatMapM (return . f)--- >>> concatMap f = Stream.concat . fmap f--- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream)------ See 'unfoldMany' for a fusible alternative.----{-# INLINE concatMap #-}-concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b-concatMap f = concatMapM (return . f)---- | Flatten a stream of streams to a single stream.------ >>> concat = Stream.concatMap id------ /Pre-release/-{-# INLINE concat #-}-concat :: Monad m => Stream m (Stream m a) -> Stream m a-concat = concatMap id---- XXX The idea behind this rule is to rewrite any calls to "concatMap--- fromArray" automatically to flattenArrays which is much faster.  However, we--- need an INLINE_EARLY on concatMap for this rule to fire. But if we use--- INLINE_EARLY on concatMap or fromArray then direct uses of--- "concatMap fromArray" (without the RULE) become much slower, this means--- "concatMap f" in general would become slower. Need to find a solution to--- this.------ {-# RULES "concatMap Array.toStreamD"---      concatMap Array.toStreamD = Array.flattenArray #-}---- >>> concatEffect = Stream.concat . lift    -- requires (MonadTrans t)--- >>> concatEffect = join . lift             -- requires (MonadTrans t, Monad (Stream m))---- | Given a stream value in the underlying monad, lift and join the underlying--- monad with the stream monad.------ >>> concatEffect = Stream.concat . Stream.fromEffect--- >>> concatEffect eff = Stream.concatMapM (\() -> eff) (Stream.fromPure ())------ See also: 'concat', 'sequence'----{-# INLINE concatEffect #-}-concatEffect :: Monad m => m (Stream m a) -> Stream m a-concatEffect generator = concatMapM (\() -> generator) (fromPure ())--{---- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,--- the monad instance does not seem to be significantly faster.-instance Monad m => Monad (Stream m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--    {-# INLINE (>>) #-}-    (>>) = (*>)--}----------------------------------------------------------------------------------- Traversing a tree top down----------------------------------------------------------------------------------- Next stream is to be generated by the return value of the previous stream. A--- general intuitive way of doing that could be to use an appending monad--- instance for streams where the result of the previous stream is used to--- generate the next one. In the first pass we can just emit the values in the--- stream and keep building a buffered list/stream, once done we can then--- process the buffered stream.---- | Generate a stream from an initial state, scan and concat the stream,--- generate a stream again from the final state of the previous scan and repeat--- the process.-{-# INLINE_NORMAL concatIterateScan #-}-concatIterateScan :: Monad m =>-       (b -> a -> m b)-    -> (b -> m (Maybe (b, Stream m a)))-    -> b-    -> Stream m a-concatIterateScan scanner generate initial = Stream step (Left initial)--    where--    {-# INLINE_LATE step #-}-    step _ (Left acc) = do-        r <- generate acc-        case r of-            Nothing -> return Stop-            Just v -> return $ Skip (Right v)--    step gst (Right (st, UnStream inner_step inner_st)) = do-        r <- inner_step (adaptState gst) inner_st-        case r of-            Yield b inner_s -> do-                acc <- scanner st b-                return $ Yield b (Right (acc, Stream inner_step inner_s))-            Skip inner_s ->-                return $ Skip (Right (st, Stream inner_step inner_s))-            Stop -> return $ Skip (Left st)---- Note: The iterate function returns a Maybe Stream instead of returning a nil--- stream for indicating a leaf node. This is to optimize so that we do not--- have to store any state. This makes the stored state proportional to the--- number of non-leaf nodes rather than total number of nodes.---- | Same as 'concatIterateBfs' except that the traversal of the last--- element on a level is emitted first and then going backwards up to the first--- element (reversed ordering). This may be slightly faster than--- 'concatIterateBfs'.----{-# INLINE_NORMAL concatIterateBfsRev #-}-concatIterateBfsRev :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfsRev f stream = Stream step (stream, [])--    where--    {-# INLINE_LATE step #-}-    step gst (UnStream step1 st, xs) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield a s -> do-                let xs1 =-                        case f a of-                            Nothing -> xs-                            Just x -> x:xs-                return $ Yield a (Stream step1 s, xs1)-            Skip s -> return $ Skip (Stream step1 s, xs)-            Stop ->-                case xs of-                    (y:ys) -> return $ Skip (y, ys)-                    [] -> return Stop---- | Similar to 'concatIterateDfs' except that it traverses the stream in--- breadth first style (BFS). First, all the elements in the input stream are--- emitted, and then their traversals are emitted.------ Example, list a directory tree using BFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateBfs f input------ /Pre-release/-{-# INLINE_NORMAL concatIterateBfs #-}-concatIterateBfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfs f stream = Stream step (stream, [], [])--    where--    {-# INLINE_LATE step #-}-    step gst (UnStream step1 st, xs, ys) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield a s -> do-                let ys1 =-                        case f a of-                            Nothing -> ys-                            Just y -> y:ys-                return $ Yield a (Stream step1 s, xs, ys1)-            Skip s -> return $ Skip (Stream step1 s, xs, ys)-            Stop ->-                case xs of-                    (x:xs1) -> return $ Skip (x, xs1, ys)-                    [] ->-                        case reverse ys of-                            (x:xs1) -> return $ Skip (x, xs1, [])-                            [] -> return Stop---- | Traverse the stream in depth first style (DFS). Map each element in the--- input stream to a stream and flatten, recursively map the resulting elements--- as well to a stream and flatten until no more streams are generated.------ Example, list a directory tree using DFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateDfs f input------ This is equivalent to using @concatIterateWith StreamK.append@.------ /Pre-release/-{-# INLINE_NORMAL concatIterateDfs #-}-concatIterateDfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateDfs f stream = Stream step (stream, [])--    where--    {-# INLINE_LATE step #-}-    step gst (UnStream step1 st, xs) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield a s -> do-                let st1 =-                        case f a of-                            Nothing -> (Stream step1 s, xs)-                            Just x -> (x, Stream step1 s:xs)-                return $ Yield a st1-            Skip s -> return $ Skip (Stream step1 s, xs)-            Stop ->-                case xs of-                    (y:ys) -> return $ Skip (y, ys)-                    [] -> return Stop--{-# ANN type IterateUnfoldState Fuse #-}-data IterateUnfoldState o i =-      IterateUnfoldOuter o-    | IterateUnfoldInner o i [i]---- | Same as @concatIterateDfs@ but more efficient due to stream fusion.------ Example, list a directory tree using DFS:------ >>> f = Unfold.either Dir.eitherReaderPaths Unfold.nil--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.unfoldIterateDfs f input------ /Pre-release/-{-# INLINE_NORMAL unfoldIterateDfs #-}-unfoldIterateDfs :: Monad m =>-       Unfold m a a-    -> Stream m a-    -> Stream m a-unfoldIterateDfs (Unfold istep inject) (Stream ostep ost) =-    Stream step (IterateUnfoldOuter ost)--    where--    {-# INLINE_LATE step #-}-    step gst (IterateUnfoldOuter o) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a s -> do-                i <- inject a-                i `seq` return (Yield a (IterateUnfoldInner s i []))-            Skip s -> return $ Skip (IterateUnfoldOuter s)-            Stop -> return Stop--    step _ (IterateUnfoldInner o i ii) = do-        r <- istep i-        case r of-            Yield x s -> do-                i1 <- inject x-                i1 `seq` return $ Yield x (IterateUnfoldInner o i1 (s:ii))-            Skip s -> return $ Skip (IterateUnfoldInner o s ii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldInner o y ys)-                    [] -> return $ Skip (IterateUnfoldOuter o)--{-# ANN type IterateUnfoldBFSRevState Fuse #-}-data IterateUnfoldBFSRevState o i =-      IterateUnfoldBFSRevOuter o [i]-    | IterateUnfoldBFSRevInner i [i]---- | Like 'unfoldIterateBfs' but processes the children in reverse order,--- therefore, may be slightly faster.------ /Pre-release/-{-# INLINE_NORMAL unfoldIterateBfsRev #-}-unfoldIterateBfsRev :: Monad m =>-       Unfold m a a-    -> Stream m a-    -> Stream m a-unfoldIterateBfsRev (Unfold istep inject) (Stream ostep ost) =-    Stream step (IterateUnfoldBFSRevOuter ost [])--    where--    {-# INLINE_LATE step #-}-    step gst (IterateUnfoldBFSRevOuter o ii) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a s -> do-                i <- inject a-                i `seq` return (Yield a (IterateUnfoldBFSRevOuter s (i:ii)))-            Skip s -> return $ Skip (IterateUnfoldBFSRevOuter s ii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)-                    [] -> return Stop--    step _ (IterateUnfoldBFSRevInner i ii) = do-        r <- istep i-        case r of-            Yield x s -> do-                i1 <- inject x-                i1 `seq` return $ Yield x (IterateUnfoldBFSRevInner s (i1:ii))-            Skip s -> return $ Skip (IterateUnfoldBFSRevInner s ii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)-                    [] -> return Stop--{-# ANN type IterateUnfoldBFSState Fuse #-}-data IterateUnfoldBFSState o i =-      IterateUnfoldBFSOuter o [i]-    | IterateUnfoldBFSInner i [i] [i]---- | Like 'unfoldIterateDfs' but uses breadth first style traversal.------ /Pre-release/-{-# INLINE_NORMAL unfoldIterateBfs #-}-unfoldIterateBfs :: Monad m =>-       Unfold m a a-    -> Stream m a-    -> Stream m a-unfoldIterateBfs (Unfold istep inject) (Stream ostep ost) =-    Stream step (IterateUnfoldBFSOuter ost [])--    where--    {-# INLINE_LATE step #-}-    step gst (IterateUnfoldBFSOuter o rii) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a s -> do-                i <- inject a-                i `seq` return (Yield a (IterateUnfoldBFSOuter s (i:rii)))-            Skip s -> return $ Skip (IterateUnfoldBFSOuter s rii)-            Stop ->-                case reverse rii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])-                    [] -> return Stop--    step _ (IterateUnfoldBFSInner i ii rii) = do-        r <- istep i-        case r of-            Yield x s -> do-                i1 <- inject x-                i1 `seq` return $ Yield x (IterateUnfoldBFSInner s ii (i1:rii))-            Skip s -> return $ Skip (IterateUnfoldBFSInner s ii rii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys rii)-                    [] ->-                        case reverse rii of-                            (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])-                            [] -> return Stop----------------------------------------------------------------------------------- Folding a tree bottom up----------------------------------------------------------------------------------- | Binary BFS style reduce, folds a level entirely using the supplied fold--- function, collecting the outputs as next level of the tree, then repeats the--- same process on the next level. The last elements of a previously folded--- level are folded first.-{-# INLINE_NORMAL reduceIterateBfs #-}-reduceIterateBfs :: Monad m =>-    (a -> a -> m a) -> Stream m a -> m (Maybe a)-reduceIterateBfs f (Stream step state) = go SPEC state [] Nothing--    where--    go _ st xs Nothing = do-        r <- step defState st-        case r of-            Yield x1 s -> go SPEC s xs (Just x1)-            Skip s -> go SPEC s xs Nothing-            Stop ->-                case xs of-                    [] -> return Nothing-                    _ -> goBuf SPEC xs []-    go _ st xs (Just x1) = do-        r2 <- step defState st-        case r2 of-            Yield x2 s -> do-                x <- f x1 x2-                go SPEC s (x:xs) Nothing-            Skip s -> go SPEC s xs (Just x1)-            Stop ->-                case xs of-                    [] -> return (Just x1)-                    _ -> goBuf SPEC (x1:xs) []--    goBuf _ [] ys = goBuf SPEC ys []-    goBuf _ [x1] ys = do-        case ys of-            [] -> return (Just x1)-            (x2:xs) -> do-                y <- f x1 x2-                goBuf SPEC xs [y]-    goBuf _ (x1:x2:xs) ys = do-        y <- f x1 x2-        goBuf SPEC xs (y:ys)---- | N-Ary BFS style iterative fold, if the input stream finished before the--- fold then it returns Left otherwise Right. If the fold returns Left we--- terminate.------ /Unimplemented/-foldIterateBfs ::-    Fold m a (Either a a) -> Stream m a -> m (Maybe a)-foldIterateBfs = undefined----------------------------------------------------------------------------------- Grouping/Splitting----------------------------------------------------------------------------------- s = stream state, fs = fold state-{-# ANN type FoldManyPost Fuse #-}-data FoldManyPost s fs b a-    = FoldManyPostStart s-    | FoldManyPostLoop s fs-    | FoldManyPostYield b (FoldManyPost s fs b a)-    | FoldManyPostDone---- XXX Need a more intuitive name, and need to reconcile the names--- foldMany/fold/parse/parseMany/parseManyPost etc.---- XXX foldManyPost keeps the last fold always partial. if the last fold is--- complete then another fold is applied on empty input. This is used for--- applying folds like takeEndBy such that the last element is not the--- separator (infix style). But that looks like a hack. We should remove this--- and use a custom combinator for infix parsing.---- | Like 'foldMany' but evaluates the fold even if the fold did not receive--- any input, therefore, always results in a non-empty output even on an empty--- stream (default result of the fold).------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f--- >>> fmany $ Stream.fromList []--- [0]------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7,0]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream without consuming the input.------ /Pre-release/----{-# INLINE_NORMAL foldManyPost #-}-foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b-foldManyPost (Fold fstep initial extract) (Stream step state) =-    Stream step' (FoldManyPostStart state)--    where--    {-# INLINE consume #-}-    consume x s fs = do-        res <- fstep fs x-        return-            $ Skip-            $ case res of-                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart s)-                  FL.Partial ps -> FoldManyPostLoop s ps--    {-# INLINE_LATE step' #-}-    step' _ (FoldManyPostStart st) = do-        r <- initial-        return-            $ Skip-            $ case r of-                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart st)-                  FL.Partial fs -> FoldManyPostLoop st fs-    step' gst (FoldManyPostLoop st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyPostLoop s fs)-            Stop -> do-                b <- extract fs-                return $ Skip (FoldManyPostYield b FoldManyPostDone)-    step' _ (FoldManyPostYield b next) = return $ Yield b next-    step' _ FoldManyPostDone = return Stop--{-# ANN type FoldMany Fuse #-}-data FoldMany s fs b a-    = FoldManyStart s-    | FoldManyFirst fs s-    | FoldManyLoop s fs-    | FoldManyYield b (FoldMany s fs b a)-    | FoldManyDone---- XXX Nested foldMany does not fuse.---- | Apply a 'Fold' repeatedly on a stream and emit the results in the output--- stream.------ Definition:------ >>> foldMany f = Stream.parseMany (Parser.fromFold f)------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f--- >>> fmany $ Stream.fromList []--- []------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream on a non-empty input stream.----{-# INLINE_NORMAL foldMany #-}-foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b-foldMany (Fold fstep initial extract) (Stream step state) =-    Stream step' (FoldManyStart state)--    where--    {-# INLINE consume #-}-    consume x s fs = do-        res <- fstep fs x-        return-            $ Skip-            $ case res of-                  FL.Done b -> FoldManyYield b (FoldManyStart s)-                  FL.Partial ps -> FoldManyLoop s ps--    {-# INLINE_LATE step' #-}-    step' _ (FoldManyStart st) = do-        r <- initial-        return-            $ Skip-            $ case r of-                  FL.Done b -> FoldManyYield b (FoldManyStart st)-                  FL.Partial fs -> FoldManyFirst fs st-    step' gst (FoldManyFirst fs st) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyFirst fs s)-            Stop -> return Stop-    step' gst (FoldManyLoop st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyLoop s fs)-            Stop -> do-                b <- extract fs-                return $ Skip (FoldManyYield b FoldManyDone)-    step' _ (FoldManyYield b next) = return $ Yield b next-    step' _ FoldManyDone = return Stop--{-# INLINE groupsOf #-}-groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b-groupsOf n f = foldMany (FL.take n f)---- Keep the argument order consistent with refoldIterateM.---- | Like 'foldMany' but for the 'Refold' type.  The supplied action is used as--- the initial value for each refold.------ /Internal/-{-# INLINE_NORMAL refoldMany #-}-refoldMany :: Monad m => Refold m x a b -> m x -> Stream m a -> Stream m b-refoldMany (Refold fstep inject extract) action (Stream step state) =-    Stream step' (FoldManyStart state)--    where--    {-# INLINE consume #-}-    consume x s fs = do-        res <- fstep fs x-        return-            $ Skip-            $ case res of-                  FL.Done b -> FoldManyYield b (FoldManyStart s)-                  FL.Partial ps -> FoldManyLoop s ps--    {-# INLINE_LATE step' #-}-    step' _ (FoldManyStart st) = do-        r <- action >>= inject-        return-            $ Skip-            $ case r of-                  FL.Done b -> FoldManyYield b (FoldManyStart st)-                  FL.Partial fs -> FoldManyFirst fs st-    step' gst (FoldManyFirst fs st) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyFirst fs s)-            Stop -> return Stop-    step' gst (FoldManyLoop st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyLoop s fs)-            Stop -> do-                b <- extract fs-                return $ Skip (FoldManyYield b FoldManyDone)-    step' _ (FoldManyYield b next) = return $ Yield b next-    step' _ FoldManyDone = return Stop----------------------------------------------------------------------------------- Stream with a cross product style monad instance----------------------------------------------------------------------------------- XXX CrossStream performs better than the CrossStreamK when nesting two--- loops, however, CrossStreamK seems to be better for more than two nestings,--- need to do more perf investigation.---- | A newtype wrapper for the 'Stream' type with a cross product style monad--- instance.------ A 'Monad' bind behaves like a @for@ loop:------ >>> :{--- Stream.fold Fold.toList $ Stream.unCross $ do---     x <- Stream.mkCross $ Stream.fromList [1,2]---     -- Perform the following actions for each x in the stream---     return x--- :}--- [1,2]------ Nested monad binds behave like nested @for@ loops:------ >>> :{--- Stream.fold Fold.toList $ Stream.unCross $ do---     x <- Stream.mkCross $ Stream.fromList [1,2]---     y <- Stream.mkCross $ Stream.fromList [3,4]---     -- Perform the following actions for each x, for each y---     return (x, y)--- :}--- [(1,3),(1,4),(2,3),(2,4)]----newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a}-        deriving (Functor, Foldable)--{-# INLINE mkCross #-}-mkCross :: Stream m a -> CrossStream m a-mkCross = CrossStream--{-# INLINE unCross #-}-unCross :: CrossStream m a -> Stream m a-unCross = unCrossStream---- Pure (Identity monad) stream instances-deriving instance IsList (CrossStream Identity a)-deriving instance (a ~ Char) => IsString (CrossStream Identity a)-deriving instance Eq a => Eq (CrossStream Identity a)-deriving instance Ord a => Ord (CrossStream Identity a)---- Do not use automatic derivation for this to show as "fromList" rather than--- "fromList Identity".-instance Show a => Show (CrossStream Identity a) where-    {-# INLINE show #-}-    show (CrossStream xs) = show xs--instance Read a => Read (CrossStream Identity a) where-    {-# INLINE readPrec #-}-    readPrec = fmap CrossStream readPrec----------------------------------------------------------------------------------- Applicative----------------------------------------------------------------------------------- Note: we need to define all the typeclass operations because we want to--- INLINE them.-instance Monad m => Applicative (CrossStream m) where-    {-# INLINE pure #-}-    pure x = CrossStream (fromPure x)--    {-# INLINE (<*>) #-}-    (CrossStream s1) <*> (CrossStream s2) =-        CrossStream (crossApply s1 s2)--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (CrossStream s1) *> (CrossStream s2) =-        CrossStream (crossApplySnd s1 s2)--    {-# INLINE (<*) #-}-    (CrossStream s1) <* (CrossStream s2) =-        CrossStream (crossApplyFst s1 s2)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (CrossStream m) where-    return = pure--    -- Benchmarks better with StreamD bind and pure:-    -- toList, filterAllout, *>, *<, >> (~2x)-    ----    -- Benchmarks better with CPS bind and pure:-    -- Prime sieve (25x)-    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)-    ---    {-# INLINE (>>=) #-}-    (>>=) (CrossStream m) f = CrossStream (concatMap (unCrossStream . f) m)--    {-# INLINE (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- Transformers---------------------------------------------------------------------------------instance (MonadIO m) => MonadIO (CrossStream m) where-    liftIO x = CrossStream (fromEffect $ liftIO x)--instance MonadTrans CrossStream where-    {-# INLINE lift #-}-    lift x = CrossStream (fromEffect x)--instance (MonadThrow m) => MonadThrow (CrossStream m) where-    throwM = lift . throwM
− src/Streamly/Internal/Data/Stream/StreamDK.hs 
@@ -1,52 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamDK--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--------- This module has the following problems due to rewrite rules:------ * Rewrite rules lead to optimization problems, blocking fusion in some--- cases, specifically when combining multiple operations e.g. (filter . drop).--- * Rewrite rules lead to problems when calling a function recursively. For--- example, the StreamD version of foldBreak cannot be used recursively when--- wrapped in rewrite rules because each recursive call adds a roundtrip--- conversion from D to K and back to D. We can use the StreamK versions of--- these though because the rewrite rule gets eliminated in that case.--- * If we have a unified module, we need two different versions of several--- operations e.g. appendK and appendD, both are useful in different cases.----module Streamly.Internal.Data.Stream.StreamDK-    ( module Streamly.Internal.Data.Stream.Type-    , module Streamly.Internal.Data.Stream.Bottom-    , module Streamly.Internal.Data.Stream.Eliminate-    , module Streamly.Internal.Data.Stream.Exception-    , module Streamly.Internal.Data.Stream.Expand-    , module Streamly.Internal.Data.Stream.Generate-    , module Streamly.Internal.Data.Stream.Lift-    , module Streamly.Internal.Data.Stream.Reduce-    , module Streamly.Internal.Data.Stream.Transform-    , module Streamly.Internal.Data.Stream.Cross-    , module Streamly.Internal.Data.Stream.Zip--    -- modules having dependencies on libraries other than base-    , module Streamly.Internal.Data.Stream.Transformer-    )-where--import Streamly.Internal.Data.Stream.Bottom-import Streamly.Internal.Data.Stream.Cross-import Streamly.Internal.Data.Stream.Eliminate-import Streamly.Internal.Data.Stream.Exception-import Streamly.Internal.Data.Stream.Expand-import Streamly.Internal.Data.Stream.Generate-import Streamly.Internal.Data.Stream.Lift-import Streamly.Internal.Data.Stream.Reduce-import Streamly.Internal.Data.Stream.Transform-import Streamly.Internal.Data.Stream.Type-import Streamly.Internal.Data.Stream.Zip--import Streamly.Internal.Data.Stream.Transformer
− src/Streamly/Internal/Data/Stream/StreamK.hs 
@@ -1,1372 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamK--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.StreamK-    (-    -- * Setup-    -- | To execute the code examples provided in this module in ghci, please-    -- run the following commands first.-    ---    -- $setup--    -- * The stream type-      Stream-    , StreamK(..)-    , fromStream-    , toStream--    , CrossStreamK-    , unCross-    , mkCross--    -- * Construction Primitives-    , mkStream-    , nil-    , nilM-    , cons-    , (.:)--    -- * Elimination Primitives-    , foldStream-    , foldStreamShared--    -- * Transformation Primitives-    , unShare--    -- * Deconstruction-    , uncons--    -- * Generation-    -- ** Unfolds-    , unfoldr-    , unfoldrM--    -- ** Specialized Generation-    , repeat-    , repeatM-    , replicate-    , replicateM-    , fromIndices-    , fromIndicesM-    , iterate-    , iterateM--    -- ** Conversions-    , fromPure-    , fromEffect-    , fromFoldable-    , fromList--    -- * foldr/build-    , foldrS-    , foldrSM-    , buildS-    , augmentS--    -- * Elimination-    -- ** General Folds-    , foldr-    , foldr1-    , foldrM--    , foldl'-    , foldlM'-    , foldlS-    , foldlx'-    , foldlMx'-    , fold-    , foldBreak-    , foldEither-    , foldConcat-    , parseDBreak-    , parseD-    , parseBreakChunks-    , parseChunks--    -- ** Specialized Folds-    , drain-    , null-    , head-    , tail-    , init-    , elem-    , notElem-    , all-    , any-    , last-    , minimum-    , minimumBy-    , maximum-    , maximumBy-    , findIndices-    , lookup-    , findM-    , find-    , (!!)--    -- ** Map and Fold-    , mapM_--    -- ** Conversions-    , toList-    , hoist--    -- * Transformation-    -- ** By folding (scans)-    , scanl'-    , scanlx'--    -- ** Filtering-    , filter-    , take-    , takeWhile-    , drop-    , dropWhile--    -- ** Mapping-    , map-    , mapM-    , sequence--    -- ** Inserting-    , intersperseM-    , intersperse-    , insertBy--    -- ** Deleting-    , deleteBy--    -- ** Reordering-    , reverse-    , sortBy--    -- ** Map and Filter-    , mapMaybe--    -- ** Zipping-    , zipWith-    , zipWithM--    -- ** Merging-    , mergeBy-    , mergeByM--    -- ** Nesting-    , crossApplyWith-    , crossApply-    , crossApplySnd-    , crossApplyFst-    , crossWith--    , concatMapWith-    , concatMap-    , concatEffect-    , bindWith-    , concatIterateWith-    , concatIterateLeftsWith-    , concatIterateScanWith--    , mergeMapWith-    , mergeIterateWith--    -- ** Transformation comprehensions-    , the--    -- * Semigroup Style Composition-    , append-    , interleave--    -- * Utilities-    , consM-    , mfix-    )-where--#include "ArrayMacros.h"-#include "inline.hs"-#include "assert.hs"--import Control.Monad (void, join)-import Data.Proxy (Proxy(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Unboxed (sizeOf, Unbox)-import Streamly.Internal.Data.Parser.ParserK.Type (ParserK)--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Parser as Parser-import qualified Streamly.Internal.Data.Parser.ParserD.Type as PR-import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Prelude--import Prelude-       hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,-               take, filter, all, any, takeWhile, drop, dropWhile, minimum,-               maximum, elem, notElem, null, head, tail, init, zipWith, lookup,-               foldr1, (!!), replicate, reverse, concatMap, iterate, splitAt)--import Streamly.Internal.Data.Stream.StreamK.Type-import Streamly.Internal.Data.Parser.ParserD (ParseError(..))--#include "DocTestDataStreamK.hs"--{-# INLINE fromStream #-}-fromStream :: Monad m => Stream.Stream m a -> StreamK m a-fromStream = Stream.toStreamK--{-# INLINE toStream #-}-toStream :: Applicative m => StreamK m a -> Stream.Stream m a-toStream = Stream.fromStreamK------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{---- Generalization of concurrent streams/SVar via unfoldr.------ Unfold a value into monadic actions and then run the resulting monadic--- actions to generate a stream. Since the step of generating the monadic--- action and running them are decoupled we can run the monadic actions--- cooncurrently. For example, the seed could be a list of monadic actions or a--- pure stream of monadic actions.------ We can have different flavors of this depending on the stream type t. The--- concurrent version could be async or ahead etc. Depending on how we queue--- back the feedback portion b, it could be DFS or BFS style.----unfoldrA :: (b -> Maybe (m a, b)) -> b -> StreamK m a-unfoldrA = undefined--}------------------------------------------------------------------------------------ Special generation----------------------------------------------------------------------------------repeatM :: Monad m => m a -> StreamK m a-repeatM = repeatMWith consM--{-# INLINE replicateM #-}-replicateM :: Monad m => Int -> m a -> StreamK m a-replicateM = replicateMWith consM-{-# INLINE replicate #-}-replicate :: Int -> a -> StreamK m a-replicate n a = go n-    where-    go cnt = if cnt <= 0 then nil else a `cons` go (cnt - 1)--{-# INLINE fromIndicesM #-}-fromIndicesM :: Monad m => (Int -> m a) -> StreamK m a-fromIndicesM = fromIndicesMWith consM-{-# INLINE fromIndices #-}-fromIndices :: (Int -> a) -> StreamK m a-fromIndices gen = go 0-  where-    go n = gen n `cons` go (n + 1)--{-# INLINE iterate #-}-iterate :: (a -> a) -> a -> StreamK m a-iterate step = go-    where-        go !s = cons s (go (step s))--{-# INLINE iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> StreamK m a-iterateM = iterateMWith consM------------------------------------------------------------------------------------ Conversions----------------------------------------------------------------------------------{-# INLINE fromList #-}-fromList :: [a] -> StreamK m a-fromList = fromFoldable------------------------------------------------------------------------------------ Elimination by Folding----------------------------------------------------------------------------------{-# INLINE foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> StreamK m a -> m (Maybe a)-foldr1 step m = do-    r <- uncons m-    case r of-        Nothing -> return Nothing-        Just (h, t) -> fmap Just (go h t)-    where-    go p m1 =-        let stp = return p-            single a = return $ step a p-            yieldk a r = fmap (step p) (go a r)-         in foldStream defState yieldk single stp m1---- XXX replace the recursive "go" with explicit continuations.--- | Like 'foldx', but with a monadic step function.-{-# INLINABLE foldlMx' #-}-foldlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b-foldlMx' step begin done = go begin-    where-    go !acc m1 =-        let stop = acc >>= done-            single a = acc >>= \b -> step b a >>= done-            yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r-         in foldStream defState yieldk single stop m1---- | Fold a stream using the supplied left 'Fold' and reducing the resulting--- expression strictly at each step. The behavior is similar to 'foldl''. A--- 'Fold' can terminate early without consuming the full stream. See the--- documentation of individual 'Fold's for termination behavior.------ Definitions:------ >>> fold f = fmap fst . StreamK.foldBreak f--- >>> fold f = StreamK.parseD (Parser.fromFold f)------ Example:------ >>> StreamK.fold Fold.sum $ StreamK.fromStream $ Stream.enumerateFromTo 1 100--- 5050----{-# INLINABLE fold #-}-fold :: Monad m => FL.Fold m a b -> StreamK m a -> m b-fold (FL.Fold step begin done) m = do-    res <- begin-    case res of-        FL.Partial fs -> go fs m-        FL.Done fb -> return fb--    where-    go !acc m1 =-        let stop = done acc-            single a = step acc a-              >>= \case-                        FL.Partial s -> done s-                        FL.Done b1 -> return b1-            yieldk a r = step acc a-              >>= \case-                        FL.Partial s -> go s r-                        FL.Done b1 -> return b1-         in foldStream defState yieldk single stop m1---- | Fold resulting in either breaking the stream or continuation of the fold.--- Instead of supplying the input stream in one go we can run the fold multiple--- times, each time supplying the next segment of the input stream. If the fold--- has not yet finished it returns a fold that can be run again otherwise it--- returns the fold result and the residual stream.------ /Internal/-{-# INLINE foldEither #-}-foldEither :: Monad m =>-    Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))-foldEither (FL.Fold step begin done) m = do-    res <- begin-    case res of-        FL.Partial fs -> go fs m-        FL.Done fb -> return $ Right (fb, m)--    where--    go !acc m1 =-        let stop = return $ Left (Fold step (return $ FL.Partial acc) done)-            single a =-                step acc a-                  >>= \case-                    FL.Partial s ->-                        return $ Left (Fold step (return $ FL.Partial s) done)-                    FL.Done b1 -> return $ Right (b1, nil)-            yieldk a r =-                step acc a-                  >>= \case-                    FL.Partial s -> go s r-                    FL.Done b1 -> return $ Right (b1, r)-         in foldStream defState yieldk single stop m1---- | Like 'fold' but also returns the remaining stream. The resulting stream--- would be 'StreamK.nil' if the stream finished before the fold.----{-# INLINE foldBreak #-}-foldBreak :: Monad m => Fold m a b -> StreamK m a -> m (b, StreamK m a)-foldBreak fld strm = do-    r <- foldEither fld strm-    case r of-        Right res -> return res-        Left (Fold _ initial extract) -> do-            res <- initial-            case res of-                FL.Done _ -> error "foldBreak: unreachable state"-                FL.Partial s -> do-                    b <- extract s-                    return (b, nil)---- XXX Array folds can be implemented using this.--- foldContainers? Specialized to foldArrays.---- | Generate streams from individual elements of a stream and fold the--- concatenation of those streams using the supplied fold. Return the result of--- the fold and residual stream.------ For example, this can be used to efficiently fold an Array Word8 stream--- using Word8 folds.------ /Internal/-{-# INLINE foldConcat #-}-foldConcat :: Monad m =>-    Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)-foldConcat-    (Producer pstep pinject pextract)-    (Fold fstep begin done)-    stream = do--    res <- begin-    case res of-        FL.Partial fs -> go fs stream-        FL.Done fb -> return (fb, stream)--    where--    go !acc m1 = do-        let stop = do-                r <- done acc-                return (r, nil)-            single a = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> do-                        r <- done fs-                        return (r, nil)-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, fromPure x)-            yieldk a r = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> go fs r-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, x `cons` r)-         in foldStream defState yieldk single stop m1--    {-# INLINE go1 #-}-    go1 !_ !fs st = do-        r <- pstep st-        case r of-            Stream.Yield x s -> do-                res <- fstep fs x-                case res of-                    FL.Done b -> return $ Right (b, s)-                    FL.Partial fs1 -> go1 SPEC fs1 s-            Stream.Skip s -> go1 SPEC fs s-            Stream.Stop -> return $ Left fs---- | Like 'foldl'' but with a monadic step function.-{-# INLINE foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b-foldlM' step begin = foldlMx' step begin return----------------------------------------------------------------------------------- Specialized folds---------------------------------------------------------------------------------{-# INLINE head #-}-head :: Monad m => StreamK m a -> m (Maybe a)--- head = foldrM (\x _ -> return $ Just x) (return Nothing)-head m =-    let stop      = return Nothing-        single a  = return (Just a)-        yieldk a _ = return (Just a)-    in foldStream defState yieldk single stop m--{-# INLINE elem #-}-elem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool-elem e = go-    where-    go m1 =-        let stop      = return False-            single a  = return (a == e)-            yieldk a r = if a == e then return True else go r-        in foldStream defState yieldk single stop m1--{-# INLINE notElem #-}-notElem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool-notElem e = go-    where-    go m1 =-        let stop      = return True-            single a  = return (a /= e)-            yieldk a r = if a == e then return False else go r-        in foldStream defState yieldk single stop m1--{-# INLINABLE all #-}-all :: Monad m => (a -> Bool) -> StreamK m a -> m Bool-all p = go-    where-    go m1 =-        let single a   | p a       = return True-                       | otherwise = return False-            yieldk a r | p a       = go r-                       | otherwise = return False-         in foldStream defState yieldk single (return True) m1--{-# INLINABLE any #-}-any :: Monad m => (a -> Bool) -> StreamK m a -> m Bool-any p = go-    where-    go m1 =-        let single a   | p a       = return True-                       | otherwise = return False-            yieldk a r | p a       = return True-                       | otherwise = go r-         in foldStream defState yieldk single (return False) m1---- | Extract the last element of the stream, if any.-{-# INLINE last #-}-last :: Monad m => StreamK m a -> m (Maybe a)-last = foldlx' (\_ y -> Just y) Nothing id--{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)-minimum = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  =-                if res <= a-                then return (Just res)-                else return (Just a)-            yieldk a r =-                if res <= a-                then go (Just res) r-                else go (Just a) r-        in foldStream defState yieldk single stop m1--{-# INLINE minimumBy #-}-minimumBy-    :: (Monad m)-    => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)-minimumBy cmp = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  = case cmp res a of-                GT -> return (Just a)-                _  -> return (Just res)-            yieldk a r = case cmp res a of-                GT -> go (Just a) r-                _  -> go (Just res) r-        in foldStream defState yieldk single stop m1--{-# INLINE maximum #-}-maximum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)-maximum = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  =-                if res <= a-                then return (Just a)-                else return (Just res)-            yieldk a r =-                if res <= a-                then go (Just a) r-                else go (Just res) r-        in foldStream defState yieldk single stop m1--{-# INLINE maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)-maximumBy cmp = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  = case cmp res a of-                GT -> return (Just res)-                _  -> return (Just a)-            yieldk a r = case cmp res a of-                GT -> go (Just res) r-                _  -> go (Just a) r-        in foldStream defState yieldk single stop m1--{-# INLINE (!!) #-}-(!!) :: Monad m => StreamK m a -> Int -> m (Maybe a)-m !! i = go i m-    where-    go n m1 =-      let single a | n == 0 = return $ Just a-                   | otherwise = return Nothing-          yieldk a x | n < 0 = return Nothing-                     | n == 0 = return $ Just a-                     | otherwise = go (n - 1) x-      in foldStream defState yieldk single (return Nothing) m1--{-# INLINE lookup #-}-lookup :: (Monad m, Eq a) => a -> StreamK m (a, b) -> m (Maybe b)-lookup e = go-    where-    go m1 =-        let single (a, b) | a == e = return $ Just b-                          | otherwise = return Nothing-            yieldk (a, b) x | a == e = return $ Just b-                            | otherwise = go x-        in foldStream defState yieldk single (return Nothing) m1--{-# INLINE findM #-}-findM :: Monad m => (a -> m Bool) -> StreamK m a -> m (Maybe a)-findM p = go-    where-    go m1 =-        let single a = do-                b <- p a-                if b then return $ Just a else return Nothing-            yieldk a x = do-                b <- p a-                if b then return $ Just a else go x-        in foldStream defState yieldk single (return Nothing) m1--{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> StreamK m a -> m (Maybe a)-find p = findM (return . p)--{-# INLINE findIndices #-}-findIndices :: (a -> Bool) -> StreamK m a -> StreamK m Int-findIndices p = go 0-    where-    go offset m1 = mkStream $ \st yld sng stp ->-        let single a | p a = sng offset-                     | otherwise = stp-            yieldk a x | p a = yld offset $ go (offset + 1) x-                       | otherwise = foldStream (adaptState st) yld sng stp $-                            go (offset + 1) x-        in foldStream (adaptState st) yieldk single stp m1----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- | Apply a monadic action to each element of the stream and discard the--- output of the action.-{-# INLINE mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> StreamK m a -> m ()-mapM_ f = go-    where-    go m1 =-        let stop = return ()-            single a = void (f a)-            yieldk a r = f a >> go r-         in foldStream defState yieldk single stop m1--{-# INLINE mapM #-}-mapM :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b-mapM = mapMWith consM----------------------------------------------------------------------------------- Converting folds---------------------------------------------------------------------------------{-# INLINABLE toList #-}-toList :: Monad m => StreamK m a -> m [a]-toList = foldr (:) []---- Based on suggestions by David Feuer and Pranay Sashank-{-# INLINE hoist #-}-hoist :: (Monad m, Monad n)-    => (forall x. m x -> n x) -> StreamK m a -> StreamK n a-hoist f str =-    mkStream $ \st yld sng stp ->-            let single = return . sng-                yieldk a s = return $ yld a (hoist f s)-                stop = return stp-                state = adaptState st-             in join . f $ foldStreamShared state yieldk single stop str------------------------------------------------------------------------------------ Transformation by folding (Scans)----------------------------------------------------------------------------------{-# INLINE scanlx' #-}-scanlx' :: (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> StreamK m b-scanlx' step begin done m =-    cons (done begin) $ go m begin-    where-    go m1 !acc = mkStream $ \st yld sng stp ->-        let single a = sng (done $ step acc a)-            yieldk a r =-                let s = step acc a-                in yld (done s) (go r s)-        in foldStream (adaptState st) yieldk single stp m1--{-# INLINE scanl' #-}-scanl' :: (b -> a -> b) -> b -> StreamK m a -> StreamK m b-scanl' step begin = scanlx' step begin id------------------------------------------------------------------------------------ Filtering----------------------------------------------------------------------------------{-# INLINE filter #-}-filter :: (a -> Bool) -> StreamK m a -> StreamK m a-filter p = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a   | p a       = sng a-                       | otherwise = stp-            yieldk a r | p a       = yld a (go r)-                       | otherwise = foldStream st yieldk single stp r-         in foldStream st yieldk single stp m1--{-# INLINE take #-}-take :: Int -> StreamK m a -> StreamK m a-take = go-    where-    go n1 m1 = mkStream $ \st yld sng stp ->-        let yieldk a r = yld a (go (n1 - 1) r)-        in if n1 <= 0-           then stp-           else foldStream st yieldk sng stp m1--{-# INLINE takeWhile #-}-takeWhile :: (a -> Bool) -> StreamK m a -> StreamK m a-takeWhile p = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a   | p a       = sng a-                       | otherwise = stp-            yieldk a r | p a       = yld a (go r)-                       | otherwise = stp-         in foldStream st yieldk single stp m1--{-# INLINE drop #-}-drop :: Int -> StreamK m a -> StreamK m a-drop n m = unShare (go n m)-    where-    go n1 m1 = mkStream $ \st yld sng stp ->-        let single _ = stp-            yieldk _ r = foldStreamShared st yld sng stp $ go (n1 - 1) r-        -- Somehow "<=" check performs better than a ">"-        in if n1 <= 0-           then foldStreamShared st yld sng stp m1-           else foldStreamShared st yieldk single stp m1--{-# INLINE dropWhile #-}-dropWhile :: (a -> Bool) -> StreamK m a -> StreamK m a-dropWhile p = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a   | p a       = stp-                       | otherwise = sng a-            yieldk a r | p a = foldStream st yieldk single stp r-                       | otherwise = yld a r-         in foldStream st yieldk single stp m1------------------------------------------------------------------------------------ Mapping------------------------------------------------------------------------------------ Be careful when modifying this, this uses a consM (|:) deliberately to allow--- other stream types to overload it.-{-# INLINE sequence #-}-sequence :: Monad m => StreamK m (m a) -> StreamK m a-sequence = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single ma = ma >>= sng-            yieldk ma r = foldStreamShared st yld sng stp $ ma `consM` go r-         in foldStream (adaptState st) yieldk single stp m1------------------------------------------------------------------------------------ Inserting----------------------------------------------------------------------------------{-# INLINE intersperseM #-}-intersperseM :: Monad m => m a -> StreamK m a -> StreamK m a-intersperseM a = prependingStart-    where-    prependingStart m1 = mkStream $ \st yld sng stp ->-        let yieldk i x =-                foldStreamShared st yld sng stp $ return i `consM` go x-         in foldStream st yieldk sng stp m1-    go m2 = mkStream $ \st yld sng stp ->-        let single i = foldStreamShared st yld sng stp $ a `consM` fromPure i-            yieldk i x =-                foldStreamShared-                    st yld sng stp $ a `consM` return i `consM` go x-         in foldStream st yieldk single stp m2--{-# INLINE intersperse #-}-intersperse :: Monad m => a -> StreamK m a -> StreamK m a-intersperse a = intersperseM (return a)--{-# INLINE insertBy #-}-insertBy :: (a -> a -> Ordering) -> a -> StreamK m a -> StreamK m a-insertBy cmp x = go-  where-    go m1 = mkStream $ \st yld _ _ ->-        let single a = case cmp x a of-                GT -> yld a (fromPure x)-                _  -> yld x (fromPure a)-            stop = yld x nil-            yieldk a r = case cmp x a of-                GT -> yld a (go r)-                _  -> yld x (a `cons` r)-         in foldStream st yieldk single stop m1----------------------------------------------------------------------------------- Deleting---------------------------------------------------------------------------------{-# INLINE deleteBy #-}-deleteBy :: (a -> a -> Bool) -> a -> StreamK m a -> StreamK m a-deleteBy eq x = go-  where-    go m1 = mkStream $ \st yld sng stp ->-        let single a = if eq x a then stp else sng a-            yieldk a r = if eq x a-              then foldStream st yld sng stp r-              else yld a (go r)-         in foldStream st yieldk single stp m1------------------------------------------------------------------------------------ Map and Filter----------------------------------------------------------------------------------{-# INLINE mapMaybe #-}-mapMaybe :: (a -> Maybe b) -> StreamK m a -> StreamK m b-mapMaybe f = go-  where-    go m1 = mkStream $ \st yld sng stp ->-        let single a = maybe stp sng (f a)-            yieldk a r = case f a of-                Just b  -> yld b $ go r-                Nothing -> foldStream (adaptState st) yieldk single stp r-        in foldStream (adaptState st) yieldk single stp m1----------------------------------------------------------------------------------- Serial Zipping----------------------------------------------------------------------------------- | Zip two streams serially using a pure zipping function.----{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c-zipWith f = zipWithM (\a b -> return (f a b))---- | Zip two streams serially using a monadic zipping function.----{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> StreamK m a -> StreamK m b -> StreamK m c-zipWithM f = go--    where--    go mx my = mkStream $ \st yld sng stp -> do-        let merge a ra =-                let single2 b   = f a b >>= sng-                    yield2 b rb = f a b >>= \x -> yld x (go ra rb)-                 in foldStream (adaptState st) yield2 single2 stp my-        let single1 a = merge a nil-            yield1 = merge-        foldStream (adaptState st) yield1 single1 stp mx----------------------------------------------------------------------------------- Merging---------------------------------------------------------------------------------{-# INLINE mergeByM #-}-mergeByM :: Monad m =>-    (a -> a -> m Ordering) -> StreamK m a -> StreamK m a -> StreamK m a-mergeByM cmp = go--    where--    go mx my = mkStream $ \st yld sng stp -> do-        let stop = foldStream st yld sng stp my-            single x = foldStream st yld sng stp (goX0 x my)-            yield x rx = foldStream st yld sng stp (goX x rx my)-        foldStream st yield single stop mx--    goX0 x my = mkStream $ \st yld sng _ -> do-        let stop = sng x-            single y = do-                r <- cmp x y-                case r of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield y ry = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX0 x ry)-                    _  -> yld x (y `cons` ry)-         in foldStream st yield single stop my--    goX x mx my = mkStream $ \st yld _ _ -> do-        let stop = yld x mx-            single y = do-                r <- cmp x y-                case r of-                    GT -> yld y (x `cons` mx)-                    _  -> yld x (goY0 mx y)-            yield y ry = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX x mx ry)-                    _  -> yld x (goY mx y ry)-         in foldStream st yield single stop my--    goY0 mx y = mkStream $ \st yld sng _ -> do-        let stop = sng y-            single x = do-                r <- cmp x y-                case r of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield x rx = do-                r <- cmp x y-                case r of-                    GT -> yld y (x `cons` rx)-                    _  -> yld x (goY0 rx y)-         in foldStream st yield single stop mx--    goY mx y my = mkStream $ \st yld _ _ -> do-        let stop = yld y my-            single x = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX0 x my)-                    _  -> yld x (y `cons` my)-            yield x rx = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX x rx my)-                    _  -> yld x (goY rx y my)-         in foldStream st yield single stop mx--{-# INLINE mergeBy #-}-mergeBy :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a -> StreamK m a--- XXX GHC: This has slightly worse performance than replacing "r <- cmp x y"--- with "let r = cmp x y" in the monadic version. The definition below is--- exactly the same as mergeByM except this change.--- mergeBy cmp = mergeByM (\a b -> return $ cmp a b)-mergeBy cmp = go--    where--    go mx my = mkStream $ \st yld sng stp -> do-        let stop = foldStream st yld sng stp my-            single x = foldStream st yld sng stp (goX0 x my)-            yield x rx = foldStream st yld sng stp (goX x rx my)-        foldStream st yield single stop mx--    goX0 x my = mkStream $ \st yld sng _ -> do-        let stop = sng x-            single y = do-                case cmp x y of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield y ry = do-                case cmp x y of-                    GT -> yld y (goX0 x ry)-                    _  -> yld x (y `cons` ry)-         in foldStream st yield single stop my--    goX x mx my = mkStream $ \st yld _ _ -> do-        let stop = yld x mx-            single y = do-                case cmp x y of-                    GT -> yld y (x `cons` mx)-                    _  -> yld x (goY0 mx y)-            yield y ry = do-                case cmp x y of-                    GT -> yld y (goX x mx ry)-                    _  -> yld x (goY mx y ry)-         in foldStream st yield single stop my--    goY0 mx y = mkStream $ \st yld sng _ -> do-        let stop = sng y-            single x = do-                case cmp x y of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield x rx = do-                case cmp x y of-                    GT -> yld y (x `cons` rx)-                    _  -> yld x (goY0 rx y)-         in foldStream st yield single stop mx--    goY mx y my = mkStream $ \st yld _ _ -> do-        let stop = yld y my-            single x = do-                case cmp x y of-                    GT -> yld y (goX0 x my)-                    _  -> yld x (y `cons` my)-            yield x rx = do-                case cmp x y of-                    GT -> yld y (goX x rx my)-                    _  -> yld x (goY rx y my)-         in foldStream st yield single stop mx----------------------------------------------------------------------------------- Transformation comprehensions---------------------------------------------------------------------------------{-# INLINE the #-}-the :: (Eq a, Monad m) => StreamK m a -> m (Maybe a)-the m = do-    r <- uncons m-    case r of-        Nothing -> return Nothing-        Just (h, t) -> go h t-    where-    go h m1 =-        let single a   | h == a    = return $ Just h-                       | otherwise = return Nothing-            yieldk a r | h == a    = go h r-                       | otherwise = return Nothing-         in foldStream defState yieldk single (return $ Just h) m1----------------------------------------------------------------------------------- Alternative & MonadPlus---------------------------------------------------------------------------------_alt :: StreamK m a -> StreamK m a -> StreamK m a-_alt m1 m2 = mkStream $ \st yld sng stp ->-    let stop  = foldStream st yld sng stp m2-    in foldStream st yld sng stop m1----------------------------------------------------------------------------------- MonadError---------------------------------------------------------------------------------{---- XXX handle and test cross thread state transfer-withCatchError-    :: MonadError e m-    => StreamK m a -> (e -> StreamK m a) -> StreamK m a-withCatchError m h =-    mkStream $ \_ stp sng yld ->-        let run x = unStream x Nothing stp sng yieldk-            handle r = r `catchError` \e -> run $ h e-            yieldk a r = yld a (withCatchError r h)-        in handle $ run m--}------------------------------------------------------------------------------------ Parsing------------------------------------------------------------------------------------ Inlined definition.-{-# INLINE splitAt #-}-splitAt :: Int -> [a] -> ([a],[a])-splitAt n ls-  | n <= 0 = ([], ls)-  | otherwise          = splitAt' n ls-    where-        splitAt' :: Int -> [a] -> ([a], [a])-        splitAt' _  []     = ([], [])-        splitAt' 1  (x:xs) = ([x], xs)-        splitAt' m  (x:xs) = (x:xs', xs'')-          where-            (xs', xs'') = splitAt' (m - 1) xs---- | Run a 'Parser' over a stream and return rest of the Stream.-{-# INLINE_NORMAL parseDBreak #-}-parseDBreak-    :: Monad m-    => PR.Parser a m b-    -> StreamK m a-    -> m (Either ParseError b, StreamK m a)-parseDBreak (PR.Parser pstep initial extract) stream = do-    res <- initial-    case res of-        PR.IPartial s -> goStream stream [] s-        PR.IDone b -> return (Right b, stream)-        PR.IError err -> return (Left (ParseError err), stream)--    where--    -- "buf" 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.-    goStream st buf !pst =-        let stop = do-                r <- extract pst-                case r of-                    PR.Error err -> return (Left (ParseError err), nil)-                    PR.Done n b -> do-                        assertM(n <= length buf)-                        let src0 = Prelude.take n buf-                            src  = Prelude.reverse src0-                        return (Right b, fromList src)-                    PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-                    PR.Continue 0 s -> goStream nil buf s-                    PR.Continue n s -> do-                        assertM(n <= length buf)-                        let (src0, buf1) = splitAt n buf-                            src = Prelude.reverse src0-                        goBuf nil buf1 src s-            single x = yieldk x nil-            yieldk x r = do-                res <- pstep pst x-                case res of-                    PR.Partial 0 s -> goStream r [] s-                    PR.Partial n s -> do-                        assertM(n <= length (x:buf))-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        goBuf r [] src s-                    PR.Continue 0 s -> goStream r (x:buf) s-                    PR.Continue n s -> do-                        assertM(n <= length (x:buf))-                        let (src0, buf1) = splitAt n (x:buf)-                            src = Prelude.reverse src0-                        goBuf r buf1 src s-                    PR.Done 0 b -> return (Right b, r)-                    PR.Done n b -> do-                        assertM(n <= length (x:buf))-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        return (Right b, append (fromList src) r)-                    PR.Error err -> return (Left (ParseError err), r)-         in foldStream defState yieldk single stop st--    goBuf st buf [] !pst = goStream st buf pst-    goBuf st buf (x:xs) !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 s -> goBuf st [] xs s-            PR.Partial n s -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                goBuf st [] src s-            PR.Continue 0 s -> goBuf st (x:buf) xs s-            PR.Continue n s -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                goBuf st buf1 src s-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0-                return (Right b, append (fromList src) st)-            PR.Error err -> return (Left (ParseError err), nil)---- Using ParserD or ParserK on StreamK may not make much difference. We should--- perhaps use only chunked parsing on StreamK. We can always convert a stream--- to chunks before parsing. Or just have a ParserK element parser for StreamK--- and convert ParserD to ParserK for element parsing using StreamK.-{-# INLINE parseD #-}-parseD :: Monad m =>-    Parser.Parser a m b -> StreamK m a -> m (Either ParseError b)-parseD f = fmap fst . parseDBreak f------------------------------------------------------------------------------------ Chunked parsing using ParserK------------------------------------------------------------------------------------ The backracking buffer consists of arrays in the most-recent-first order. We--- want to take a total of n array elements from this buffer. Note: when we--- have to take an array partially, we must take the last part of the array.-{-# INLINE backTrack #-}-backTrack :: forall m a. Unbox a =>-       Int-    -> [Array a]-    -> StreamK m (Array a)-    -> (StreamK m (Array a), [Array a])-backTrack = go--    where--    go _ [] stream = (stream, [])-    go n xs stream | n <= 0 = (stream, xs)-    go n (x:xs) stream =-        let len = Array.length x-        in if n > len-           then go (n - len) xs (cons x stream)-           else if n == len-           then (cons x stream, xs)-           else let !(Array contents start end) = x-                    !start1 = end - (n * SIZE_OF(a))-                    arr1 = Array contents start1 end-                    arr2 = Array contents start start1-                 in (cons arr1 stream, arr2:xs)---- | A continuation to extract the result when a CPS parser is done.-{-# INLINE parserDone #-}-parserDone :: Applicative m =>-    ParserK.ParseResult b -> Int -> ParserK.Input a -> m (ParserK.Step a m b)-parserDone (ParserK.Success n b) _ _ = pure $ ParserK.Done n b-parserDone (ParserK.Failure n e) _ _ = pure $ ParserK.Error n e---- XXX parseDBreakChunks may be faster than converting parserD to parserK and--- using parseBreakChunks. We can also use parseBreak as an alternative to the--- monad instance of ParserD.---- | Run a 'ParserK' over a chunked 'StreamK' and return the rest of the Stream.-{-# INLINE_NORMAL parseBreakChunks #-}-parseBreakChunks-    :: (Monad m, Unbox a)-    => ParserK a m b-    -> StreamK m (Array a)-    -> m (Either ParseError b, StreamK m (Array a))-parseBreakChunks parser input = do-    let parserk = ParserK.runParser parser parserDone 0 0-     in go [] parserk input--    where--    {-# INLINE goStop #-}-    goStop backBuf parserk = do-        pRes <- parserk ParserK.None-        case pRes of-            -- If we stop in an alternative, it will try calling the next-            -- parser, the next parser may call initial returning Partial and-            -- then immediately we have to call extract on it.-            ParserK.Partial 0 cont1 ->-                 go [] cont1 nil-            ParserK.Partial n cont1 -> do-                let n1 = negate n-                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))-                let (s1, backBuf1) = backTrack n1 backBuf nil-                 in go backBuf1 cont1 s1-            ParserK.Continue 0 cont1 ->-                go backBuf cont1 nil-            ParserK.Continue n cont1 -> do-                let n1 = negate n-                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))-                let (s1, backBuf1) = backTrack n1 backBuf nil-                 in go backBuf1 cont1 s1-            ParserK.Done 0 b ->-                return (Right b, nil)-            ParserK.Done n b -> do-                let n1 = negate n-                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))-                let (s1, _) = backTrack n1 backBuf nil-                 in return (Right b, s1)-            ParserK.Error _ err -> return (Left (ParseError err), nil)--    seekErr n len =-        error $ "parseBreak: Partial: forward seek not implemented n = "-            ++ show n ++ " len = " ++ show len--    yieldk backBuf parserk arr stream = do-        pRes <- parserk (ParserK.Chunk arr)-        let len = Array.length arr-        case pRes of-            ParserK.Partial n cont1 ->-                case compare n len of-                    EQ -> go [] cont1 stream-                    LT -> do-                        if n >= 0-                        then yieldk [] cont1 arr stream-                        else do-                            let n1 = negate n-                                bufLen = sum (Prelude.map Array.length backBuf)-                                s = cons arr stream-                            assertM(n1 >= 0 && n1 <= bufLen)-                            let (s1, _) = backTrack n1 backBuf s-                            go [] cont1 s1-                    GT -> seekErr n len-            ParserK.Continue n cont1 ->-                case compare n len of-                    EQ -> go (arr:backBuf) cont1 stream-                    LT -> do-                        if n >= 0-                        then yieldk backBuf cont1 arr stream-                        else do-                            let n1 = negate n-                                bufLen = sum (Prelude.map Array.length backBuf)-                                s = cons arr stream-                            assertM(n1 >= 0 && n1 <= bufLen)-                            let (s1, backBuf1) = backTrack n1 backBuf s-                            go backBuf1 cont1 s1-                    GT -> seekErr n len-            ParserK.Done n b -> do-                let n1 = len - n-                assertM(n1 <= sum (Prelude.map Array.length (arr:backBuf)))-                let (s1, _) = backTrack n1 (arr:backBuf) stream-                 in return (Right b, s1)-            ParserK.Error _ err -> return (Left (ParseError err), nil)--    go backBuf parserk stream = do-        let stop = goStop backBuf parserk-            single a = yieldk backBuf parserk a nil-         in foldStream-                defState (yieldk backBuf parserk) single stop stream--{-# INLINE parseChunks #-}-parseChunks :: (Monad m, Unbox a) =>-    ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b)-parseChunks f = fmap fst . parseBreakChunks f------------------------------------------------------------------------------------ Sorting------------------------------------------------------------------------------------ | Sort the input stream using a supplied comparison function.------ Sorting can be achieved by simply:------ >>> sortBy cmp = StreamK.mergeMapWith (StreamK.mergeBy cmp) StreamK.fromPure------ However, this combinator uses a parser to first split the input stream into--- down and up sorted segments and then merges them to optimize sorting when--- pre-sorted sequences exist in the input stream.------ /O(n) space/----{-# INLINE sortBy #-}-sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a--- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure-sortBy cmp =-    let p =-            Parser.groupByRollingEither-                (\x -> (< GT) . cmp x)-                FL.toStreamKRev-                FL.toStreamK-     in   mergeMapWith (mergeBy cmp) id-        . Stream.toStreamK-        . Stream.catRights -- its a non-failing backtracking parser-        . Stream.parseMany (fmap (either id id) p)-        . Stream.fromStreamK
− src/Streamly/Internal/Data/Stream/StreamK/Alt.hs 
@@ -1,244 +0,0 @@--- |--- Module      : Streamly.StreamDK.Type--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ A CPS style stream using a constructor based representation instead of a--- function based representation.------ Streamly internally uses two fundamental stream representations, (1) streams--- with an open or arbitrary control flow (we call it StreamK), (2) streams--- with a structured or closed loop control flow (we call it StreamD). The--- higher level stream types can use any of these representations under the--- hood and can interconvert between the two.------ StreamD:------ StreamD is a non-recursive data type in which the state of the stream and--- the step function are separate. When the step function is called, a stream--- element and the new stream state is yielded. The generated element and the--- state are passed to the next consumer in the loop. The state is threaded--- around in the loop until control returns back to the original step function--- to run the next step. This creates a structured closed loop representation--- (like "for" loops in C) with state of each step being hidden/abstracted or--- existential within that step. This creates a loop representation identical--- to the "for" or "while" loop constructs in imperative languages, the states--- of the steps combined together constitute the state of the loop iteration.------ Internally most combinators use a closed loop representation because it--- provides very high efficiency due to stream fusion. The performance of this--- representation is competitive to the C language implementations.------ Pros and Cons of StreamD:------ 1) stream-fusion: This representation can be optimized very efficiently by--- the compiler because the state is explicitly separated from step functions,--- represented using pure data constructors and visible to the compiler, the--- stream steps can be fused using case-of-case transformations and the state--- can be specialized using spec-constructor optimization, yielding a C like--- tight loop/state machine with no constructors, the state is used unboxed and--- therefore no unnecessary allocation.------ 2) Because of a closed representation consing too many elements in this type--- of stream does not scale, it will have quadratic performance slowdown. Each--- cons creates a layer that needs to return the control back to the caller.--- Another implementation of cons is possible but that will have to box/unbox--- the state and will not fuse. So effectively cons breaks fusion.------ 3) unconsing an item from the stream breaks fusion, we have to "pause" the--- loop, rebox and save the state.------ 3) Exception handling is easy to implement in this model because control--- flow is structured in the loop and cannot be arbitrary. Therefore,--- implementing "bracket" is natural.------ 4) Round-robin scheduling for co-operative multitasking is easy to implement.------ 5) It fuses well with the direct style Fold implementation.------ StreamK/StreamDK:------ StreamDK i.e. the stream defined in this module, like StreamK, is a--- recursive data type which has no explicit state defined using constructors,--- each step yields an element and a computation representing the rest of the--- stream.  Stream state is part of the function representing the rest of the--- stream.  This creates an open computation representation, or essentially a--- continuation passing style computation.  After the stream step is executed,--- the caller is free to consume the produced element and then send the control--- wherever it wants, there is no restriction on the control to return back--- somewhere, the control is free to go anywhere. The caller may decide not to--- consume the rest of the stream. This representation is more like a "goto"--- based implementation in imperative languages.------ Pros and Cons of StreamK:------ 1) The way StreamD can be optimized using stream-fusion, this type can be--- optimized using foldr/build fusion. However, foldr/build has not yet been--- fully implemented for StreamK/StreamDK.------ 2) Using cons is natural in this representation, unlike in StreamD it does--- not have a quadratic slowdown. Currently, we in fact wrap StreamD in StreamK--- to support a better cons operation.------ 3) Similarly, uncons is natural in this representation.------ 4) Exception handling is not easy to implement because of the "goto" nature--- of CPS.------ 5) Composable folds are not implemented/proven, however, intuition says that--- a push style CPS representation should be able to be used along with StreamK--- to efficiently implement composable folds.--module Streamly.Internal.Data.Stream.StreamK.Alt-    (-    -- * Stream Type--      Stream-    , Step (..)--    -- * Construction-    , nil-    , cons-    , consM-    , unfoldr-    , unfoldrM-    , replicateM--    -- * Folding-    , uncons-    , foldrS--    -- * Specific Folds-    , drain-    )-where--#include "inline.hs"---- XXX Use Cons and Nil instead of Yield and Stop?-data Step m a = Yield a (Stream m a) | Stop--newtype Stream m a = Stream (m (Step m a))------------------------------------------------------------------------------------ Construction----------------------------------------------------------------------------------nil :: Monad m => Stream m a-nil = Stream $ return Stop--{-# INLINE_NORMAL cons #-}-cons :: Monad m => a -> Stream m a -> Stream m a-cons x xs = Stream $ return $ Yield x xs--consM :: Monad m => m a -> Stream m a -> Stream m a-consM eff xs = Stream $ eff >>= \x -> return $ Yield x xs--unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-unfoldrM next state = Stream (step' state)-  where-    step' st = do-        r <- next st-        return $ case r of-            Just (x, s) -> Yield x (Stream (step' s))-            Nothing     -> Stop-{--unfoldrM next s0 = buildM $ \yld stp ->-    let go s = do-            r <- next s-            case r of-                Just (a, b) -> yld a (go b)-                Nothing -> stp-    in go s0--}--{-# INLINE unfoldr #-}-unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a-unfoldr next s0 = build $ \yld stp ->-    let go s =-            case next s of-                Just (a, b) -> yld a (go b)-                Nothing -> stp-    in go s0--replicateM :: Monad m => Int -> a -> Stream m a-replicateM n x = Stream (step n)-    where-    step i = return $-        if i <= 0-        then Stop-        else Yield x (Stream (step (i - 1)))------------------------------------------------------------------------------------ Folding----------------------------------------------------------------------------------uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons (Stream step) = do-    r <- step-    return $ case r of-        Yield x xs -> Just (x, xs)-        Stop -> Nothing---- | Lazy right associative fold to a stream.-{-# INLINE_NORMAL foldrS #-}-foldrS :: Monad m-       => (a -> Stream m b -> Stream m b)-       -> Stream m b-       -> Stream m a-       -> Stream m b-foldrS f streamb = go-    where-    go (Stream stepa) = Stream $ do-        r <- stepa-        case r of-            Yield x xs -> let Stream step = f x (go xs) in step-            Stop -> let Stream step = streamb in step--{-# INLINE_LATE foldrM #-}-foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-foldrM fstep acc = go-    where-    go (Stream step) = do-        r <- step-        case r of-            Yield x xs -> fstep x (go xs)-            Stop -> acc--{-# INLINE_NORMAL build #-}-build :: Monad m-    => forall a. (forall b. (a -> b -> b) -> b -> b) -> Stream m a-build g = g cons nil--{-# RULES-"foldrM/build"  forall k z (g :: forall b. (a -> b -> b) -> b -> b).-                foldrM k z (build g) = g k z #-}--{---- To fuse foldrM with unfoldrM we need the type m1 to be polymorphic such that--- it is either Monad m or Stream m.  So that we can use cons/nil as well as--- monadic construction function as its arguments.----{-# INLINE_NORMAL buildM #-}-buildM :: Monad m-    => forall a. (forall b. (a -> m1 b -> m1 b) -> m1 b -> m1 b) -> Stream m a-buildM g = g cons nil--}------------------------------------------------------------------------------------ Specific folds----------------------------------------------------------------------------------{-# INLINE drain #-}-drain :: Monad m => Stream m a -> m ()-drain = foldrM (\_ xs -> xs) (return ())-{--drain (Stream step) = do-    r <- step-    case r of-        Yield _ next -> drain next-        Stop      -> return ()-        -}
− src/Streamly/Internal/Data/Stream/StreamK/Transformer.hs 
@@ -1,79 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamK.Transformer--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.StreamK.Transformer-    (-      foldlT-    , foldrT--    , liftInner-    , evalStateT-    )-where--import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.State.Strict (StateT)-import Streamly.Internal.Data.Stream.StreamK-    (StreamK, nil, cons, uncons, concatEffect)--import qualified Control.Monad.Trans.State.Strict as State---- | Lazy left fold to an arbitrary transformer monad.-{-# INLINE foldlT #-}-foldlT :: (Monad m, Monad (s m), MonadTrans s)-    => (s m b -> a -> s m b) -> s m b -> StreamK m a -> s m b-foldlT step = go-  where-    go acc m1 = do-        res <- lift $ uncons m1-        case res of-            Just (h, t) -> go (step acc h) t-            Nothing -> acc---- | Right associative fold to an arbitrary transformer monad.-{-# INLINE foldrT #-}-foldrT :: (Monad m, Monad (s m), MonadTrans s)-    => (a -> s m b -> s m b) -> s m b -> StreamK m a -> s m b-foldrT step final = go-  where-    go m1 = do-        res <- lift $ uncons m1-        case res of-            Just (h, t) -> step h (go t)-            Nothing -> final----------------------------------------------------------------------------------- Lifting inner monad---------------------------------------------------------------------------------{-# INLINE evalStateT #-}-evalStateT :: Monad m => m s -> StreamK (StateT s m) a -> StreamK m a-evalStateT = go--    where--    go st m1 = concatEffect $ fmap f (st >>= State.runStateT (uncons m1))--    f (res, s1) =-        case res of-            Just (h, t) -> cons h (go (return s1) t)-            Nothing -> nil--{-# INLINE liftInner #-}-liftInner :: (Monad m, MonadTrans t, Monad (t m)) =>-    StreamK m a -> StreamK (t m) a-liftInner = go--    where--    go m1 = concatEffect $ fmap f $ lift $ uncons m1--    f res =-        case res of-            Just (h, t) -> cons h (go t)-            Nothing -> nil
− src/Streamly/Internal/Data/Stream/StreamK/Type.hs 
@@ -1,2063 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UndecidableInstances #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamK.Type--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--------- Continuation passing style (CPS) stream implementation. The symbol 'K' below--- denotes a function as well as a Kontinuation.----module Streamly.Internal.Data.Stream.StreamK.Type-    (-    -- * StreamK type-      Stream-    , StreamK (..)--    -- * CrossStreamK type wrapper-    , CrossStreamK-    , unCross-    , mkCross--    -- * foldr/build Fusion-    , mkStream-    , foldStream-    , foldStreamShared-    , foldrM-    , foldrS-    , foldrSShared-    , foldrSM-    , build-    , buildS-    , buildM-    , buildSM-    , augmentS-    , augmentSM-    , unShare--    -- * Construction-    -- ** Primitives-    , fromStopK-    , fromYieldK-    , consK-    , cons-    , (.:)-    , consM-    , consMBy-    , nil-    , nilM--    -- ** Unfolding-    , unfoldr-    , unfoldrMWith-    , unfoldrM--    -- ** From Values-    , fromEffect-    , fromPure-    , repeat-    , repeatMWith-    , replicateMWith--    -- ** From Indices-    , fromIndicesMWith--    -- ** Iteration-    , iterateMWith--    -- ** From Containers-    , fromFoldable-    , fromFoldableM--    -- ** Cyclic-    , mfix--    -- * Elimination-    -- ** Primitives-    , uncons--    -- ** Strict Left Folds-    , Streamly.Internal.Data.Stream.StreamK.Type.foldl'-    , foldlx'--    -- ** Lazy Right Folds-    , Streamly.Internal.Data.Stream.StreamK.Type.foldr--    -- ** Specific Folds-    , drain-    , null-    , tail-    , init--    -- * Mapping-    , map-    , mapMWith-    , mapMSerial--    -- * Combining Two Streams-    -- ** Appending-    , conjoin-    , append--    -- ** Interleave-    , interleave-    , interleaveFst-    , interleaveMin--    -- ** Cross Product-    , crossApplyWith-    , crossApply-    , crossApplySnd-    , crossApplyFst-    , crossWith-    , cross--    -- * Concat-    , before-    , concatEffect-    , concatMapEffect-    , concatMapWith-    , concatMap-    , bindWith-    , concatIterateWith-    , concatIterateLeftsWith-    , concatIterateScanWith--    -- * Merge-    , mergeMapWith-    , mergeIterateWith--    -- * Buffered Operations-    , foldlS-    , reverse-    )-where--#include "inline.hs"---- import Control.Applicative (liftA2)-import Control.Monad ((>=>))-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Applicative (liftA2)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Foldable (Foldable(foldl'), fold, foldr)-import Data.Function (fix)-import Data.Functor.Identity (Identity(..))-import Data.Maybe (fromMaybe)-import Data.Semigroup (Endo(..))-import GHC.Exts (IsList(..), IsString(..), oneShot)-import Streamly.Internal.BaseCompat ((#.))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import qualified Prelude--import Prelude hiding-    (map, mapM, concatMap, foldr, repeat, null, reverse, tail, init)--#include "DocTestDataStreamK.hs"----------------------------------------------------------------------------------- Basic stream type----------------------------------------------------------------------------------- It uses stop, singleton and yield continuations equivalent to the following--- direct style type:------ @--- data StreamK m a = Stop | Singleton a | Yield a (StreamK m a)--- @------ To facilitate parallel composition we maintain a local state in an 'SVar'--- that is shared across and is used for synchronization of the streams being--- composed.------ The singleton case can be expressed in terms of stop and yield but we have--- it as a separate case to optimize composition operations for streams with--- single element.  We build singleton streams in the implementation of 'pure'--- for Applicative and Monad, and in 'lift' for MonadTrans.---- XXX remove the State param.---- | Continuation Passing Style (CPS) version of "Streamly.Data.Stream.Stream".--- Unlike "Streamly.Data.Stream.Stream", 'StreamK' can be composed recursively--- without affecting performance.------ Semigroup instance appends two streams:------ >>> (<>) = Stream.append----{-# DEPRECATED Stream "Please use StreamK instead." #-}-type Stream = StreamK--newtype StreamK m a =-    MkStream (forall r.-               State StreamK m a         -- state-            -> (a -> StreamK m a -> m r) -- yield-            -> (a -> m r)               -- singleton-            -> m r                      -- stop-            -> m r-            )--mkStream-    :: (forall r. State StreamK m a-        -> (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r)-    -> StreamK m a-mkStream = MkStream---- | A terminal function that has no continuation to follow.-type StopK m = forall r. m r -> m r---- | A monadic continuation, it is a function that yields a value of type "a"--- and calls the argument (a -> m r) as a continuation with that value. We can--- also think of it as a callback with a handler (a -> m r).  Category--- theorists call it a codensity type, a special type of right kan extension.-type YieldK m a = forall r. (a -> m r) -> m r--_wrapM :: Monad m => m a -> YieldK m a-_wrapM m = (m >>=)---- | Make an empty stream from a stop function.-fromStopK :: StopK m -> StreamK m a-fromStopK k = mkStream $ \_ _ _ stp -> k stp---- | Make a singleton stream from a callback function. The callback function--- calls the one-shot yield continuation to yield an element.-fromYieldK :: YieldK m a -> StreamK m a-fromYieldK k = mkStream $ \_ _ sng _ -> k sng---- | Add a yield function at the head of the stream.-consK :: YieldK m a -> StreamK m a -> StreamK m a-consK k r = mkStream $ \_ yld _ _ -> k (`yld` r)---- XXX Build a stream from a repeating callback function.----------------------------------------------------------------------------------- Construction---------------------------------------------------------------------------------infixr 5 `cons`---- faster than consM because there is no bind.---- | A right associative prepend operation to add a pure value at the head of--- an existing stream::------ >>> s = 1 `StreamK.cons` 2 `StreamK.cons` 3 `StreamK.cons` StreamK.nil--- >>> Stream.fold Fold.toList (StreamK.toStream s)--- [1,2,3]------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil------ Same as the following but more efficient:------ >>> cons x xs = return x `StreamK.consM` xs----{-# INLINE_NORMAL cons #-}-cons :: a -> StreamK m a -> StreamK m a-cons a r = mkStream $ \_ yield _ _ -> yield a r--infixr 5 .:---- | Operator equivalent of 'cons'.------ @--- > toList $ 1 .: 2 .: 3 .: nil--- [1,2,3]--- @----{-# INLINE (.:) #-}-(.:) :: a -> StreamK m a -> StreamK m a-(.:) = cons---- | A stream that terminates without producing any output or side effect.------ >>> Stream.fold Fold.toList (StreamK.toStream StreamK.nil)--- []----{-# INLINE_NORMAL nil #-}-nil :: StreamK m a-nil = mkStream $ \_ _ _ stp -> stp---- | A stream that terminates without producing any output, but produces a side--- effect.------ >>> Stream.fold Fold.toList (StreamK.toStream (StreamK.nilM (print "nil")))--- "nil"--- []------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Applicative m => m b -> StreamK m a-nilM m = mkStream $ \_ _ _ stp -> m *> stp---- | Create a singleton stream from a pure value.------ >>> fromPure a = a `StreamK.cons` StreamK.nil--- >>> fromPure = pure--- >>> fromPure = StreamK.fromEffect . pure----{-# INLINE_NORMAL fromPure #-}-fromPure :: a -> StreamK m a-fromPure a = mkStream $ \_ _ single _ -> single a---- | Create a singleton stream from a monadic action.------ >>> fromEffect m = m `StreamK.consM` StreamK.nil------ >>> Stream.fold Fold.drain $ StreamK.toStream $ StreamK.fromEffect (putStrLn "hello")--- hello----{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Monad m => m a -> StreamK m a-fromEffect m = mkStream $ \_ _ single _ -> m >>= single--infixr 5 `consM`---- NOTE: specializing the function outside the instance definition seems to--- improve performance quite a bit at times, even if we have the same--- SPECIALIZE in the instance definition.---- | A right associative prepend operation to add an effectful value at the--- head of an existing stream::------ >>> s = putStrLn "hello" `StreamK.consM` putStrLn "world" `StreamK.consM` StreamK.nil--- >>> Stream.fold Fold.drain (StreamK.toStream s)--- hello--- world------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldableM = Prelude.foldr StreamK.consM StreamK.nil------ Same as the following but more efficient:------ >>> consM x xs = StreamK.fromEffect x `StreamK.append` xs----{-# INLINE consM #-}-{-# SPECIALIZE consM :: IO a -> StreamK IO a -> StreamK IO a #-}-consM :: Monad m => m a -> StreamK m a -> StreamK m a-consM m r = MkStream $ \_ yld _ _ -> m >>= (`yld` r)---- XXX specialize to IO?-{-# INLINE consMBy #-}-consMBy :: Monad m =>-    (StreamK m a -> StreamK m a -> StreamK m a) -> m a -> StreamK m a -> StreamK m a-consMBy f m r = fromEffect m `f` r----------------------------------------------------------------------------------- Folding a stream----------------------------------------------------------------------------------- | Fold a stream by providing an SVar, a stop continuation, a singleton--- continuation and a yield continuation. The stream would share the current--- SVar passed via the State.-{-# INLINE_EARLY foldStreamShared #-}-foldStreamShared-    :: State StreamK m a-    -> (a -> StreamK m a -> m r)-    -> (a -> m r)-    -> m r-    -> StreamK m a-    -> m r-foldStreamShared s yield single stop (MkStream k) = k s yield single stop---- | Fold a stream by providing a State, stop continuation, a singleton--- continuation and a yield continuation. The stream will not use the SVar--- passed via State.-{-# INLINE foldStream #-}-foldStream-    :: State StreamK m a-    -> (a -> StreamK m a -> m r)-    -> (a -> m r)-    -> m r-    -> StreamK m a-    -> m r-foldStream s yield single stop (MkStream k) =-    k (adaptState s) yield single stop------------------------------------------------------------------------------------ foldr/build fusion------------------------------------------------------------------------------------ XXX perhaps we can just use foldrSM/buildM everywhere as they are more--- general and cover foldrS/buildS as well.---- | The function 'f' decides how to reconstruct the stream. We could--- reconstruct using a shared state (SVar) or without sharing the state.----{-# INLINE foldrSWith #-}-foldrSWith ::-    (forall r. State StreamK m b-        -> (b -> StreamK m b -> m r)-        -> (b -> m r)-        -> m r-        -> StreamK m b-        -> m r)-    -> (a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSWith f step final m = go m-    where-    go m1 = mkStream $ \st yld sng stp ->-        let run x = f st yld sng stp x-            stop = run final-            single a = run $ step a final-            yieldk a r = run $ step a (go r)-         -- XXX if type a and b are the same we do not need adaptState, can we-         -- save some perf with that?-         -- XXX since we are using adaptState anyway here we can use-         -- foldStreamShared instead, will that save some perf?-         in foldStream (adaptState st) yieldk single stop m1---- XXX we can use rewrite rules just for foldrSWith, if the function f is the--- same we can rewrite it.---- | Fold sharing the SVar state within the reconstructed stream-{-# INLINE_NORMAL foldrSShared #-}-foldrSShared ::-       (a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSShared = foldrSWith foldStreamShared---- XXX consM is a typeclass method, therefore rewritten already. Instead maybe--- we can make consM polymorphic using rewrite rules.--- {-# RULES "foldrSShared/id"     foldrSShared consM nil = \x -> x #-}-{-# RULES "foldrSShared/nil"-    forall k z. foldrSShared k z nil = z #-}-{-# RULES "foldrSShared/single"-    forall k z x. foldrSShared k z (fromPure x) = k x z #-}--- {-# RULES "foldrSShared/app" [1]---     forall ys. foldrSShared consM ys = \xs -> xs `conjoin` ys #-}---- | Right fold to a streaming monad.------ > foldrS StreamK.cons StreamK.nil === id------ 'foldrS' can be used to perform stateless stream to stream transformations--- like map and filter in general. It can be coupled with a scan to perform--- stateful transformations. However, note that the custom map and filter--- routines can be much more efficient than this due to better stream fusion.------ >>> input = StreamK.fromStream $ Stream.fromList [1..5]--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS StreamK.cons StreamK.nil input--- [1,2,3,4,5]------ Find if any element in the stream is 'True':------ >>> step x xs = if odd x then StreamK.fromPure True else xs--- >>> input = StreamK.fromStream (Stream.fromList (2:4:5:undefined)) :: StreamK IO Int--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step (StreamK.fromPure False) input--- [True]------ Map (+2) on odd elements and filter out the even elements:------ >>> step x xs = if odd x then (x + 2) `StreamK.cons` xs else xs--- >>> input = StreamK.fromStream (Stream.fromList [1..5]) :: StreamK IO Int--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step StreamK.nil input--- [3,5,7]------ /Pre-release/-{-# INLINE_NORMAL foldrS #-}-foldrS ::-       (a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrS = foldrSWith foldStream--{-# RULES "foldrS/id"     foldrS cons nil = \x -> x #-}-{-# RULES "foldrS/nil"    forall k z.   foldrS k z nil  = z #-}--- See notes in GHC.Base about this rule--- {-# RULES "foldr/cons"---  forall k z x xs. foldrS k z (x `cons` xs) = k x (foldrS k z xs) #-}-{-# RULES "foldrS/single" forall k z x. foldrS k z (fromPure x) = k x z #-}--- {-# RULES "foldrS/app" [1]---  forall ys. foldrS cons ys = \xs -> xs `conjoin` ys #-}------------------------------------------------------------------------------------ foldrS with monadic cons i.e. consM----------------------------------------------------------------------------------{-# INLINE foldrSMWith #-}-foldrSMWith :: Monad m-    => (forall r. State StreamK m b-        -> (b -> StreamK m b -> m r)-        -> (b -> m r)-        -> m r-        -> StreamK m b-        -> m r)-    -> (m a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSMWith f step final m = go m-    where-    go m1 = mkStream $ \st yld sng stp ->-        let run x = f st yld sng stp x-            stop = run final-            single a = run $ step (return a) final-            yieldk a r = run $ step (return a) (go r)-         in foldStream (adaptState st) yieldk single stop m1--{-# INLINE_NORMAL foldrSM #-}-foldrSM :: Monad m-    => (m a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSM = foldrSMWith foldStream---- {-# RULES "foldrSM/id"     foldrSM consM nil = \x -> x #-}-{-# RULES "foldrSM/nil"    forall k z.   foldrSM k z nil  = z #-}-{-# RULES "foldrSM/single" forall k z x. foldrSM k z (fromEffect x) = k x z #-}--- {-# RULES "foldrSM/app" [1]---  forall ys. foldrSM consM ys = \xs -> xs `conjoin` ys #-}---- Like foldrSM but sharing the SVar state within the recostructed stream.-{-# INLINE_NORMAL foldrSMShared #-}-foldrSMShared :: Monad m-    => (m a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSMShared = foldrSMWith foldStreamShared---- {-# RULES "foldrSM/id"     foldrSM consM nil = \x -> x #-}-{-# RULES "foldrSMShared/nil"-    forall k z. foldrSMShared k z nil = z #-}-{-# RULES "foldrSMShared/single"-    forall k z x. foldrSMShared k z (fromEffect x) = k x z #-}--- {-# RULES "foldrSM/app" [1]---  forall ys. foldrSM consM ys = \xs -> xs `conjoin` ys #-}------------------------------------------------------------------------------------ build----------------------------------------------------------------------------------{-# INLINE_NORMAL build #-}-build :: forall m a. (forall b. (a -> b -> b) -> b -> b) -> StreamK m a-build g = g cons nil--{-# RULES "foldrM/build"-    forall k z (g :: forall b. (a -> b -> b) -> b -> b).-    foldrM k z (build g) = g k z #-}--{-# RULES "foldrS/build"-      forall k z (g :: forall b. (a -> b -> b) -> b -> b).-      foldrS k z (build g) = g k z #-}--{-# RULES "foldrS/cons/build"-      forall k z x (g :: forall b. (a -> b -> b) -> b -> b).-      foldrS k z (x `cons` build g) = k x (g k z) #-}--{-# RULES "foldrSShared/build"-      forall k z (g :: forall b. (a -> b -> b) -> b -> b).-      foldrSShared k z (build g) = g k z #-}--{-# RULES "foldrSShared/cons/build"-      forall k z x (g :: forall b. (a -> b -> b) -> b -> b).-      foldrSShared k z (x `cons` build g) = k x (g k z) #-}---- build a stream by applying cons and nil to a build function-{-# INLINE_NORMAL buildS #-}-buildS ::-       ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a-buildS g = g cons nil--{-# RULES "foldrS/buildS"-      forall k z-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrS k z (buildS g) = g k z #-}--{-# RULES "foldrS/cons/buildS"-      forall k z x-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrS k z (x `cons` buildS g) = k x (g k z) #-}--{-# RULES "foldrSShared/buildS"-      forall k z-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrSShared k z (buildS g) = g k z #-}--{-# RULES "foldrSShared/cons/buildS"-      forall k z x-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrSShared k z (x `cons` buildS g) = k x (g k z) #-}---- build a stream by applying consM and nil to a build function-{-# INLINE_NORMAL buildSM #-}-buildSM :: Monad m-    => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a-buildSM g = g consM nil--{-# RULES "foldrSM/buildSM"-     forall k z-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-     foldrSM k z (buildSM g) = g k z #-}--{-# RULES "foldrSMShared/buildSM"-     forall k z-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-     foldrSMShared k z (buildSM g) = g k z #-}---- Disabled because this may not fire as consM is a class Op-{--{-# RULES "foldrS/consM/buildSM"-      forall k z x (g :: (m a -> t m a -> t m a) -> t m a -> t m a)-    . foldrSM k z (x `consM` buildSM g)-    = k x (g k z)-#-}--}---- Build using monadic build functions (continuations) instead of--- reconstructing a stream.-{-# INLINE_NORMAL buildM #-}-buildM :: Monad m-    => (forall r. (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )-    -> StreamK m a-buildM g = mkStream $ \st yld sng stp ->-    g (\a r -> foldStream st yld sng stp (return a `consM` r)) sng stp---- | Like 'buildM' but shares the SVar state across computations.-{-# INLINE_NORMAL sharedMWith #-}-sharedMWith :: Monad m-    => (m a -> StreamK m a -> StreamK m a)-    -> (forall r. (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )-    -> StreamK m a-sharedMWith cns g = mkStream $ \st yld sng stp ->-    g (\a r -> foldStreamShared st yld sng stp (return a `cns` r)) sng stp------------------------------------------------------------------------------------ augment----------------------------------------------------------------------------------{-# INLINE_NORMAL augmentS #-}-augmentS ::-       ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a-    -> StreamK m a-augmentS g xs = g cons xs--{-# RULES "augmentS/nil"-    forall (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentS g nil = buildS g-    #-}--{-# RULES "foldrS/augmentS"-    forall k z xs-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    foldrS k z (augmentS g xs) = g k (foldrS k z xs)-    #-}--{-# RULES "augmentS/buildS"-    forall (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-           (h :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentS g (buildS h) = buildS (\c n -> g c (h c n))-    #-}--{-# INLINE_NORMAL augmentSM #-}-augmentSM :: Monad m =>-       ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a -> StreamK m a-augmentSM g xs = g consM xs--{-# RULES "augmentSM/nil"-    forall-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentSM g nil = buildSM g-    #-}--{-# RULES "foldrSM/augmentSM"-    forall k z xs-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    foldrSM k z (augmentSM g xs) = g k (foldrSM k z xs)-    #-}--{-# RULES "augmentSM/buildSM"-    forall-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-        (h :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentSM g (buildSM h) = buildSM (\c n -> g c (h c n))-    #-}------------------------------------------------------------------------------------ Experimental foldrM/buildM------------------------------------------------------------------------------------ | Lazy right fold with a monadic step function.-{-# INLINE_NORMAL foldrM #-}-foldrM :: (a -> m b -> m b) -> m b -> StreamK m a -> m b-foldrM step acc m = go m-    where-    go m1 =-        let stop = acc-            single a = step a acc-            yieldk a r = step a (go r)-        in foldStream defState yieldk single stop m1--{-# INLINE_NORMAL foldrMKWith #-}-foldrMKWith-    :: (State StreamK m a-        -> (a -> StreamK m a -> m b)-        -> (a -> m b)-        -> m b-        -> StreamK m a-        -> m b)-    -> (a -> m b -> m b)-    -> m b-    -> ((a -> StreamK m a -> m b) -> (a -> m b) -> m b -> m b)-    -> m b-foldrMKWith f step acc = go-    where-    go k =-        let stop = acc-            single a = step a acc-            yieldk a r = step a (go (\yld sng stp -> f defState yld sng stp r))-        in k yieldk single stop--{--{-# RULES "foldrM/buildS"-      forall k z (g :: (a -> t m a -> t m a) -> t m a -> t m a)-    . foldrM k z (buildS g)-    = g k z-#-}--}--- XXX in which case will foldrM/buildM fusion be useful?-{-# RULES "foldrM/buildM"-    forall step acc (g :: (forall r.-           (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )).-    foldrM step acc (buildM g) = foldrMKWith foldStream step acc g-    #-}--{--{-# RULES "foldrM/sharedM"-    forall step acc (g :: (forall r.-           (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )).-    foldrM step acc (sharedM g) = foldrMKWith foldStreamShared step acc g-    #-}--}----------------------------------------------------------------------------------- Left fold----------------------------------------------------------------------------------- | Strict left fold with an extraction function. Like the standard strict--- left fold, but applies a user supplied extraction function (the third--- argument) to the folded value at the end. This is designed to work with the--- @foldl@ library. The suffix @x@ is a mnemonic for extraction.------ Note that the accumulator is always evaluated including the initial value.-{-# INLINE foldlx' #-}-foldlx' :: forall m a b x. Monad m-    => (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> m b-foldlx' step begin done m = get $ go m begin-    where-    {-# NOINLINE get #-}-    get :: StreamK m x -> m b-    get m1 =-        -- XXX we are not strictly evaluating the accumulator here. Is this-        -- okay?-        let single = return . done-        -- XXX this is foldSingleton. why foldStreamShared?-         in foldStreamShared undefined undefined single undefined m1--    -- Note, this can be implemented by making a recursive call to "go",-    -- however that is more expensive because of unnecessary recursion-    -- that cannot be tail call optimized. Unfolding recursion explicitly via-    -- continuations is much more efficient.-    go :: StreamK m a -> x -> StreamK m x-    go m1 !acc = mkStream $ \_ yld sng _ ->-        let stop = sng acc-            single a = sng $ step acc a-            -- XXX this is foldNonEmptyStream-            yieldk a r = foldStream defState yld sng undefined $-                go r (step acc a)-        in foldStream defState yieldk single stop m1---- | Strict left associative fold.-{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> StreamK m a -> m b-foldl' step begin = foldlx' step begin id----------------------------------------------------------------------------------- Specialized folds----------------------------------------------------------------------------------- XXX use foldrM to implement folds where possible--- XXX This (commented) definition of drain and mapM_ perform much better on--- some benchmarks but worse on others. Need to investigate why, may there is--- an optimization opportunity that we can exploit.--- drain = foldrM (\_ xs -> return () >> xs) (return ())---- |--- > drain = foldl' (\_ _ -> ()) ()--- > drain = mapM_ (\_ -> return ())-{-# INLINE drain #-}-drain :: Monad m => StreamK m a -> m ()-drain = foldrM (\_ xs -> xs) (return ())-{--drain = go-    where-    go m1 =-        let stop = return ()-            single _ = return ()-            yieldk _ r = go r-         in foldStream defState yieldk single stop m1--}--{-# INLINE null #-}-null :: Monad m => StreamK m a -> m Bool--- null = foldrM (\_ _ -> return True) (return False)-null m =-    let stop      = return True-        single _  = return False-        yieldk _ _ = return False-    in foldStream defState yieldk single stop m----------------------------------------------------------------------------------- Semigroup---------------------------------------------------------------------------------infixr 6 `append`---- | Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ >>> s1 = StreamK.fromStream $ Stream.fromList [1,2]--- >>> s2 = StreamK.fromStream $ Stream.fromList [3,4]--- >>> Stream.fold Fold.toList $ StreamK.toStream $ s1 `StreamK.append` s2--- [1,2,3,4]------ This has O(n) append performance where @n@ is the number of streams. It can--- be used to efficiently fold an infinite lazy container of streams using--- 'concatMapWith' et. al.----{-# INLINE append #-}-append :: StreamK m a -> StreamK m a -> StreamK m a--- XXX This doubles the time of toNullAp benchmark, may not be fusing properly--- serial xs ys = augmentS (\c n -> foldrS c n xs) ys-append m1 m2 = go m1-    where-    go m = mkStream $ \st yld sng stp ->-               let stop       = foldStream st yld sng stp m2-                   single a   = yld a m2-                   yieldk a r = yld a (go r)-               in foldStream st yieldk single stop m---- join/merge/append streams depending on consM-{-# INLINE conjoin #-}-conjoin :: Monad m => StreamK m a -> StreamK m a -> StreamK m a-conjoin xs = augmentSM (\c n -> foldrSM c n xs)--instance Semigroup (StreamK m a) where-    (<>) = append----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance Monoid (StreamK m a) where-    mempty = nil-    mappend = (<>)------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ IMPORTANT: This is eta expanded on purpose. This should not be eta--- reduced. This will cause a lot of regressions, probably because of some--- rewrite rules. Ideally don't run hlint on this file.-{-# INLINE_LATE mapFB #-}-mapFB :: forall b m a.-       (b -> StreamK m b -> StreamK m b)-    -> (a -> b)-    -> a-    -> StreamK m b-    -> StreamK m b-mapFB c f = \x ys -> c (f x) ys--{-# RULES-"mapFB/mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f . g)-"mapFB/id"    forall c.     mapFB c (\x -> x)   = c-    #-}--{-# INLINE map #-}-map :: (a -> b) -> StreamK m a -> StreamK m b-map f xs = buildS (\c n -> foldrS (mapFB c f) n xs)---- XXX This definition might potentially be more efficient, but the cost in the--- benchmark is dominated by unfoldrM cost so we cannot correctly determine--- differences in the mapping cost. We should perhaps deduct the cost of--- unfoldrM from the benchmarks and then compare.-{--map f m = go m-    where-        go m1 =-            mkStream $ \st yld sng stp ->-            let single     = sng . f-                yieldk a r = yld (f a) (go r)-            in foldStream (adaptState st) yieldk single stp m1--}--{-# INLINE_LATE mapMFB #-}-mapMFB :: Monad m => (m b -> t m b -> t m b) -> (a -> m b) -> m a -> t m b -> t m b-mapMFB c f x = c (x >>= f)--{-# RULES-    "mapMFB/mapMFB" forall c f g. mapMFB (mapMFB c f) g = mapMFB c (f >=> g)-    #-}--- XXX These rules may never fire because pure/return type class rules will--- fire first.-{--"mapMFB/pure"    forall c.     mapMFB c (\x -> pure x)   = c-"mapMFB/return"  forall c.     mapMFB c (\x -> return x) = c--}---- This is experimental serial version supporting fusion.------ XXX what if we do not want to fuse two concurrent mapMs?--- XXX we can combine two concurrent mapM only if the SVar is of the same type--- So for now we use it only for serial streams.--- XXX fusion would be easier for monomoprhic stream types.--- {-# RULES "mapM serial" mapM = mapMSerial #-}-{-# INLINE mapMSerial #-}-mapMSerial :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b-mapMSerial f xs = buildSM (\c n -> foldrSMShared (mapMFB c f) n xs)--{-# INLINE mapMWith #-}-mapMWith ::-       (m b -> StreamK m b -> StreamK m b)-    -> (a -> m b)-    -> StreamK m a-    -> StreamK m b-mapMWith cns f = foldrSShared (\x xs -> f x `cns` xs) nil--{---- See note under map definition above.-mapMWith cns f = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a  = f a >>= sng-            yieldk a r = foldStreamShared st yld sng stp $ f a `cns` go r-         in foldStream (adaptState st) yieldk single stp m1--}---- XXX in fact use the Stream type everywhere and only use polymorphism in the--- high level modules/prelude.-instance Monad m => Functor (StreamK m) where-    fmap = map----------------------------------------------------------------------------------- Lists----------------------------------------------------------------------------------- Serial streams can act like regular lists using the Identity monad---- XXX Show instance is 10x slower compared to read, we can do much better.--- The list show instance itself is really slow.---- XXX The default definitions of "<" in the Ord instance etc. do not perform--- well, because they do not get inlined. Need to add INLINE in Ord class in--- base?--instance IsList (StreamK Identity a) where-    type (Item (StreamK Identity a)) = a--    {-# INLINE fromList #-}-    fromList = fromFoldable--    {-# INLINE toList #-}-    toList = Data.Foldable.foldr (:) []---- XXX Fix these-{--instance Eq a => Eq (StreamK Identity a) where-    {-# INLINE (==) #-}-    (==) xs ys = runIdentity $ eqBy (==) xs ys--instance Ord a => Ord (StreamK Identity a) where-    {-# INLINE compare #-}-    compare xs ys = runIdentity $ cmpBy compare xs ys--    {-# INLINE (<) #-}-    x < y =-        case compare x y of-            LT -> True-            _ -> False--    {-# INLINE (<=) #-}-    x <= y =-        case compare x y of-            GT -> False-            _ -> True--    {-# INLINE (>) #-}-    x > y =-        case compare x y of-            GT -> True-            _ -> False--    {-# INLINE (>=) #-}-    x >= y =-        case compare x y of-            LT -> False-            _ -> True--    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y--}--instance Show a => Show (StreamK Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (toList dl)--instance Read a => Read (StreamK Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        fromList <$> readPrec--    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (StreamK Identity a) where-    {-# INLINE fromString #-}-    fromString = fromList------------------------------------------------------------------------------------ Foldable------------------------------------------------------------------------------------ | Lazy right associative fold.-{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> StreamK m a -> m b-foldr step acc = foldrM (\x xs -> xs >>= \b -> return (step x b)) (return acc)---- The default Foldable instance has several issues:--- 1) several definitions do not have INLINE on them, so we provide---    re-implementations with INLINE pragmas.--- 2) the definitions of sum/product/maximum/minimum are inefficient as they---    use right folds, they cannot run in constant memory. We provide---    implementations using strict left folds here.--instance (Foldable m, Monad m) => Foldable (StreamK m) where--    {-# INLINE foldMap #-}-    foldMap f =-          fold-        . Streamly.Internal.Data.Stream.StreamK.Type.foldr (mappend . f) mempty--    {-# INLINE foldr #-}-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    {-# INLINE foldl' #-}-    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0-        where f' x k = oneShot $ \z -> k $! f z x--    {-# INLINE length #-}-    length = Data.Foldable.foldl' (\n _ -> n + 1) 0--    {-# INLINE elem #-}-    elem = any . (==)--    {-# INLINE maximum #-}-    maximum =-          fromMaybe (errorWithoutStackTrace "maximum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMax Nothing'--        where--        getMax Nothing' x = Just' x-        getMax (Just' mx) x = Just' $! max mx x--    {-# INLINE minimum #-}-    minimum =-          fromMaybe (errorWithoutStackTrace "minimum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMin Nothing'--        where--        getMin Nothing' x = Just' x-        getMin (Just' mn) x = Just' $! min mn x--    {-# INLINE sum #-}-    sum = Data.Foldable.foldl' (+) 0--    {-# INLINE product #-}-    product = Data.Foldable.foldl' (*) 1------------------------------------------------------------------------------------ Traversable----------------------------------------------------------------------------------instance Traversable (StreamK Identity) where-    {-# INLINE traverse #-}-    traverse f xs =-        runIdentity-            $ Streamly.Internal.Data.Stream.StreamK.Type.foldr-                consA (pure mempty) xs--        where--        consA x ys = liftA2 cons (f x) ys------------------------------------------------------------------------------------ Nesting------------------------------------------------------------------------------------ | Detach a stream from an SVar-{-# INLINE unShare #-}-unShare :: StreamK m a -> StreamK m a-unShare x = mkStream $ \st yld sng stp ->-    foldStream st yld sng stp x---- XXX the function stream and value stream can run in parallel-{-# INLINE crossApplyWith #-}-crossApplyWith ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> StreamK m (a -> b)-    -> StreamK m a-    -> StreamK m b-crossApplyWith par fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single f   = foldShared $ unShare (go2 f stream)-                yieldk f r = foldShared $ unShare (go2 f stream) `par` go1 r-            in foldStream (adaptState st) yieldk single stp m--    go2 f m =-        mkStream $ \st yld sng stp ->-            let single a   = sng (f a)-                yieldk a r = yld (f a) (go2 f r)-            in foldStream (adaptState st) yieldk single stp m---- | Apply a stream of functions to a stream of values and flatten the results.------ Note that the second stream is evaluated multiple times.------ Definition:------ >>> crossApply = StreamK.crossApplyWith StreamK.append--- >>> crossApply = Stream.crossWith id----{-# INLINE crossApply #-}-crossApply ::-       StreamK m (a -> b)-    -> StreamK m a-    -> StreamK m b-crossApply fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single f   = foldShared $ go3 f stream-                yieldk f r = foldShared $ go2 f r stream-            in foldStream (adaptState st) yieldk single stp m--    go2 f r1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ go1 r1-                single a   = yld (f a) (go1 r1)-                yieldk a r = yld (f a) (go2 f r1 r)-            in foldStream (adaptState st) yieldk single stop m--    go3 f m =-        mkStream $ \st yld sng stp ->-            let single a   = sng (f a)-                yieldk a r = yld (f a) (go3 f r)-            in foldStream (adaptState st) yieldk single stp m--{-# INLINE crossApplySnd #-}-crossApplySnd ::-       StreamK m a-    -> StreamK m b-    -> StreamK m b-crossApplySnd fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single _   = foldShared stream-                yieldk _ r = foldShared $ go2 r stream-            in foldStream (adaptState st) yieldk single stp m--    go2 r1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ go1 r1-                single a   = yld a (go1 r1)-                yieldk a r = yld a (go2 r1 r)-            in foldStream st yieldk single stop m--{-# INLINE crossApplyFst #-}-crossApplyFst ::-       StreamK m a-    -> StreamK m b-    -> StreamK m a-crossApplyFst fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single f   = foldShared $ go3 f stream-                yieldk f r = foldShared $ go2 f r stream-            in foldStream st yieldk single stp m--    go2 f r1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ go1 r1-                single _   = yld f (go1 r1)-                yieldk _ r = yld f (go2 f r1 r)-            in foldStream (adaptState st) yieldk single stop m--    go3 f m =-        mkStream $ \st yld sng stp ->-            let single _   = sng f-                yieldk _ r = yld f (go3 f r)-            in foldStream (adaptState st) yieldk single stp m---- |--- Definition:------ >>> crossWith f m1 m2 = fmap f m1 `StreamK.crossApply` m2------ Note that the second stream is evaluated multiple times.----{-# INLINE crossWith #-}-crossWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c-crossWith f m1 m2 = fmap f m1 `crossApply` m2---- | Given a @StreamK m a@ and @StreamK m b@ generate a stream with all possible--- combinations of the tuple @(a, b)@.------ Definition:------ >>> cross = StreamK.crossWith (,)------ The second stream is evaluated multiple times. If that is not desired it can--- be cached in an 'Data.Array.Array' and then generated from the array before--- calling this function. Caching may also improve performance if the stream is--- expensive to evaluate.------ See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE cross #-}-cross :: Monad m => StreamK m a -> StreamK m b -> StreamK m (a, b)-cross = crossWith (,)---- XXX This is just concatMapWith with arguments flipped. We need to keep this--- instead of using a concatMap style definition because the bind--- implementation in Async and WAsync streams show significant perf degradation--- if the argument order is changed.-{-# INLINE bindWith #-}-bindWith ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> StreamK m a-    -> (a -> StreamK m b)-    -> StreamK m b-bindWith par m1 f = go m1-    where-        go m =-            mkStream $ \st yld sng stp ->-                let foldShared = foldStreamShared st yld sng stp-                    single a   = foldShared $ unShare (f a)-                    yieldk a r = foldShared $ unShare (f a) `par` go r-                in foldStream (adaptState st) yieldk single stp m---- XXX express in terms of foldrS?--- XXX can we use a different stream type for the generated stream being--- falttened so that we can combine them differently and keep the resulting--- stream different?--- XXX do we need specialize to IO?--- XXX can we optimize when c and a are same, by removing the forall using--- rewrite rules with type applications?---- | Perform a 'concatMap' using a specified concat strategy. The first--- argument specifies a merge or concat function that is used to merge the--- streams generated by the map function.----{-# INLINE concatMapWith #-}-concatMapWith-    ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> (a -> StreamK m b)-    -> StreamK m a-    -> StreamK m b-concatMapWith par f xs = bindWith par xs f--{-# INLINE concatMap #-}-concatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b-concatMap = concatMapWith append--{---- Fused version.--- XXX This fuses but when the stream is nil this performs poorly.--- The filterAllOut benchmark degrades. Need to investigate and fix that.-{-# INLINE concatMap #-}-concatMap :: IsStream t => (a -> t m b) -> t m a -> t m b-concatMap f xs = buildS-    (\c n -> foldrS (\x b -> foldrS c b (f x)) n xs)---- Stream polymorphic concatMap implementation--- XXX need to use buildSM/foldrSMShared for parallel behavior--- XXX unShare seems to degrade the fused performance-{-# INLINE_EARLY concatMap_ #-}-concatMap_ :: IsStream t => (a -> t m b) -> t m a -> t m b-concatMap_ f xs = buildS-     (\c n -> foldrSShared (\x b -> foldrSShared c b (unShare $ f x)) n xs)--}---- | Combine streams in pairs using a binary combinator, the resulting streams--- are then combined again in pairs recursively until we get to a single--- combined stream. The composition would thus form a binary tree.------ For example, you can sort a stream using merge sort like this:------ >>> s = StreamK.fromStream $ Stream.fromList [5,1,7,9,2]--- >>> generate = StreamK.fromPure--- >>> combine = StreamK.mergeBy compare--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.mergeMapWith combine generate s--- [1,2,5,7,9]------ Note that if the stream length is not a power of 2, the binary tree composed--- by mergeMapWith would not be balanced, which may or may not be important--- depending on what you are trying to achieve.------ /Caution: the stream of streams must be finite/------ /Pre-release/----{-# INLINE mergeMapWith #-}-mergeMapWith-    ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> (a -> StreamK m b)-    -> StreamK m a-    -> StreamK m b-mergeMapWith combine f str = go (leafPairs str)--    where--    go stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single a   = foldShared $ unShare a-                yieldk a r = foldShared $ go1 a r-            in foldStream (adaptState st) yieldk single stp stream--    go1 a1 stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ unShare a1-                single a = foldShared $ unShare a1 `combine` a-                yieldk a r =-                    foldShared $ go $ combine a1 a `cons` nonLeafPairs r-            in foldStream (adaptState st) yieldk single stop stream--    -- Exactly the same as "go" except that stop continuation extracts the-    -- stream.-    leafPairs stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single a   = sng (f a)-                yieldk a r = foldShared $ leafPairs1 a r-            in foldStream (adaptState st) yieldk single stp stream--    leafPairs1 a1 stream =-        mkStream $ \st yld sng _ ->-            let stop = sng (f a1)-                single a = sng (f a1 `combine` f a)-                yieldk a r = yld (f a1 `combine` f a) $ leafPairs r-            in foldStream (adaptState st) yieldk single stop stream--    -- Exactly the same as "leafPairs" except that it does not map "f"-    nonLeafPairs stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single a   = sng a-                yieldk a r = foldShared $ nonLeafPairs1 a r-            in foldStream (adaptState st) yieldk single stp stream--    nonLeafPairs1 a1 stream =-        mkStream $ \st yld sng _ ->-            let stop = sng a1-                single a = sng (a1 `combine` a)-                yieldk a r = yld (a1 `combine` a) $ nonLeafPairs r-            in foldStream (adaptState st) yieldk single stop stream--{--instance Monad m => Applicative (StreamK m) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (*>) = crossApplySnd--    {-# INLINE (<*) #-}-    (<*) = crossApplyFst---- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,--- the monad instance of StreamD is slower than StreamK after foldr/build--- fusion.-instance Monad m => Monad (StreamK m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--}--{---- Like concatMap but generates stream using an unfold function. Similar to--- unfoldMany but for StreamK.-concatUnfoldr :: IsStream t-    => (b -> t m (Maybe (a, b))) -> t m b -> t m a-concatUnfoldr = undefined--}----------------------------------------------------------------------------------- concatIterate - Map and flatten Trees of Streams----------------------------------------------------------------------------------- | Yield an input element in the output stream, map a stream generator on it--- and repeat the process on the resulting stream. Resulting streams are--- flattened using the 'concatMapWith' combinator. This can be used for a depth--- first style (DFS) traversal of a tree like structure.------ Example, list a directory tree using DFS:------ >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil)--- >>> input = StreamK.fromPure (Left ".")--- >>> ls = StreamK.concatIterateWith StreamK.append f input------ Note that 'iterateM' is a special case of 'concatIterateWith':------ >>> iterateM f = StreamK.concatIterateWith StreamK.append (StreamK.fromEffect . f) . StreamK.fromEffect------ /Pre-release/----{-# INLINE concatIterateWith #-}-concatIterateWith ::-       (StreamK m a -> StreamK m a -> StreamK m a)-    -> (a -> StreamK m a)-    -> StreamK m a-    -> StreamK m a-concatIterateWith combine f = iterateStream--    where--    iterateStream = concatMapWith combine generate--    generate x = x `cons` iterateStream (f x)---- | Like 'concatIterateWith' but uses the pairwise flattening combinator--- 'mergeMapWith' for flattening the resulting streams. This can be used for a--- balanced traversal of a tree like structure.------ Example, list a directory tree using balanced traversal:------ >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil)--- >>> input = StreamK.fromPure (Left ".")--- >>> ls = StreamK.mergeIterateWith StreamK.interleave f input------ /Pre-release/----{-# INLINE mergeIterateWith #-}-mergeIterateWith ::-       (StreamK m a -> StreamK m a -> StreamK m a)-    -> (a -> StreamK m a)-    -> StreamK m a-    -> StreamK m a-mergeIterateWith combine f = iterateStream--    where--    iterateStream = mergeMapWith combine generate--    generate x = x `cons` iterateStream (f x)----------------------------------------------------------------------------------- Flattening Graphs----------------------------------------------------------------------------------- To traverse graphs we need a state to be carried around in the traversal.--- For example, we can use a hashmap to store the visited status of nodes.---- | Like 'iterateMap' but carries a state in the stream generation function.--- This can be used to traverse graph like structures, we can remember the--- visited nodes in the state to avoid cycles.------ Note that a combination of 'iterateMap' and 'usingState' can also be used to--- traverse graphs. However, this function provides a more localized state--- instead of using a global state.------ See also: 'mfix'------ /Pre-release/----{-# INLINE concatIterateScanWith #-}-concatIterateScanWith-    :: Monad m-    => (StreamK m a -> StreamK m a -> StreamK m a)-    -> (b -> a -> m (b, StreamK m a))-    -> m b-    -> StreamK m a-    -> StreamK m a-concatIterateScanWith combine f initial stream =-    concatEffect $ do-        b <- initial-        iterateStream (b, stream)--    where--    iterateStream (b, s) = pure $ concatMapWith combine (generate b) s--    generate b a = a `cons` feedback b a--    feedback b a = concatEffect $ f b a >>= iterateStream----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- Keep concating either streams as long as rights are generated, stop as soon--- as a left is generated and concat the left stream.------ See also: 'handle'------ /Unimplemented/----{--concatMapEitherWith-    :: (forall x. t m x -> t m x -> t m x)-    -> (a -> t m (Either (StreamK m b) b))-    -> StreamK m a-    -> StreamK m b-concatMapEitherWith = undefined--}---- XXX We should prefer using the Maybe stream returning signatures over this.--- This API should perhaps be removed in favor of those.---- | In an 'Either' stream iterate on 'Left's.  This is a special case of--- 'concatIterateWith':------ >>> concatIterateLeftsWith combine f = StreamK.concatIterateWith combine (either f (const StreamK.nil))------ To traverse a directory tree:------ >>> input = StreamK.fromPure (Left ".")--- >>> ls = StreamK.concatIterateLeftsWith StreamK.append (StreamK.fromStream . Dir.readEither) input------ /Pre-release/----{-# INLINE concatIterateLeftsWith #-}-concatIterateLeftsWith-    :: (b ~ Either a c)-    => (StreamK m b -> StreamK m b -> StreamK m b)-    -> (a -> StreamK m b)-    -> StreamK m b-    -> StreamK m b-concatIterateLeftsWith combine f =-    concatIterateWith combine (either f (const nil))----------------------------------------------------------------------------------- Interleaving---------------------------------------------------------------------------------infixr 6 `interleave`---- Additionally we can have m elements yield from the first stream and n--- elements yielding from the second stream. We can also have time slicing--- variants of positional interleaving, e.g. run first stream for m seconds and--- run the second stream for n seconds.---- | Interleaves two streams, yielding one element from each stream--- alternately.  When one stream stops the rest of the other stream is used in--- the output stream.------ When joining many streams in a left associative manner earlier streams will--- get exponential priority than the ones joining later. Because of exponential--- weighting it can be used with 'concatMapWith' even on a large number of--- streams.----{-# INLINE interleave #-}-interleave :: StreamK m a -> StreamK m a -> StreamK m a-interleave m1 m2 = mkStream $ \st yld sng stp -> do-    let stop       = foldStream st yld sng stp m2-        single a   = yld a m2-        yieldk a r = yld a (interleave m2 r)-    foldStream st yieldk single stop m1--infixr 6 `interleaveFst`---- | Like `interleave` but stops interleaving as soon as the first stream stops.----{-# INLINE interleaveFst #-}-interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a-interleaveFst m1 m2 = mkStream $ \st yld sng stp -> do-    let yieldFirst a r = yld a (yieldSecond r m2)-     in foldStream st yieldFirst sng stp m1--    where--    yieldSecond s1 s2 = mkStream $ \st yld sng stp -> do-            let stop       = foldStream st yld sng stp s1-                single a   = yld a s1-                yieldk a r = yld a (interleave s1 r)-             in foldStream st yieldk single stop s2--infixr 6 `interleaveMin`---- | Like `interleave` but stops interleaving as soon as any of the two streams--- stops.----{-# INLINE interleaveMin #-}-interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a-interleaveMin m1 m2 = mkStream $ \st yld _ stp -> do-    let stop       = stp-        -- "single a" is defined as "yld a (interleaveMin m2 nil)" instead of-        -- "sng a" to keep the behaviour consistent with the yield-        -- continuation.-        single a   = yld a (interleaveMin m2 nil)-        yieldk a r = yld a (interleaveMin m2 r)-    foldStream st yieldk single stop m1------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{-# INLINE unfoldr #-}-unfoldr :: (b -> Maybe (a, b)) -> b -> StreamK m a-unfoldr next s0 = build $ \yld stp ->-    let go s =-            case next s of-                Just (a, b) -> yld a (go b)-                Nothing -> stp-    in go s0--{-# INLINE unfoldrMWith #-}-unfoldrMWith :: Monad m =>-       (m a -> StreamK m a -> StreamK m a)-    -> (b -> m (Maybe (a, b)))-    -> b-    -> StreamK m a-unfoldrMWith cns step = go--    where--    go s = sharedMWith cns $ \yld _ stp -> do-                r <- step s-                case r of-                    Just (a, b) -> yld a (go b)-                    Nothing -> stp--{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> StreamK m a-unfoldrM = unfoldrMWith consM---- | Generate an infinite stream by repeating a pure value.------ /Pre-release/-{-# INLINE repeat #-}-repeat :: a -> StreamK m a-repeat a = let x = cons a x in x---- | Like 'repeatM' but takes a stream 'cons' operation to combine the actions--- in a stream specific manner. A serial cons would repeat the values serially--- while an async cons would repeat concurrently.------ /Pre-release/-repeatMWith :: (m a -> t m a -> t m a) -> m a -> t m a-repeatMWith cns = go--    where--    go m = m `cns` go m--{-# INLINE replicateMWith #-}-replicateMWith :: (m a -> StreamK m a -> StreamK m a) -> Int -> m a -> StreamK m a-replicateMWith cns n m = go n--    where--    go cnt = if cnt <= 0 then nil else m `cns` go (cnt - 1)--{-# INLINE fromIndicesMWith #-}-fromIndicesMWith ::-    (m a -> StreamK m a -> StreamK m a) -> (Int -> m a) -> StreamK m a-fromIndicesMWith cns gen = go 0--    where--    go i = mkStream $ \st stp sng yld -> do-        foldStreamShared st stp sng yld (gen i `cns` go (i + 1))--{-# INLINE iterateMWith #-}-iterateMWith :: Monad m =>-    (m a -> StreamK m a -> StreamK m a) -> (a -> m a) -> m a -> StreamK m a-iterateMWith cns step = go--    where--    go s = mkStream $ \st stp sng yld -> do-        !next <- s-        foldStreamShared st stp sng yld (return next `cns` go (step next))--{-# INLINE headPartial #-}-headPartial :: Monad m => StreamK m a -> m a-headPartial = foldrM (\x _ -> return x) (error "head of nil")--{-# INLINE tailPartial #-}-tailPartial :: StreamK m a -> StreamK m a-tailPartial m = mkStream $ \st yld sng stp ->-    let stop      = error "tail of nil"-        single _  = stp-        yieldk _ r = foldStream st yld sng stp r-    in foldStream st yieldk single stop m---- | We can define cyclic structures using @let@:------ >>> let (a, b) = ([1, b], head a) in (a, b)--- ([1,1],1)------ The function @fix@ defined as:------ >>> fix f = let x = f x in x------ ensures that the argument of a function and its output refer to the same--- lazy value @x@ i.e.  the same location in memory.  Thus @x@ can be defined--- in terms of itself, creating structures with cyclic references.------ >>> f ~(a, b) = ([1, b], head a)--- >>> fix f--- ([1,1],1)------ 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic--- values.------ Using 'mfix' for streams we can construct a stream in which each element of--- the stream is defined in a cyclic fashion. The argument of the function--- being fixed represents the current element of the stream which is being--- returned by the stream monad. Thus, we can use the argument to construct--- itself.------ In the following example, the argument @action@ of the function @f@--- represents the tuple @(x,y)@ returned by it in a given iteration. We define--- the first element of the tuple in terms of the second.------ >>> import System.IO.Unsafe (unsafeInterleaveIO)------ >>> :{--- main = Stream.fold (Fold.drainMapM print) $ StreamK.toStream $ StreamK.mfix f---     where---     f action = StreamK.unCross $ do---         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act---         x <- StreamK.mkCross $ StreamK.fromStream $ Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action]---         y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [4,5]---         return (x, y)--- :}------ Note: you cannot achieve this by just changing the order of the monad--- statements because that would change the order in which the stream elements--- are generated.------ Note that the function @f@ must be lazy in its argument, that's why we use--- 'unsafeInterleaveIO' on @action@ because IO monad is strict.------ /Pre-release/-{-# INLINE mfix #-}-mfix :: Monad m => (m a -> StreamK m a) -> StreamK m a-mfix f = mkStream $ \st yld sng stp ->-    let single a  = foldStream st yld sng stp $ a `cons` ys-        yieldk a _ = foldStream st yld sng stp $ a `cons` ys-    in foldStream st yieldk single stp xs--    where--    -- fix the head element of the stream-    xs = fix  (f . headPartial)--    -- now fix the tail recursively-    ys = mfix (tailPartial . f)------------------------------------------------------------------------------------ Conversions------------------------------------------------------------------------------------ |--- >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil------ Construct a stream from a 'Foldable' containing pure values:----{-# INLINE fromFoldable #-}-fromFoldable :: Foldable f => f a -> StreamK m a-fromFoldable = Prelude.foldr cons nil--{-# INLINE fromFoldableM #-}-fromFoldableM :: (Foldable f, Monad m) => f (m a) -> StreamK m a-fromFoldableM = Prelude.foldr consM nil------------------------------------------------------------------------------------ Deconstruction----------------------------------------------------------------------------------{-# INLINE uncons #-}-uncons :: Applicative m => StreamK m a -> m (Maybe (a, StreamK m a))-uncons m =-    let stop = pure Nothing-        single a = pure (Just (a, nil))-        yieldk a r = pure (Just (a, r))-    in foldStream defState yieldk single stop m--{-# INLINE tail #-}-tail :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))-tail =-    let stop      = pure Nothing-        single _  = pure $ Just nil-        yieldk _ r = pure $ Just r-    in foldStream defState yieldk single stop---- | Extract all but the last element of the stream, if any.------ Note: This will end up buffering the entire stream.------ /Pre-release/-{-# INLINE init #-}-init :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))-init = go1-    where-    go1 m1 = do-        (\case-            Nothing -> Nothing-            Just (h, t) -> Just $ go h t) <$> uncons m1-    go p m1 = mkStream $ \_ yld sng stp ->-        let single _ = sng p-            yieldk a x = yld p $ go a x-         in foldStream defState yieldk single stp m1----------------------------------------------------------------------------------- Reordering----------------------------------------------------------------------------------- | Lazy left fold to a stream.-{-# INLINE foldlS #-}-foldlS ::-    (StreamK m b -> a -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b-foldlS step = go-    where-    go acc rest = mkStream $ \st yld sng stp ->-        let run x = foldStream st yld sng stp x-            stop = run acc-            single a = run $ step acc a-            yieldk a r = run $ go (step acc a) r-         in foldStream (adaptState st) yieldk single stop rest--{-# INLINE reverse #-}-reverse :: StreamK m a -> StreamK m a-reverse = foldlS (flip cons) nil----------------------------------------------------------------------------------- Running effects----------------------------------------------------------------------------------- | Run an action before evaluating the stream.-{-# INLINE before #-}-before :: Monad m => m b -> StreamK m a -> StreamK m a-before action stream =-    mkStream $ \st yld sng stp ->-        action >> foldStreamShared st yld sng stp stream---- | concat . fromEffect-{-# INLINE concatEffect #-}-concatEffect :: Monad m => m (StreamK m a) -> StreamK m a-concatEffect action =-    mkStream $ \st yld sng stp ->-        action >>= foldStreamShared st yld sng stp--{-# INLINE concatMapEffect #-}-concatMapEffect :: Monad m => (b -> StreamK m a) -> m b -> StreamK m a-concatMapEffect f action =-    mkStream $ \st yld sng stp ->-        action >>= foldStreamShared st yld sng stp . f----------------------------------------------------------------------------------- Stream with a cross product style monad instance----------------------------------------------------------------------------------- | A newtype wrapper for the 'StreamK' type adding a cross product style--- monad instance.------ A 'Monad' bind behaves like a @for@ loop:------ >>> :{--- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do---     x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2]---     -- Perform the following actions for each x in the stream---     return x--- :}--- [1,2]------ Nested monad binds behave like nested @for@ loops:------ >>> :{--- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do---     x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2]---     y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [3,4]---     -- Perform the following actions for each x, for each y---     return (x, y)--- :}--- [(1,3),(1,4),(2,3),(2,4)]----newtype CrossStreamK m a = CrossStreamK {unCrossStreamK :: StreamK m a}-        deriving (Functor, Semigroup, Monoid, Foldable)---- | Wrap the 'StreamK' type in a 'CrossStreamK' newtype to enable cross--- product style applicative and monad instances.------ This is a type level operation with no runtime overhead.-{-# INLINE mkCross #-}-mkCross :: StreamK m a -> CrossStreamK m a-mkCross = CrossStreamK---- | Unwrap the 'StreamK' type from 'CrossStreamK' newtype.------ This is a type level operation with no runtime overhead.-{-# INLINE unCross #-}-unCross :: CrossStreamK m a -> StreamK m a-unCross = unCrossStreamK---- Pure (Identity monad) stream instances-deriving instance Traversable (CrossStreamK Identity)-deriving instance IsList (CrossStreamK Identity a)-deriving instance (a ~ Char) => IsString (CrossStreamK Identity a)--- deriving instance Eq a => Eq (CrossStreamK Identity a)--- deriving instance Ord a => Ord (CrossStreamK Identity a)---- Do not use automatic derivation for this to show as "fromList" rather than--- "fromList Identity".-instance Show a => Show (CrossStreamK Identity a) where-    {-# INLINE show #-}-    show (CrossStreamK xs) = show xs--instance Read a => Read (CrossStreamK Identity a) where-    {-# INLINE readPrec #-}-    readPrec = fmap CrossStreamK readPrec----------------------------------------------------------------------------------- Applicative----------------------------------------------------------------------------------- Note: we need to define all the typeclass operations because we want to--- INLINE them.-instance Monad m => Applicative (CrossStreamK m) where-    {-# INLINE pure #-}-    pure x = CrossStreamK (fromPure x)--    {-# INLINE (<*>) #-}-    (CrossStreamK s1) <*> (CrossStreamK s2) =-        CrossStreamK (crossApply s1 s2)--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (CrossStreamK s1) *> (CrossStreamK s2) =-        CrossStreamK (crossApplySnd s1 s2)--    {-# INLINE (<*) #-}-    (CrossStreamK s1) <* (CrossStreamK s2) =-        CrossStreamK (crossApplyFst s1 s2)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (CrossStreamK m) where-    return = pure--    -- Benchmarks better with CPS bind and pure:-    -- Prime sieve (25x)-    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)-    ---    {-# INLINE (>>=) #-}-    (>>=) (CrossStreamK m) f =-        CrossStreamK (bindWith append m (unCrossStreamK . f))--    {-# INLINE (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- Transformers---------------------------------------------------------------------------------instance (MonadIO m) => MonadIO (CrossStreamK m) where-    liftIO x = CrossStreamK (fromEffect $ liftIO x)--instance MonadTrans CrossStreamK where-    {-# INLINE lift #-}-    lift x = CrossStreamK (fromEffect x)--instance (MonadThrow m) => MonadThrow (CrossStreamK m) where-    throwM = lift . throwM
+ src/Streamly/Internal/Data/Stream/Top.hs view
@@ -0,0 +1,352 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Top+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Top level module that can depend on all other lower level Stream modules.++module Streamly.Internal.Data.Stream.Top+    (+    -- * Transformation+    -- ** Sampling+    -- | Value agnostic filtering.+      strideFromThen++    -- * Nesting+    -- ** Set like operations+    -- | These are not exactly set operations because streams are not+    -- necessarily sets, they may have duplicated elements. These operations+    -- are generic i.e. they work on streams of unconstrained types, therefore,+    -- they have quadratic performance characterstics. For better performance+    -- using Set structures see the Streamly.Internal.Data.Stream.Container+    -- module.+    , filterInStreamGenericBy+    , deleteInStreamGenericBy+    , unionWithStreamGenericBy++    -- ** Set like operations on sorted streams+    , filterInStreamAscBy+    , deleteInStreamAscBy+    , unionWithStreamAscBy++    -- ** Join operations+    , joinInnerGeneric++    -- * Joins on sorted stream+    , joinInnerAscBy+    , joinLeftAscBy+    , joinOuterAscBy+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (newIORef, readIORef, modifyIORef')+import Streamly.Internal.Data.Fold.Type (Fold)+import Streamly.Internal.Data.Stream.Type (Stream, cross)++import qualified Data.List as List+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Stream.Nesting as Stream+import qualified Streamly.Internal.Data.Stream.Transform as Stream++import Prelude hiding (filter, zipWith, concatMap, concat)++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Sampling+------------------------------------------------------------------------------++-- XXX We can implement this using addition instead of "mod" to make it more+-- efficient.++-- | @strideFromthen offset stride@ takes the element at @offset@ index and+-- then every element at strides of @stride@.+--+-- >>> Stream.fold Fold.toList $ Stream.strideFromThen 2 3 $ Stream.enumerateFromTo 0 10+-- [2,5,8]+--+{-# INLINE strideFromThen #-}+strideFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a+strideFromThen offset stride =+    Stream.with Stream.indexed Stream.filter+        (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0)++------------------------------------------------------------------------------+-- SQL Joins+------------------------------------------------------------------------------+--+-- Some references:+-- * https://en.wikipedia.org/wiki/Relational_algebra+-- * https://en.wikipedia.org/wiki/Join_(SQL)++-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only+-- constraint, the best would be to use an Array with linear search. If the+-- second stream is sorted we can also use a binary search, using Ord+-- constraint or an ordering function.+--+-- For Storables we can cache the second stream into an unboxed array for+-- possibly faster access/compact representation?+--+-- If we do not want to keep the stream in memory but always read it from the+-- source (disk/network) every time we iterate through it then we can do that+-- too by reading the stream every time, the stream must have immutable state+-- in that case and the user is responsible for the behavior if the stream+-- source changes during iterations. We can also use an Unfold instead of+-- stream. We probably need a way to distinguish streams that can be read+-- mutliple times without any interference (e.g. unfolding a stream using an+-- immutable handle would work i.e. using pread/pwrite instead of maintaining+-- an offset in the handle).++-- XXX We can do this concurrently.+-- XXX If the second stream is sorted and passed as an Array we could use+-- binary search if we have an Ord instance or Ordering returning function. The+-- time complexity would then become (m x log n).++-- | Like 'cross' but emits only those tuples where @a == b@ using the+-- supplied equality predicate.+--+-- Definition:+--+-- >>> joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ Stream.cross s1 s2+--+-- You should almost always prefer @joinInnerOrd@ over 'joinInnerGeneric' if+-- possible. @joinInnerOrd@ is an order of magnitude faster but may take more+-- space for caching the second stream.+--+-- See 'Streamly.Internal.Data.Unfold.joinInnerGeneric' for a much faster fused+-- alternative.+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE joinInnerGeneric #-}+joinInnerGeneric :: Monad m =>+    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)+joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ cross s1 s2+{-+joinInnerGeneric eq s1 s2 = do+    -- ConcatMap works faster than bind+    Stream.concatMap (\a ->+        Stream.concatMap (\b ->+            if a `eq` b+            then Stream.fromPure (a, b)+            else Stream.nil+            ) s2+        ) s1+-}++-- | A more efficient 'joinInner' for sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE joinInnerAscBy #-}+joinInnerAscBy ::+    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)+joinInnerAscBy = undefined++-- | A more efficient 'joinLeft' for sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE joinLeftAscBy #-}+joinLeftAscBy :: -- Monad m =>+    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+joinLeftAscBy _eq _s1 _s2 = undefined++-- | A more efficient 'joinOuter' for sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE joinOuterAscBy #-}+joinOuterAscBy :: -- Monad m =>+       (a -> b -> Ordering)+    -> Stream m a+    -> Stream m b+    -> Stream m (Maybe a, Maybe b)+joinOuterAscBy _eq _s1 _s2 = undefined++------------------------------------------------------------------------------+-- Set operations (special joins)+------------------------------------------------------------------------------+--+-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only constraint+-- the best would be to use an Array with linear search. If the second stream+-- is sorted we can also use a binary search, using Ord constraint.++-- | Keep only those elements in the second stream that are present in the+-- first stream too. The first stream is folded to a container using the+-- supplied fold and then the elements in the container are looked up using the+-- supplied lookup function.+--+-- The first stream must be finite and must not block.+{-# INLINE filterStreamWith #-}+filterStreamWith :: Monad m =>+       Fold m a (f a)+    -> (a -> f a -> Bool)+    -> Stream m a+    -> Stream m a+    -> Stream m a+filterStreamWith fld member s1 s2 =+    Stream.concatEffect+        $ do+            xs <- Stream.fold fld s1+            return $ Stream.filter (`member` xs) s2++-- | 'filterInStreamGenericBy' retains only those elements in the second stream that+-- are present in the first stream.+--+-- >>> Stream.fold Fold.toList $ Stream.filterInStreamGenericBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])+-- [2,1,1]+--+-- >>> Stream.fold Fold.toList $ Stream.filterInStreamGenericBy (==) (Stream.fromList [2,1,1,3]) (Stream.fromList [1,2,2,4])+-- [1,2,2]+--+-- Similar to the list intersectBy operation but with the stream argument order+-- flipped.+--+-- The first stream must be finite and must not block. Second stream is+-- processed only after the first stream is fully realized.+--+-- Space: O(n) where @n@ is the number of elements in the second stream.+--+-- Time: O(m x n) where @m@ is the number of elements in the first stream and+-- @n@ is the number of elements in the second stream.+--+-- /Pre-release/+{-# INLINE filterInStreamGenericBy #-}+filterInStreamGenericBy :: Monad m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+filterInStreamGenericBy eq =+    -- XXX Use an (unboxed) array instead.+    filterStreamWith+        (Fold.scanMaybe (Fold.uniqBy eq) Fold.toListRev)+        (List.any . eq)++-- | Like 'filterInStreamGenericBy' but assumes that the input streams are sorted in+-- ascending order. To use it on streams sorted in descending order pass an+-- inverted comparison function returning GT for less than and LT for greater+-- than.+--+-- Space: O(1)+--+-- Time: O(m+n)+--+-- /Pre-release/+{-# INLINE filterInStreamAscBy #-}+filterInStreamAscBy :: Monad m =>+    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+filterInStreamAscBy eq s1 s2 = Stream.intersectBySorted eq s2 s1++-- | Delete all elements of the first stream from the seconds stream. If an+-- element occurs multiple times in the first stream as many occurrences of it+-- are deleted from the second stream.+--+-- >>> Stream.fold Fold.toList $ Stream.deleteInStreamGenericBy (==) (Stream.fromList [1,2,3]) (Stream.fromList [1,2,2])+-- [2]+--+-- The following laws hold:+--+-- > deleteInStreamGenericBy (==) s1 (s1 `append` s2) === s2+-- > deleteInStreamGenericBy (==) s1 (s1 `interleave` s2) === s2+--+-- Same as the list 'Data.List.//' operation but with argument order flipped.+--+-- The first stream must be finite and must not block. Second stream is+-- processed only after the first stream is fully realized.+--+-- Space: O(m) where @m@ is the number of elements in the first stream.+--+-- Time: O(m x n) where @m@ is the number of elements in the first stream and+-- @n@ is the number of elements in the second stream.+--+-- /Pre-release/+{-# INLINE deleteInStreamGenericBy #-}+deleteInStreamGenericBy :: Monad m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+deleteInStreamGenericBy eq s1 s2 =+    Stream.concatEffect+        $ do+            -- This may work well if s1 is small+            -- If s1 is big we can go through s1, deleting elements from s2 and+            -- not emitting an element if it was successfully deleted from s2.+            -- we will need a deleteBy that can return whether the element was+            -- deleted or not.+            xs <- Stream.fold Fold.toList s2+            let f = Fold.foldl' (flip (List.deleteBy eq)) xs+            fmap Stream.fromList $ Stream.fold f s1++-- | A more efficient 'deleteInStreamGenericBy' for streams sorted in ascending order.+--+-- Space: O(1)+--+-- /Unimplemented/+{-# INLINE deleteInStreamAscBy #-}+deleteInStreamAscBy :: -- (Monad m) =>+    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+deleteInStreamAscBy _eq _s1 _s2 = undefined++-- XXX Remove the MonadIO constraint. We can just cache one stream and then+-- implement using differenceEqBy.++-- | This essentially appends to the second stream all the occurrences of+-- elements in the first stream that are not already present in the second+-- stream.+--+-- Equivalent to the following except that @s2@ is evaluated only once:+--+-- >>> unionWithStreamGenericBy eq s1 s2 = s2 `Stream.append` (Stream.deleteInStreamGenericBy eq s2 s1)+--+-- Example:+--+-- >>> Stream.fold Fold.toList $ Stream.unionWithStreamGenericBy (==) (Stream.fromList [1,1,2,3]) (Stream.fromList [1,2,2,4])+-- [1,2,2,4,3]+--+-- Space: O(n)+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE unionWithStreamGenericBy #-}+unionWithStreamGenericBy :: MonadIO m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+unionWithStreamGenericBy eq s1 s2 =+    Stream.concatEffect+        $ do+            xs <- Stream.fold Fold.toList  s1+            -- XXX we can use postscanlMAfter' instead of IORef+            ref <- liftIO $ newIORef $! List.nubBy eq xs+            let f x = do+                    liftIO $ modifyIORef' ref (List.deleteBy eq x)+                    return x+                s3 = Stream.concatEffect+                        $ do+                            xs1 <- liftIO $ readIORef ref+                            return $ Stream.fromList xs1+            return $ Stream.mapM f s2 `Stream.append` s3++-- | A more efficient 'unionWithStreamGenericBy' for sorted streams.+--+-- Space: O(1)+--+-- /Unimplemented/+{-# INLINE unionWithStreamAscBy #-}+unionWithStreamAscBy :: -- (Monad m) =>+    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+unionWithStreamAscBy _eq _s1 _s2 = undefined
src/Streamly/Internal/Data/Stream/Transform.hs view
@@ -1,1056 +1,1945 @@--- |--- Module      : Streamly.Internal.Data.Stream.Transform--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Transform-    (-    -- * Piping-    -- | Pass through a 'Pipe'.-      transform--    -- * Folding-    , foldrS--    -- * Mapping-    -- | Stateless one-to-one maps.-    , sequence-    , mapM--    -- * Mapping Side Effects (Observation)-    -- | See also the intersperse*_ combinators.-    , trace-    , trace_-    , tap--    -- * Scanning-    , scan-    , scanMany-    , postscan-    , smapM-    , scanlMAfter'--    -- * Filtering-    -- | Produce a subset of the stream using criteria based on the values of-    -- the elements. We can use a concatMap and scan for filtering but these-    -- combinators are more efficient and convenient.--    -- mapMaybeM is a general filtering combinator as we can map the stream to-    -- Just/Nothing using any stateful fold and then use this to filter out.-    , mapMaybeM-    , mapMaybe-    , catMaybes-    , scanMaybe--    , with-    , deleteBy-    , filter-    , filterM--    -- Stateful/scanning filters-    , uniq-    , uniqBy-    , prune-    , repeated--    -- * Trimming-    -- | Produce a subset of the stream trimmed at ends.--    , take-    , takeWhile-    , takeWhileM-    , takeWhileLast-    , takeWhileAround-    , drop-    , dropLast-    , dropWhile-    , dropWhileM-    , dropWhileLast-    , dropWhileAround--    -- * Position Indexing-    , indexed-    , indexedR--      -- * Time Indexing-    , timestamped-    , timestampWith-    , timeIndexed-    , timeIndexWith--    -- * Searching-    , findIndices -- XXX indicesBy-    , elemIndices -- XXX indicesOf--    -- * Rolling map-    -- | Map using the previous element.-    , rollingMapM-    , rollingMap-    , rollingMap2--    -- Merge--    -- * Inserting Elements-    -- | Produce a superset of the stream. This is the opposite of-    -- filtering/sampling.  We can always use concatMap and scan for inserting-    -- but these combinators are more efficient and convenient.--    -- Element agnostic (Opposite of sampling)-    , intersperse-    , intersperseM -- XXX naming-    , intersperseMWith--    , intersperseMSuffix-    , intersperseMSuffixWith--    -- , interspersePrefix-    -- , interspersePrefixBySpan--    -- * Inserting Side Effects/Time-    , intersperseM_ -- XXX naming-    , delay-    , intersperseMSuffix_-    , delayPost-    , intersperseMPrefix_-    , delayPre--    -- * Element Aware Insertion-    -- | Opposite of filtering-    , insertBy-    -- , intersperseByBefore-    -- , intersperseByAfter--    -- Fold and Unfold, Buffering--    -- * Reordering-    , reverse-    , reverse'-    , reassembleBy--    -- * Either Streams-    -- Move these to Streamly.Data.Either.Stream?-    , catLefts-    , catRights-    , catEithers-    )-where--#include "inline.hs"--import Control.Concurrent (threadDelay)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Data.Either (fromLeft, isLeft, isRight, fromRight)-import Data.Maybe (isJust, fromJust)--import Streamly.Internal.Data.Fold.Type (Fold)-import Streamly.Internal.Data.Pipe (Pipe)-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64)--import qualified Streamly.Internal.Data.Fold as FL--- import qualified Streamly.Internal.Data.Fold.Window as Window-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as D-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---import Streamly.Internal.Data.Stream.Bottom-import Streamly.Internal.Data.Stream.Type--import Prelude hiding-       ( filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence-       , reverse, foldr1 , repeat, scanl, scanl1, zipWith)------- $setup--- >>> :m--- >>> import Control.Concurrent (threadDelay)--- >>> import Control.Monad (void)--- >>> import Control.Monad.IO.Class (MonadIO (liftIO))--- >>> import Data.Either (fromLeft, fromRight, isLeft, isRight, either)--- >>> import Data.Function ((&))--- >>> import Data.Maybe (fromJust, isJust)--- >>> import Prelude hiding (filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence, reverse, foldr1 , scanl, scanl1)--- >>> import Streamly.Internal.Data.Stream (Stream)--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Fold as Fold (filtering)--- >>> import qualified Streamly.Internal.Data.Fold.Window as Window--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))------ >>> hSetBuffering stdout LineBuffering---- XXX because of the use of D.cons for appending, folds and scans have--- quadratic complexity when iterated over a stream. We should use StreamK for--- linear performance on iteration.----------------------------------------------------------------------------------- Piping----------------------------------------------------------------------------------- | Use a 'Pipe' to transform a stream.------ /Pre-release/----{-# INLINE transform #-}-transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b-transform pipe xs = fromStreamD $ D.transform pipe (toStreamD xs)----------------------------------------------------------------------------------- Transformation Folds----------------------------------------------------------------------------------- | Right fold to a streaming monad.------ > foldrS Stream.cons Stream.nil === id------ 'foldrS' can be used to perform stateless stream to stream transformations--- like map and filter in general. It can be coupled with a scan to perform--- stateful transformations. However, note that the custom map and filter--- routines can be much more efficient than this due to better stream fusion.------ >>> input = Stream.fromList [1..5]--- >>> Stream.fold Fold.toList $ Stream.foldrS Stream.cons Stream.nil input--- [1,2,3,4,5]------ Find if any element in the stream is 'True':------ >>> step x xs = if odd x then Stream.fromPure True else xs--- >>> input = Stream.fromList (2:4:5:undefined) :: Stream IO Int--- >>> Stream.fold Fold.toList $ Stream.foldrS step (Stream.fromPure False) input--- [True]------ Map (+2) on odd elements and filter out the even elements:------ >>> step x xs = if odd x then (x + 2) `Stream.cons` xs else xs--- >>> input = Stream.fromList [1..5] :: Stream IO Int--- >>> Stream.fold Fold.toList $ Stream.foldrS step Stream.nil input--- [3,5,7]------ /Pre-release/-{-# INLINE foldrS #-}-foldrS ::-     (a -> Stream m b -> Stream m b)-  -> Stream m b-  -> Stream m a-  -> Stream m b-foldrS f z xs =-    fromStreamK-        $ K.foldrS-            (\y ys -> toStreamK $ f y (fromStreamK ys))-            (toStreamK z)-            (toStreamK xs)----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- |--- >>> mapM f = Stream.sequence . fmap f------ Apply a monadic function to each element of the stream and replace it with--- the output of the resulting action.------ >>> s = Stream.fromList ["a", "b", "c"]--- >>> Stream.fold Fold.drain $ Stream.mapM putStr s--- abc----{-# INLINE mapM #-}-mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-mapM f m = fromStreamK $ D.toStreamK $ D.mapM f $ toStreamD m---- |--- >>> sequence = Stream.mapM id------ Replace the elements of a stream of monadic actions with the outputs of--- those actions.------ >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"]--- >>> Stream.fold Fold.drain $ Stream.sequence s--- abc----{-# INLINE sequence #-}-sequence :: Monad m => Stream m (m a) -> Stream m a-sequence = mapM id----------------------------------------------------------------------------------- Mapping side effects----------------------------------------------------------------------------------- | Tap the data flowing through a stream into a 'Fold'. For example, you may--- add a tap to log the contents flowing through the stream. The fold is used--- only for effects, its result is discarded.------ @---                   Fold m a b---                       |--- -----stream m a ---------------stream m a----------- @------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s--- 1--- 2------ Compare with 'trace'.----{-# INLINE tap #-}-tap :: Monad m => FL.Fold m a b -> Stream m a -> Stream m a-tap f xs = fromStreamD $ D.tap f (toStreamD xs)---- | Apply a monadic function to each element flowing through the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace print s--- 1--- 2------ Compare with 'tap'.----{-# INLINE trace #-}-trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a-trace f = mapM (\x -> void (f x) >> return x)---- | Perform a side effect before yielding each element of the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s--- "got here"--- "got here"------ Same as 'intersperseMPrefix_' but always serial.------ See also: 'trace'------ /Pre-release/-{-# INLINE trace_ #-}-trace_ :: Monad m => m b -> Stream m a -> Stream m a-trace_ eff = fromStreamD . D.mapM (\x -> eff >> return x) . toStreamD------------------------------------------------------------------------------------ Scanning------------------------------------------------------------------------------------ | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except--- that it provides an additional @done@ function to be applied on the--- accumulator when the stream stops. The result of @done@ is also emitted in--- the stream.------ This function can be used to allocate a resource in the beginning of the--- scan and release it when the stream ends or to flush the internal state of--- the scan at the end.------ /Pre-release/----{-# INLINE scanlMAfter' #-}-scanlMAfter' ::-       Monad m-    => (b -> a -> m b)-    -> m b-    -> (b -> m b)-    -> Stream m a-    -> Stream m b-scanlMAfter' step initial done stream =-    fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream----------------------------------------------------------------------------------- Scanning with a Fold----------------------------------------------------------------------------------- XXX It may be useful to have a version of scan where we can keep the--- accumulator independent of the value emitted. So that we do not necessarily--- have to keep a value in the accumulator which we are not using. We can pass--- an extraction function that will take the accumulator and the current value--- of the element and emit the next value in the stream. That will also make it--- possible to modify the accumulator after using it. In fact, the step function--- can return new accumulator and the value to be emitted. The signature would--- be more like mapAccumL.---- | Strict left scan. Scan a stream using the given monadic fold.------ >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s--- [0,1,3,6]------ See also: 'usingStateT'------- EXPLANATION:--- >>> scanl' step z = Stream.scan (Fold.foldl' step z)------ Like 'map', 'scanl'' too is a one to one transformation,--- however it adds an extra element.------ >>> s = Stream.fromList [1,2,3,4]--- >>> Stream.fold Fold.toList $ scanl' (+) 0 s--- [0,1,3,6,10]------ >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s--- [[],[1],[2,1],[3,2,1],[4,3,2,1]]------ The output of 'scanl'' is the initial value of the accumulator followed by--- all the intermediate steps and the final result of 'foldl''.------ By streaming the accumulated state after each fold step, we can share the--- state across multiple stages of stream composition. Each stage can modify or--- extend the state, do some processing with it and emit it for the next stage,--- thus modularizing the stream processing. This can be useful in--- stateful or event-driven programming.------ Consider the following monolithic example, computing the sum and the product--- of the elements in a stream in one go using a @foldl'@:------ >>> foldl' step z = Stream.fold (Fold.foldl' step z)--- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s--- (10,24)------ Using @scanl'@ we can make it modular by computing the sum in the first--- stage and passing it down to the next stage for computing the product:------ >>> :{---   foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)---   $ scanl' (\(s, _) x -> (s + x, x)) (0,1)---   $ Stream.fromList [1,2,3,4]--- :}--- (10,24)------ IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building--- lazy expressions inside the accumulator, it is recommended that a strict--- data structure is used for accumulator.----{-# INLINE scan #-}-scan :: Monad m => Fold m a b -> Stream m a -> Stream m b-scan fld m = fromStreamD $ D.scan fld $ toStreamD m---- | Like 'scan' but restarts scanning afresh when the scanning fold--- terminates.----{-# INLINE scanMany #-}-scanMany :: Monad m => Fold m a b -> Stream m a -> Stream m b-scanMany fld m = fromStreamD $ D.scanMany fld $ toStreamD m----------------------------------------------------------------------------------- Filtering----------------------------------------------------------------------------------- | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a--- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a--- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with--- index or time.------ >>> filterWithIndex = Stream.with Stream.indexed Stream.filter------ /Pre-release/-{-# INLINE with #-}-with :: Monad m =>-       (Stream m a -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m a -> Stream m a)-with f comb g = fmap snd . comb g . f---- | Include only those elements that pass a predicate.------ >>> filter p = Stream.filterM (return . p)--- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing)--- >>> filter p = Stream.scanMaybe (Fold.filtering p)----{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- filter p = scanMaybe (FL.filtering p)-filter p m = fromStreamD $ D.filter p $ toStreamD m---- | Same as 'filter' but with a monadic predicate.------ >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing--- >>> filterM p = Stream.mapMaybeM (f p)----{-# INLINE filterM #-}-filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-filterM p m = fromStreamD $ D.filterM p $ toStreamD m---- | Drop repeated elements that are adjacent to each other using the supplied--- comparison function.------ >>> uniq = Stream.uniqBy (==)------ To strip duplicate path separators:------ >>> input = Stream.fromList "//a//b"--- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.uniqBy f input--- "/a/b"------ Space: @O(1)@------ /Pre-release/----{-# INLINE uniqBy #-}-uniqBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a--- uniqBy eq = scanMaybe (FL.uniqBy eq)-uniqBy eq = catMaybes . rollingMap f--    where--    f pre curr =-        case pre of-            Nothing -> Just curr-            Just x -> if x `eq` curr then Nothing else Just curr---- | Drop repeated elements that are adjacent to each other.------ >>> uniq = Stream.uniqBy (==)----{-# INLINE uniq #-}-uniq :: (Eq a, Monad m) => Stream m a -> Stream m a--- uniq = scanMaybe FL.uniq-uniq = fromStreamD . D.uniq . toStreamD---- | Strip all leading and trailing occurrences of an element passing a--- predicate and make all other consecutive occurrences uniq.------ >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)------ @--- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")--- "hello world!"------ @------ Space: @O(1)@------ /Unimplemented/-{-# INLINE prune #-}-prune ::-    -- (Monad m, Eq a) =>-    (a -> Bool) -> Stream m a -> Stream m a-prune = error "Not implemented yet!"---- Possible implementation:--- @repeated =---      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@------ 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a--- single element.---- | Emit only repeated elements, once.------ /Unimplemented/-repeated :: -- (Monad m, Eq a) =>-    Stream m a -> Stream m a-repeated = undefined---- | Deletes the first occurrence of the element in the stream that satisfies--- the given equality predicate.------ >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input--- [1,3,5]----{-# INLINE deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a--- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x)-deleteBy cmp x m = fromStreamD $ D.deleteBy cmp x (toStreamD m)----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Same as 'takeWhile' but with a monadic predicate.----{-# INLINE takeWhileM #-}-takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x))-takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m---- | Take all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements taken.------ /Unimplemented/-{-# INLINE takeWhileLast #-}-takeWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m---- | Like 'takeWhile' and 'takeWhileLast' combined.------ O(n) space, where n is the number elements taken from the end.------ /Unimplemented/-{-# INLINE takeWhileAround #-}-takeWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m---- | Drop elements in the stream as long as the predicate succeeds and then--- take the rest of the stream.----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- dropWhile p = scanMaybe (FL.droppingWhile p)-dropWhile p m = fromStreamD $ D.dropWhile p $ toStreamD m---- | Same as 'dropWhile' but with a monadic predicate.----{-# INLINE dropWhileM #-}-dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- dropWhileM p = scanMaybe (FL.droppingWhileM p)-dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m---- | Drop @n@ elements at the end of the stream.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropLast #-}-dropLast :: -- Monad m =>-    Int -> Stream m a -> Stream m a-dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m---- | Drop all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropWhileLast #-}-dropWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m---- | Like 'dropWhile' and 'dropWhileLast' combined.------ O(n) space, where n is the number elements dropped from the end.------ /Unimplemented/-{-# INLINE dropWhileAround #-}-dropWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m----------------------------------------------------------------------------------- Inserting Elements----------------------------------------------------------------------------------- | @insertBy cmp elem stream@ inserts @elem@ before the first element in--- @stream@ that is less than @elem@ when compared using @cmp@.------ >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x)------ >>> input = Stream.fromList [1,3,5]--- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input--- [1,2,3,5]----{-# INLINE insertBy #-}-insertBy ::Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a-insertBy cmp x m = fromStreamD $ D.insertBy cmp x (toStreamD m)---- | Insert a pure value between successive elements of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input--- "h,e,l,l,o"----{-# INLINE intersperse #-}-intersperse :: Monad m => a -> Stream m a -> Stream m a-intersperse a = fromStreamD . D.intersperse a . toStreamD---- | Insert a side effect before consuming an element of a stream except the--- first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input--- h.e.l.l.o------ /Pre-release/-{-# INLINE intersperseM_ #-}-intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseM_ m = fromStreamD . D.intersperseM_ m . toStreamD---- | Intersperse a monadic action into the input stream after every @n@--- elements.------ >> input = Stream.fromList "hello"--- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input--- "he,ll,o"------ /Unimplemented/-{-# INLINE intersperseMWith #-}-intersperseMWith :: -- Monad m =>-    Int -> m a -> Stream m a -> Stream m a-intersperseMWith _n _f _xs = undefined---- | Insert an effect and its output after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMSuffix (putChar '.' >> return ',') input--- h.,e.,l.,l.,o.,"h,e,l,l,o,"------ /Pre-release/-{-# INLINE intersperseMSuffix #-}-intersperseMSuffix :: Monad m => m a -> Stream m a -> Stream m a-intersperseMSuffix m = fromStreamD . D.intersperseMSuffix m . toStreamD---- | Insert a side effect after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input--- "hello"------ /Pre-release/----{-# INLINE intersperseMSuffix_ #-}-intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMSuffix_ m = fromStreamD . D.intersperseMSuffix_ m . toStreamD---- XXX Use an offset argument, like tapOffsetEvery---- | Like 'intersperseMSuffix' but intersperses an effectful action into the--- input stream after every @n@ elements and after the last element.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input--- "he,ll,o,"------ /Pre-release/----{-# INLINE intersperseMSuffixWith #-}-intersperseMSuffixWith :: Monad m-    => Int -> m a -> Stream m a -> Stream m a-intersperseMSuffixWith n eff =-    fromStreamD . D.intersperseMSuffixWith n eff . toStreamD---- | Insert a side effect before consuming an element of a stream.------ Definition:------ >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x)------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') input--- .h.e.l.l.o"hello"------ Same as 'trace_'.------ /Pre-release/----{-# INLINE intersperseMPrefix_ #-}-intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMPrefix_ m = mapM (\x -> void m >> return x)----------------------------------------------------------------------------------- Inserting Time----------------------------------------------------------------------------------- XXX This should be in Prelude, should we export this as a helper function?---- | Block the current thread for specified number of seconds.-{-# INLINE sleep #-}-sleep :: MonadIO m => Double -> m ()-sleep n = liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds between elements of the stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delay = Stream.intersperseM_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input--- 1--- 2--- 3----{-# INLINE delay #-}-delay :: MonadIO m => Double -> Stream m a -> Stream m a-delay = intersperseM_ . sleep---- | Introduce a delay of specified seconds after consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPost = Stream.intersperseMSuffix_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPost #-}-delayPost :: MonadIO m => Double -> Stream m a -> Stream m a-delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds before consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPre = Stream.intersperseMPrefix_. sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPre #-}-delayPre :: MonadIO m => Double -> Stream m a -> Stream m a-delayPre = intersperseMPrefix_. sleep----------------------------------------------------------------------------------- Reorder in sequence----------------------------------------------------------------------------------- | Buffer until the next element in sequence arrives. The function argument--- determines the difference in sequence numbers. This could be useful in--- implementing sequenced streams, for example, TCP reassembly.------ /Unimplemented/----{-# INLINE reassembleBy #-}-reassembleBy-    :: -- Monad m =>-       Fold m a b-    -> (a -> a -> Int)-    -> Stream m a-    -> Stream m b-reassembleBy = undefined----------------------------------------------------------------------------------- Position Indexing----------------------------------------------------------------------------------- |--- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined)--- >>> indexed = Stream.postscan f--- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0)--- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed------ Pair each element in a stream with its index, starting from index 0.------ >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello"--- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]----{-# INLINE indexed #-}-indexed :: Monad m => Stream m a -> Stream m (Int, a)--- indexed = scanMaybe FL.indexing-indexed = fromStreamD . D.indexed . toStreamD---- |--- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)--- >>> indexedR n = Stream.postscan (f n)------ >>> s n = Stream.enumerateFromThen n (n - 1)--- >>> indexedR n = Stream.zipWith (,) (s n)------ Pair each element in a stream with its index, starting from the--- given index @n@ and counting down.------ >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello"--- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]----{-# INLINE indexedR #-}-indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)--- indexedR n = scanMaybe (FL.indexingRev n)-indexedR n = fromStreamD . D.indexedR n . toStreamD------------------------------------------------------------------------------------ Time Indexing------------------------------------------------------------------------------------ Note: The timestamp stream must be the second stream in the zip so that the--- timestamp is generated after generating the stream element and not before.--- If we do not do that then the following example will generate the same--- timestamp for first two elements:------ Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3------ | Pair each element in a stream with an absolute timestamp, using a clock of--- specified granularity.  The timestamp is generated just before the element--- is consumed.------ >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)]------ /Pre-release/----{-# INLINE timestampWith #-}-timestampWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (AbsTime, a)-timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)---- TBD: check performance vs a custom implementation without using zipWith.------ /Pre-release/----{-# INLINE timestamped #-}-timestamped :: (MonadIO m)-    => Stream m a -> Stream m (AbsTime, a)-timestamped = timestampWith 0.01---- | Pair each element in a stream with relative times starting from 0, using a--- clock with the specified granularity. The time is measured just before the--- element is consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/Monad----{-# INLINE timeIndexWith #-}-timeIndexWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (RelTime64, a)-timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)---- | Pair each element in a stream with relative times starting from 0, using a--- 10 ms granularity clock. The time is measured just before the element is--- consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/----{-# INLINE timeIndexed #-}-timeIndexed :: (MonadIO m)-    => Stream m a -> Stream m (RelTime64, a)-timeIndexed = timeIndexWith 0.01----------------------------------------------------------------------------------- Searching----------------------------------------------------------------------------------- | Find all the indices where the value of the element in the stream is equal--- to the given value.------ >>> elemIndices a = Stream.findIndices (== a)----{-# INLINE elemIndices #-}-elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int-elemIndices a = findIndices (== a)----------------------------------------------------------------------------------- Rolling map----------------------------------------------------------------------------------- XXX this is not a one-to-one map so calling it map may not be right.--- We can perhaps call it zipWithTail or rollWith.---- | Apply a function on every two successive elements of a stream. The first--- argument of the map function is the previous element and the second argument--- is the current element. When the current element is the first element, the--- previous element is 'Nothing'.------ /Pre-release/----{-# INLINE rollingMap #-}-rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b--- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f)-rollingMap f m = fromStreamD $ D.rollingMap f $ toStreamD m---- | Like 'rollingMap' but with an effectful map function.------ /Pre-release/----{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b--- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f)-rollingMapM f m = fromStreamD $ D.rollingMapM f $ toStreamD m---- | Like 'rollingMap' but requires at least two elements in the stream,--- returns an empty stream otherwise.------ This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.------ /Pre-release/----{-# INLINE rollingMap2 #-}-rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b-rollingMap2 f m = fromStreamD $ D.rollingMap2 f $ toStreamD m----------------------------------------------------------------------------------- Maybe Streams----------------------------------------------------------------------------------- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'--- elements, and return a stream of values extracted from 'Just'.------ Equivalent to:------ >>> mapMaybe f = Stream.catMaybes . fmap f----{-# INLINE mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b-mapMaybe f m = fromStreamD $ D.mapMaybe f $ toStreamD m---- | Like 'mapMaybe' but maps a monadic function.------ Equivalent to:------ >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f------ >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x)----{-# INLINE_EARLY mapMaybeM #-}-mapMaybeM :: Monad m-          => (a -> m (Maybe b)) -> Stream m a -> Stream m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.------ >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft------ /Pre-release/----{-# INLINE catLefts #-}-catLefts :: Monad m => Stream m (Either a b) -> Stream m a-catLefts = fmap (fromLeft undefined) . filter isLeft---- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.------ >>> catRights = fmap (fromRight undefined) . Stream.filter isRight------ /Pre-release/----{-# INLINE catRights #-}-catRights :: Monad m => Stream m (Either a b) -> Stream m b-catRights = fmap (fromRight undefined) . filter isRight---- | Remove the either wrapper and flatten both lefts and as well as rights in--- the output stream.------ >>> catEithers = fmap (either id id)------ /Pre-release/----{-# INLINE catEithers #-}-catEithers :: Monad m => Stream m (Either a a) -> Stream m a-catEithers = fmap (either id id)+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Transform+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- "Streamly.Internal.Data.Pipe" might ultimately replace this module.++-- A few functions in this module have been adapted from the vector package+-- (c) Roman Leshchinskiy. See the notes in specific combinators.++module Streamly.Internal.Data.Stream.Transform+    (+    -- * Piping+    -- | Pass through a 'Pipe'.+      transform++    -- * Mapping+    -- | Stateless one-to-one maps.+    , map+    , mapM+    , sequence++    -- * Mapping Effects+    , tap+    , tapOffsetEvery+    , trace+    , trace_++    -- * Folding+    , foldrS+    , foldlS++    -- * Scanning By 'Fold'+    , postscan+    , scan+    , scanMany++    -- * Splitting+    , splitOn++    -- * Scanning+    -- | Left scans. Stateful, mostly one-to-one maps.+    , scanlM'+    , scanlMAfter'+    , scanl'+    , scanlM+    , scanl+    , scanl1M'+    , scanl1'+    , scanl1M+    , scanl1++    , prescanl'+    , prescanlM'++    , postscanl+    , postscanlM+    , postscanl'+    , postscanlM'+    , postscanlMAfter'++    , postscanlx'+    , postscanlMx'+    , scanlMx'+    , scanlx'++    -- * Filtering+    -- | Produce a subset of the stream.+    , with+    , scanMaybe+    , filter+    , filterM+    , deleteBy+    , uniqBy+    , uniq+    , prune+    , repeated++    -- * Trimming+    -- | Produce a subset of the stream trimmed at ends.+    , take+    , takeWhile+    , takeWhileM+    , takeWhileLast+    , takeWhileAround+    , drop+    , dropWhile+    , dropWhileM+    , dropLast+    , dropWhileLast+    , dropWhileAround++    -- * Inserting Elements+    -- | Produce a superset of the stream.+    , insertBy+    , intersperse+    , intersperseM+    , intersperseMWith+    , intersperseMSuffix+    , intersperseMSuffixWith++    -- * Inserting Side Effects+    , intersperseM_+    , intersperseMSuffix_+    , intersperseMPrefix_++    , delay+    , delayPre+    , delayPost++    -- * Reordering+    -- | Produce strictly the same set but reordered.+    , reverse+    , reverseUnbox+    , reassembleBy++    -- * Position Indexing+    , indexed+    , indexedR++    -- * Time Indexing+    , timestampWith+    , timestamped+    , timeIndexWith+    , timeIndexed++    -- * Searching+    , findIndices+    , elemIndices+    , slicesBy++    -- * Rolling map+    -- | Map using the previous element.+    , rollingMap+    , rollingMapM+    , rollingMap2++    -- * Maybe Streams+    , mapMaybe+    , mapMaybeM+    , catMaybes++    -- * Either Streams+    , catLefts+    , catRights+    , catEithers+    )+where++#include "inline.hs"++import Control.Concurrent (threadDelay)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Either (fromLeft, isLeft, isRight, fromRight)+import Data.Functor ((<&>))+import Data.Maybe (fromJust, isJust)+import Fusion.Plugin.Types (Fuse(..))++import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Pipe.Type (Pipe(..), PipeState(..))+import Streamly.Internal.Data.SVar.Type (adaptState)+import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64)+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.System.IO (defaultChunkSize)++-- import qualified Data.List as List+import qualified Streamly.Internal.Data.Array.Type as A+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Pipe.Type as Pipe+import qualified Streamly.Internal.Data.StreamK.Type as K++import Prelude hiding+       ( drop, dropWhile, filter, map, mapM, reverse+       , scanl, scanl1, sequence, take, takeWhile, zipWith)++import Streamly.Internal.Data.Stream.Generate+    (absTimesWith, relTimesWith)+import Streamly.Internal.Data.Stream.Type++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Piping+------------------------------------------------------------------------------++-- | Use a 'Pipe' to transform a stream.+--+-- /Pre-release/+--+{-# INLINE_NORMAL transform #-}+transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b+transform (Pipe pstep1 pstep2 pstate) (Stream step state) =+    Stream step' (Consume pstate, state)++  where++    {-# INLINE_LATE step' #-}++    step' gst (Consume pst, st) = pst `seq` do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                res <- pstep1 pst x+                case res of+                    Pipe.Yield b pst' -> return $ Yield b (pst', s)+                    Pipe.Continue pst' -> return $ Skip (pst', s)+            Skip s -> return $ Skip (Consume pst, s)+            Stop   -> return Stop++    step' _ (Produce pst, st) = pst `seq` do+        res <- pstep2 pst+        case res of+            Pipe.Yield b pst' -> return $ Yield b (pst', st)+            Pipe.Continue pst' -> return $ Skip (pst', st)++------------------------------------------------------------------------------+-- Transformation Folds+------------------------------------------------------------------------------++-- Note, this is going to have horrible performance, because of the nature of+-- the stream type (i.e. direct stream vs CPS). Its only for reference, it is+-- likely be practically unusable.+{-# INLINE_NORMAL foldlS #-}+foldlS :: Monad m+    => (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b+foldlS fstep begin (Stream step state) = Stream step' (Left (state, begin))+  where+    step' gst (Left (st, acc)) = do+        r <- step (adaptState gst) st+        return $ case r of+            Yield x s -> Skip (Left (s, fstep acc x))+            Skip s -> Skip (Left (s, acc))+            Stop   -> Skip (Right acc)++    step' gst (Right (Stream stp stt)) = do+        r <- stp (adaptState gst) stt+        return $ case r of+            Yield x s -> Yield x (Right (Stream stp s))+            Skip s -> Skip (Right (Stream stp s))+            Stop   -> Stop++------------------------------------------------------------------------------+-- Transformation by Mapping+------------------------------------------------------------------------------++-- |+-- >>> sequence = Stream.mapM id+--+-- Replace the elements of a stream of monadic actions with the outputs of+-- those actions.+--+-- >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"]+-- >>> Stream.fold Fold.drain $ Stream.sequence s+-- abc+--+{-# INLINE_NORMAL sequence #-}+sequence :: Monad m => Stream m (m a) -> Stream m a+sequence (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+         r <- step (adaptState gst) st+         case r of+             Yield x s -> x >>= \a -> return (Yield a s)+             Skip s    -> return $ Skip s+             Stop      -> return Stop++------------------------------------------------------------------------------+-- Mapping side effects+------------------------------------------------------------------------------++data TapState fs st a+    = TapInit | Tapping !fs st | TapDone st++-- XXX Multiple yield points++-- | Tap the data flowing through a stream into a 'Fold'. For example, you may+-- add a tap to log the contents flowing through the stream. The fold is used+-- only for effects, its result is discarded.+--+-- @+--                   Fold m a b+--                       |+-- -----stream m a ---------------stream m a-----+--+-- @+--+-- >>> s = Stream.enumerateFromTo 1 2+-- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s+-- 1+-- 2+--+-- Compare with 'trace'.+--+{-# INLINE tap #-}+tap :: Monad m => Fold m a b -> Stream m a -> Stream m a+tap (Fold fstep initial _ final) (Stream step state) = Stream step' TapInit++    where++    step' _ TapInit = do+        res <- initial+        return+            $ Skip+            $ case res of+                  FL.Partial s -> Tapping s state+                  FL.Done _ -> TapDone state+    step' gst (Tapping acc st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                res <- fstep acc x+                return+                    $ Yield x+                    $ case res of+                          FL.Partial fs -> Tapping fs s+                          FL.Done _ -> TapDone s+            Skip s -> return $ Skip (Tapping acc s)+            Stop -> do+                void $ final acc+                return Stop+    step' gst (TapDone st) = do+        r <- step gst st+        return+            $ case r of+                  Yield x s -> Yield x (TapDone s)+                  Skip s -> Skip (TapDone s)+                  Stop -> Stop++data TapOffState fs s a+    = TapOffInit+    | TapOffTapping !fs s Int+    | TapOffDone s++-- XXX Multiple yield points+{-# INLINE_NORMAL tapOffsetEvery #-}+tapOffsetEvery :: Monad m+    => Int -> Int -> Fold m a b -> Stream m a -> Stream m a+tapOffsetEvery offset n (Fold fstep initial _ final) (Stream step state) =+    Stream step' TapOffInit++    where++    {-# INLINE_LATE step' #-}+    step' _ TapOffInit = do+        res <- initial+        return+            $ Skip+            $ case res of+                  FL.Partial s -> TapOffTapping s state (offset `mod` n)+                  FL.Done _ -> TapOffDone state+    step' gst (TapOffTapping acc st count) = do+        r <- step gst st+        case r of+            Yield x s -> do+                next <-+                    if count <= 0+                    then do+                        res <- fstep acc x+                        return+                            $ case res of+                                  FL.Partial sres ->+                                    TapOffTapping sres s (n - 1)+                                  FL.Done _ -> TapOffDone s+                    else return $ TapOffTapping acc s (count - 1)+                return $ Yield x next+            Skip s -> return $ Skip (TapOffTapping acc s count)+            Stop -> do+                void $ final acc+                return Stop+    step' gst (TapOffDone st) = do+        r <- step gst st+        return+            $ case r of+                  Yield x s -> Yield x (TapOffDone s)+                  Skip s -> Skip (TapOffDone s)+                  Stop -> Stop++-- | Apply a monadic function to each element flowing through the stream and+-- discard the results.+--+-- >>> s = Stream.enumerateFromTo 1 2+-- >>> Stream.fold Fold.drain $ Stream.trace print s+-- 1+-- 2+--+-- Compare with 'tap'.+--+{-# INLINE trace #-}+trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a+trace f = mapM (\x -> void (f x) >> return x)++-- | Perform a side effect before yielding each element of the stream and+-- discard the results.+--+-- >>> s = Stream.enumerateFromTo 1 2+-- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s+-- "got here"+-- "got here"+--+-- Same as 'intersperseMPrefix_' but always serial.+--+-- See also: 'trace'+--+-- /Pre-release/+{-# INLINE trace_ #-}+trace_ :: Monad m => m b -> Stream m a -> Stream m a+trace_ eff = mapM (\x -> eff >> return x)++------------------------------------------------------------------------------+-- Scanning with a Fold+------------------------------------------------------------------------------++data ScanState s f = ScanInit s | ScanDo s !f | ScanDone++-- | Postscan a stream using the given monadic fold.+--+-- The following example extracts the input stream up to a point where the+-- running average of elements is no more than 10:+--+-- >>> import Data.Maybe (fromJust)+-- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)+-- >>> s = Stream.enumerateFromTo 1.0 100.0+-- >>> :{+--  Stream.fold Fold.toList+--   $ fmap (fromJust . fst)+--   $ Stream.takeWhile (\(_,x) -> x <= 10)+--   $ Stream.postscan (Fold.tee Fold.latest avg) s+-- :}+-- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0]+--+{-# INLINE_NORMAL postscan #-}+postscan :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b+postscan (FL.Fold fstep initial extract final) (Stream sstep state) =+    Stream step (ScanInit state)++    where++    {-# INLINE_LATE step #-}+    step _ (ScanInit st) = do+        res <- initial+        return+            $ case res of+                  FL.Partial fs -> Skip $ ScanDo st fs+                  FL.Done b -> Yield b ScanDone+    step gst (ScanDo st fs) = do+        res <- sstep (adaptState gst) st+        case res of+            Yield x s -> do+                r <- fstep fs x+                case r of+                    FL.Partial fs1 -> do+                        !b <- extract fs1+                        return $ Yield b $ ScanDo s fs1+                    FL.Done b -> return $ Yield b ScanDone+            Skip s -> return $ Skip $ ScanDo s fs+            Stop -> final fs >> return Stop+    step _ ScanDone = return Stop++{-# INLINE scanWith #-}+scanWith :: Monad m+    => Bool -> Fold m a b -> Stream m a -> Stream m b+scanWith restart (Fold fstep initial extract final) (Stream sstep state) =+    Stream step (ScanInit state)++    where++    {-# INLINE runStep #-}+    runStep st action = do+        res <- action+        case res of+            FL.Partial fs -> do+                !b <- extract fs+                return $ Yield b $ ScanDo st fs+            FL.Done b ->+                let next = if restart then ScanInit st else ScanDone+                 in return $ Yield b next++    {-# INLINE_LATE step #-}+    step _ (ScanInit st) = runStep st initial+    step gst (ScanDo st fs) = do+        res <- sstep (adaptState gst) st+        case res of+            Yield x s -> runStep s (fstep fs x)+            Skip s -> return $ Skip $ ScanDo s fs+            Stop -> final fs >> return Stop+    step _ ScanDone = return Stop++-- XXX It may be useful to have a version of scan where we can keep the+-- accumulator independent of the value emitted. So that we do not necessarily+-- have to keep a value in the accumulator which we are not using. We can pass+-- an extraction function that will take the accumulator and the current value+-- of the element and emit the next value in the stream. That will also make it+-- possible to modify the accumulator after using it. In fact, the step function+-- can return new accumulator and the value to be emitted. The signature would+-- be more like mapAccumL.++-- | Strict left scan. Scan a stream using the given monadic fold.+--+-- >>> s = Stream.fromList [1..10]+-- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s+-- [0,1,3,6]+--+-- See also: 'usingStateT'+--++-- EXPLANATION:+-- >>> scanl' step z = Stream.scan (Fold.foldl' step z)+--+-- Like 'map', 'scanl'' too is a one to one transformation,+-- however it adds an extra element.+--+-- >>> s = Stream.fromList [1,2,3,4]+-- >>> Stream.fold Fold.toList $ scanl' (+) 0 s+-- [0,1,3,6,10]+--+-- >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]+--+-- The output of 'scanl'' is the initial value of the accumulator followed by+-- all the intermediate steps and the final result of 'foldl''.+--+-- By streaming the accumulated state after each fold step, we can share the+-- state across multiple stages of stream composition. Each stage can modify or+-- extend the state, do some processing with it and emit it for the next stage,+-- thus modularizing the stream processing. This can be useful in+-- stateful or event-driven programming.+--+-- Consider the following monolithic example, computing the sum and the product+-- of the elements in a stream in one go using a @foldl'@:+--+-- >>> foldl' step z = Stream.fold (Fold.foldl' step z)+-- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s+-- (10,24)+--+-- Using @scanl'@ we can make it modular by computing the sum in the first+-- stage and passing it down to the next stage for computing the product:+--+-- >>> :{+--   foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)+--   $ scanl' (\(s, _) x -> (s + x, x)) (0,1)+--   $ Stream.fromList [1,2,3,4]+-- :}+-- (10,24)+--+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building+-- lazy expressions inside the accumulator, it is recommended that a strict+-- data structure is used for accumulator.+--+{-# INLINE_NORMAL scan #-}+scan :: Monad m+    => FL.Fold m a b -> Stream m a -> Stream m b+scan = scanWith False++-- | Like 'scan' but restarts scanning afresh when the scanning fold+-- terminates.+--+{-# INLINE_NORMAL scanMany #-}+scanMany :: Monad m+    => FL.Fold m a b -> Stream m a -> Stream m b+scanMany = scanWith True++------------------------------------------------------------------------------+-- Scanning - Prescans+------------------------------------------------------------------------------++-- Adapted from the vector package.+--+-- XXX Is a prescan useful, discarding the last step does not sound useful?  I+-- am not sure about the utility of this function, so this is implemented but+-- not exposed. We can expose it if someone provides good reasons why this is+-- useful.+--+-- XXX We have to execute the stream one step ahead to know that we are at the+-- last step.  The vector implementation of prescan executes the last fold step+-- but does not yield the result. This means we have executed the effect but+-- discarded value. This does not sound right. In this implementation we are+-- not executing the last fold step.+{-# INLINE_NORMAL prescanlM' #-}+prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+prescanlM' f mz (Stream step state) = Stream step' (state, mz)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, prev) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                acc <- prev+                return $ Yield acc (s, f acc x)+            Skip s -> return $ Skip (s, prev)+            Stop   -> return Stop++{-# INLINE prescanl' #-}+prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)++------------------------------------------------------------------------------+-- Monolithic postscans (postscan followed by a map)+------------------------------------------------------------------------------++-- The performance of a modular postscan followed by a map seems to be+-- equivalent to this monolithic scan followed by map therefore we may not need+-- this implementation. We just have it for performance comparison and in case+-- modular version does not perform well in some situation.+--+{-# INLINE_NORMAL postscanlMx' #-}+postscanlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+postscanlMx' fstep begin done (Stream step state) = do+    Stream step' (state, begin)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, acc) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                old <- acc+                y <- fstep old x+                v <- done y+                v `seq` y `seq` return (Yield v (s, return y))+            Skip s -> return $ Skip (s, acc)+            Stop   -> return Stop++{-# INLINE_NORMAL postscanlx' #-}+postscanlx' :: Monad m+    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+postscanlx' fstep begin done =+    postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)++-- XXX do we need consM strict to evaluate the begin value?+{-# INLINE scanlMx' #-}+scanlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+scanlMx' fstep begin done s =+    (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s++{-# INLINE scanlx' #-}+scanlx' :: Monad m+    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+scanlx' fstep begin done =+    scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)++------------------------------------------------------------------------------+-- postscans+------------------------------------------------------------------------------++-- Adapted from the vector package.+{-# INLINE_NORMAL postscanlM' #-}+postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+postscanlM' fstep begin (Stream step state) =+    Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        !x <- begin+        return $ Skip (Just (state, x))++    step' gst (Just (st, acc)) =  do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                !y <- fstep acc x+                return $ Yield y (Just (s, y))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++{-# INLINE_NORMAL postscanl' #-}+postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)++{-# ANN type PScanAfterState Fuse #-}+data PScanAfterState m st acc =+      PScanAfterStep st (m acc)+    | PScanAfterYield acc (PScanAfterState m st acc)+    | PScanAfterStop++-- We can possibly have the "done" function as a Maybe to provide an option to+-- emit or not emit the accumulator when the stream stops.+--+-- TBD: use a single Yield point+--+{-# INLINE_NORMAL postscanlMAfter' #-}+postscanlMAfter' :: Monad m+    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+postscanlMAfter' fstep initial done (Stream step1 state1) = do+    Stream step (PScanAfterStep state1 initial)++    where++    {-# INLINE_LATE step #-}+    step gst (PScanAfterStep st acc) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield x s -> do+                !old <- acc+                !y <- fstep old x+                return (Skip $ PScanAfterYield y (PScanAfterStep s (return y)))+            Skip s -> return $ Skip $ PScanAfterStep s acc+            -- Strictness is important for fusion+            Stop -> do+                !v <- acc+                !res <- done v+                return (Skip $ PScanAfterYield res PScanAfterStop)+    step _ (PScanAfterYield acc next) = return $ Yield acc next+    step _ PScanAfterStop = return Stop++{-# INLINE_NORMAL postscanlM #-}+postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+postscanlM fstep begin (Stream step state) = Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        r <- begin+        return $ Skip (Just (state, r))++    step' gst (Just (st, acc)) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                y <- fstep acc x+                return (Yield y (Just (s, y)))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++{-# INLINE_NORMAL postscanl #-}+postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+postscanl f seed = postscanlM (\a b -> return (f a b)) (return seed)++-- | Like 'scanl'' but with a monadic step function and a monadic seed.+--+{-# INLINE_NORMAL scanlM' #-}+scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+scanlM' fstep begin (Stream step state) = Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        !x <- begin+        return $ Yield x (Just (state, x))+    step' gst (Just (st, acc)) =  do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                !y <- fstep acc x+                return $ Yield y (Just (s, y))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except+-- that it provides an additional @done@ function to be applied on the+-- accumulator when the stream stops. The result of @done@ is also emitted in+-- the stream.+--+-- This function can be used to allocate a resource in the beginning of the+-- scan and release it when the stream ends or to flush the internal state of+-- the scan at the end.+--+-- /Pre-release/+--+{-# INLINE scanlMAfter' #-}+scanlMAfter' :: Monad m+    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+scanlMAfter' fstep initial done s =+    initial `consM` postscanlMAfter' fstep initial done s++-- >>> scanl' f z xs = z `Stream.cons` postscanl' f z xs++-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,+-- however it adds an extra element.+--+-- >>> Stream.toList $ Stream.scanl' (+) 0 $ Stream.fromList [1,2,3,4]+-- [0,1,3,6,10]+--+-- >>> Stream.toList $ Stream.scanl' (flip (:)) [] $ Stream.fromList [1,2,3,4]+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]+--+-- The output of 'scanl'' is the initial value of the accumulator followed by+-- all the intermediate steps and the final result of 'foldl''.+--+-- By streaming the accumulated state after each fold step, we can share the+-- state across multiple stages of stream composition. Each stage can modify or+-- extend the state, do some processing with it and emit it for the next stage,+-- thus modularizing the stream processing. This can be useful in+-- stateful or event-driven programming.+--+-- Consider the following monolithic example, computing the sum and the product+-- of the elements in a stream in one go using a @foldl'@:+--+-- >>> Stream.fold (Fold.foldl' (\(s, p) x -> (s + x, p * x)) (0,1)) $ Stream.fromList [1,2,3,4]+-- (10,24)+--+-- Using @scanl'@ we can make it modular by computing the sum in the first+-- stage and passing it down to the next stage for computing the product:+--+-- >>> :{+--   Stream.fold (Fold.foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1))+--   $ Stream.scanl' (\(s, _) x -> (s + x, x)) (0,1)+--   $ Stream.fromList [1,2,3,4]+-- :}+-- (10,24)+--+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building+-- lazy expressions inside the accumulator, it is recommended that a strict+-- data structure is used for accumulator.+--+-- >>> scanl' step z = Stream.scan (Fold.foldl' step z)+-- >>> scanl' f z xs = Stream.scanlM' (\a b -> return (f a b)) (return z) xs+--+-- See also: 'usingStateT'+--+{-# INLINE scanl' #-}+scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl' f seed = scanlM' (\a b -> return (f a b)) (return seed)++{-# INLINE_NORMAL scanlM #-}+scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+scanlM fstep begin (Stream step state) = Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        x <- begin+        return $ Yield x (Just (state, x))+    step' gst (Just (st, acc)) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                y <- fstep acc x+                return $ Yield y (Just (s, y))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++{-# INLINE scanl #-}+scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl f seed = scanlM (\a b -> return (f a b)) (return seed)++-- Adapted from the vector package+{-# INLINE_NORMAL scanl1M #-}+scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+scanl1M fstep (Stream step state) = Stream step' (state, Nothing)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, Nothing) = do+        r <- step gst st+        case r of+            Yield x s -> return $ Yield x (s, Just x)+            Skip s -> return $ Skip (s, Nothing)+            Stop   -> return Stop++    step' gst (st, Just acc) = do+        r <- step gst st+        case r of+            Yield y s -> do+                z <- fstep acc y+                return $ Yield z (s, Just z)+            Skip s -> return $ Skip (s, Just acc)+            Stop   -> return Stop++{-# INLINE scanl1 #-}+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+scanl1 f = scanl1M (\x y -> return (f x y))++-- Adapted from the vector package++-- | Like 'scanl1'' but with a monadic step function.+--+{-# INLINE_NORMAL scanl1M' #-}+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, Nothing) = do+        r <- step gst st+        case r of+            Yield x s -> x `seq` return $ Yield x (s, Just x)+            Skip s -> return $ Skip (s, Nothing)+            Stop   -> return Stop++    step' gst (st, Just acc) = acc `seq` do+        r <- step gst st+        case r of+            Yield y s -> do+                z <- fstep acc y+                z `seq` return $ Yield z (s, Just z)+            Skip s -> return $ Skip (s, Just acc)+            Stop   -> return Stop++-- | Like 'scanl'' but for a non-empty stream. The first element of the stream+-- is used as the initial value of the accumulator. Does nothing if the stream+-- is empty.+--+-- >>> Stream.toList $ Stream.scanl1' (+) $ Stream.fromList [1,2,3,4]+-- [1,3,6,10]+--+{-# INLINE scanl1' #-}+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+scanl1' f = scanl1M' (\x y -> return (f x y))++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++-- | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a+-- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a+-- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with+-- index or time.+--+-- >>> filterWithIndex = Stream.with Stream.indexed Stream.filter+--+-- /Pre-release/+{-# INLINE with #-}+with :: Monad m =>+       (Stream m a -> Stream m (s, a))+    -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a))+    -> (((s, a) -> b) -> Stream m a -> Stream m a)+with f comb g = fmap snd . comb g . f++-- Adapted from the vector package++-- | Same as 'filter' but with a monadic predicate.+--+-- >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing+-- >>> filterM p = Stream.mapMaybeM (f p)+--+{-# INLINE_NORMAL filterM #-}+filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+filterM f (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                return $ if b+                         then Yield x s+                         else Skip s+            Skip s -> return $ Skip s+            Stop   -> return Stop++-- | Include only those elements that pass a predicate.+--+-- >>> filter p = Stream.filterM (return . p)+-- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing)+-- >>> filter p = Stream.scanMaybe (Fold.filtering p)+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+filter f = filterM (return . f)+-- filter p = scanMaybe (FL.filtering p)++-- | Drop repeated elements that are adjacent to each other using the supplied+-- comparison function.+--+-- >>> uniq = Stream.uniqBy (==)+--+-- To strip duplicate path separators:+--+-- >>> input = Stream.fromList "//a//b"+-- >>> f x y = x == '/' && y == '/'+-- >>> Stream.fold Fold.toList $ Stream.uniqBy f input+-- "/a/b"+--+-- Space: @O(1)@+--+-- /Pre-release/+--+{-# INLINE uniqBy #-}+uniqBy :: Monad m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a+-- uniqBy eq = scanMaybe (FL.uniqBy eq)+uniqBy eq = catMaybes . rollingMap f++    where++    f pre curr =+        case pre of+            Nothing -> Just curr+            Just x -> if x `eq` curr then Nothing else Just curr++-- Adapted from the vector package++-- | Drop repeated elements that are adjacent to each other.+--+-- >>> uniq = Stream.uniqBy (==)+--+{-# INLINE_NORMAL uniq #-}+uniq :: (Eq a, Monad m) => Stream m a -> Stream m a+-- uniq = scanMaybe FL.uniq+uniq (Stream step state) = Stream step' (Nothing, state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (Nothing, st) = do+        r <- step gst st+        case r of+            Yield x s -> return $ Yield x (Just x, s)+            Skip  s   -> return $ Skip  (Nothing, s)+            Stop      -> return Stop+    step' gst (Just x, st)  = do+         r <- step gst st+         case r of+             Yield y s | x == y   -> return $ Skip (Just x, s)+                       | otherwise -> return $ Yield y (Just y, s)+             Skip  s   -> return $ Skip (Just x, s)+             Stop      -> return Stop++-- | Deletes the first occurrence of the element in the stream that satisfies+-- the given equality predicate.+--+-- >>> input = Stream.fromList [1,3,3,5]+-- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input+-- [1,3,5]+--+{-# INLINE_NORMAL deleteBy #-}+deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a+-- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x)+deleteBy eq x (Stream step state) = Stream step' (state, False)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, False) = do+        r <- step gst st+        case r of+            Yield y s -> return $+                if eq x y then Skip (s, True) else Yield y (s, False)+            Skip s -> return $ Skip (s, False)+            Stop   -> return Stop++    step' gst (st, True) = do+        r <- step gst st+        case r of+            Yield y s -> return $ Yield y (s, True)+            Skip s -> return $ Skip (s, True)+            Stop   -> return Stop++-- | Strip all leading and trailing occurrences of an element passing a+-- predicate and make all other consecutive occurrences uniq.+--+-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)+--+-- @+-- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")+-- "hello world!"+--+-- @+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE prune #-}+prune ::+    -- (Monad m, Eq a) =>+    (a -> Bool) -> Stream m a -> Stream m a+prune = error "Not implemented yet!"++-- Possible implementation:+-- @repeated =+--      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@+--+-- 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a+-- single element.++-- | Emit only repeated elements, once.+--+-- /Unimplemented/+repeated :: -- (Monad m, Eq a) =>+    Stream m a -> Stream m a+repeated = undefined++------------------------------------------------------------------------------+-- Trimming+------------------------------------------------------------------------------++-- | Take all consecutive elements at the end of the stream for which the+-- predicate is true.+--+-- O(n) space, where n is the number elements taken.+--+-- /Unimplemented/+{-# INLINE takeWhileLast #-}+takeWhileLast :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m++-- | Like 'takeWhile' and 'takeWhileLast' combined.+--+-- O(n) space, where n is the number elements taken from the end.+--+-- /Unimplemented/+{-# INLINE takeWhileAround #-}+takeWhileAround :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m++-- Adapted from the vector package++-- | Discard first 'n' elements from the stream and take the rest.+--+{-# INLINE_NORMAL drop #-}+drop :: Monad m => Int -> Stream m a -> Stream m a+drop n (Stream step state) = Stream step' (state, Just n)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, Just i)+      | i > 0 = do+          r <- step gst st+          return $+            case r of+              Yield _ s -> Skip (s, Just (i - 1))+              Skip s    -> Skip (s, Just i)+              Stop      -> Stop+      | otherwise = return $ Skip (st, Nothing)++    step' gst (st, Nothing) = do+      r <- step gst st+      return $+        case r of+          Yield x s -> Yield x (s, Nothing)+          Skip  s   -> Skip (s, Nothing)+          Stop      -> Stop++-- Adapted from the vector package+data DropWhileState s a+    = DropWhileDrop s+    | DropWhileYield a s+    | DropWhileNext s++-- | Same as 'dropWhile' but with a monadic predicate.+--+{-# INLINE_NORMAL dropWhileM #-}+dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+-- dropWhileM p = scanMaybe (FL.droppingWhileM p)+dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (DropWhileDrop st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                if b+                then return $ Skip (DropWhileDrop s)+                else return $ Skip (DropWhileYield x s)+            Skip s -> return $ Skip (DropWhileDrop s)+            Stop -> return Stop++    step' gst (DropWhileNext st) =  do+        r <- step gst st+        case r of+            Yield x s -> return $ Skip (DropWhileYield x s)+            Skip s    -> return $ Skip (DropWhileNext s)+            Stop      -> return Stop++    step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)++-- | Drop elements in the stream as long as the predicate succeeds and then+-- take the rest of the stream.+--+{-# INLINE dropWhile #-}+dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+-- dropWhile p = scanMaybe (FL.droppingWhile p)+dropWhile f = dropWhileM (return . f)++-- | Drop @n@ elements at the end of the stream.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropLast #-}+dropLast :: -- Monad m =>+    Int -> Stream m a -> Stream m a+dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m++-- | Drop all consecutive elements at the end of the stream for which the+-- predicate is true.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropWhileLast #-}+dropWhileLast :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m++-- | Like 'dropWhile' and 'dropWhileLast' combined.+--+-- O(n) space, where n is the number elements dropped from the end.+--+-- /Unimplemented/+{-# INLINE dropWhileAround #-}+dropWhileAround :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m++------------------------------------------------------------------------------+-- Inserting Elements+------------------------------------------------------------------------------++-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in+-- @stream@ that is less than @elem@ when compared using @cmp@.+--+-- >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x)+--+-- >>> input = Stream.fromList [1,3,5]+-- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input+-- [1,2,3,5]+--+{-# INLINE_NORMAL insertBy #-}+insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a+insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, False, _) = do+        r <- step gst st+        case r of+            Yield x s -> case cmp a x of+                GT -> return $ Yield x (s, False, Nothing)+                _  -> return $ Yield a (s, True, Just x)+            Skip s -> return $ Skip (s, False, Nothing)+            Stop   -> return $ Yield a (st, True, Nothing)++    step' _ (_, True, Nothing) = return Stop++    step' gst (st, True, Just prev) = do+        r <- step gst st+        case r of+            Yield x s -> return $ Yield prev (s, True, Just x)+            Skip s    -> return $ Skip (s, True, Just prev)+            Stop      -> return $ Yield prev (st, True, Nothing)++data LoopState x s = FirstYield s+                   | InterspersingYield s+                   | YieldAndCarry x s++-- intersperseM = intersperseMWith 1++-- | Insert an effect and its output before consuming an element of a stream+-- except the first one.+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') input+-- h.,e.,l.,l.,o"h,e,l,l,o"+--+-- Be careful about the order of effects. In the above example we used trace+-- after the intersperse, if we use it before the intersperse the output would+-- be he.l.l.o."h,e,l,l,o".+--+-- >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input+-- he.l.l.o."h,e,l,l,o"+--+{-# INLINE_NORMAL intersperseM #-}+intersperseM :: Monad m => m a -> Stream m a -> Stream m a+intersperseM m (Stream step state) = Stream step' (FirstYield state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (FirstYield st) = do+        r <- step gst st+        return $+            case r of+                Yield x s -> Skip (YieldAndCarry x s)+                Skip s -> Skip (FirstYield s)+                Stop -> Stop++    step' gst (InterspersingYield st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                a <- m+                return $ Yield a (YieldAndCarry x s)+            Skip s -> return $ Skip $ InterspersingYield s+            Stop -> return Stop++    step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st)++-- | Insert a pure value between successive elements of a stream.+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input+-- "h,e,l,l,o"+--+{-# INLINE intersperse #-}+intersperse :: Monad m => a -> Stream m a -> Stream m a+intersperse a = intersperseM (return a)++-- | Insert a side effect before consuming an element of a stream except the+-- first one.+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input+-- h.e.l.l.o+--+-- /Pre-release/+{-# INLINE_NORMAL intersperseM_ #-}+intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a+intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1))+  where+    {-# INLINE_LATE step #-}+    step gst (Left (eff, st)) = do+        r <- step1 gst st+        case r of+            Yield x s -> eff >> return (Yield x (Right s))+            Skip s -> return $ Skip (Left (eff, s))+            Stop -> return Stop++    step _ (Right st) = return $ Skip $ Left (void m, st)++-- | Intersperse a monadic action into the input stream after every @n@+-- elements.+--+-- >> input = Stream.fromList "hello"+-- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input+-- "he,ll,o"+--+-- /Unimplemented/+{-# INLINE intersperseMWith #-}+intersperseMWith :: -- Monad m =>+    Int -> m a -> Stream m a -> Stream m a+intersperseMWith _n _f _xs = undefined++data SuffixState s a+    = SuffixElem s+    | SuffixSuffix s+    | SuffixYield a (SuffixState s a)++-- | Insert an effect and its output after consuming an element of a stream.+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMSuffix (putChar '.' >> return ',') input+-- h.,e.,l.,l.,o.,"h,e,l,l,o,"+--+-- /Pre-release/+{-# INLINE_NORMAL intersperseMSuffix #-}+intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a+intersperseMSuffix action (Stream step state) = Stream step' (SuffixElem state)+    where+    {-# INLINE_LATE step' #-}+    step' gst (SuffixElem st) = do+        r <- step gst st+        return $ case r of+            Yield x s -> Skip (SuffixYield x (SuffixSuffix s))+            Skip s -> Skip (SuffixElem s)+            Stop -> Stop++    step' _ (SuffixSuffix st) = do+        action >>= \r -> return $ Skip (SuffixYield r (SuffixElem st))++    step' _ (SuffixYield x next) = return $ Yield x next++-- | Insert a side effect after consuming an element of a stream.+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input+-- "hello"+--+-- /Pre-release/+--+{-# INLINE_NORMAL intersperseMSuffix_ #-}+intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a+intersperseMSuffix_ m (Stream step1 state1) = Stream step (Left state1)+  where+    {-# INLINE_LATE step #-}+    step gst (Left st) = do+        r <- step1 gst st+        case r of+            Yield x s -> return $ Yield x (Right s)+            Skip s -> return $ Skip $ Left s+            Stop -> return Stop++    step _ (Right st) = m >> return (Skip (Left st))++data SuffixSpanState s a+    = SuffixSpanElem s Int+    | SuffixSpanSuffix s+    | SuffixSpanYield a (SuffixSpanState s a)+    | SuffixSpanLast+    | SuffixSpanStop++-- | Like 'intersperseMSuffix' but intersperses an effectful action into the+-- input stream after every @n@ elements and after the last element.+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input+-- "he,ll,o,"+--+-- /Pre-release/+--+{-# INLINE_NORMAL intersperseMSuffixWith #-}+intersperseMSuffixWith :: forall m a. Monad m+    => Int -> m a -> Stream m a -> Stream m a+intersperseMSuffixWith n action (Stream step state) =+    Stream step' (SuffixSpanElem state n)+    where+    {-# INLINE_LATE step' #-}+    step' gst (SuffixSpanElem st i) | i > 0 = do+        r <- step gst st+        return $ case r of+            Yield x s -> Skip (SuffixSpanYield x (SuffixSpanElem s (i - 1)))+            Skip s -> Skip (SuffixSpanElem s i)+            Stop -> if i == n then Stop else Skip SuffixSpanLast+    step' _ (SuffixSpanElem st _) = return $ Skip (SuffixSpanSuffix st)++    step' _ (SuffixSpanSuffix st) = do+        action >>= \r -> return $ Skip (SuffixSpanYield r (SuffixSpanElem st n))++    step' _ SuffixSpanLast = do+        action >>= \r -> return $ Skip (SuffixSpanYield r SuffixSpanStop)++    step' _ (SuffixSpanYield x next) = return $ Yield x next++    step' _ SuffixSpanStop = return Stop++-- | Insert a side effect before consuming an element of a stream.+--+-- Definition:+--+-- >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x)+--+-- >>> input = Stream.fromList "hello"+-- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') input+-- .h.e.l.l.o"hello"+--+-- Same as 'trace_'.+--+-- /Pre-release/+--+{-# INLINE intersperseMPrefix_ #-}+intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a+intersperseMPrefix_ m = mapM (\x -> void m >> return x)++------------------------------------------------------------------------------+-- Inserting Time+------------------------------------------------------------------------------++-- XXX This should be in Prelude, should we export this as a helper function?++-- | Block the current thread for specified number of seconds.+{-# INLINE sleep #-}+sleep :: MonadIO m => Double -> m ()+sleep n = liftIO $ threadDelay $ round $ n * 1000000++-- | Introduce a delay of specified seconds between elements of the stream.+--+-- Definition:+--+-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000+-- >>> delay = Stream.intersperseM_ . sleep+--+-- Example:+--+-- >>> input = Stream.enumerateFromTo 1 3+-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input+-- 1+-- 2+-- 3+--+{-# INLINE delay #-}+delay :: MonadIO m => Double -> Stream m a -> Stream m a+delay = intersperseM_ . sleep++-- | Introduce a delay of specified seconds after consuming an element of a+-- stream.+--+-- Definition:+--+-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000+-- >>> delayPost = Stream.intersperseMSuffix_ . sleep+--+-- Example:+--+-- >>> input = Stream.enumerateFromTo 1 3+-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input+-- 1+-- 2+-- 3+--+-- /Pre-release/+--+{-# INLINE delayPost #-}+delayPost :: MonadIO m => Double -> Stream m a -> Stream m a+delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000++-- | Introduce a delay of specified seconds before consuming an element of a+-- stream.+--+-- Definition:+--+-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000+-- >>> delayPre = Stream.intersperseMPrefix_. sleep+--+-- Example:+--+-- >>> input = Stream.enumerateFromTo 1 3+-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input+-- 1+-- 2+-- 3+--+-- /Pre-release/+--+{-# INLINE delayPre #-}+delayPre :: MonadIO m => Double -> Stream m a -> Stream m a+delayPre = intersperseMPrefix_. sleep++------------------------------------------------------------------------------+-- Reordering+------------------------------------------------------------------------------++-- | Returns the elements of the stream in reverse order.  The stream must be+-- finite. Note that this necessarily buffers the entire stream in memory.+--+-- Definition:+--+-- >>> reverse m = Stream.concatEffect $ Stream.fold Fold.toListRev m >>= return . Stream.fromList+--+{-# INLINE_NORMAL reverse #-}+reverse :: Monad m => Stream m a -> Stream m a+reverse m = concatEffect $ fold FL.toListRev m <&> fromList+{-+reverse m = Stream step Nothing+    where+    {-# INLINE_LATE step #-}+    step _ Nothing = do+        xs <- foldl' (flip (:)) [] m+        return $ Skip (Just xs)+    step _ (Just (x:xs)) = return $ Yield x (Just xs)+    step _ (Just []) = return Stop+-}++-- | Like 'reverse' but several times faster, requires an 'Unbox' instance.+--+-- /O(n) space/+--+-- /Pre-release/+{-# INLINE reverseUnbox #-}+reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a+reverseUnbox =+    A.flattenArraysRev -- unfoldMany A.readRev+        . fromStreamK+        . K.reverse+        . toStreamK+        . A.chunksOf defaultChunkSize++-- | Buffer until the next element in sequence arrives. The function argument+-- determines the difference in sequence numbers. This could be useful in+-- implementing sequenced streams, for example, TCP reassembly.+--+-- /Unimplemented/+--+{-# INLINE reassembleBy #-}+reassembleBy+    :: -- Monad m =>+       Fold m a b+    -> (a -> a -> Int)+    -> Stream m a+    -> Stream m b+reassembleBy = undefined++------------------------------------------------------------------------------+-- Position Indexing+------------------------------------------------------------------------------++-- Adapted from the vector package++-- |+-- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined)+-- >>> indexed = Stream.postscan f+-- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0)+-- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed+--+-- Pair each element in a stream with its index, starting from index 0.+--+-- >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello"+-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]+--+{-# INLINE_NORMAL indexed #-}+indexed :: Monad m => Stream m a -> Stream m (Int, a)+-- indexed = scanMaybe FL.indexing+indexed (Stream step state) = Stream step' (state, 0)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, i) = i `seq` do+         r <- step (adaptState gst) st+         case r of+             Yield x s -> return $ Yield (i, x) (s, i+1)+             Skip    s -> return $ Skip (s, i)+             Stop      -> return Stop++-- Adapted from the vector package++-- |+-- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)+-- >>> indexedR n = Stream.postscan (f n)+--+-- >>> s n = Stream.enumerateFromThen n (n - 1)+-- >>> indexedR n = Stream.zipWith (,) (s n)+--+-- Pair each element in a stream with its index, starting from the+-- given index @n@ and counting down.+--+-- >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello"+-- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]+--+{-# INLINE_NORMAL indexedR #-}+indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)+-- indexedR n = scanMaybe (FL.indexingRev n)+indexedR m (Stream step state) = Stream step' (state, m)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, i) = i `seq` do+         r <- step (adaptState gst) st+         case r of+             Yield x s -> let i' = i - 1+                          in return $ Yield (i, x) (s, i')+             Skip    s -> return $ Skip (s, i)+             Stop      -> return Stop++-------------------------------------------------------------------------------+-- Time Indexing+-------------------------------------------------------------------------------++-- Note: The timestamp stream must be the second stream in the zip so that the+-- timestamp is generated after generating the stream element and not before.+-- If we do not do that then the following example will generate the same+-- timestamp for first two elements:+--+-- Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3++-- | Pair each element in a stream with an absolute timestamp, using a clock of+-- specified granularity.  The timestamp is generated just before the element+-- is consumed.+--+-- >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)]+--+-- /Pre-release/+--+{-# INLINE timestampWith #-}+timestampWith :: (MonadIO m)+    => Double -> Stream m a -> Stream m (AbsTime, a)+timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)++-- TBD: check performance vs a custom implementation without using zipWith.+--+-- /Pre-release/+--+{-# INLINE timestamped #-}+timestamped :: (MonadIO m)+    => Stream m a -> Stream m (AbsTime, a)+timestamped = timestampWith 0.01++-- | Pair each element in a stream with relative times starting from 0, using a+-- clock with the specified granularity. The time is measured just before the+-- element is consumed.+--+-- >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]+--+-- /Pre-release/+--+{-# INLINE timeIndexWith #-}+timeIndexWith :: (MonadIO m)+    => Double -> Stream m a -> Stream m (RelTime64, a)+timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)++-- | Pair each element in a stream with relative times starting from 0, using a+-- 10 ms granularity clock. The time is measured just before the element is+-- consumed.+--+-- >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]+--+-- /Pre-release/+--+{-# INLINE timeIndexed #-}+timeIndexed :: (MonadIO m)+    => Stream m a -> Stream m (RelTime64, a)+timeIndexed = timeIndexWith 0.01++------------------------------------------------------------------------------+-- Searching+------------------------------------------------------------------------------++-- | Find all the indices where the element in the stream satisfies the given+-- predicate.+--+-- >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)+--+{-# INLINE_NORMAL findIndices #-}+findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int+findIndices p (Stream step state) = Stream step' (state, 0)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, i) = i `seq` do+      r <- step (adaptState gst) st+      return $ case r of+          Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)+          Skip s -> Skip (s, i)+          Stop   -> Stop++-- | Find all the indices where the value of the element in the stream is equal+-- to the given value.+--+-- >>> elemIndices a = Stream.findIndices (== a)+--+{-# INLINE elemIndices #-}+elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int+elemIndices a = findIndices (== a)++{-# INLINE_NORMAL slicesBy #-}+slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+slicesBy p (Stream step1 state1) = Stream step (Just (state1, 0, 0))++    where++    {-# INLINE_LATE step #-}+    step gst (Just (st, i, len)) = i `seq` len `seq` do+      r <- step1 (adaptState gst) st+      return+        $ case r of+              Yield x s ->+                if p x+                then Yield (i, len + 1) (Just (s, i + len + 1, 0))+                else Skip (Just (s, i, len + 1))+              Skip s -> Skip (Just (s, i, len))+              Stop -> if len == 0 then Stop else Yield (i, len) Nothing+    step _ Nothing = return Stop++------------------------------------------------------------------------------+-- Rolling map+------------------------------------------------------------------------------++data RollingMapState s a = RollingMapGo s a++-- | Like 'rollingMap' but with an effectful map function.+--+-- /Pre-release/+--+{-# INLINE rollingMapM #-}+rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b+-- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f)+rollingMapM f (Stream step1 state1) = Stream step (RollingMapGo state1 Nothing)++    where++    step gst (RollingMapGo s1 curr) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield x s -> do+                !res <- f curr x+                return $ Yield res $ RollingMapGo s (Just x)+            Skip s -> return $ Skip $ RollingMapGo s curr+            Stop   -> return Stop++-- rollingMap is a special case of an incremental sliding fold. It can be+-- written as:+--+-- > fld f = slidingWindow 1 (Fold.foldl' (\_ (x,y) -> f y x)+-- > rollingMap f = Stream.postscan (fld f) undefined++-- | Apply a function on every two successive elements of a stream. The first+-- argument of the map function is the previous element and the second argument+-- is the current element. When the current element is the first element, the+-- previous element is 'Nothing'.+--+-- /Pre-release/+--+{-# INLINE rollingMap #-}+rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b+-- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f)+rollingMap f = rollingMapM (\x y -> return $ f x y)++-- | Like 'rollingMap' but requires at least two elements in the stream,+-- returns an empty stream otherwise.+--+-- This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.+--+-- /Pre-release/+--+{-# INLINE rollingMap2 #-}+rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b+rollingMap2 f = catMaybes . rollingMap g++    where++    g Nothing _ = Nothing+    g (Just x) y = Just (f x y)++------------------------------------------------------------------------------+-- Maybe Streams+------------------------------------------------------------------------------++-- XXX Will this always fuse properly?++-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'+-- elements, and return a stream of values extracted from 'Just'.+--+-- Equivalent to:+--+-- >>> mapMaybe f = Stream.catMaybes . fmap f+--+{-# INLINE_NORMAL mapMaybe #-}+mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b+mapMaybe f = fmap fromJust . filter isJust . map f++-- | Like 'mapMaybe' but maps a monadic function.+--+-- Equivalent to:+--+-- >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f+--+-- >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x)+--+{-# INLINE_NORMAL mapMaybeM #-}+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b+mapMaybeM f = fmap fromJust . filter isJust . mapM f++-- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.+--+-- >>> catMaybes = Stream.mapMaybe id+-- >>> catMaybes = fmap fromJust . Stream.filter isJust+--+-- /Pre-release/+--+{-# INLINE catMaybes #-}+catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a+-- catMaybes = fmap fromJust . filter isJust+catMaybes (Stream step state) = Stream step1 state++    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                return+                    $ case x of+                        Just a -> Yield a s+                        Nothing -> Skip s+            Skip s -> return $ Skip s+            Stop -> return Stop++-- | Use a filtering fold on a stream.+--+-- >>> scanMaybe f = Stream.catMaybes . Stream.postscan f+--+{-# INLINE scanMaybe #-}+scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b+scanMaybe f = catMaybes . postscan f++------------------------------------------------------------------------------+-- Either streams+------------------------------------------------------------------------------++-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.+--+-- >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft+--+-- /Pre-release/+--+{-# INLINE catLefts #-}+catLefts :: Monad m => Stream m (Either a b) -> Stream m a+catLefts = fmap (fromLeft undefined) . filter isLeft++-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.+--+-- >>> catRights = fmap (fromRight undefined) . Stream.filter isRight+--+-- /Pre-release/+--+{-# INLINE catRights #-}+catRights :: Monad m => Stream m (Either a b) -> Stream m b+catRights = fmap (fromRight undefined) . filter isRight++-- | Remove the either wrapper and flatten both lefts and as well as rights in+-- the output stream.+--+-- >>> catEithers = fmap (either id id)+--+-- /Pre-release/+--+{-# INLINE catEithers #-}+catEithers :: Monad m => Stream m (Either a a) -> Stream m a+catEithers = fmap (either id id)++------------------------------------------------------------------------------+-- Splitting+------------------------------------------------------------------------------++-- | Split on an infixed separator element, dropping the separator.  The+-- supplied 'Fold' is applied on the split segments.  Splits the stream on+-- separator elements determined by the supplied predicate, separator is+-- considered as infixed between two segments:+--+-- >>> splitOn' p xs = Stream.fold Fold.toList $ Stream.splitOn p Fold.toList (Stream.fromList xs)+-- >>> splitOn' (== '.') "a.b"+-- ["a","b"]+--+-- An empty stream is folded to the default value of the fold:+--+-- >>> splitOn' (== '.') ""+-- [""]+--+-- If one or both sides of the separator are missing then the empty segment on+-- that side is folded to the default output of the fold:+--+-- >>> splitOn' (== '.') "."+-- ["",""]+--+-- >>> splitOn' (== '.') ".a"+-- ["","a"]+--+-- >>> splitOn' (== '.') "a."+-- ["a",""]+--+-- >>> splitOn' (== '.') "a..b"+-- ["a","","b"]+--+-- splitOn is an inverse of intercalating single element:+--+-- > Stream.intercalate (Stream.fromPure '.') Unfold.fromList . Stream.splitOn (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > Stream.splitOn (== '.') Fold.toList . Stream.intercalate (Stream.fromPure '.') Unfold.fromList === id+--+{-# INLINE splitOn #-}+splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitOn predicate f =+    -- We can express the infix splitting in terms of optional suffix split+    -- fold.  After applying a suffix split fold repeatedly if the last segment+    -- ends with a suffix then we need to return the default output of the fold+    -- after that to make it an infix split.+    --+    -- Alternately, we can also express it using an optional prefix split fold.+    -- If the first segment starts with a prefix then we need to emit the+    -- default output of the fold before that to make it an infix split, and+    -- then apply prefix split fold repeatedly.+    --+    -- Since a suffix split fold can be easily expressed using a+    -- non-backtracking fold, we use that.+    foldManyPost (FL.takeEndBy_ predicate f)
src/Streamly/Internal/Data/Stream/Transformer.hs view
@@ -1,44 +1,57 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Transformer--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC+--+-- Transform the underlying monad of a stream using a monad transfomer.  module Streamly.Internal.Data.Stream.Transformer     (       foldlT     , foldrT +    -- * Transform Inner Monad     , liftInner-    , usingReaderT     , runReaderT+    , usingReaderT     , evalStateT-    , usingStateT     , runStateT+    , usingStateT     ) where -import Control.Monad.Trans.Class (MonadTrans)+#include "inline.hs"++import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.State.Strict (StateT)-import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.SVar.Type (defState, adaptState) -import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as D+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.State.Strict as State --- $setup--- >>> :m--- >>> import Control.Monad.Trans.Class (lift)--- >>> import Control.Monad.Trans.Identity (runIdentityT)--- >>> import qualified Streamly.Internal.Data.Stream as Stream+import Streamly.Internal.Data.Stream.Type +#include "DocTestDataStream.hs"+ -- | Lazy left fold to a transformer monad. ---{-# INLINE foldlT #-}+{-# INLINE_NORMAL foldlT #-} foldlT :: (Monad m, Monad (s m), MonadTrans s)     => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b-foldlT f z s = D.foldlT f z (toStreamD s)+foldlT fstep begin (Stream step state) = go SPEC begin state+  where+    go !_ acc st = do+        r <- lift $ step defState st+        case r of+            Yield x s -> go SPEC (fstep acc x) s+            Skip s -> go SPEC acc s+            Stop   -> acc  -- | Right fold to a transformer monad.  This is the most general right fold -- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'@@ -53,22 +66,38 @@ -- monads e.g.  to a different streaming type. -- -- /Pre-release/-{-# INLINE foldrT #-}-foldrT :: (Monad m, Monad (s m), MonadTrans s)-    => (a -> s m b -> s m b) -> s m b -> Stream m a -> s m b-foldrT f z s = D.foldrT f z (toStreamD s)+{-# INLINE_NORMAL foldrT #-}+foldrT :: (Monad m, Monad (t m), MonadTrans t)+    => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b+foldrT f final (Stream step state) = go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = do+          r <- lift $ step defState st+          case r of+            Yield x s -> f x (go SPEC s)+            Skip s    -> go SPEC s+            Stop      -> final ---------------------------------------------------------------------------------- Add and remove a monad transformer-------------------------------------------------------------------------------+-------------------------------------------------------------------------------+-- Transform Inner Monad+-------------------------------------------------------------------------------  -- | Lift the inner monad @m@ of @Stream m a@ to @t m@ where @t@ is a monad -- transformer. ---{-# INLINE liftInner #-}+{-# INLINE_NORMAL liftInner #-} liftInner :: (Monad m, MonadTrans t, Monad (t m))     => Stream m a -> Stream (t m) a-liftInner xs = fromStreamD $ D.liftInner (toStreamD xs)+liftInner (Stream step state) = Stream step' state+    where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- lift $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip s    -> Skip s+            Stop      -> Stop  ------------------------------------------------------------------------------ -- Sharing read only state in a stream@@ -76,16 +105,21 @@  -- | Evaluate the inner monad of a stream as 'ReaderT'. ---{-# INLINE runReaderT #-}+{-# INLINE_NORMAL runReaderT #-} runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a-runReaderT s xs = fromStreamD $ D.runReaderT s (toStreamD xs)+runReaderT env (Stream step state) = Stream step' (state, env)+    where+    {-# INLINE_LATE step' #-}+    step' gst (st, action) = do+        sv <- action+        r <- Reader.runReaderT (step (adaptState gst) st) sv+        return $ case r of+            Yield x s -> Yield x (s, return sv)+            Skip  s   -> Skip (s, return sv)+            Stop      -> Stop  -- | Run a stream transformation using a given environment. ----- See also: 'Serial.map'------ / Internal/--- {-# INLINE usingReaderT #-} usingReaderT     :: Monad m@@ -103,12 +137,34 @@ -- -- >>> evalStateT s = fmap snd . Stream.runStateT s ----- / Internal/+{-# INLINE_NORMAL evalStateT #-}+evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a+evalStateT initial (Stream step state) = Stream step' (state, initial)+    where+    {-# INLINE_LATE step' #-}+    step' gst (st, action) = do+        sv <- action+        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv+        return $ case r of+            Yield x s -> Yield x (s, return sv')+            Skip  s   -> Skip (s, return sv')+            Stop      -> Stop++-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting+-- state and value pair after each step. ---{-# INLINE evalStateT #-}-evalStateT ::  Monad m => m s -> Stream (StateT s m) a -> Stream m a--- evalStateT s = fmap snd . runStateT s-evalStateT s xs = fromStreamD $ D.evalStateT s (toStreamD xs)+{-# INLINE_NORMAL runStateT #-}+runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)+runStateT initial (Stream step state) = Stream step' (state, initial)+    where+    {-# INLINE_LATE step' #-}+    step' gst (st, action) = do+        sv <- action+        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv+        return $ case r of+            Yield x s -> Yield (sv', x) (s, return sv')+            Skip  s   -> Skip (s, return sv')+            Stop      -> Stop  -- | Run a stateful (StateT) stream transformation using a given state. --@@ -116,8 +172,6 @@ -- -- See also: 'scan' ----- / Internal/--- {-# INLINE usingStateT #-} usingStateT     :: Monad m@@ -126,10 +180,3 @@     -> Stream m a     -> Stream m a usingStateT s f = evalStateT s . f . liftInner---- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting--- state and value pair after each step.----{-# INLINE runStateT #-}-runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)-runStateT s xs = fromStreamD $ D.runStateT s (toStreamD xs)
src/Streamly/Internal/Data/Stream/Type.hs view
@@ -1,491 +1,2091 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.Type--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Type-    (-    -- * Stream Type-      Stream -- XXX To be removed-    , StreamK--    -- * Type Conversion-    , fromStreamK-    , toStreamK-    , fromStreamD-    , toStreamD-    , fromStream-    , toStream-    , Streamly.Internal.Data.Stream.Type.fromList--    -- * Construction-    , cons-    , consM-    , nil-    , nilM-    , fromPure-    , fromEffect--    -- * Applicative-    , crossApply-    , crossApplySnd-    , crossApplyFst-    , crossWith-    , cross--    -- * Bind/Concat-    , bindWith-    , concatMapWith--    -- * Double folds-    , eqBy-    , cmpBy-    )-where--#include "inline.hs"--import Control.Applicative (liftA2)-import Data.Foldable (Foldable(foldl'), fold)-import Data.Functor.Identity (Identity(..), runIdentity)-import Data.Maybe (fromMaybe)-import Data.Semigroup (Endo(..))-import GHC.Exts (IsList(..), IsString(..), oneShot)-import Streamly.Internal.BaseCompat ((#.))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import qualified Streamly.Internal.Data.Stream.Common as P-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---- $setup--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Stream as Stream----------------------------------------------------------------------------------- Stream----------------------------------------------------------------------------------- | Semigroup instance appends two streams:------ >>> (<>) = Stream.append----newtype StreamK m a = StreamK (K.StreamK m a)-    -- XXX when deriving do we inherit an INLINE?-    deriving (Semigroup, Monoid)--type Stream = StreamK----------------------------------------------------------------------------------- Conversions---------------------------------------------------------------------------------{-# INLINE_EARLY fromStreamK #-}-fromStreamK :: K.StreamK m a -> Stream m a-fromStreamK = StreamK--{-# INLINE_EARLY toStreamK #-}-toStreamK :: Stream m a -> K.StreamK m a-toStreamK (StreamK k) = k--{-# INLINE_EARLY fromStreamD #-}-fromStreamD :: Monad m => D.Stream m a -> Stream m a-fromStreamD = fromStreamK . D.toStreamK--{-# INLINE_EARLY toStreamD #-}-toStreamD :: Applicative m => Stream m a -> D.Stream m a-toStreamD = D.fromStreamK . toStreamK--{-# INLINE fromStream #-}-fromStream :: Monad m => D.Stream m a -> Stream m a-fromStream = fromStreamD--{-# INLINE toStream #-}-toStream :: Applicative m => Stream m a -> D.Stream m a-toStream = toStreamD----------------------------------------------------------------------------------- Generation----------------------------------------------------------------------------------- |--- >>> fromList = Prelude.foldr Stream.cons Stream.nil------ Construct a stream from a list of pure values. This is more efficient than--- 'fromFoldable'.----{-# INLINE fromList #-}-fromList :: Monad m => [a] -> Stream m a-fromList = fromStreamK . P.fromList----------------------------------------------------------------------------------- Comparison----------------------------------------------------------------------------------- | Compare two streams for equality----{-# INLINE eqBy #-}-eqBy :: Monad m =>-    (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool-eqBy f m1 m2 = D.eqBy f (toStreamD m1) (toStreamD m2)---- | Compare two streams----{-# INLINE cmpBy #-}-cmpBy-    :: Monad m-    => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering-cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Functor---------------------------------------------------------------------------------instance Monad m => Functor (Stream m) where-    {-# INLINE fmap #-}-    -- IMPORTANT: do not use eta reduction.-    fmap f m = fromStreamD $ D.mapM (return . f) $ toStreamD m--    {-# INLINE (<$) #-}-    (<$) = fmap . const----------------------------------------------------------------------------------- Lists----------------------------------------------------------------------------------- Serial streams can act like regular lists using the Identity monad---- XXX Show instance is 10x slower compared to read, we can do much better.--- The list show instance itself is really slow.---- XXX The default definitions of "<" in the Ord instance etc. do not perform--- well, because they do not get inlined. Need to add INLINE in Ord class in--- base?--instance IsList (Stream Identity a) where-    type (Item (Stream Identity a)) = a--    {-# INLINE fromList #-}-    fromList xs = StreamK $ P.fromList xs--    {-# INLINE toList #-}-    toList (StreamK xs) = runIdentity $ P.toList xs--instance Eq a => Eq (Stream Identity a) where-    {-# INLINE (==) #-}-    (==) (StreamK xs) (StreamK ys) = runIdentity $ P.eqBy (==) xs ys--instance Ord a => Ord (Stream Identity a) where-    {-# INLINE compare #-}-    compare (StreamK xs) (StreamK ys) = runIdentity $ P.cmpBy compare xs ys--    {-# INLINE (<) #-}-    x < y =-        case compare x y of-            LT -> True-            _ -> False--    {-# INLINE (<=) #-}-    x <= y =-        case compare x y of-            GT -> False-            _ -> True--    {-# INLINE (>) #-}-    x > y =-        case compare x y of-            GT -> True-            _ -> False--    {-# INLINE (>=) #-}-    x >= y =-        case compare x y of-            LT -> False-            _ -> True--    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y--instance Show a => Show (Stream Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (toList dl)--instance Read a => Read (Stream Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        Streamly.Internal.Data.Stream.Type.fromList <$> readPrec--    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (Stream Identity a) where-    {-# INLINE fromString #-}-    fromString xs = StreamK $ P.fromList xs------------------------------------------------------------------------------------ Foldable------------------------------------------------------------------------------------ The default Foldable instance has several issues:--- 1) several definitions do not have INLINE on them, so we provide---    re-implementations with INLINE pragmas.--- 2) the definitions of sum/product/maximum/minimum are inefficient as they---    use right folds, they cannot run in constant memory. We provide---    implementations using strict left folds here.--instance (Foldable m, Monad m) => Foldable (Stream m) where--    {-# INLINE foldMap #-}-    foldMap f (StreamK xs) = fold $ P.foldr (mappend . f) mempty xs--    {-# INLINE foldr #-}-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    {-# INLINE foldl' #-}-    foldl' f z0 xs = foldr f' id xs z0-        where f' x k = oneShot $ \z -> k $! f z x--    {-# INLINE length #-}-    length = foldl' (\n _ -> n + 1) 0--    {-# INLINE elem #-}-    elem = any . (==)--    {-# INLINE maximum #-}-    maximum =-          fromMaybe (errorWithoutStackTrace "maximum: empty stream")-        . toMaybe-        . foldl' getMax Nothing'--        where--        getMax Nothing' x = Just' x-        getMax (Just' mx) x = Just' $! max mx x--    {-# INLINE minimum #-}-    minimum =-          fromMaybe (errorWithoutStackTrace "minimum: empty stream")-        . toMaybe-        . foldl' getMin Nothing'--        where--        getMin Nothing' x = Just' x-        getMin (Just' mn) x = Just' $! min mn x--    {-# INLINE sum #-}-    sum = foldl' (+) 0--    {-# INLINE product #-}-    product = foldl' (*) 1------------------------------------------------------------------------------------ Traversable----------------------------------------------------------------------------------instance Traversable (Stream Identity) where-    {-# INLINE traverse #-}-    traverse f (StreamK xs) =-        fmap StreamK $ runIdentity $ P.foldr consA (pure mempty) xs--        where--        consA x ys = liftA2 K.cons (f x) ys------------------------------------------------------------------------------------ Construction----------------------------------------------------------------------------------infixr 5 `cons`---- | A right associative prepend operation to add a pure value at the head of--- an existing stream::------ >>> s = 1 `Stream.cons` 2 `Stream.cons` 3 `Stream.cons` Stream.nil--- >>> Stream.fold Fold.toList s--- [1,2,3]------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil------ Same as the following but more efficient:------ >>> cons x xs = return x `Stream.consM` xs------ /CPS/----{-# INLINE_NORMAL cons #-}-cons ::  a -> Stream m a -> Stream m a-cons x = fromStreamK . K.cons x . toStreamK--infixr 5 `consM`---- | A right associative prepend operation to add an effectful value at the--- head of an existing stream::------ >>> s = putStrLn "hello" `consM` putStrLn "world" `consM` Stream.nil--- >>> Stream.fold Fold.drain s--- hello--- world------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil------ Same as the following but more efficient:------ >>> consM x xs = Stream.fromEffect x `Stream.append` xs------ /CPS/----{-# INLINE consM #-}-{-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}-consM :: Monad m => m a -> Stream m a -> Stream m a-consM m = fromStreamK . K.consM m . toStreamK---- | A stream that terminates without producing any output or side effect.------ >>> Stream.fold Fold.toList Stream.nil--- []----{-# INLINE_NORMAL nil #-}-nil ::  Stream m a-nil = fromStreamK K.nil---- | A stream that terminates without producing any output, but produces a side--- effect.------ >>> Stream.fold Fold.toList (Stream.nilM (print "nil"))--- "nil"--- []------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Monad m => m b -> Stream m a-nilM = fromStreamK . K.nilM---- | Create a singleton stream from a pure value.------ >>> fromPure a = a `cons` Stream.nil--- >>> fromPure = pure--- >>> fromPure = fromEffect . pure----{-# INLINE_NORMAL fromPure #-}-fromPure :: a -> Stream m a-fromPure = fromStreamK . K.fromPure---- | Create a singleton stream from a monadic action.------ >>> fromEffect m = m `consM` Stream.nil--- >>> fromEffect = Stream.sequence . Stream.fromPure------ >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello")--- hello----{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Monad m => m a -> Stream m a-fromEffect = fromStreamK . K.fromEffect------------------------------------------------------------------------------------ Applicative------------------------------------------------------------------------------------ | Apply a stream of functions to a stream of values and flatten the results.------ Note that the second stream is evaluated multiple times.------ >>> crossApply = Stream.crossWith id----{-# INLINE crossApply #-}-crossApply :: Stream m (a -> b) -> Stream m a -> Stream m b-crossApply m1 m2 =-    fromStreamK $ K.crossApply (toStreamK m1) (toStreamK m2)--{-# INLINE crossApplySnd #-}-crossApplySnd :: Stream m a -> Stream m b -> Stream m b-crossApplySnd m1 m2 =-    fromStreamK $ K.crossApplySnd (toStreamK m1) (toStreamK m2)--{-# INLINE crossApplyFst #-}-crossApplyFst :: Stream m a -> Stream m b -> Stream m a-crossApplyFst m1 m2 =-    fromStreamK $ K.crossApplyFst (toStreamK m1) (toStreamK m2)---- |--- Definition:------ >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2------ Note that the second stream is evaluated multiple times.----{-# INLINE crossWith #-}-crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-crossWith f m1 m2 = fmap f m1 `crossApply` m2---- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible--- combinations of the tuple @(a, b)@.------ Definition:------ >>> cross = Stream.crossWith (,)------ The second stream is evaluated multiple times. If that is not desired it can--- be cached in an 'Data.Array.Array' and then generated from the array before--- calling this function. Caching may also improve performance if the stream is--- expensive to evaluate.------ See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE cross #-}-cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)-cross = crossWith (,)------------------------------------------------------------------------------------ Bind/Concat------------------------------------------------------------------------------------ |------ /CPS/-{-# INLINE bindWith #-}-bindWith-    :: (Stream m b -> Stream m b -> Stream m b)-    -> Stream m a-    -> (a -> Stream m b)-    -> Stream m b-bindWith par m1 f =-    fromStreamK-        $ K.bindWith-            (\s1 s2 -> toStreamK $ par (fromStreamK s1) (fromStreamK s2))-            (toStreamK m1)-            (toStreamK . f)---- | @concatMapWith mixer generator stream@ is a two dimensional looping--- combinator.  The @generator@ function is used to generate streams from the--- elements in the input @stream@ and the @mixer@ function is used to merge--- those streams.------ /CPS/-{-# INLINE concatMapWith #-}-concatMapWith-    :: (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m a-    -> Stream m b-concatMapWith par f xs = bindWith par xs f+{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Streamly.Internal.Data.Stream.Type+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- The stream type is inspired by the vector package.  A few functions in this+-- module have been originally adapted from the vector package (c) Roman+-- Leshchinskiy. See the notes in specific functions.++module Streamly.Internal.Data.Stream.Type+    (+    -- * The stream type+      Step (..)+    -- XXX UnStream is exported to avoid a performance issue in some+    -- combinators if we use the pattern synonym "Stream".+    , Stream (Stream, UnStream)++    -- * CrossStream type wrapper+    , CrossStream+    , unCross+    , mkCross++    -- * Conversion to StreamK+    , fromStreamK+    , toStreamK++    -- * From Unfold+    , unfold++    -- * Construction+    -- ** Primitives+    , nilM+    , consM++    -- ** From Values+    , fromPure+    , fromEffect++    -- ** From Containers+    , Streamly.Internal.Data.Stream.Type.fromList++    -- * Elimination+    -- ** Primitives+    , uncons++    -- ** Strict Left Folds+    , Streamly.Internal.Data.Stream.Type.fold+    , foldBreak+    , foldAddLazy+    , foldAdd+    , foldEither++    , Streamly.Internal.Data.Stream.Type.foldl'+    , foldlM'+    , foldlx'+    , foldlMx'++    -- ** Lazy Right Folds+    , foldrM+    , foldrMx+    , Streamly.Internal.Data.Stream.Type.foldr+    , foldrS++    -- ** Specific Folds+    , drain+    , Streamly.Internal.Data.Stream.Type.toList++    -- * Mapping+    , map+    , mapM++    -- * Stateful Filters+    , take+    , takeWhile+    , takeWhileM+    , takeEndBy+    , takeEndByM++    -- * Combining Two Streams+    -- ** Zipping+    , zipWithM+    , zipWith++    -- ** Cross Product+    , crossApply+    , crossApplyFst+    , crossApplySnd+    , crossWith+    , cross++    -- * Unfold Many+    , ConcatMapUState (..)+    , unfoldMany++    -- * Concat+    , concatEffect+    , concatMap+    , concatMapM+    , concat++    -- * Unfold Iterate+    , unfoldIterateDfs+    , unfoldIterateBfs+    , unfoldIterateBfsRev++    -- * Concat Iterate+    , concatIterateScan+    , concatIterateDfs+    , concatIterateBfs+    , concatIterateBfsRev++    -- * Fold Many+    , FoldMany (..) -- for inspection testing+    , FoldManyPost (..)+    , foldMany+    , foldManyPost+    , groupsOf+    , refoldMany++    -- * Fold Iterate+    , reduceIterateBfs+    , foldIterateBfs++    -- * Multi-stream folds+    , eqBy+    , cmpBy+    )+where++#include "inline.hs"++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Monad.Catch (MonadThrow, throwM)+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.IO.Class (MonadIO(..))+import Data.Foldable (Foldable(foldl'), fold, foldr)+import Data.Functor (($>))+import Data.Functor.Identity (Identity(..))+import Data.Maybe (fromMaybe)+import Data.Semigroup (Endo(..))+import Fusion.Plugin.Types (Fuse(..))+import GHC.Base (build)+import GHC.Exts (IsList(..), IsString(..), oneShot)+import GHC.Types (SPEC(..))+import Prelude hiding (map, mapM, take, concatMap, takeWhile, zipWith, concat)+import Text.Read+       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec+       , readListPrecDefault)++import Streamly.Internal.BaseCompat ((#.))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Refold.Type (Refold(..))+import Streamly.Internal.Data.Stream.Step (Step (..))+import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Fold.Type as FL hiding (foldr)+import qualified Streamly.Internal.Data.StreamK.Type as K+#ifdef USE_UNFOLDS_EVERYWHERE+import qualified Streamly.Internal.Data.Unfold.Type as Unfold+#endif++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- The direct style stream type+------------------------------------------------------------------------------++-- gst = global state++-- | A stream consists of a step function that generates the next step given a+-- current state, and the current state.+data Stream m a =+    forall s. UnStream (State K.StreamK m a -> s -> m (Step s a)) s++-- XXX This causes perf trouble when pattern matching with "Stream"  in a+-- recursive way, e.g. in uncons, foldBreak, concatMap. We need to get rid of+-- this.+unShare :: Stream m a -> Stream m a+unShare (UnStream step state) = UnStream step' state+    where step' gst = step (adaptState gst)++pattern Stream :: (State K.StreamK m a -> s -> m (Step s a)) -> s -> Stream m a+pattern Stream step state <- (unShare -> UnStream step state)+    where Stream = UnStream++{-# COMPLETE Stream #-}++------------------------------------------------------------------------------+-- Primitives+------------------------------------------------------------------------------++-- | A stream that terminates without producing any output, but produces a side+-- effect.+--+-- >>> Stream.fold Fold.toList (Stream.nilM (print "nil"))+-- "nil"+-- []+--+-- /Pre-release/+{-# INLINE_NORMAL nilM #-}+nilM :: Applicative m => m b -> Stream m a+nilM m = Stream (\_ _ -> m $> Stop) ()++-- | Like 'cons' but fuses an effect instead of a pure value.+{-# INLINE_NORMAL consM #-}+consM :: Applicative m => m a -> Stream m a -> Stream m a+consM m (Stream step state) = Stream step1 Nothing++    where++    {-# INLINE_LATE step1 #-}+    step1 _ Nothing = (`Yield` Just state) <$> m+    step1 gst (Just st) = do+          (\case+            Yield a s -> Yield a (Just s)+            Skip  s   -> Skip (Just s)+            Stop      -> Stop) <$> step gst st++-- | Decompose a stream into its head and tail. If the stream is empty, returns+-- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is+-- the head of the stream and @ma@ its tail.+--+-- Properties:+--+-- >>> Nothing <- Stream.uncons Stream.nil+-- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil)+--+-- This can be used to consume the stream in an imperative manner one element+-- at a time, as it just breaks down the stream into individual elements and we+-- can loop over them as we deem fit. For example, this can be used to convert+-- a streamly stream into other stream types.+--+-- All the folds in this module can be expressed in terms of 'uncons', however,+-- this is generally less efficient than specific folds because it takes apart+-- the stream one element at a time, therefore, does not take adavantage of+-- stream fusion.+--+-- 'foldBreak' is a more general way of consuming a stream piecemeal.+--+-- >>> :{+-- uncons xs = do+--     r <- Stream.foldBreak Fold.one xs+--     return $ case r of+--         (Nothing, _) -> Nothing+--         (Just h, t) -> Just (h, t)+-- :}+--+{-# INLINE_NORMAL uncons #-}+uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+uncons (UnStream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s -> return $ Just (x, Stream step s)+            Skip  s   -> go SPEC s+            Stop      -> return Nothing++------------------------------------------------------------------------------+-- From 'Unfold'+------------------------------------------------------------------------------++data UnfoldState s = UnfoldNothing | UnfoldJust s++-- | Convert an 'Unfold' into a stream by supplying it an input seed.+--+-- >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello")+-- >>> Stream.fold Fold.drain s+-- hello+-- hello+-- hello+--+{-# INLINE_NORMAL unfold #-}+unfold :: Applicative m => Unfold m a b -> a -> Stream m b+unfold (Unfold ustep inject) seed = Stream step UnfoldNothing++    where++    {-# INLINE_LATE step #-}+    step _ UnfoldNothing = Skip . UnfoldJust <$> inject seed+    step _ (UnfoldJust st) = do+        (\case+            Yield x s -> Yield x (UnfoldJust s)+            Skip s    -> Skip (UnfoldJust s)+            Stop      -> Stop) <$> ustep st++------------------------------------------------------------------------------+-- From Values+------------------------------------------------------------------------------++-- | Create a singleton stream from a pure value.+--+-- >>> fromPure a = a `Stream.cons` Stream.nil+-- >>> fromPure = pure+-- >>> fromPure = Stream.fromEffect . pure+--+{-# INLINE_NORMAL fromPure #-}+fromPure :: Applicative m => a -> Stream m a+fromPure x = Stream (\_ s -> pure $ step undefined s) True+  where+    {-# INLINE_LATE step #-}+    step _ True  = Yield x False+    step _ False = Stop++-- | Create a singleton stream from a monadic action.+--+-- >>> fromEffect m = m `Stream.consM` Stream.nil+-- >>> fromEffect = Stream.sequence . Stream.fromPure+--+-- >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello")+-- hello+--+{-# INLINE_NORMAL fromEffect #-}+fromEffect :: Applicative m => m a -> Stream m a+fromEffect m = Stream step True++    where++    {-# INLINE_LATE step #-}+    step _ True  = (`Yield` False) <$> m+    step _ False = pure Stop++------------------------------------------------------------------------------+-- From Containers+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Construct a stream from a list of pure values.+{-# INLINE_LATE fromList #-}+fromList :: Applicative m => [a] -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+fromList = unfold Unfold.fromList+#else+fromList = Stream step+  where+    {-# INLINE_LATE step #-}+    step _ (x:xs) = pure $ Yield x xs+    step _ []     = pure Stop+#endif++------------------------------------------------------------------------------+-- Conversions From/To+------------------------------------------------------------------------------++-- | Convert a CPS encoded StreamK to direct style step encoded StreamD+{-# INLINE_LATE fromStreamK #-}+fromStreamK :: Applicative m => K.StreamK m a -> Stream m a+fromStreamK = Stream step+    where+    step gst m1 =+        let stop       = pure Stop+            single a   = pure $ Yield a K.nil+            yieldk a r = pure $ Yield a r+         in K.foldStreamShared gst yieldk single stop m1++-- | Convert a direct style step encoded StreamD to a CPS encoded StreamK+{-# INLINE_LATE toStreamK #-}+toStreamK :: Monad m => Stream m a -> K.StreamK m a+toStreamK (Stream step state) = go state+    where+    go st = K.MkStream $ \gst yld _ stp ->+      let go' ss = do+           r <- step gst ss+           case r of+               Yield x s -> yld x (go s)+               Skip  s   -> go' s+               Stop      -> stp+      in go' st++{-# RULES "fromStreamK/toStreamK fusion"+    forall s. toStreamK (fromStreamK s) = s #-}+{-# RULES "toStreamK/fromStreamK fusion"+    forall s. fromStreamK (toStreamK s) = s #-}++------------------------------------------------------------------------------+-- Running a 'Fold'+------------------------------------------------------------------------------++-- | Fold resulting in either breaking the stream or continuation of the fold.+-- Instead of supplying the input stream in one go we can run the fold multiple+-- times, each time supplying the next segment of the input stream. If the fold+-- has not yet finished it returns a fold that can be run again otherwise it+-- returns the fold result and the residual stream.+--+-- /Internal/+{-# INLINE_NORMAL foldEither #-}+foldEither :: Monad m =>+    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))+foldEither (Fold fstep begin done final) (UnStream step state) = do+    res <- begin+    case res of+        FL.Partial fs -> go SPEC fs state+        FL.Done fb -> return $! Right (fb, Stream step state)++    where++    {-# INLINE go #-}+    go !_ !fs st = do+        r <- step defState st+        case r of+            Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Done b -> return $! Right (b, Stream step s)+                    FL.Partial fs1 -> go SPEC fs1 s+            Skip s -> go SPEC fs s+            Stop ->+                let f = Fold fstep (return $ FL.Partial fs) done final+                 in return $! Left f++-- | Like 'fold' but also returns the remaining stream. The resulting stream+-- would be 'Stream.nil' if the stream finished before the fold.+--+{-# INLINE_NORMAL foldBreak #-}+foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)+foldBreak fld strm = do+    r <- foldEither fld strm+    case r of+        Right res -> return res+        Left (Fold _ initial _ final) -> do+            res <- initial+            case res of+                FL.Done _ -> error "foldBreak: unreachable state"+                FL.Partial s -> do+                    b <- final s+                    return (b, nil)++    where++    nil = Stream (\_ _ -> return Stop) ()++-- >>> fold f = Fold.extractM . Stream.foldAddLazy f+-- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f+-- >>> fold f = Fold.extractM <=< Stream.foldAdd f++-- | Fold a stream using the supplied left 'Fold' and reducing the resulting+-- expression strictly at each step. The behavior is similar to 'foldl''. A+-- 'Fold' can terminate early without consuming the full stream. See the+-- documentation of individual 'Fold's for termination behavior.+--+-- Definitions:+--+-- >>> fold f = fmap fst . Stream.foldBreak f+-- >>> fold f = Stream.parse (Parser.fromFold f)+--+-- Example:+--+-- >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)+-- 5050+--+{-# INLINE_NORMAL fold #-}+fold :: Monad m => Fold m a b -> Stream m a -> m b+fold fld strm = do+    (b, _) <- foldBreak fld strm+    return b++-- | Append a stream to a fold lazily to build an accumulator incrementally.+--+-- Example, to continue folding a list of streams on the same sum fold:+--+-- >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]]+-- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams+-- >>> Stream.fold f Stream.nil+-- 55+--+{-# INLINE_NORMAL foldAddLazy #-}+foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b+foldAddLazy (Fold fstep finitial fextract ffinal) (Stream sstep state) =+    Fold fstep initial fextract ffinal++    where++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> go SPEC fs state+            FL.Done fb -> return $ FL.Done fb++    {-# INLINE go #-}+    go !_ !fs st = do+        r <- sstep defState st+        case r of+            Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Done b -> return $ FL.Done b+                    FL.Partial fs1 -> go SPEC fs1 s+            Skip s -> go SPEC fs s+            Stop -> return $ FL.Partial fs++-- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce++-- |+-- >>> foldAdd = flip Fold.addStream+--+foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)+foldAdd f =+    Streamly.Internal.Data.Stream.Type.fold (FL.duplicate f)++------------------------------------------------------------------------------+-- Right Folds+------------------------------------------------------------------------------++-- Adapted from the vector package.+--+-- XXX Use of SPEC constructor in folds causes 2x performance degradation in+-- one shot operations, but helps immensely in operations composed of multiple+-- combinators or the same combinator many times. There seems to be an+-- opportunity to optimize here, can we get both, better perf for single ops+-- as well as composed ops? Without SPEC, all single operation benchmarks+-- become 2x faster.++-- The way we want a left fold to be strict, dually we want the right fold to+-- be lazy.  The correct signature of the fold function to keep it lazy must be+-- (a -> m b -> m b) instead of (a -> b -> m b). We were using the latter+-- earlier, which is incorrect. In the latter signature we have to feed the+-- value to the fold function after evaluating the monadic action, depending on+-- the bind behavior of the monad, the action may get evaluated immediately+-- introducing unnecessary strictness to the fold. If the implementation is+-- lazy the following example, must work:+--+-- S.foldrM (\x t -> if x then return t else return False) (return True)+--  (S.fromList [False,undefined] :: Stream IO Bool)++-- | Right associative/lazy pull fold. @foldrM build final stream@ constructs+-- an output structure using the step function @build@. @build@ is invoked with+-- the next input element and the remaining (lazy) tail of the output+-- structure. It builds a lazy output expression using the two. When the "tail+-- structure" in the output expression is evaluated it calls @build@ again thus+-- lazily consuming the input @stream@ until either the output expression built+-- by @build@ is free of the "tail" or the input is exhausted in which case+-- @final@ is used as the terminating case for the output structure. For more+-- details see the description in the previous section.+--+-- Example, determine if any element is 'odd' in a stream:+--+-- >>> s = Stream.fromList (2:4:5:undefined)+-- >>> step x xs = if odd x then return True else xs+-- >>> Stream.foldrM step (return False) s+-- True+--+{-# INLINE_NORMAL foldrM #-}+foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+foldrM f z (Stream step state) = go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = do+          r <- step defState st+          case r of+            Yield x s -> f x (go SPEC s)+            Skip s    -> go SPEC s+            Stop      -> z++{-# INLINE_NORMAL foldrMx #-}+foldrMx :: Monad m+    => (a -> m x -> m x) -> m x -> (m x -> m b) -> Stream m a -> m b+foldrMx fstep final convert (Stream step state) = convert $ go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = do+          r <- step defState st+          case r of+            Yield x s -> fstep x (go SPEC s)+            Skip s    -> go SPEC s+            Stop      -> final++-- XXX Should we make all argument strict wherever we use SPEC?++-- Note that foldr works on pure values, therefore it becomes necessarily+-- strict when the monad m is strict. In that case it cannot terminate early,+-- it would evaluate all of its input.  Though, this should work fine with lazy+-- monads. For example, if "any" is implemented using "foldr" instead of+-- "foldrM" it performs the same with Identity monad but performs 1000x slower+-- with IO monad.++-- | Right fold, lazy for lazy monads and pure streams, and strict for strict+-- monads.+--+-- Please avoid using this routine in strict monads like IO unless you need a+-- strict right fold. This is provided only for use in lazy monads (e.g.+-- Identity) or pure streams. Note that with this signature it is not possible+-- to implement a lazy foldr when the monad @m@ is strict. In that case it+-- would be strict in its accumulator and therefore would necessarily consume+-- all its input.+--+-- >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z)+--+-- Note: This is similar to Fold.foldr' (the right fold via left fold), but+-- could be more efficient.+--+{-# INLINE_NORMAL foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+foldr f z = foldrM (liftA2 f . return) (return z)++-- this performs horribly, should not be used+{-# INLINE_NORMAL foldrS #-}+foldrS+    :: Monad m+    => (a -> Stream m b -> Stream m b)+    -> Stream m b+    -> Stream m a+    -> Stream m b+foldrS f final (Stream step state) = go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = concatEffect $ fmap g $ step defState st++    g r =+        case r of+          Yield x s -> f x (go SPEC s)+          Skip s    -> go SPEC s+          Stop      -> final++------------------------------------------------------------------------------+-- Left Folds+------------------------------------------------------------------------------++-- XXX run begin action only if the stream is not empty.+{-# INLINE_NORMAL foldlMx' #-}+foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b+foldlMx' fstep begin done (Stream step state) =+    begin >>= \x -> go SPEC x state+  where+    -- XXX !acc?+    {-# INLINE_LATE go #-}+    go !_ acc st = acc `seq` do+        r <- step defState st+        case r of+            Yield x s -> do+                acc' <- fstep acc x+                go SPEC acc' s+            Skip s -> go SPEC acc s+            Stop   -> done acc++{-# INLINE foldlx' #-}+foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b+foldlx' fstep begin done =+    foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done)++-- Adapted from the vector package.+-- XXX implement in terms of foldlMx'?+{-# INLINE_NORMAL foldlM' #-}+foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b+foldlM' fstep mbegin (Stream step state) = do+    begin <- mbegin+    go SPEC begin state+  where+    {-# INLINE_LATE go #-}+    go !_ acc st = acc `seq` do+        r <- step defState st+        case r of+            Yield x s -> do+                acc' <- fstep acc x+                go SPEC acc' s+            Skip s -> go SPEC acc s+            Stop   -> return acc++{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+foldl' fstep begin = foldlM' (\b a -> return (fstep b a)) (return begin)++------------------------------------------------------------------------------+-- Special folds+------------------------------------------------------------------------------++-- >>> drain = mapM_ (\_ -> return ())++-- |+-- Definitions:+--+-- >>> drain = Stream.fold Fold.drain+-- >>> drain = Stream.foldrM (\_ xs -> xs) (return ())+--+-- Run a stream, discarding the results.+--+{-# INLINE_LATE drain #-}+drain :: Monad m => Stream m a -> m ()+-- drain = foldrM (\_ xs -> xs) (return ())+drain (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield _ s -> go SPEC s+            Skip s    -> go SPEC s+            Stop      -> return ()++------------------------------------------------------------------------------+-- To Containers+------------------------------------------------------------------------------++-- This toList impl is faster (30% on streaming-benchmarks) than the+-- corresponding left fold. The left fold retains an additional argument in the+-- recursive loop.+--+-- Core for the right fold loop:+--+-- main_$s$wgo1+--   = \ sc_s3e6 sc1_s3e5 ->+--       case ># sc1_s3e5 100000# of {+--         __DEFAULT ->+--           case main_$s$wgo1 sc_s3e6 (+# sc1_s3e5 1#) of+--+-- Core for the left fold loop:+--+--  main_$s$wgo1+--   = \ sc_s3oT sc1_s3oS sc2_s3oR ->+--       case sc2_s3oR of fs2_a2lw { __DEFAULT ->+--       case ># sc1_s3oS 100000# of {+--         __DEFAULT ->+--           let { wild_a2og = I# sc1_s3oS } in+--           main_$s$wgo1+--             sc_s3oT (+# sc1_s3oS 1#) (\ x_X9 -> fs2_a2lw (: wild_a2og x_X9));++-- |+-- Definitions:+--+-- >>> toList = Stream.foldr (:) []+-- >>> toList = Stream.fold Fold.toList+--+-- Convert a stream into a list in the underlying monad. The list can be+-- consumed lazily in a lazy monad (e.g. 'Identity'). In a strict monad (e.g.+-- IO) the whole list is generated and buffered before it can be consumed.+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Data.Array" instead.+--+-- Note that this could a bit more efficient compared to @Stream.fold+-- Fold.toList@, and it can fuse with pure list consumers.+--+{-# INLINE_NORMAL toList #-}+toList :: Monad m => Stream m a -> m [a]+toList = Streamly.Internal.Data.Stream.Type.foldr (:) []++-- Use foldr/build fusion to fuse with list consumers+-- This can be useful when using the IsList instance+{-# INLINE_LATE toListFB #-}+toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b+toListFB c n (Stream step state) = go state+  where+    go st = case runIdentity (step defState st) of+             Yield x s -> x `c` go s+             Skip s    -> go s+             Stop      -> n++{-# RULES "toList Identity" Streamly.Internal.Data.Stream.Type.toList = toListId #-}+{-# INLINE_EARLY toListId #-}+toListId :: Stream Identity a -> Identity [a]+toListId s = Identity $ build (\c n -> toListFB c n s)++------------------------------------------------------------------------------+-- Multi-stream folds+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Compare two streams for equality+{-# INLINE_NORMAL eqBy #-}+eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2+  where+    eq_loop0 !_ s1 s2 = do+      r <- step1 defState s1+      case r of+        Yield x s1' -> eq_loop1 SPEC x s1' s2+        Skip    s1' -> eq_loop0 SPEC   s1' s2+        Stop        -> eq_null s2++    eq_loop1 !_ x s1 s2 = do+      r <- step2 defState s2+      case r of+        Yield y s2'+          | eq x y    -> eq_loop0 SPEC   s1 s2'+          | otherwise -> return False+        Skip    s2'   -> eq_loop1 SPEC x s1 s2'+        Stop          -> return False++    eq_null s2 = do+      r <- step2 defState s2+      case r of+        Yield _ _ -> return False+        Skip s2'  -> eq_null s2'+        Stop      -> return True++-- Adapted from the vector package.++-- | Compare two streams lexicographically.+{-# INLINE_NORMAL cmpBy #-}+cmpBy+    :: Monad m+    => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering+cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2+  where+    cmp_loop0 !_ s1 s2 = do+      r <- step1 defState s1+      case r of+        Yield x s1' -> cmp_loop1 SPEC x s1' s2+        Skip    s1' -> cmp_loop0 SPEC   s1' s2+        Stop        -> cmp_null s2++    cmp_loop1 !_ x s1 s2 = do+      r <- step2 defState s2+      case r of+        Yield y s2' -> case x `cmp` y of+                         EQ -> cmp_loop0 SPEC s1 s2'+                         c  -> return c+        Skip    s2' -> cmp_loop1 SPEC x s1 s2'+        Stop        -> return GT++    cmp_null s2 = do+      r <- step2 defState s2+      case r of+        Yield _ _ -> return LT+        Skip s2'  -> cmp_null s2'+        Stop      -> return EQ++------------------------------------------------------------------------------+-- Transformations+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- |+-- >>> mapM f = Stream.sequence . fmap f+--+-- Apply a monadic function to each element of the stream and replace it with+-- the output of the resulting action.+--+-- >>> s = Stream.fromList ["a", "b", "c"]+-- >>> Stream.fold Fold.drain $ Stream.mapM putStr s+-- abc+--+{-# INLINE_NORMAL mapM #-}+mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+mapM f (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> f x >>= \a -> return $ Yield a s+            Skip s    -> return $ Skip s+            Stop      -> return Stop++{-# INLINE map #-}+map :: Monad m => (a -> b) -> Stream m a -> Stream m b+map f = mapM (return . f)++-- (Functor m) based implementation of fmap does not fuse well in+-- streaming-benchmarks. XXX need to investigate why.+instance Monad m => Functor (Stream m) where+    {-# INLINE fmap #-}+    fmap = map++    {-# INLINE (<$) #-}+    (<$) = fmap . const++------------------------------------------------------------------------------+-- Lists+------------------------------------------------------------------------------++-- XXX Show instance is 10x slower compared to read, we can do much better.+-- The list show instance itself is really slow.++-- XXX The default definitions of "<" in the Ord instance etc. do not perform+-- well, because they do not get inlined. Need to add INLINE in Ord class in+-- base?++instance IsList (Stream Identity a) where+    type (Item (Stream Identity a)) = a++    {-# INLINE fromList #-}+    fromList = Streamly.Internal.Data.Stream.Type.fromList++    {-# INLINE toList #-}+    toList = runIdentity . Streamly.Internal.Data.Stream.Type.toList++instance Eq a => Eq (Stream Identity a) where+    {-# INLINE (==) #-}+    (==) xs ys = runIdentity $ eqBy (==) xs ys++instance Ord a => Ord (Stream Identity a) where+    {-# INLINE compare #-}+    compare xs ys = runIdentity $ cmpBy compare xs ys++    {-# INLINE (<) #-}+    x < y =+        case compare x y of+            LT -> True+            _ -> False++    {-# INLINE (<=) #-}+    x <= y =+        case compare x y of+            GT -> False+            _ -> True++    {-# INLINE (>) #-}+    x > y =+        case compare x y of+            GT -> True+            _ -> False++    {-# INLINE (>=) #-}+    x >= y =+        case compare x y of+            LT -> False+            _ -> True++    {-# INLINE max #-}+    max x y = if x <= y then y else x++    {-# INLINE min #-}+    min x y = if x <= y then x else y++instance Show a => Show (Stream Identity a) where+    showsPrec p dl = showParen (p > 10) $+        showString "fromList " . shows (GHC.Exts.toList dl)++instance Read a => Read (Stream Identity a) where+    readPrec = parens $ prec 10 $ do+        Ident "fromList" <- lexP+        Streamly.Internal.Data.Stream.Type.fromList <$> readPrec++    readListPrec = readListPrecDefault++instance (a ~ Char) => IsString (Stream Identity a) where+    {-# INLINE fromString #-}+    fromString = Streamly.Internal.Data.Stream.Type.fromList++-------------------------------------------------------------------------------+-- Foldable+-------------------------------------------------------------------------------++-- The default Foldable instance has several issues:+-- 1) several definitions do not have INLINE on them, so we provide+--    re-implementations with INLINE pragmas.+-- 2) the definitions of sum/product/maximum/minimum are inefficient as they+--    use right folds, they cannot run in constant memory. We provide+--    implementations using strict left folds here.++-- There is no Traversable instance because, there is no scalable cons for+-- StreamD, use toList and fromList instead.++instance (Foldable m, Monad m) => Foldable (Stream m) where++    {-# INLINE foldMap #-}+    foldMap f =+        Data.Foldable.fold+            . Streamly.Internal.Data.Stream.Type.foldr (mappend . f) mempty++    {-# INLINE foldr #-}+    foldr f z t = appEndo (foldMap (Endo #. f) t) z++    {-# INLINE foldl' #-}+    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0+        where f' x k = oneShot $ \z -> k $! f z x++    {-# INLINE length #-}+    length = Data.Foldable.foldl' (\n _ -> n + 1) 0++    {-# INLINE elem #-}+    elem = any . (==)++    {-# INLINE maximum #-}+    maximum =+          fromMaybe (errorWithoutStackTrace "maximum: empty stream")+        . toMaybe+        . Data.Foldable.foldl' getMax Nothing'++        where++        getMax Nothing' x = Just' x+        getMax (Just' mx) x = Just' $! max mx x++    {-# INLINE minimum #-}+    minimum =+          fromMaybe (errorWithoutStackTrace "minimum: empty stream")+        . toMaybe+        . Data.Foldable.foldl' getMin Nothing'++        where++        getMin Nothing' x = Just' x+        getMin (Just' mn) x = Just' $! min mn x++    {-# INLINE sum #-}+    sum = Data.Foldable.foldl' (+) 0++    {-# INLINE product #-}+    product = Data.Foldable.foldl' (*) 1++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Take first 'n' elements from the stream and discard the rest.+--+{-# INLINE_NORMAL take #-}+take :: Applicative m => Int -> Stream m a -> Stream m a+take n (Stream step state) = n `seq` Stream step' (state, 0)++    where++    {-# INLINE_LATE step' #-}+    step' gst (st, i) | i < n = do+        (\case+            Yield x s -> Yield x (s, i + 1)+            Skip s    -> Skip (s, i)+            Stop      -> Stop) <$> step gst st+    step' _ (_, _) = pure Stop++-- Adapted from the vector package.++-- | Same as 'takeWhile' but with a monadic predicate.+--+{-# INLINE_NORMAL takeWhileM #-}+takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+-- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x))+takeWhileM f (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                return $ if b then Yield x s else Stop+            Skip s -> return $ Skip s+            Stop   -> return Stop++-- | End the stream as soon as the predicate fails on an element.+--+{-# INLINE takeWhile #-}+takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeWhile f = takeWhileM (return . f)++-- Like takeWhile but with an inverted condition and also taking+-- the matching element.++{-# INLINE_NORMAL takeEndByM #-}+takeEndByM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+takeEndByM f (Stream step state) = Stream step' (Just state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (Just st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                return $+                    if not b+                    then Yield x (Just s)+                    else Yield x Nothing+            Skip s -> return $ Skip (Just s)+            Stop   -> return Stop++    step' _ Nothing = return Stop++{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeEndBy f = takeEndByM (return . f)++------------------------------------------------------------------------------+-- Zipping+------------------------------------------------------------------------------++-- | Like 'zipWith' but using a monadic zipping function.+--+{-# INLINE_NORMAL zipWithM #-}+zipWithM :: Monad m+    => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)+  where+    {-# INLINE_LATE step #-}+    step gst (sa, sb, Nothing) = do+        r <- stepa (adaptState gst) sa+        return $+          case r of+            Yield x sa' -> Skip (sa', sb, Just x)+            Skip sa'    -> Skip (sa', sb, Nothing)+            Stop        -> Stop++    step gst (sa, sb, Just x) = do+        r <- stepb (adaptState gst) sb+        case r of+            Yield y sb' -> do+                z <- f x y+                return $ Yield z (sa, sb', Nothing)+            Skip sb' -> return $ Skip (sa, sb', Just x)+            Stop     -> return Stop++{-# RULES "zipWithM xs xs"+    forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}++-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for+-- statically fusing a small number of streams. Use the O(n) complexity+-- StreamK.'Streamly.Data.StreamK.zipWith' otherwise.+--+-- Stream @a@ is evaluated first, followed by stream @b@, the resulting+-- elements @a@ and @b@ are then zipped using the supplied zip function and the+-- result @c@ is yielded to the consumer.+--+-- If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends+-- first, the element @a@ from previous evaluation of stream @a@ is discarded.+--+-- >>> s1 = Stream.fromList [1,2,3]+-- >>> s2 = Stream.fromList [4,5,6]+-- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2+-- [5,7,9]+--+{-# INLINE zipWith #-}+zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+zipWith f = zipWithM (\a b -> return (f a b))++------------------------------------------------------------------------------+-- Combine N Streams - concatAp+------------------------------------------------------------------------------++-- | Apply a stream of functions to a stream of values and flatten the results.+--+-- Note that the second stream is evaluated multiple times.+--+-- >>> crossApply = Stream.crossWith id+--+{-# INLINE_NORMAL crossApply #-}+crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b+crossApply (Stream stepa statea) (Stream stepb stateb) =+    Stream step' (Left statea)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Left st) = fmap+        (\case+            Yield f s -> Skip (Right (f, s, stateb))+            Skip    s -> Skip (Left s)+            Stop      -> Stop)+        (stepa (adaptState gst) st)+    step' gst (Right (f, os, st)) = fmap+        (\case+            Yield a s -> Yield (f a) (Right (f, os, s))+            Skip s    -> Skip (Right (f,os, s))+            Stop      -> Skip (Left os))+        (stepb (adaptState gst) st)++{-# INLINE_NORMAL crossApplySnd #-}+crossApplySnd :: Functor f => Stream f a -> Stream f b -> Stream f b+crossApplySnd (Stream stepa statea) (Stream stepb stateb) =+    Stream step (Left statea)++    where++    {-# INLINE_LATE step #-}+    step gst (Left st) =+        fmap+            (\case+                 Yield _ s -> Skip (Right (s, stateb))+                 Skip s -> Skip (Left s)+                 Stop -> Stop)+            (stepa (adaptState gst) st)+    step gst (Right (ostate, st)) =+        fmap+            (\case+                 Yield b s -> Yield b (Right (ostate, s))+                 Skip s -> Skip (Right (ostate, s))+                 Stop -> Skip (Left ostate))+            (stepb gst st)++{-# INLINE_NORMAL crossApplyFst #-}+crossApplyFst :: Functor f => Stream f a -> Stream f b -> Stream f a+crossApplyFst (Stream stepa statea) (Stream stepb stateb) =+    Stream step (Left statea)++    where++    {-# INLINE_LATE step #-}+    step gst (Left st) =+        fmap+            (\case+                 Yield b s -> Skip (Right (s, stateb, b))+                 Skip s -> Skip (Left s)+                 Stop -> Stop)+            (stepa gst st)+    step gst (Right (ostate, st, b)) =+        fmap+            (\case+                 Yield _ s -> Yield b (Right (ostate, s, b))+                 Skip s -> Skip (Right (ostate, s, b))+                 Stop -> Skip (Left ostate))+            (stepb (adaptState gst) st)++{-+instance Applicative f => Applicative (Stream f) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = crossApplyFst+-}++-- |+-- Definition:+--+-- >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2+--+-- Note that the second stream is evaluated multiple times.+--+{-# INLINE crossWith #-}+crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+crossWith f m1 m2 = fmap f m1 `crossApply` m2++-- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible+-- combinations of the tuple @(a, b)@.+--+-- Definition:+--+-- >>> cross = Stream.crossWith (,)+--+-- The second stream is evaluated multiple times. If that is not desired it can+-- be cached in an 'Data.Array.Array' and then generated from the array before+-- calling this function. Caching may also improve performance if the stream is+-- expensive to evaluate.+--+-- See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused+-- alternative.+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE cross #-}+cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+cross = crossWith (,)++------------------------------------------------------------------------------+-- Combine N Streams - unfoldMany+------------------------------------------------------------------------------++{-# ANN type ConcatMapUState Fuse #-}+data ConcatMapUState o i =+      ConcatMapUOuter o+    | ConcatMapUInner o i++-- | @unfoldMany unfold stream@ uses @unfold@ to map the input stream elements+-- to streams and then flattens the generated streams into a single output+-- stream.++-- This is like 'concatMap' but uses an unfold with an explicit state to+-- generate the stream instead of a 'Stream' type generator. This allows better+-- optimization via fusion.  This can be many times more efficient than+-- 'concatMap'.++-- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike+-- 'concatMap' this can fuse the 'Unfold' code with the inner loop and+-- therefore provide many times better performance.+--+{-# INLINE_NORMAL unfoldMany #-}+unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b+unfoldMany (Unfold istep inject) (Stream ostep ost) =+    Stream step (ConcatMapUOuter ost)+  where+    {-# INLINE_LATE step #-}+    step gst (ConcatMapUOuter o) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (ConcatMapUInner o' i))+            Skip o' -> return $ Skip (ConcatMapUOuter o')+            Stop -> return Stop++    step _ (ConcatMapUInner o i) = do+        r <- istep i+        return $ case r of+            Yield x i' -> Yield x (ConcatMapUInner o i')+            Skip i'    -> Skip (ConcatMapUInner o i')+            Stop       -> Skip (ConcatMapUOuter o)++------------------------------------------------------------------------------+-- Combine N Streams - concatMap+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Map a stream producing monadic function on each element of the stream+-- and then flatten the results into a single stream. Since the stream+-- generation function is monadic, unlike 'concatMap', it can produce an+-- effect at the beginning of each iteration of the inner loop.+--+-- See 'unfoldMany' for a fusible alternative.+--+{-# INLINE_NORMAL concatMapM #-}+concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+concatMapM f (Stream step state) = Stream step' (Left state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (Left st) = do+        r <- step (adaptState gst) st+        case r of+            Yield a s -> do+                b_stream <- f a+                return $ Skip (Right (b_stream, s))+            Skip s -> return $ Skip (Left s)+            Stop -> return Stop++    -- XXX flattenArrays is 5x faster than "concatMap fromArray". if somehow we+    -- can get inner_step to inline and fuse here we can perhaps get the same+    -- performance using "concatMap fromArray".+    --+    -- XXX using the pattern synonym "Stream" causes a major performance issue+    -- here even if the synonym does not include an adaptState call. Need to+    -- find out why. Is that something to be fixed in GHC?+    step' gst (Right (UnStream inner_step inner_st, st)) = do+        r <- inner_step (adaptState gst) inner_st+        case r of+            Yield b inner_s ->+                return $ Yield b (Right (Stream inner_step inner_s, st))+            Skip inner_s ->+                return $ Skip (Right (Stream inner_step inner_s, st))+            Stop -> return $ Skip (Left st)++-- | Map a stream producing function on each element of the stream and then+-- flatten the results into a single stream.+--+-- >>> concatMap f = Stream.concatMapM (return . f)+-- >>> concatMap f = Stream.concat . fmap f+-- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream)+--+-- See 'unfoldMany' for a fusible alternative.+--+{-# INLINE concatMap #-}+concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+concatMap f = concatMapM (return . f)++-- | Flatten a stream of streams to a single stream.+--+-- >>> concat = Stream.concatMap id+--+-- /Pre-release/+{-# INLINE concat #-}+concat :: Monad m => Stream m (Stream m a) -> Stream m a+concat = concatMap id++-- XXX The idea behind this rule is to rewrite any calls to "concatMap+-- fromArray" automatically to flattenArrays which is much faster.  However, we+-- need an INLINE_EARLY on concatMap for this rule to fire. But if we use+-- INLINE_EARLY on concatMap or fromArray then direct uses of+-- "concatMap fromArray" (without the RULE) become much slower, this means+-- "concatMap f" in general would become slower. Need to find a solution to+-- this.+--+-- {-# RULES "concatMap Array.toStreamD"+--      concatMap Array.toStreamD = Array.flattenArray #-}++-- >>> concatEffect = Stream.concat . lift    -- requires (MonadTrans t)+-- >>> concatEffect = join . lift             -- requires (MonadTrans t, Monad (Stream m))++-- | Given a stream value in the underlying monad, lift and join the underlying+-- monad with the stream monad.+--+-- >>> concatEffect = Stream.concat . Stream.fromEffect+-- >>> concatEffect eff = Stream.concatMapM (\() -> eff) (Stream.fromPure ())+--+-- See also: 'concat', 'sequence'+--+{-# INLINE concatEffect #-}+concatEffect :: Monad m => m (Stream m a) -> Stream m a+concatEffect generator = concatMapM (\() -> generator) (fromPure ())++{-+-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,+-- the monad instance does not seem to be significantly faster.+instance Monad m => Monad (Stream m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap++    {-# INLINE (>>) #-}+    (>>) = (*>)+-}++------------------------------------------------------------------------------+-- Traversing a tree top down+------------------------------------------------------------------------------++-- Next stream is to be generated by the return value of the previous stream. A+-- general intuitive way of doing that could be to use an appending monad+-- instance for streams where the result of the previous stream is used to+-- generate the next one. In the first pass we can just emit the values in the+-- stream and keep building a buffered list/stream, once done we can then+-- process the buffered stream.++-- | Generate a stream from an initial state, scan and concat the stream,+-- generate a stream again from the final state of the previous scan and repeat+-- the process.+{-# INLINE_NORMAL concatIterateScan #-}+concatIterateScan :: Monad m =>+       (b -> a -> m b)+    -> (b -> m (Maybe (b, Stream m a)))+    -> b+    -> Stream m a+concatIterateScan scanner generate initial = Stream step (Left initial)++    where++    {-# INLINE_LATE step #-}+    step _ (Left acc) = do+        r <- generate acc+        case r of+            Nothing -> return Stop+            Just v -> return $ Skip (Right v)++    step gst (Right (st, UnStream inner_step inner_st)) = do+        r <- inner_step (adaptState gst) inner_st+        case r of+            Yield b inner_s -> do+                acc <- scanner st b+                return $ Yield b (Right (acc, Stream inner_step inner_s))+            Skip inner_s ->+                return $ Skip (Right (st, Stream inner_step inner_s))+            Stop -> return $ Skip (Left st)++-- Note: The iterate function returns a Maybe Stream instead of returning a nil+-- stream for indicating a leaf node. This is to optimize so that we do not+-- have to store any state. This makes the stored state proportional to the+-- number of non-leaf nodes rather than total number of nodes.++-- | Same as 'concatIterateBfs' except that the traversal of the last+-- element on a level is emitted first and then going backwards up to the first+-- element (reversed ordering). This may be slightly faster than+-- 'concatIterateBfs'.+--+{-# INLINE_NORMAL concatIterateBfsRev #-}+concatIterateBfsRev :: Monad m =>+       (a -> Maybe (Stream m a))+    -> Stream m a+    -> Stream m a+concatIterateBfsRev f stream = Stream step (stream, [])++    where++    {-# INLINE_LATE step #-}+    step gst (UnStream step1 st, xs) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield a s -> do+                let xs1 =+                        case f a of+                            Nothing -> xs+                            Just x -> x:xs+                return $ Yield a (Stream step1 s, xs1)+            Skip s -> return $ Skip (Stream step1 s, xs)+            Stop ->+                case xs of+                    (y:ys) -> return $ Skip (y, ys)+                    [] -> return Stop++-- | Similar to 'concatIterateDfs' except that it traverses the stream in+-- breadth first style (BFS). First, all the elements in the input stream are+-- emitted, and then their traversals are emitted.+--+-- Example, list a directory tree using BFS:+--+-- >>> f = either (Just . Dir.readEitherPaths) (const Nothing)+-- >>> input = Stream.fromPure (Left ".")+-- >>> ls = Stream.concatIterateBfs f input+--+-- /Pre-release/+{-# INLINE_NORMAL concatIterateBfs #-}+concatIterateBfs :: Monad m =>+       (a -> Maybe (Stream m a))+    -> Stream m a+    -> Stream m a+concatIterateBfs f stream = Stream step (stream, [], [])++    where++    {-# INLINE_LATE step #-}+    step gst (UnStream step1 st, xs, ys) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield a s -> do+                let ys1 =+                        case f a of+                            Nothing -> ys+                            Just y -> y:ys+                return $ Yield a (Stream step1 s, xs, ys1)+            Skip s -> return $ Skip (Stream step1 s, xs, ys)+            Stop ->+                case xs of+                    (x:xs1) -> return $ Skip (x, xs1, ys)+                    [] ->+                        case reverse ys of+                            (x:xs1) -> return $ Skip (x, xs1, [])+                            [] -> return Stop++-- | Traverse the stream in depth first style (DFS). Map each element in the+-- input stream to a stream and flatten, recursively map the resulting elements+-- as well to a stream and flatten until no more streams are generated.+--+-- Example, list a directory tree using DFS:+--+-- >>> f = either (Just . Dir.readEitherPaths) (const Nothing)+-- >>> input = Stream.fromPure (Left ".")+-- >>> ls = Stream.concatIterateDfs f input+--+-- This is equivalent to using @concatIterateWith StreamK.append@.+--+-- /Pre-release/+{-# INLINE_NORMAL concatIterateDfs #-}+concatIterateDfs :: Monad m =>+       (a -> Maybe (Stream m a))+    -> Stream m a+    -> Stream m a+concatIterateDfs f stream = Stream step (stream, [])++    where++    {-# INLINE_LATE step #-}+    step gst (UnStream step1 st, xs) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield a s -> do+                let st1 =+                        case f a of+                            Nothing -> (Stream step1 s, xs)+                            Just x -> (x, Stream step1 s:xs)+                return $ Yield a st1+            Skip s -> return $ Skip (Stream step1 s, xs)+            Stop ->+                case xs of+                    (y:ys) -> return $ Skip (y, ys)+                    [] -> return Stop++{-# ANN type IterateUnfoldState Fuse #-}+data IterateUnfoldState o i =+      IterateUnfoldOuter o+    | IterateUnfoldInner o i [i]++-- | Same as @concatIterateDfs@ but more efficient due to stream fusion.+--+-- Example, list a directory tree using DFS:+--+-- >>> f = Unfold.either Dir.eitherReaderPaths Unfold.nil+-- >>> input = Stream.fromPure (Left ".")+-- >>> ls = Stream.unfoldIterateDfs f input+--+-- /Pre-release/+{-# INLINE_NORMAL unfoldIterateDfs #-}+unfoldIterateDfs :: Monad m =>+       Unfold m a a+    -> Stream m a+    -> Stream m a+unfoldIterateDfs (Unfold istep inject) (Stream ostep ost) =+    Stream step (IterateUnfoldOuter ost)++    where++    {-# INLINE_LATE step #-}+    step gst (IterateUnfoldOuter o) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a s -> do+                i <- inject a+                i `seq` return (Yield a (IterateUnfoldInner s i []))+            Skip s -> return $ Skip (IterateUnfoldOuter s)+            Stop -> return Stop++    step _ (IterateUnfoldInner o i ii) = do+        r <- istep i+        case r of+            Yield x s -> do+                i1 <- inject x+                i1 `seq` return $ Yield x (IterateUnfoldInner o i1 (s:ii))+            Skip s -> return $ Skip (IterateUnfoldInner o s ii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldInner o y ys)+                    [] -> return $ Skip (IterateUnfoldOuter o)++{-# ANN type IterateUnfoldBFSRevState Fuse #-}+data IterateUnfoldBFSRevState o i =+      IterateUnfoldBFSRevOuter o [i]+    | IterateUnfoldBFSRevInner i [i]++-- | Like 'unfoldIterateBfs' but processes the children in reverse order,+-- therefore, may be slightly faster.+--+-- /Pre-release/+{-# INLINE_NORMAL unfoldIterateBfsRev #-}+unfoldIterateBfsRev :: Monad m =>+       Unfold m a a+    -> Stream m a+    -> Stream m a+unfoldIterateBfsRev (Unfold istep inject) (Stream ostep ost) =+    Stream step (IterateUnfoldBFSRevOuter ost [])++    where++    {-# INLINE_LATE step #-}+    step gst (IterateUnfoldBFSRevOuter o ii) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a s -> do+                i <- inject a+                i `seq` return (Yield a (IterateUnfoldBFSRevOuter s (i:ii)))+            Skip s -> return $ Skip (IterateUnfoldBFSRevOuter s ii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)+                    [] -> return Stop++    step _ (IterateUnfoldBFSRevInner i ii) = do+        r <- istep i+        case r of+            Yield x s -> do+                i1 <- inject x+                i1 `seq` return $ Yield x (IterateUnfoldBFSRevInner s (i1:ii))+            Skip s -> return $ Skip (IterateUnfoldBFSRevInner s ii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)+                    [] -> return Stop++{-# ANN type IterateUnfoldBFSState Fuse #-}+data IterateUnfoldBFSState o i =+      IterateUnfoldBFSOuter o [i]+    | IterateUnfoldBFSInner i [i] [i]++-- | Like 'unfoldIterateDfs' but uses breadth first style traversal.+--+-- /Pre-release/+{-# INLINE_NORMAL unfoldIterateBfs #-}+unfoldIterateBfs :: Monad m =>+       Unfold m a a+    -> Stream m a+    -> Stream m a+unfoldIterateBfs (Unfold istep inject) (Stream ostep ost) =+    Stream step (IterateUnfoldBFSOuter ost [])++    where++    {-# INLINE_LATE step #-}+    step gst (IterateUnfoldBFSOuter o rii) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a s -> do+                i <- inject a+                i `seq` return (Yield a (IterateUnfoldBFSOuter s (i:rii)))+            Skip s -> return $ Skip (IterateUnfoldBFSOuter s rii)+            Stop ->+                case reverse rii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])+                    [] -> return Stop++    step _ (IterateUnfoldBFSInner i ii rii) = do+        r <- istep i+        case r of+            Yield x s -> do+                i1 <- inject x+                i1 `seq` return $ Yield x (IterateUnfoldBFSInner s ii (i1:rii))+            Skip s -> return $ Skip (IterateUnfoldBFSInner s ii rii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys rii)+                    [] ->+                        case reverse rii of+                            (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])+                            [] -> return Stop++------------------------------------------------------------------------------+-- Folding a tree bottom up+------------------------------------------------------------------------------++-- | Binary BFS style reduce, folds a level entirely using the supplied fold+-- function, collecting the outputs as next level of the tree, then repeats the+-- same process on the next level. The last elements of a previously folded+-- level are folded first.+{-# INLINE_NORMAL reduceIterateBfs #-}+reduceIterateBfs :: Monad m =>+    (a -> a -> m a) -> Stream m a -> m (Maybe a)+reduceIterateBfs f (Stream step state) = go SPEC state [] Nothing++    where++    go _ st xs Nothing = do+        r <- step defState st+        case r of+            Yield x1 s -> go SPEC s xs (Just x1)+            Skip s -> go SPEC s xs Nothing+            Stop ->+                case xs of+                    [] -> return Nothing+                    _ -> goBuf SPEC xs []+    go _ st xs (Just x1) = do+        r2 <- step defState st+        case r2 of+            Yield x2 s -> do+                x <- f x1 x2+                go SPEC s (x:xs) Nothing+            Skip s -> go SPEC s xs (Just x1)+            Stop ->+                case xs of+                    [] -> return (Just x1)+                    _ -> goBuf SPEC (x1:xs) []++    goBuf _ [] ys = goBuf SPEC ys []+    goBuf _ [x1] ys = do+        case ys of+            [] -> return (Just x1)+            (x2:xs) -> do+                y <- f x1 x2+                goBuf SPEC xs [y]+    goBuf _ (x1:x2:xs) ys = do+        y <- f x1 x2+        goBuf SPEC xs (y:ys)++-- | N-Ary BFS style iterative fold, if the input stream finished before the+-- fold then it returns Left otherwise Right. If the fold returns Left we+-- terminate.+--+-- /Unimplemented/+foldIterateBfs ::+    Fold m a (Either a a) -> Stream m a -> m (Maybe a)+foldIterateBfs = undefined++------------------------------------------------------------------------------+-- Grouping/Splitting+------------------------------------------------------------------------------++-- s = stream state, fs = fold state+{-# ANN type FoldManyPost Fuse #-}+data FoldManyPost s fs b a+    = FoldManyPostStart s+    | FoldManyPostLoop s fs+    | FoldManyPostYield b (FoldManyPost s fs b a)+    | FoldManyPostDone++-- XXX Need a more intuitive name, and need to reconcile the names+-- foldMany/fold/parse/parseMany/parseManyPost etc.++-- XXX foldManyPost keeps the last fold always partial. if the last fold is+-- complete then another fold is applied on empty input. This is used for+-- applying folds like takeEndBy such that the last element is not the+-- separator (infix style). But that looks like a hack. We should remove this+-- and use a custom combinator for infix parsing.++-- | Like 'foldMany' but evaluates the fold even if the fold did not receive+-- any input, therefore, always results in a non-empty output even on an empty+-- stream (default result of the fold).+--+-- Example, empty stream:+--+-- >>> f = Fold.take 2 Fold.sum+-- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f+-- >>> fmany $ Stream.fromList []+-- [0]+--+-- Example, last fold empty:+--+-- >>> fmany $ Stream.fromList [1..4]+-- [3,7,0]+--+-- Example, last fold non-empty:+--+-- >>> fmany $ Stream.fromList [1..5]+-- [3,7,5]+--+-- Note that using a closed fold e.g. @Fold.take 0@, would result in an+-- infinite stream without consuming the input.+--+-- /Pre-release/+--+{-# INLINE_NORMAL foldManyPost #-}+foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b+foldManyPost (Fold fstep initial _ final) (Stream step state) =+    Stream step' (FoldManyPostStart state)++    where++    {-# INLINE consume #-}+    consume x s fs = do+        res <- fstep fs x+        return+            $ Skip+            $ case res of+                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart s)+                  FL.Partial ps -> FoldManyPostLoop s ps++    {-# INLINE_LATE step' #-}+    step' _ (FoldManyPostStart st) = do+        r <- initial+        return+            $ Skip+            $ case r of+                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart st)+                  FL.Partial fs -> FoldManyPostLoop st fs+    step' gst (FoldManyPostLoop st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyPostLoop s fs)+            Stop -> do+                b <- final fs+                return $ Skip (FoldManyPostYield b FoldManyPostDone)+    step' _ (FoldManyPostYield b next) = return $ Yield b next+    step' _ FoldManyPostDone = return Stop++{-# ANN type FoldMany Fuse #-}+data FoldMany s fs b a+    = FoldManyStart s+    | FoldManyFirst fs s+    | FoldManyLoop s fs+    | FoldManyYield b (FoldMany s fs b a)+    | FoldManyDone++-- XXX Nested foldMany does not fuse.++-- | Apply a 'Fold' repeatedly on a stream and emit the results in the output+-- stream.+--+-- Definition:+--+-- >>> foldMany f = Stream.parseMany (Parser.fromFold f)+--+-- Example, empty stream:+--+-- >>> f = Fold.take 2 Fold.sum+-- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f+-- >>> fmany $ Stream.fromList []+-- []+--+-- Example, last fold empty:+--+-- >>> fmany $ Stream.fromList [1..4]+-- [3,7]+--+-- Example, last fold non-empty:+--+-- >>> fmany $ Stream.fromList [1..5]+-- [3,7,5]+--+-- Note that using a closed fold e.g. @Fold.take 0@, would result in an+-- infinite stream on a non-empty input stream.+--+{-# INLINE_NORMAL foldMany #-}+foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+foldMany (Fold fstep initial _ final) (Stream step state) =+    Stream step' (FoldManyStart state)++    where++    {-# INLINE consume #-}+    consume x s fs = do+        res <- fstep fs x+        return+            $ Skip+            $ case res of+                  FL.Done b -> FoldManyYield b (FoldManyStart s)+                  FL.Partial ps -> FoldManyLoop s ps++    {-# INLINE_LATE step' #-}+    step' _ (FoldManyStart st) = do+        r <- initial+        return+            $ Skip+            $ case r of+                  FL.Done b -> FoldManyYield b (FoldManyStart st)+                  FL.Partial fs -> FoldManyFirst fs st+    step' gst (FoldManyFirst fs st) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyFirst fs s)+            Stop -> final fs >> return Stop+    step' gst (FoldManyLoop st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyLoop s fs)+            Stop -> do+                b <- final fs+                return $ Skip (FoldManyYield b FoldManyDone)+    step' _ (FoldManyYield b next) = return $ Yield b next+    step' _ FoldManyDone = return Stop++-- | Group the input stream into groups of @n@ elements each and then fold each+-- group using the provided fold function.+--+-- @groupsOf n f = foldMany (FL.take n f)@+--+-- >>> Stream.toList $ Stream.groupsOf 2 Fold.sum (Stream.enumerateFromTo 1 10)+-- [3,7,11,15,19]+--+-- This can be considered as an n-fold version of 'take' where we apply+-- 'take' repeatedly on the leftover stream until the stream exhausts.+--+{-# INLINE groupsOf #-}+groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b+groupsOf n f = foldMany (FL.take n f)++-- Keep the argument order consistent with refoldIterateM.++-- | Like 'foldMany' but for the 'Refold' type.  The supplied action is used as+-- the initial value for each refold.+--+-- /Internal/+{-# INLINE_NORMAL refoldMany #-}+refoldMany :: Monad m => Refold m x a b -> m x -> Stream m a -> Stream m b+refoldMany (Refold fstep inject extract) action (Stream step state) =+    Stream step' (FoldManyStart state)++    where++    {-# INLINE consume #-}+    consume x s fs = do+        res <- fstep fs x+        return+            $ Skip+            $ case res of+                  FL.Done b -> FoldManyYield b (FoldManyStart s)+                  FL.Partial ps -> FoldManyLoop s ps++    {-# INLINE_LATE step' #-}+    step' _ (FoldManyStart st) = do+        r <- action >>= inject+        return+            $ Skip+            $ case r of+                  FL.Done b -> FoldManyYield b (FoldManyStart st)+                  FL.Partial fs -> FoldManyFirst fs st+    step' gst (FoldManyFirst fs st) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyFirst fs s)+            Stop -> return Stop+    step' gst (FoldManyLoop st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyLoop s fs)+            Stop -> do+                b <- extract fs+                return $ Skip (FoldManyYield b FoldManyDone)+    step' _ (FoldManyYield b next) = return $ Yield b next+    step' _ FoldManyDone = return Stop++------------------------------------------------------------------------------+-- Stream with a cross product style monad instance+------------------------------------------------------------------------------++-- XXX CrossStream performs better than the CrossStreamK when nesting two+-- loops, however, CrossStreamK seems to be better for more than two nestings,+-- need to do more perf investigation.++-- | A newtype wrapper for the 'Stream' type with a cross product style monad+-- instance.+--+-- A 'Monad' bind behaves like a @for@ loop:+--+-- >>> :{+-- Stream.fold Fold.toList $ Stream.unCross $ do+--     x <- Stream.mkCross $ Stream.fromList [1,2]+--     -- Perform the following actions for each x in the stream+--     return x+-- :}+-- [1,2]+--+-- Nested monad binds behave like nested @for@ loops:+--+-- >>> :{+-- Stream.fold Fold.toList $ Stream.unCross $ do+--     x <- Stream.mkCross $ Stream.fromList [1,2]+--     y <- Stream.mkCross $ Stream.fromList [3,4]+--     -- Perform the following actions for each x, for each y+--     return (x, y)+-- :}+-- [(1,3),(1,4),(2,3),(2,4)]+--+newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a}+        deriving (Functor, Foldable)++{-# INLINE mkCross #-}+mkCross :: Stream m a -> CrossStream m a+mkCross = CrossStream++{-# INLINE unCross #-}+unCross :: CrossStream m a -> Stream m a+unCross = unCrossStream++-- Pure (Identity monad) stream instances+deriving instance IsList (CrossStream Identity a)+deriving instance (a ~ Char) => IsString (CrossStream Identity a)+deriving instance Eq a => Eq (CrossStream Identity a)+deriving instance Ord a => Ord (CrossStream Identity a)++-- Do not use automatic derivation for this to show as "fromList" rather than+-- "fromList Identity".+instance Show a => Show (CrossStream Identity a) where+    {-# INLINE show #-}+    show (CrossStream xs) = show xs++instance Read a => Read (CrossStream Identity a) where+    {-# INLINE readPrec #-}+    readPrec = fmap CrossStream readPrec++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++-- Note: we need to define all the typeclass operations because we want to+-- INLINE them.+instance Monad m => Applicative (CrossStream m) where+    {-# INLINE pure #-}+    pure x = CrossStream (fromPure x)++    {-# INLINE (<*>) #-}+    (CrossStream s1) <*> (CrossStream s2) =+        CrossStream (crossApply s1 s2)++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (CrossStream s1) *> (CrossStream s2) =+        CrossStream (crossApplySnd s1 s2)++    {-# INLINE (<*) #-}+    (CrossStream s1) <* (CrossStream s2) =+        CrossStream (crossApplyFst s1 s2)++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++instance Monad m => Monad (CrossStream m) where+    return = pure++    -- Benchmarks better with StreamD bind and pure:+    -- toList, filterAllout, *>, *<, >> (~2x)+    --++    -- Benchmarks better with CPS bind and pure:+    -- Prime sieve (25x)+    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)+    --+    {-# INLINE (>>=) #-}+    (>>=) (CrossStream m) f = CrossStream (concatMap (unCrossStream . f) m)++    {-# INLINE (>>) #-}+    (>>) = (*>)++------------------------------------------------------------------------------+-- Transformers+------------------------------------------------------------------------------++instance (MonadIO m) => MonadIO (CrossStream m) where+    liftIO x = CrossStream (fromEffect $ liftIO x)++instance MonadTrans CrossStream where+    {-# INLINE lift #-}+    lift x = CrossStream (fromEffect x)++instance (MonadThrow m) => MonadThrow (CrossStream m) where+    throwM = lift . throwM
− src/Streamly/Internal/Data/Stream/Zip.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.Zip--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ To run examples in this module:------ >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.Zip as Stream----module Streamly.Internal.Data.Stream.Zip-    (-      ZipStream (..)-    , ZipSerialM-    , ZipSerial-    )-where--import Data.Functor.Identity (Identity(..))-import GHC.Exts (IsList(..), IsString(..))-import Streamly.Internal.Data.Stream.Type (Stream)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import qualified Streamly.Internal.Data.Stream.Bottom as Stream-import qualified Streamly.Internal.Data.Stream.Generate as Stream---- $setup--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.Zip as Stream----------------------------------------------------------------------------------- Serially Zipping Streams----------------------------------------------------------------------------------- | For 'ZipStream':------ @--- (<>) = 'Streamly.Data.Stream.append'--- (\<*>) = 'Streamly.Data.Stream.zipWith' id--- @------ Applicative evaluates the streams being zipped serially:------ >>> s1 = Stream.ZipStream $ Stream.fromFoldable [1, 2]--- >>> s2 = Stream.ZipStream $ Stream.fromFoldable [3, 4]--- >>> s3 = Stream.ZipStream $ Stream.fromFoldable [5, 6]--- >>> s = (,,) <$> s1 <*> s2 <*> s3--- >>> Stream.fold Fold.toList (Stream.unZipStream s)--- [(1,3,5),(2,4,6)]----newtype ZipStream m a = ZipStream {unZipStream :: Stream m a}-        deriving (Functor, Semigroup, Monoid)--deriving instance IsList (ZipStream Identity a)-deriving instance (a ~ Char) => IsString (ZipStream Identity a)-deriving instance Eq a => Eq (ZipStream Identity a)-deriving instance Ord a => Ord (ZipStream Identity a)-deriving instance (Foldable m, Monad m) => Foldable (ZipStream m)-deriving instance Traversable (ZipStream Identity)--instance Show a => Show (ZipStream Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (toList dl)--instance Read a => Read (ZipStream Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        fromList <$> readPrec-    readListPrec = readListPrecDefault--type ZipSerialM = ZipStream---- | An IO stream whose applicative instance zips streams serially.----type ZipSerial = ZipSerialM IO--instance Monad m => Applicative (ZipStream m) where-    pure = ZipStream . Stream.repeat--    {-# INLINE (<*>) #-}-    ZipStream m1 <*> ZipStream m2 = ZipStream $ Stream.zipWith id m1 m2
+ src/Streamly/Internal/Data/StreamK.hs view
@@ -0,0 +1,1739 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.StreamK+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.StreamK+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * The stream type+      module Streamly.Internal.Data.StreamK.Type+    , module Streamly.Internal.Data.StreamK.Transformer++    , StreamK(..)+    , fromList+    , fromStream+    , toStream++    -- ** Specialized Generation+    , repeatM+    , replicate+    , replicateM+    , fromIndices+    , fromIndicesM+    , iterate+    , iterateM++    -- * Elimination+    -- ** General Folds+    , foldr1+    , foldlM'+    , foldlMx'+    , fold+    , foldBreak+    , foldEither+    , foldConcat+    , parseDBreak+    , parseD+    , parseBreakChunks+    , parseChunks+    , parseBreak+    , parse+    , parseBreakChunksGeneric+    , parseChunksGeneric++    -- ** Specialized Folds+    , head+    , elem+    , notElem+    , all+    , any+    , last+    , minimum+    , minimumBy+    , maximum+    , maximumBy+    , findIndices+    , lookup+    , findM+    , find+    , (!!)++    -- ** Map and Fold+    , mapM_++    -- ** Conversions+    , toList+    , hoist++    -- * Transformation+    -- ** By folding (scans)+    , scanl'+    , scanlx'++    -- ** Filtering+    , filter+    , take+    , takeWhile+    , drop+    , dropWhile++    -- ** Mapping+    , mapM+    , sequence++    -- ** Inserting+    , intersperseM+    , intersperse+    , insertBy++    -- ** Deleting+    , deleteBy++    -- ** Reordering+    , sortBy++    -- ** Map and Filter+    , mapMaybe++    -- ** Zipping+    , zipWith+    , zipWithM++    -- ** Merging+    , mergeBy+    , mergeByM++    -- ** Transformation comprehensions+    , the++    -- * Exceptions+    , handle++    -- * Resource Management+    , bracketIO+    )+where++#include "ArrayMacros.h"+#include "inline.hs"+#include "assert.hs"++import Control.Exception (mask_, Exception)+import Control.Monad (void, join)+import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Proxy (Proxy(..))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.IOFinalizer (newIOFinalizer, runIOFinalizer)+import Streamly.Internal.Data.ParserK.Type (ParserK)+import Streamly.Internal.Data.Producer.Type (Producer(..))+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Unbox (sizeOf, Unbox)++import qualified Control.Monad.Catch as MC+import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Array.Generic as GenArr+import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Parser as Parser+import qualified Streamly.Internal.Data.Parser.Type as PR+import qualified Streamly.Internal.Data.ParserK.Type as ParserK+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Prelude++import Prelude+       hiding (Foldable(..), last, map, mapM, mapM_, repeat, sequence,+               take, filter, all, any, takeWhile, drop, dropWhile,+               notElem, head, tail, init, zipWith, lookup,+               (!!), replicate, reverse, concatMap, iterate, splitAt)+import Data.Foldable (sum, length)+import Streamly.Internal.Data.StreamK.Type+import Streamly.Internal.Data.StreamK.Transformer+import Streamly.Internal.Data.Parser (ParseError(..))++#include "DocTestDataStreamK.hs"++-- | Convert a fused 'Stream' to 'StreamK'.+--+-- For example:+--+-- >>> s1 = StreamK.fromStream $ Stream.fromList [1,2]+-- >>> s2 = StreamK.fromStream $ Stream.fromList [3,4]+-- >>> Stream.fold Fold.toList $ StreamK.toStream $ s1 `StreamK.append` s2+-- [1,2,3,4]+--+{-# INLINE fromStream #-}+fromStream :: Monad m => Stream.Stream m a -> StreamK m a+fromStream = Stream.toStreamK++-- | Convert a 'StreamK' to a fused 'Stream'.+--+{-# INLINE toStream #-}+toStream :: Applicative m => StreamK m a -> Stream.Stream m a+toStream = Stream.fromStreamK++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++{-+-- Generalization of concurrent streams/SVar via unfoldr.+--+-- Unfold a value into monadic actions and then run the resulting monadic+-- actions to generate a stream. Since the step of generating the monadic+-- action and running them are decoupled we can run the monadic actions+-- cooncurrently. For example, the seed could be a list of monadic actions or a+-- pure stream of monadic actions.+--+-- We can have different flavors of this depending on the stream type t. The+-- concurrent version could be async or ahead etc. Depending on how we queue+-- back the feedback portion b, it could be DFS or BFS style.+--+unfoldrA :: (b -> Maybe (m a, b)) -> b -> StreamK m a+unfoldrA = undefined+-}++-------------------------------------------------------------------------------+-- Special generation+-------------------------------------------------------------------------------++-- |+-- >>> repeatM = StreamK.sequence . StreamK.repeat+-- >>> repeatM = fix . StreamK.consM+-- >>> repeatM = cycle1 . StreamK.fromEffect+--+-- Generate a stream by repeatedly executing a monadic action forever.+--+-- >>> :{+-- repeatAction =+--        StreamK.repeatM (threadDelay 1000000 >> print 1)+--      & StreamK.take 10+--      & StreamK.fold Fold.drain+-- :}+--+repeatM :: Monad m => m a -> StreamK m a+repeatM = repeatMWith consM++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> m a -> StreamK m a+replicateM = replicateMWith consM+{-# INLINE replicate #-}+replicate :: Int -> a -> StreamK m a+replicate n a = go n+    where+    go cnt = if cnt <= 0 then nil else a `cons` go (cnt - 1)++{-# INLINE fromIndicesM #-}+fromIndicesM :: Monad m => (Int -> m a) -> StreamK m a+fromIndicesM = fromIndicesMWith consM+{-# INLINE fromIndices #-}+fromIndices :: (Int -> a) -> StreamK m a+fromIndices gen = go 0+  where+    go n = gen n `cons` go (n + 1)++-- |+-- >>> iterate f x = x `StreamK.cons` iterate f x+--+-- Generate an infinite stream with @x@ as the first element and each+-- successive element derived by applying the function @f@ on the previous+-- element.+--+-- >>> StreamK.toList $ StreamK.take 5 $ StreamK.iterate (+1) 1+-- [1,2,3,4,5]+--+{-# INLINE iterate #-}+iterate :: (a -> a) -> a -> StreamK m a+iterate step = go+    where+        go !s = cons s (go (step s))++-- |+-- >>> iterateM f m = m >>= \a -> return a `StreamK.consM` iterateM f (f a)+--+-- Generate an infinite stream with the first element generated by the action+-- @m@ and each successive element derived by applying the monadic function+-- @f@ on the previous element.+--+-- >>> :{+-- StreamK.iterateM (\x -> print x >> return (x + 1)) (return 0)+--     & StreamK.take 3+--     & StreamK.toList+-- :}+-- 0+-- 1+-- [0,1,2]+--+{-# INLINE iterateM #-}+iterateM :: Monad m => (a -> m a) -> m a -> StreamK m a+iterateM = iterateMWith consM++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++{-# INLINE fromList #-}+fromList :: [a] -> StreamK m a+fromList = fromFoldable++-------------------------------------------------------------------------------+-- Elimination by Folding+-------------------------------------------------------------------------------++{-# INLINE foldr1 #-}+foldr1 :: Monad m => (a -> a -> a) -> StreamK m a -> m (Maybe a)+foldr1 step m = do+    r <- uncons m+    case r of+        Nothing -> return Nothing+        Just (h, t) -> fmap Just (go h t)+    where+    go p m1 =+        let stp = return p+            single a = return $ step a p+            yieldk a r = fmap (step p) (go a r)+         in foldStream defState yieldk single stp m1++-- XXX replace the recursive "go" with explicit continuations.+-- | Like 'foldx', but with a monadic step function.+{-# INLINABLE foldlMx' #-}+foldlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b+foldlMx' step begin done = go begin+    where+    go !acc m1 =+        let stop = acc >>= done+            single a = acc >>= \b -> step b a >>= done+            yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r+         in foldStream defState yieldk single stop m1++-- | Fold a stream using the supplied left 'Fold' and reducing the resulting+-- expression strictly at each step. The behavior is similar to 'foldl''. A+-- 'Fold' can terminate early without consuming the full stream. See the+-- documentation of individual 'Fold's for termination behavior.+--+-- Definitions:+--+-- >>> fold f = fmap fst . StreamK.foldBreak f+-- >>> fold f = StreamK.parseD (Parser.fromFold f)+--+-- Example:+--+-- >>> StreamK.fold Fold.sum $ StreamK.fromStream $ Stream.enumerateFromTo 1 100+-- 5050+--+{-# INLINABLE fold #-}+fold :: Monad m => FL.Fold m a b -> StreamK m a -> m b+fold (FL.Fold step begin _ final) m = do+    res <- begin+    case res of+        FL.Partial fs -> go fs m+        FL.Done fb -> return fb++    where+    go !acc m1 =+        let stop = final acc+            single a = step acc a+              >>= \case+                        FL.Partial s -> final s+                        FL.Done b1 -> return b1+            yieldk a r = step acc a+              >>= \case+                        FL.Partial s -> go s r+                        FL.Done b1 -> return b1+         in foldStream defState yieldk single stop m1++-- | Fold resulting in either breaking the stream or continuation of the fold.+-- Instead of supplying the input stream in one go we can run the fold multiple+-- times, each time supplying the next segment of the input stream. If the fold+-- has not yet finished it returns a fold that can be run again otherwise it+-- returns the fold result and the residual stream.+--+-- /Internal/+{-# INLINE foldEither #-}+foldEither :: Monad m =>+    Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))+foldEither (FL.Fold step begin done final) m = do+    res <- begin+    case res of+        FL.Partial fs -> go fs m+        FL.Done fb -> return $ Right (fb, m)++    where++    go !acc m1 =+        let stop =+                let f = Fold step (return $ FL.Partial acc) done final+                 in return $ Left f+            single a =+                step acc a+                  >>= \case+                    FL.Partial s ->+                        let f = Fold step (return $ FL.Partial s) done final+                         in return $ Left f+                    FL.Done b1 -> return $ Right (b1, nil)+            yieldk a r =+                step acc a+                  >>= \case+                    FL.Partial s -> go s r+                    FL.Done b1 -> return $ Right (b1, r)+         in foldStream defState yieldk single stop m1++-- | Like 'fold' but also returns the remaining stream. The resulting stream+-- would be 'StreamK.nil' if the stream finished before the fold.+--+{-# INLINE foldBreak #-}+foldBreak :: Monad m => Fold m a b -> StreamK m a -> m (b, StreamK m a)+foldBreak fld strm = do+    r <- foldEither fld strm+    case r of+        Right res -> return res+        Left (Fold _ initial _ final) -> do+            res <- initial+            case res of+                FL.Done _ -> error "foldBreak: unreachable state"+                FL.Partial s -> do+                    b <- final s+                    return (b, nil)++-- XXX Array folds can be implemented using this.+-- foldContainers? Specialized to foldArrays.++-- | Generate streams from individual elements of a stream and fold the+-- concatenation of those streams using the supplied fold. Return the result of+-- the fold and residual stream.+--+-- For example, this can be used to efficiently fold an Array Word8 stream+-- using Word8 folds.+--+-- /Internal/+{-# INLINE foldConcat #-}+foldConcat :: Monad m =>+    Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)+foldConcat+    (Producer pstep pinject pextract)+    (Fold fstep begin _ final)+    stream = do++    res <- begin+    case res of+        FL.Partial fs -> go fs stream+        FL.Done fb -> return (fb, stream)++    where++    go !acc m1 = do+        let stop = do+                r <- final acc+                return (r, nil)+            single a = do+                st <- pinject a+                res <- go1 SPEC acc st+                case res of+                    Left fs -> do+                        r <- final fs+                        return (r, nil)+                    Right (b, s) -> do+                        x <- pextract s+                        return (b, fromPure x)+            yieldk a r = do+                st <- pinject a+                res <- go1 SPEC acc st+                case res of+                    Left fs -> go fs r+                    Right (b, s) -> do+                        x <- pextract s+                        return (b, x `cons` r)+         in foldStream defState yieldk single stop m1++    {-# INLINE go1 #-}+    go1 !_ !fs st = do+        r <- pstep st+        case r of+            Stream.Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Done b -> return $ Right (b, s)+                    FL.Partial fs1 -> go1 SPEC fs1 s+            Stream.Skip s -> go1 SPEC fs s+            Stream.Stop -> return $ Left fs++-- | Like 'foldl'' but with a monadic step function.+{-# INLINE foldlM' #-}+foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b+foldlM' step begin = foldlMx' step begin return++------------------------------------------------------------------------------+-- Specialized folds+------------------------------------------------------------------------------++{-# INLINE head #-}+head :: Monad m => StreamK m a -> m (Maybe a)+-- head = foldrM (\x _ -> return $ Just x) (return Nothing)+head m =+    let stop      = return Nothing+        single a  = return (Just a)+        yieldk a _ = return (Just a)+    in foldStream defState yieldk single stop m++{-# INLINE elem #-}+elem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+elem e = go+    where+    go m1 =+        let stop      = return False+            single a  = return (a == e)+            yieldk a r = if a == e then return True else go r+        in foldStream defState yieldk single stop m1++{-# INLINE notElem #-}+notElem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+notElem e = go+    where+    go m1 =+        let stop      = return True+            single a  = return (a /= e)+            yieldk a r = if a == e then return False else go r+        in foldStream defState yieldk single stop m1++{-# INLINABLE all #-}+all :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+all p = go+    where+    go m1 =+        let single a   | p a       = return True+                       | otherwise = return False+            yieldk a r | p a       = go r+                       | otherwise = return False+         in foldStream defState yieldk single (return True) m1++{-# INLINABLE any #-}+any :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+any p = go+    where+    go m1 =+        let single a   | p a       = return True+                       | otherwise = return False+            yieldk a r | p a       = return True+                       | otherwise = go r+         in foldStream defState yieldk single (return False) m1++-- | Extract the last element of the stream, if any.+{-# INLINE last #-}+last :: Monad m => StreamK m a -> m (Maybe a)+last = foldlx' (\_ y -> Just y) Nothing id++{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+minimum = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  =+                if res <= a+                then return (Just res)+                else return (Just a)+            yieldk a r =+                if res <= a+                then go (Just res) r+                else go (Just a) r+        in foldStream defState yieldk single stop m1++{-# INLINE minimumBy #-}+minimumBy+    :: (Monad m)+    => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+minimumBy cmp = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  = case cmp res a of+                GT -> return (Just a)+                _  -> return (Just res)+            yieldk a r = case cmp res a of+                GT -> go (Just a) r+                _  -> go (Just res) r+        in foldStream defState yieldk single stop m1++{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+maximum = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  =+                if res <= a+                then return (Just a)+                else return (Just res)+            yieldk a r =+                if res <= a+                then go (Just a) r+                else go (Just res) r+        in foldStream defState yieldk single stop m1++{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+maximumBy cmp = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  = case cmp res a of+                GT -> return (Just res)+                _  -> return (Just a)+            yieldk a r = case cmp res a of+                GT -> go (Just res) r+                _  -> go (Just a) r+        in foldStream defState yieldk single stop m1++{-# INLINE (!!) #-}+(!!) :: Monad m => StreamK m a -> Int -> m (Maybe a)+m !! i = go i m+    where+    go n m1 =+      let single a | n == 0 = return $ Just a+                   | otherwise = return Nothing+          yieldk a x | n < 0 = return Nothing+                     | n == 0 = return $ Just a+                     | otherwise = go (n - 1) x+      in foldStream defState yieldk single (return Nothing) m1++{-# INLINE lookup #-}+lookup :: (Monad m, Eq a) => a -> StreamK m (a, b) -> m (Maybe b)+lookup e = go+    where+    go m1 =+        let single (a, b) | a == e = return $ Just b+                          | otherwise = return Nothing+            yieldk (a, b) x | a == e = return $ Just b+                            | otherwise = go x+        in foldStream defState yieldk single (return Nothing) m1++{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> StreamK m a -> m (Maybe a)+findM p = go+    where+    go m1 =+        let single a = do+                b <- p a+                if b then return $ Just a else return Nothing+            yieldk a x = do+                b <- p a+                if b then return $ Just a else go x+        in foldStream defState yieldk single (return Nothing) m1++{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> StreamK m a -> m (Maybe a)+find p = findM (return . p)++{-# INLINE findIndices #-}+findIndices :: (a -> Bool) -> StreamK m a -> StreamK m Int+findIndices p = go 0+    where+    go offset m1 = mkStream $ \st yld sng stp ->+        let single a | p a = sng offset+                     | otherwise = stp+            yieldk a x | p a = yld offset $ go (offset + 1) x+                       | otherwise = foldStream (adaptState st) yld sng stp $+                            go (offset + 1) x+        in foldStream (adaptState st) yieldk single stp m1++------------------------------------------------------------------------------+-- Map and Fold+------------------------------------------------------------------------------++-- | Apply a monadic action to each element of the stream and discard the+-- output of the action.+{-# INLINE mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> StreamK m a -> m ()+mapM_ f = go+    where+    go m1 =+        let stop = return ()+            single a = void (f a)+            yieldk a r = f a >> go r+         in foldStream defState yieldk single stop m1++{-# INLINE mapM #-}+mapM :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+mapM = mapMWith consM++------------------------------------------------------------------------------+-- Converting folds+------------------------------------------------------------------------------++{-# INLINABLE toList #-}+toList :: Monad m => StreamK m a -> m [a]+toList = foldr (:) []++-- Based on suggestions by David Feuer and Pranay Sashank+{-# INLINE hoist #-}+hoist :: (Monad m, Monad n)+    => (forall x. m x -> n x) -> StreamK m a -> StreamK n a+hoist f str =+    mkStream $ \st yld sng stp ->+            let single = return . sng+                yieldk a s = return $ yld a (hoist f s)+                stop = return stp+                state = adaptState st+             in join . f $ foldStreamShared state yieldk single stop str++-------------------------------------------------------------------------------+-- Transformation by folding (Scans)+-------------------------------------------------------------------------------++{-# INLINE scanlx' #-}+scanlx' :: (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> StreamK m b+scanlx' step begin done m =+    cons (done begin) $ go m begin+    where+    go m1 !acc = mkStream $ \st yld sng stp ->+        let single a = sng (done $ step acc a)+            yieldk a r =+                let s = step acc a+                in yld (done s) (go r s)+        in foldStream (adaptState st) yieldk single stp m1++{-# INLINE scanl' #-}+scanl' :: (b -> a -> b) -> b -> StreamK m a -> StreamK m b+scanl' step begin = scanlx' step begin id++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++{-# INLINE filter #-}+filter :: (a -> Bool) -> StreamK m a -> StreamK m a+filter p = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a   | p a       = sng a+                       | otherwise = stp+            yieldk a r | p a       = yld a (go r)+                       | otherwise = foldStream st yieldk single stp r+         in foldStream st yieldk single stp m1++{-# INLINE take #-}+take :: Int -> StreamK m a -> StreamK m a+take = go+    where+    go n1 m1 = mkStream $ \st yld sng stp ->+        let yieldk a r = yld a (go (n1 - 1) r)+        in if n1 <= 0+           then stp+           else foldStream st yieldk sng stp m1++{-# INLINE takeWhile #-}+takeWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+takeWhile p = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a   | p a       = sng a+                       | otherwise = stp+            yieldk a r | p a       = yld a (go r)+                       | otherwise = stp+         in foldStream st yieldk single stp m1++{-# INLINE drop #-}+drop :: Int -> StreamK m a -> StreamK m a+drop n m = unShare (go n m)+    where+    go n1 m1 = mkStream $ \st yld sng stp ->+        let single _ = stp+            yieldk _ r = foldStreamShared st yld sng stp $ go (n1 - 1) r+        -- Somehow "<=" check performs better than a ">"+        in if n1 <= 0+           then foldStreamShared st yld sng stp m1+           else foldStreamShared st yieldk single stp m1++{-# INLINE dropWhile #-}+dropWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+dropWhile p = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a   | p a       = stp+                       | otherwise = sng a+            yieldk a r | p a = foldStream st yieldk single stp r+                       | otherwise = yld a r+         in foldStream st yieldk single stp m1++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++-- Be careful when modifying this, this uses a consM (|:) deliberately to allow+-- other stream types to overload it.+{-# INLINE sequence #-}+sequence :: Monad m => StreamK m (m a) -> StreamK m a+sequence = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single ma = ma >>= sng+            yieldk ma r = foldStreamShared st yld sng stp $ ma `consM` go r+         in foldStream (adaptState st) yieldk single stp m1++-------------------------------------------------------------------------------+-- Inserting+-------------------------------------------------------------------------------++{-# INLINE intersperseM #-}+intersperseM :: Monad m => m a -> StreamK m a -> StreamK m a+intersperseM a = prependingStart+    where+    prependingStart m1 = mkStream $ \st yld sng stp ->+        let yieldk i x =+                foldStreamShared st yld sng stp $ return i `consM` go x+         in foldStream st yieldk sng stp m1+    go m2 = mkStream $ \st yld sng stp ->+        let single i = foldStreamShared st yld sng stp $ a `consM` fromPure i+            yieldk i x =+                foldStreamShared+                    st yld sng stp $ a `consM` return i `consM` go x+         in foldStream st yieldk single stp m2++{-# INLINE intersperse #-}+intersperse :: Monad m => a -> StreamK m a -> StreamK m a+intersperse a = intersperseM (return a)++{-# INLINE insertBy #-}+insertBy :: (a -> a -> Ordering) -> a -> StreamK m a -> StreamK m a+insertBy cmp x = go+  where+    go m1 = mkStream $ \st yld _ _ ->+        let single a = case cmp x a of+                GT -> yld a (fromPure x)+                _  -> yld x (fromPure a)+            stop = yld x nil+            yieldk a r = case cmp x a of+                GT -> yld a (go r)+                _  -> yld x (a `cons` r)+         in foldStream st yieldk single stop m1++------------------------------------------------------------------------------+-- Deleting+------------------------------------------------------------------------------++{-# INLINE deleteBy #-}+deleteBy :: (a -> a -> Bool) -> a -> StreamK m a -> StreamK m a+deleteBy eq x = go+  where+    go m1 = mkStream $ \st yld sng stp ->+        let single a = if eq x a then stp else sng a+            yieldk a r = if eq x a+              then foldStream st yld sng stp r+              else yld a (go r)+         in foldStream st yieldk single stp m1++-------------------------------------------------------------------------------+-- Map and Filter+-------------------------------------------------------------------------------++{-# INLINE mapMaybe #-}+mapMaybe :: (a -> Maybe b) -> StreamK m a -> StreamK m b+mapMaybe f = go+  where+    go m1 = mkStream $ \st yld sng stp ->+        let single a = maybe stp sng (f a)+            yieldk a r = case f a of+                Just b  -> yld b $ go r+                Nothing -> foldStream (adaptState st) yieldk single stp r+        in foldStream (adaptState st) yieldk single stp m1++-------------------------------------------------------------------------------+-- Exception Handling+-------------------------------------------------------------------------------++-- | Like Streamly.Data.Stream.'Streamly.Data.Stream.handle' but with one+-- significant difference, this function observes exceptions from the consumer+-- of the stream as well.+--+-- You can also convert 'StreamK' to 'Stream' and use exception handling from+-- 'Stream' module:+--+-- >>> handle f s = StreamK.fromStream $ Stream.handle (\e -> StreamK.toStream (f e)) (StreamK.toStream s)+--+{-# INLINABLE handle #-}+handle :: (MonadCatch m, Exception e)+    => (e -> m (StreamK m a)) -> StreamK m a -> StreamK m a+handle f stream = go stream++    where++    go m1 = mkStream $ \st yld sng stp ->+        let yieldk a r = yld a $ go r+        in do+            res <- MC.try (foldStream (adaptState st) yieldk sng stp m1)+            case res of+                Right r -> return r+                Left e -> do+                    r <- f e+                    foldStream (adaptState st) yld sng stp r++-------------------------------------------------------------------------------+-- Resource Management+-------------------------------------------------------------------------------++-- If we are folding the stream and we do not drain the entire stream (e.g. if+-- the fold terminates before the stream) then the finalizer will run on GC.+--+-- XXX To implement a prompt cleanup, we will have to yield a cleanup function+-- via the yield continuation. A chain of cleanup functions can be built and+-- the entire chain can be invoked when the stream ends voluntarily or if+-- someone decides to abandon the stream.++-- | Like Streamly.Data.Stream.'Streamly.Data.Stream.bracketIO' but with one+-- significant difference, this function observes exceptions from the consumer+-- of the stream as well. Therefore, it cleans up the resource promptly when+-- the consumer encounters an exception.+--+-- You can also convert 'StreamK' to 'Stream' and use resource handling from+-- 'Stream' module:+--+-- >>> bracketIO bef aft bet = StreamK.fromStream $ Stream.bracketIO bef aft (StreamK.toStream . bet)+--+{-# INLINABLE bracketIO #-}+bracketIO :: (MonadIO m, MonadCatch m)+    => IO b -> (b -> IO c) -> (b -> StreamK m a) -> StreamK m a+bracketIO bef aft bet =+    concatEffect $ do+        (r, ref) <- liftIO $ mask_ $ do+            r <- bef+            ref <- newIOFinalizer (aft r)+            return (r, ref)+        return $ go ref (bet r)++    where++    go ref m1 = mkStream $ \st yld sng stp ->+        let+            -- We can discard exceptions on continuations to make it equivalent+            -- to StreamD, but it seems like a desirable behavior.+            stop = liftIO (runIOFinalizer ref) >> stp+            single a = liftIO (runIOFinalizer ref) >> sng a+            yieldk a r = yld a $ go ref r+        in do+            -- Do not call the finalizer twice if it has already been+            -- called via stop continuation and stop continuation itself+            -- generated an exception. runIOFinalizer takes care of that.+            res <- MC.try (foldStream (adaptState st) yieldk single stop m1)+            case res of+                Right r -> return r+                Left (e :: MC.SomeException) ->+                    liftIO (runIOFinalizer ref) >> MC.throwM e++------------------------------------------------------------------------------+-- Serial Zipping+------------------------------------------------------------------------------++-- | Zipping of @n@ streams can be performed by combining the streams pair+-- wise using 'mergeMapWith' with O(n * log n) time complexity. If used+-- with 'concatMapWith' it will have O(n^2) performance.+{-# INLINE zipWith #-}+zipWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+zipWith f = zipWithM (\a b -> return (f a b))++{-# INLINE zipWithM #-}+zipWithM :: Monad m =>+    (a -> b -> m c) -> StreamK m a -> StreamK m b -> StreamK m c+zipWithM f = go++    where++    go mx my = mkStream $ \st yld sng stp -> do+        let merge a ra =+                let single2 b   = f a b >>= sng+                    yield2 b rb = f a b >>= \x -> yld x (go ra rb)+                 in foldStream (adaptState st) yield2 single2 stp my+        let single1 a = merge a nil+            yield1 = merge+        foldStream (adaptState st) yield1 single1 stp mx++------------------------------------------------------------------------------+-- Merging+------------------------------------------------------------------------------++{-# INLINE mergeByM #-}+mergeByM :: Monad m =>+    (a -> a -> m Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+mergeByM cmp = go++    where++    go mx my = mkStream $ \st yld sng stp -> do+        let stop = foldStream st yld sng stp my+            single x = foldStream st yld sng stp (goX0 x my)+            yield x rx = foldStream st yld sng stp (goX x rx my)+        foldStream st yield single stop mx++    goX0 x my = mkStream $ \st yld sng _ -> do+        let stop = sng x+            single y = do+                r <- cmp x y+                case r of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield y ry = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX0 x ry)+                    _  -> yld x (y `cons` ry)+         in foldStream st yield single stop my++    goX x mx my = mkStream $ \st yld _ _ -> do+        let stop = yld x mx+            single y = do+                r <- cmp x y+                case r of+                    GT -> yld y (x `cons` mx)+                    _  -> yld x (goY0 mx y)+            yield y ry = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX x mx ry)+                    _  -> yld x (goY mx y ry)+         in foldStream st yield single stop my++    goY0 mx y = mkStream $ \st yld sng _ -> do+        let stop = sng y+            single x = do+                r <- cmp x y+                case r of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield x rx = do+                r <- cmp x y+                case r of+                    GT -> yld y (x `cons` rx)+                    _  -> yld x (goY0 rx y)+         in foldStream st yield single stop mx++    goY mx y my = mkStream $ \st yld _ _ -> do+        let stop = yld y my+            single x = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX0 x my)+                    _  -> yld x (y `cons` my)+            yield x rx = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX x rx my)+                    _  -> yld x (goY rx y my)+         in foldStream st yield single stop mx++-- | Merging of @n@ streams can be performed by combining the streams pair+-- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used+-- with 'concatMapWith' it will have O(n^2) performance.+--+{-# INLINE mergeBy #-}+mergeBy :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+-- XXX GHC: This has slightly worse performance than replacing "r <- cmp x y"+-- with "let r = cmp x y" in the monadic version. The definition below is+-- exactly the same as mergeByM except this change.+-- mergeBy cmp = mergeByM (\a b -> return $ cmp a b)+mergeBy cmp = go++    where++    go mx my = mkStream $ \st yld sng stp -> do+        let stop = foldStream st yld sng stp my+            single x = foldStream st yld sng stp (goX0 x my)+            yield x rx = foldStream st yld sng stp (goX x rx my)+        foldStream st yield single stop mx++    goX0 x my = mkStream $ \st yld sng _ -> do+        let stop = sng x+            single y = do+                case cmp x y of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield y ry = do+                case cmp x y of+                    GT -> yld y (goX0 x ry)+                    _  -> yld x (y `cons` ry)+         in foldStream st yield single stop my++    goX x mx my = mkStream $ \st yld _ _ -> do+        let stop = yld x mx+            single y = do+                case cmp x y of+                    GT -> yld y (x `cons` mx)+                    _  -> yld x (goY0 mx y)+            yield y ry = do+                case cmp x y of+                    GT -> yld y (goX x mx ry)+                    _  -> yld x (goY mx y ry)+         in foldStream st yield single stop my++    goY0 mx y = mkStream $ \st yld sng _ -> do+        let stop = sng y+            single x = do+                case cmp x y of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield x rx = do+                case cmp x y of+                    GT -> yld y (x `cons` rx)+                    _  -> yld x (goY0 rx y)+         in foldStream st yield single stop mx++    goY mx y my = mkStream $ \st yld _ _ -> do+        let stop = yld y my+            single x = do+                case cmp x y of+                    GT -> yld y (goX0 x my)+                    _  -> yld x (y `cons` my)+            yield x rx = do+                case cmp x y of+                    GT -> yld y (goX x rx my)+                    _  -> yld x (goY rx y my)+         in foldStream st yield single stop mx++------------------------------------------------------------------------------+-- Transformation comprehensions+------------------------------------------------------------------------------++{-# INLINE the #-}+the :: (Eq a, Monad m) => StreamK m a -> m (Maybe a)+the m = do+    r <- uncons m+    case r of+        Nothing -> return Nothing+        Just (h, t) -> go h t+    where+    go h m1 =+        let single a   | h == a    = return $ Just h+                       | otherwise = return Nothing+            yieldk a r | h == a    = go h r+                       | otherwise = return Nothing+         in foldStream defState yieldk single (return $ Just h) m1++------------------------------------------------------------------------------+-- Alternative & MonadPlus+------------------------------------------------------------------------------++_alt :: StreamK m a -> StreamK m a -> StreamK m a+_alt m1 m2 = mkStream $ \st yld sng stp ->+    let stop  = foldStream st yld sng stp m2+    in foldStream st yld sng stop m1++------------------------------------------------------------------------------+-- MonadError+------------------------------------------------------------------------------++{-+-- XXX handle and test cross thread state transfer+withCatchError+    :: MonadError e m+    => StreamK m a -> (e -> StreamK m a) -> StreamK m a+withCatchError m h =+    mkStream $ \_ stp sng yld ->+        let run x = unStream x Nothing stp sng yieldk+            handle r = r `catchError` \e -> run $ h e+            yieldk a r = yld a (withCatchError r h)+        in handle $ run m+-}++-------------------------------------------------------------------------------+-- Parsing+-------------------------------------------------------------------------------++-- Inlined definition.+{-# INLINE splitAt #-}+splitAt :: Int -> [a] -> ([a],[a])+splitAt n ls+  | n <= 0 = ([], ls)+  | otherwise          = splitAt' n ls+    where+        splitAt' :: Int -> [a] -> ([a], [a])+        splitAt' _  []     = ([], [])+        splitAt' 1  (x:xs) = ([x], xs)+        splitAt' m  (x:xs) = (x:xs', xs'')+          where+            (xs', xs'') = splitAt' (m - 1) xs++-- | Run a 'Parser' over a stream and return rest of the Stream.+{-# INLINE_NORMAL parseDBreak #-}+parseDBreak+    :: Monad m+    => PR.Parser a m b+    -> StreamK m a+    -> m (Either ParseError b, StreamK m a)+parseDBreak (PR.Parser pstep initial extract) stream = do+    res <- initial+    case res of+        PR.IPartial s -> goStream stream [] s+        PR.IDone b -> return (Right b, stream)+        PR.IError err -> return (Left (ParseError err), stream)++    where++    -- "buf" 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.+    goStream st buf !pst =+        let stop = do+                r <- extract pst+                case r of+                    PR.Error err -> do+                        let src = Prelude.reverse buf+                        return (Left (ParseError err), fromList src)+                    PR.Done n b -> do+                        assertM(n <= length buf)+                        let src0 = Prelude.take n buf+                            src  = Prelude.reverse src0+                        return (Right b, fromList src)+                    PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"+                    PR.Continue 0 s -> goStream nil buf s+                    PR.Continue n s -> do+                        assertM(n <= length buf)+                        let (src0, buf1) = splitAt n buf+                            src = Prelude.reverse src0+                        goBuf nil buf1 src s+            single x = yieldk x nil+            yieldk x r = do+                res <- pstep pst x+                case res of+                    PR.Partial 0 s -> goStream r [] s+                    PR.Partial n s -> do+                        assertM(n <= length (x:buf))+                        let src0 = Prelude.take n (x:buf)+                            src  = Prelude.reverse src0+                        goBuf r [] src s+                    PR.Continue 0 s -> goStream r (x:buf) s+                    PR.Continue n s -> do+                        assertM(n <= length (x:buf))+                        let (src0, buf1) = splitAt n (x:buf)+                            src = Prelude.reverse src0+                        goBuf r buf1 src s+                    PR.Done 0 b -> return (Right b, r)+                    PR.Done n b -> do+                        assertM(n <= length (x:buf))+                        let src0 = Prelude.take n (x:buf)+                            src  = Prelude.reverse src0+                        return (Right b, append (fromList src) r)+                    PR.Error err -> do+                        let src = Prelude.reverse (x:buf)+                        return (Left (ParseError err), append (fromList src) r)+         in foldStream defState yieldk single stop st++    goBuf st buf [] !pst = goStream st buf pst+    goBuf st buf (x:xs) !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 s -> goBuf st [] xs s+            PR.Partial n s -> do+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                goBuf st [] src s+            PR.Continue 0 s -> goBuf st (x:buf) xs s+            PR.Continue n s -> do+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                goBuf st buf1 src s+            PR.Done n b -> do+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0+                return (Right b, append (fromList src) st)+            PR.Error err -> do+                let src = Prelude.reverse buf ++ x:xs+                return (Left (ParseError err), append (fromList src) st)++-- Using ParserD or ParserK on StreamK may not make much difference. We should+-- perhaps use only chunked parsing on StreamK. We can always convert a stream+-- to chunks before parsing. Or just have a ParserK element parser for StreamK+-- and convert ParserD to ParserK for element parsing using StreamK.+{-# INLINE parseD #-}+parseD :: Monad m =>+    Parser.Parser a m b -> StreamK m a -> m (Either ParseError b)+parseD f = fmap fst . parseDBreak f++-------------------------------------------------------------------------------+-- ParserK Chunked+-------------------------------------------------------------------------------++-- The backracking buffer consists of arrays in the most-recent-first order. We+-- want to take a total of n array elements from this buffer. Note: when we+-- have to take an array partially, we must take the last part of the array.+{-# INLINE backTrack #-}+backTrack :: forall m a. Unbox a =>+       Int+    -> [Array a]+    -> StreamK m (Array a)+    -> (StreamK m (Array a), [Array a])+backTrack = go++    where++    go _ [] stream = (stream, [])+    go n xs stream | n <= 0 = (stream, xs)+    go n (x:xs) stream =+        let len = Array.length x+        in if n > len+           then go (n - len) xs (cons x stream)+           else if n == len+           then (cons x stream, xs)+           else let !(Array contents start end) = x+                    !start1 = end - (n * SIZE_OF(a))+                    arr1 = Array contents start1 end+                    arr2 = Array contents start start1+                 in (cons arr1 stream, arr2:xs)++-- | A continuation to extract the result when a CPS parser is done.+{-# INLINE parserDone #-}+parserDone :: Applicative m =>+    ParserK.ParseResult b -> Int -> ParserK.Input a -> m (ParserK.Step a m b)+parserDone (ParserK.Success n b) _ _ = pure $ ParserK.Done n b+parserDone (ParserK.Failure n e) _ _ = pure $ ParserK.Error n e++-- XXX parseDBreakChunks may be faster than converting parserD to parserK and+-- using parseBreakChunks. We can also use parseBreak as an alternative to the+-- monad instance of ParserD.++-- | Run a 'ParserK' over a chunked 'StreamK' and return the parse result and+-- the remaining Stream.+{-# INLINE_NORMAL parseBreakChunks #-}+parseBreakChunks+    :: (Monad m, Unbox a)+    => ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseError b, StreamK m (Array a))+parseBreakChunks parser input = do+    let parserk = ParserK.runParser parser parserDone 0 0+     in go [] parserk input++    where++    {-# INLINE goStop #-}+    goStop backBuf parserk = do+        pRes <- parserk ParserK.None+        case pRes of+            -- If we stop in an alternative, it will try calling the next+            -- parser, the next parser may call initial returning Partial and+            -- then immediately we have to call extract on it.+            ParserK.Partial 0 cont1 ->+                 go [] cont1 nil+            ParserK.Partial n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))+                let (s1, backBuf1) = backTrack n1 backBuf nil+                 in go backBuf1 cont1 s1+            ParserK.Continue 0 cont1 ->+                go backBuf cont1 nil+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))+                let (s1, backBuf1) = backTrack n1 backBuf nil+                 in go backBuf1 cont1 s1+            ParserK.Done 0 b ->+                return (Right b, nil)+            ParserK.Done n b -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))+                let (s1, _) = backTrack n1 backBuf nil+                 in return (Right b, s1)+            ParserK.Error _ err -> do+                let (s1, _) = backTrack maxBound backBuf nil+                return (Left (ParseError err), s1)++    seekErr n len =+        error $ "parseBreak: Partial: forward seek not implemented n = "+            ++ show n ++ " len = " ++ show len++    yieldk backBuf parserk arr stream = do+        pRes <- parserk (ParserK.Chunk arr)+        let len = Array.length arr+        case pRes of+            ParserK.Partial n cont1 ->+                case compare n len of+                    EQ -> go [] cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk [] cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map Array.length backBuf)+                                s = cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, _) = backTrack n1 backBuf s+                            go [] cont1 s1+                    GT -> seekErr n len+            ParserK.Continue n cont1 ->+                case compare n len of+                    EQ -> go (arr:backBuf) cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk backBuf cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map Array.length backBuf)+                                s = cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, backBuf1) = backTrack n1 backBuf s+                            go backBuf1 cont1 s1+                    GT -> seekErr n len+            ParserK.Done n b -> do+                let n1 = len - n+                assertM(n1 <= sum (Prelude.map Array.length (arr:backBuf)))+                let (s1, _) = backTrack n1 (arr:backBuf) stream+                 in return (Right b, s1)+            ParserK.Error _ err -> do+                let (s1, _) = backTrack maxBound (arr:backBuf) stream+                return (Left (ParseError err), s1)++    go backBuf parserk stream = do+        let stop = goStop backBuf parserk+            single a = yieldk backBuf parserk a nil+         in foldStream+                defState (yieldk backBuf parserk) single stop stream++{-# INLINE parseChunks #-}+parseChunks :: (Monad m, Unbox a) =>+    ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+parseChunks f = fmap fst . parseBreakChunks f++-------------------------------------------------------------------------------+-- ParserK Singular+-------------------------------------------------------------------------------++{-# INLINE backTrackSingular #-}+backTrackSingular :: Int -> [a] -> StreamK m a -> (StreamK m a, [a])+backTrackSingular = go++    where++    go _ [] stream = (stream, [])+    go n xs stream | n <= 0 = (stream, xs)+    go n xs stream =+        let (appendBuf, newBTBuf) = splitAt n xs+         in (append (fromList (Prelude.reverse appendBuf)) stream, newBTBuf)+++-- | Similar to 'parseBreak' but works on singular elements.+--+{-# INLINE_NORMAL parseBreak #-}+parseBreak+    :: forall m a b. Monad m+    => ParserK.ParserK a m b+    -> StreamK m a+    -> m (Either ParseError b, StreamK m a)+parseBreak parser input = do+    let parserk = ParserK.runParser parser parserDone 0 0+     in go [] parserk input++    where++    {-# INLINE goStop #-}+    goStop+        :: [a]+        -> (ParserK.Input a -> m (ParserK.Step a m b))+        -> m (Either ParseError b, StreamK m a)+    goStop backBuf parserk = do+        pRes <- parserk ParserK.None+        case pRes of+            -- If we stop in an alternative, it will try calling the next+            -- parser, the next parser may call initial returning Partial and+            -- then immediately we have to call extract on it.+            ParserK.Partial 0 cont1 ->+                 go [] cont1 nil+            ParserK.Partial n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= length backBuf)+                let (s1, backBuf1) = backTrackSingular n1 backBuf nil+                 in go backBuf1 cont1 s1+            ParserK.Continue 0 cont1 ->+                go backBuf cont1 nil+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= length backBuf)+                let (s1, backBuf1) = backTrackSingular n1 backBuf nil+                 in go backBuf1 cont1 s1+            ParserK.Done 0 b ->+                return (Right b, nil)+            ParserK.Done n b -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= length backBuf)+                let (s1, _) = backTrackSingular n1 backBuf nil+                 in return (Right b, s1)+            ParserK.Error _ err -> return (Left (ParseError err), nil)++    seekErr n =+        error $ "parseBreak: Partial: forward seek not implemented n = "+            ++ show n++    yieldk+        :: [a]+        -> (ParserK.Input a -> m (ParserK.Step a m b))+        -> a+        -> StreamK m a+        -> m (Either ParseError b, StreamK m a)+    yieldk backBuf parserk arr stream = do+        pRes <- parserk (ParserK.Chunk arr)+        case pRes of+            ParserK.Partial 1 cont1 -> go [] cont1 stream+            ParserK.Partial 0 cont1 -> go [] cont1 (cons arr stream)+            ParserK.Partial n _ | n > 1 -> seekErr n+            ParserK.Partial n cont1 -> do+                let n1 = negate n+                    bufLen = length backBuf+                    s = cons arr stream+                assertM(n1 >= 0 && n1 <= bufLen)+                let (s1, _) = backTrackSingular n1 backBuf s+                go [] cont1 s1+            ParserK.Continue 1 cont1 -> go (arr:backBuf) cont1 stream+            ParserK.Continue 0 cont1 ->+                go backBuf cont1 (cons arr stream)+            ParserK.Continue n _ | n > 1 -> seekErr n+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                    bufLen = length backBuf+                    s = cons arr stream+                assertM(n1 >= 0 && n1 <= bufLen)+                let (s1, backBuf1) = backTrackSingular n1 backBuf s+                go backBuf1 cont1 s1+            ParserK.Done 1 b -> pure (Right b, stream)+            ParserK.Done 0 b -> pure (Right b, cons arr stream)+            ParserK.Done n _ | n > 1 -> seekErr n+            ParserK.Done n b -> do+                let n1 = negate n+                    bufLen = length backBuf+                    s = cons arr stream+                assertM(n1 >= 0 && n1 <= bufLen)+                let (s1, _) = backTrackSingular n1 backBuf s+                pure (Right b, s1)+            ParserK.Error _ err -> return (Left (ParseError err), nil)++    go+        :: [a]+        -> (ParserK.Input a -> m (ParserK.Step a m b))+        -> StreamK m a+        -> m (Either ParseError b, StreamK m a)+    go backBuf parserk stream = do+        let stop = goStop backBuf parserk+            single a = yieldk backBuf parserk a nil+         in foldStream+                defState (yieldk backBuf parserk) single stop stream++-- | Run a 'ParserK' over a 'StreamK'. Please use 'parseChunks' where possible,+-- for better performance.+{-# INLINE parse #-}+parse :: Monad m =>+    ParserK.ParserK a m b -> StreamK m a -> m (Either ParseError b)+parse f = fmap fst . parseBreak f++-------------------------------------------------------------------------------+-- ParserK Chunked Generic+-------------------------------------------------------------------------------++{-# INLINE backTrackGenericChunks #-}+backTrackGenericChunks ::+       Int+    -> [GenArr.Array a]+    -> StreamK m (GenArr.Array a)+    -> (StreamK m (GenArr.Array a), [GenArr.Array a])+backTrackGenericChunks = go++    where++    go _ [] stream = (stream, [])+    go n xs stream | n <= 0 = (stream, xs)+    go n (x:xs) stream =+        let len = GenArr.length x+        in if n > len+           then go (n - len) xs (cons x stream)+           else if n == len+           then (cons x stream, xs)+           else let arr1 = GenArr.getSliceUnsafe (len - n) n x+                    arr2 = GenArr.getSliceUnsafe 0 (len - n) x+                 in (cons arr1 stream, arr2:xs)++-- | Similar to 'parseBreak' but works on generic arrays+--+{-# INLINE_NORMAL parseBreakChunksGeneric #-}+parseBreakChunksGeneric+    :: forall m a b. Monad m+    => ParserK.ParserK (GenArr.Array a) m b+    -> StreamK m (GenArr.Array a)+    -> m (Either ParseError b, StreamK m (GenArr.Array a))+parseBreakChunksGeneric parser input = do+    let parserk = ParserK.runParser parser parserDone 0 0+     in go [] parserk input++    where++    {-# INLINE goStop #-}+    goStop+        :: [GenArr.Array a]+        -> (ParserK.Input (GenArr.Array a)+                -> m (ParserK.Step (GenArr.Array a) m b))+        -> m (Either ParseError b, StreamK m (GenArr.Array a))+    goStop backBuf parserk = do+        pRes <- parserk ParserK.None+        case pRes of+            -- If we stop in an alternative, it will try calling the next+            -- parser, the next parser may call initial returning Partial and+            -- then immediately we have to call extract on it.+            ParserK.Partial 0 cont1 ->+                 go [] cont1 nil+            ParserK.Partial n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf))+                let (s1, backBuf1) = backTrackGenericChunks n1 backBuf nil+                 in go backBuf1 cont1 s1+            ParserK.Continue 0 cont1 ->+                go backBuf cont1 nil+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf))+                let (s1, backBuf1) = backTrackGenericChunks n1 backBuf nil+                 in go backBuf1 cont1 s1+            ParserK.Done 0 b ->+                return (Right b, nil)+            ParserK.Done n b -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map GenArr.length backBuf))+                let (s1, _) = backTrackGenericChunks n1 backBuf nil+                 in return (Right b, s1)+            ParserK.Error _ err -> return (Left (ParseError err), nil)++    seekErr n len =+        error $ "parseBreak: Partial: forward seek not implemented n = "+            ++ show n ++ " len = " ++ show len++    yieldk+        :: [GenArr.Array a]+        -> (ParserK.Input (GenArr.Array a)+                -> m (ParserK.Step (GenArr.Array a) m b))+        -> GenArr.Array a+        -> StreamK m (GenArr.Array a)+        -> m (Either ParseError b, StreamK m (GenArr.Array a))+    yieldk backBuf parserk arr stream = do+        pRes <- parserk (ParserK.Chunk arr)+        let len = GenArr.length arr+        case pRes of+            ParserK.Partial n cont1 ->+                case compare n len of+                    EQ -> go [] cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk [] cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map GenArr.length backBuf)+                                s = cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, _) = backTrackGenericChunks n1 backBuf s+                            go [] cont1 s1+                    GT -> seekErr n len+            ParserK.Continue n cont1 ->+                case compare n len of+                    EQ -> go (arr:backBuf) cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk backBuf cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map GenArr.length backBuf)+                                s = cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, backBuf1) = backTrackGenericChunks n1 backBuf s+                            go backBuf1 cont1 s1+                    GT -> seekErr n len+            ParserK.Done n b -> do+                let n1 = len - n+                assertM(n1 <= sum (Prelude.map GenArr.length (arr:backBuf)))+                let (s1, _) = backTrackGenericChunks n1 (arr:backBuf) stream+                 in return (Right b, s1)+            ParserK.Error _ err -> return (Left (ParseError err), nil)++    go+        :: [GenArr.Array a]+        -> (ParserK.Input (GenArr.Array a)+                -> m (ParserK.Step (GenArr.Array a) m b))+        -> StreamK m (GenArr.Array a)+        -> m (Either ParseError b, StreamK m (GenArr.Array a))+    go backBuf parserk stream = do+        let stop = goStop backBuf parserk+            single a = yieldk backBuf parserk a nil+         in foldStream+                defState (yieldk backBuf parserk) single stop stream++{-# INLINE parseChunksGeneric #-}+parseChunksGeneric ::+       (Monad m)+    => ParserK.ParserK (GenArr.Array a) m b+    -> StreamK m (GenArr.Array a)+    -> m (Either ParseError b)+parseChunksGeneric f = fmap fst . parseBreakChunksGeneric f++-------------------------------------------------------------------------------+-- Sorting+-------------------------------------------------------------------------------++-- | Sort the input stream using a supplied comparison function.+--+-- Sorting can be achieved by simply:+--+-- >>> sortBy cmp = StreamK.mergeMapWith (StreamK.mergeBy cmp) StreamK.fromPure+--+-- However, this combinator uses a parser to first split the input stream into+-- down and up sorted segments and then merges them to optimize sorting when+-- pre-sorted sequences exist in the input stream.+--+-- /O(n) space/+--+{-# INLINE sortBy #-}+sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a+-- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure+sortBy cmp =+    let p =+            Parser.groupByRollingEither+                (\x -> (< GT) . cmp x)+                FL.toStreamKRev+                FL.toStreamK+     in   mergeMapWith (mergeBy cmp) id+        . Stream.toStreamK+        . Stream.catRights -- its a non-failing backtracking parser+        . Stream.parseMany (fmap (either id id) p)+        . Stream.fromStreamK
+ src/Streamly/Internal/Data/StreamK/Alt.hs view
@@ -0,0 +1,244 @@+-- |+-- Module      : Streamly.StreamDK.Type+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A CPS style stream using a constructor based representation instead of a+-- function based representation.+--+-- Streamly internally uses two fundamental stream representations, (1) streams+-- with an open or arbitrary control flow (we call it StreamK), (2) streams+-- with a structured or closed loop control flow (we call it StreamD). The+-- higher level stream types can use any of these representations under the+-- hood and can interconvert between the two.+--+-- StreamD:+--+-- StreamD is a non-recursive data type in which the state of the stream and+-- the step function are separate. When the step function is called, a stream+-- element and the new stream state is yielded. The generated element and the+-- state are passed to the next consumer in the loop. The state is threaded+-- around in the loop until control returns back to the original step function+-- to run the next step. This creates a structured closed loop representation+-- (like "for" loops in C) with state of each step being hidden/abstracted or+-- existential within that step. This creates a loop representation identical+-- to the "for" or "while" loop constructs in imperative languages, the states+-- of the steps combined together constitute the state of the loop iteration.+--+-- Internally most combinators use a closed loop representation because it+-- provides very high efficiency due to stream fusion. The performance of this+-- representation is competitive to the C language implementations.+--+-- Pros and Cons of StreamD:+--+-- 1) stream-fusion: This representation can be optimized very efficiently by+-- the compiler because the state is explicitly separated from step functions,+-- represented using pure data constructors and visible to the compiler, the+-- stream steps can be fused using case-of-case transformations and the state+-- can be specialized using spec-constructor optimization, yielding a C like+-- tight loop/state machine with no constructors, the state is used unboxed and+-- therefore no unnecessary allocation.+--+-- 2) Because of a closed representation consing too many elements in this type+-- of stream does not scale, it will have quadratic performance slowdown. Each+-- cons creates a layer that needs to return the control back to the caller.+-- Another implementation of cons is possible but that will have to box/unbox+-- the state and will not fuse. So effectively cons breaks fusion.+--+-- 3) unconsing an item from the stream breaks fusion, we have to "pause" the+-- loop, rebox and save the state.+--+-- 3) Exception handling is easy to implement in this model because control+-- flow is structured in the loop and cannot be arbitrary. Therefore,+-- implementing "bracket" is natural.+--+-- 4) Round-robin scheduling for co-operative multitasking is easy to implement.+--+-- 5) It fuses well with the direct style Fold implementation.+--+-- StreamK/StreamDK:+--+-- StreamDK i.e. the stream defined in this module, like StreamK, is a+-- recursive data type which has no explicit state defined using constructors,+-- each step yields an element and a computation representing the rest of the+-- stream.  Stream state is part of the function representing the rest of the+-- stream.  This creates an open computation representation, or essentially a+-- continuation passing style computation.  After the stream step is executed,+-- the caller is free to consume the produced element and then send the control+-- wherever it wants, there is no restriction on the control to return back+-- somewhere, the control is free to go anywhere. The caller may decide not to+-- consume the rest of the stream. This representation is more like a "goto"+-- based implementation in imperative languages.+--+-- Pros and Cons of StreamK:+--+-- 1) The way StreamD can be optimized using stream-fusion, this type can be+-- optimized using foldr/build fusion. However, foldr/build has not yet been+-- fully implemented for StreamK/StreamDK.+--+-- 2) Using cons is natural in this representation, unlike in StreamD it does+-- not have a quadratic slowdown. Currently, we in fact wrap StreamD in StreamK+-- to support a better cons operation.+--+-- 3) Similarly, uncons is natural in this representation.+--+-- 4) Exception handling is not easy to implement because of the "goto" nature+-- of CPS.+--+-- 5) Composable folds are not implemented/proven, however, intuition says that+-- a push style CPS representation should be able to be used along with StreamK+-- to efficiently implement composable folds.++module Streamly.Internal.Data.StreamK.Alt+    (+    -- * Stream Type++      Stream+    , Step (..)++    -- * Construction+    , nil+    , cons+    , consM+    , unfoldr+    , unfoldrM+    , replicateM++    -- * Folding+    , uncons+    , foldrS++    -- * Specific Folds+    , drain+    )+where++#include "inline.hs"++-- XXX Use Cons and Nil instead of Yield and Stop?+data Step m a = Yield a (Stream m a) | Stop++newtype Stream m a = Stream (m (Step m a))++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++nil :: Monad m => Stream m a+nil = Stream $ return Stop++{-# INLINE_NORMAL cons #-}+cons :: Monad m => a -> Stream m a -> Stream m a+cons x xs = Stream $ return $ Yield x xs++consM :: Monad m => m a -> Stream m a -> Stream m a+consM eff xs = Stream $ eff >>= \x -> return $ Yield x xs++unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+unfoldrM next state = Stream (step' state)+  where+    step' st = do+        r <- next st+        return $ case r of+            Just (x, s) -> Yield x (Stream (step' s))+            Nothing     -> Stop+{-+unfoldrM next s0 = buildM $ \yld stp ->+    let go s = do+            r <- next s+            case r of+                Just (a, b) -> yld a (go b)+                Nothing -> stp+    in go s0+-}++{-# INLINE unfoldr #-}+unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a+unfoldr next s0 = build $ \yld stp ->+    let go s =+            case next s of+                Just (a, b) -> yld a (go b)+                Nothing -> stp+    in go s0++replicateM :: Monad m => Int -> a -> Stream m a+replicateM n x = Stream (step n)+    where+    step i = return $+        if i <= 0+        then Stop+        else Yield x (Stream (step (i - 1)))++-------------------------------------------------------------------------------+-- Folding+-------------------------------------------------------------------------------++uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+uncons (Stream step) = do+    r <- step+    return $ case r of+        Yield x xs -> Just (x, xs)+        Stop -> Nothing++-- | Lazy right associative fold to a stream.+{-# INLINE_NORMAL foldrS #-}+foldrS :: Monad m+       => (a -> Stream m b -> Stream m b)+       -> Stream m b+       -> Stream m a+       -> Stream m b+foldrS f streamb = go+    where+    go (Stream stepa) = Stream $ do+        r <- stepa+        case r of+            Yield x xs -> let Stream step = f x (go xs) in step+            Stop -> let Stream step = streamb in step++{-# INLINE_LATE foldrM #-}+foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+foldrM fstep acc = go+    where+    go (Stream step) = do+        r <- step+        case r of+            Yield x xs -> fstep x (go xs)+            Stop -> acc++{-# INLINE_NORMAL build #-}+build :: Monad m+    => forall a. (forall b. (a -> b -> b) -> b -> b) -> Stream m a+build g = g cons nil++{-# RULES+"foldrM/build"  forall k z (g :: forall b. (a -> b -> b) -> b -> b).+                foldrM k z (build g) = g k z #-}++{-+-- To fuse foldrM with unfoldrM we need the type m1 to be polymorphic such that+-- it is either Monad m or Stream m.  So that we can use cons/nil as well as+-- monadic construction function as its arguments.+--+{-# INLINE_NORMAL buildM #-}+buildM :: Monad m+    => forall a. (forall b. (a -> m1 b -> m1 b) -> m1 b -> m1 b) -> Stream m a+buildM g = g cons nil+-}++-------------------------------------------------------------------------------+-- Specific folds+-------------------------------------------------------------------------------++{-# INLINE drain #-}+drain :: Monad m => Stream m a -> m ()+drain = foldrM (\_ xs -> xs) (return ())+{-+drain (Stream step) = do+    r <- step+    case r of+        Yield _ next -> drain next+        Stop      -> return ()+        -}
+ src/Streamly/Internal/Data/StreamK/Transformer.hs view
@@ -0,0 +1,79 @@+-- |+-- Module      : Streamly.Internal.Data.StreamK.Transformer+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.StreamK.Transformer+    (+      foldlT+    , foldrT++    , liftInner+    , evalStateT+    )+where++import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.Trans.State.Strict (StateT)+import Streamly.Internal.Data.StreamK.Type+    (StreamK, nil, cons, uncons, concatEffect)++import qualified Control.Monad.Trans.State.Strict as State++-- | Lazy left fold to an arbitrary transformer monad.+{-# INLINE foldlT #-}+foldlT :: (Monad m, Monad (s m), MonadTrans s)+    => (s m b -> a -> s m b) -> s m b -> StreamK m a -> s m b+foldlT step = go+  where+    go acc m1 = do+        res <- lift $ uncons m1+        case res of+            Just (h, t) -> go (step acc h) t+            Nothing -> acc++-- | Right associative fold to an arbitrary transformer monad.+{-# INLINE foldrT #-}+foldrT :: (Monad m, Monad (s m), MonadTrans s)+    => (a -> s m b -> s m b) -> s m b -> StreamK m a -> s m b+foldrT step final = go+  where+    go m1 = do+        res <- lift $ uncons m1+        case res of+            Just (h, t) -> step h (go t)+            Nothing -> final++------------------------------------------------------------------------------+-- Lifting inner monad+------------------------------------------------------------------------------++{-# INLINE evalStateT #-}+evalStateT :: Monad m => m s -> StreamK (StateT s m) a -> StreamK m a+evalStateT = go++    where++    go st m1 = concatEffect $ fmap f (st >>= State.runStateT (uncons m1))++    f (res, s1) =+        case res of+            Just (h, t) -> cons h (go (return s1) t)+            Nothing -> nil++{-# INLINE liftInner #-}+liftInner :: (Monad m, MonadTrans t, Monad (t m)) =>+    StreamK m a -> StreamK (t m) a+liftInner = go++    where++    go m1 = concatEffect $ fmap f $ lift $ uncons m1++    f res =+        case res of+            Just (h, t) -> cons h (go t)+            Nothing -> nil
+ src/Streamly/Internal/Data/StreamK/Type.hs view
@@ -0,0 +1,2084 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}+-- |+-- Module      : Streamly.Internal.Data.StreamK.Type+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+--+-- Continuation passing style (CPS) stream implementation. The symbol 'K' below+-- denotes a function as well as a Kontinuation.+--+module Streamly.Internal.Data.StreamK.Type+    (+    -- * StreamK type+      Stream+    , StreamK (..)++    -- * CrossStreamK type wrapper+    , CrossStreamK+    , unCross+    , mkCross++    -- * foldr/build Fusion+    , mkStream+    , foldStream+    , foldStreamShared+    , foldrM+    , foldrS+    , foldrSShared+    , foldrSM+    , build+    , buildS+    , buildM+    , buildSM+    , augmentS+    , augmentSM+    , unShare++    -- * Construction+    -- ** Primitives+    , fromStopK+    , fromYieldK+    , consK+    , cons+    , (.:)+    , consM+    , consMBy+    , nil+    , nilM++    -- ** Unfolding+    , unfoldr+    , unfoldrMWith+    , unfoldrM++    -- ** From Values+    , fromEffect+    , fromPure+    , repeat+    , repeatMWith+    , replicateMWith++    -- ** From Indices+    , fromIndicesMWith++    -- ** Iteration+    , iterateMWith++    -- ** From Containers+    , fromFoldable+    , fromFoldableM++    -- ** Cyclic+    , mfix++    -- * Elimination+    -- ** Primitives+    , uncons++    -- ** Strict Left Folds+    , Streamly.Internal.Data.StreamK.Type.foldl'+    , foldlx'++    -- ** Lazy Right Folds+    , Streamly.Internal.Data.StreamK.Type.foldr++    -- ** Specific Folds+    , drain+    , null+    , tail+    , init++    -- * Mapping+    , map+    , mapMWith+    , mapMSerial++    -- * Combining Two Streams+    -- ** Appending+    , conjoin+    , append++    -- ** Interleave+    , interleave+    , interleaveFst+    , interleaveMin++    -- ** Cross Product+    , crossApplyWith+    , crossApply+    , crossApplySnd+    , crossApplyFst+    , crossWith+    , cross++    -- * Concat+    , before+    , concatEffect+    , concatMapEffect+    , concatMapWith+    , concatMap+    , bindWith+    , concatIterateWith+    , concatIterateLeftsWith+    , concatIterateScanWith++    -- * Merge+    , mergeMapWith+    , mergeIterateWith++    -- * Buffered Operations+    , foldlS+    , reverse+    )+where++#include "inline.hs"++-- import Control.Applicative (liftA2)+import Control.Monad ((>=>))+import Control.Monad.Catch (MonadThrow, throwM)+import Control.Monad.Trans.Class (MonadTrans(lift))+#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Monad.IO.Class (MonadIO(..))+import Data.Foldable (Foldable(foldl'), fold, foldr)+import Data.Function (fix)+import Data.Functor.Identity (Identity(..))+import Data.Maybe (fromMaybe)+import Data.Semigroup (Endo(..))+import GHC.Exts (IsList(..), IsString(..), oneShot)+import Streamly.Internal.BaseCompat ((#.))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)+import Text.Read+       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec+       , readListPrecDefault)++import qualified Prelude++import Prelude hiding+    (map, mapM, concatMap, foldr, repeat, null, reverse, tail, init)++#include "DocTestDataStreamK.hs"++------------------------------------------------------------------------------+-- Basic stream type+------------------------------------------------------------------------------++-- It uses stop, singleton and yield continuations equivalent to the following+-- direct style type:+--+-- @+-- data StreamK m a = Stop | Singleton a | Yield a (StreamK m a)+-- @+--+-- To facilitate parallel composition we maintain a local state in an 'SVar'+-- that is shared across and is used for synchronization of the streams being+-- composed.+--+-- The singleton case can be expressed in terms of stop and yield but we have+-- it as a separate case to optimize composition operations for streams with+-- single element.  We build singleton streams in the implementation of 'pure'+-- for Applicative and Monad, and in 'lift' for MonadTrans.++-- XXX remove the State param.++-- | Continuation Passing Style (CPS) version of "Streamly.Data.Stream.Stream".+-- Unlike "Streamly.Data.Stream.Stream", 'StreamK' can be composed recursively+-- without affecting performance.+--+-- Semigroup instance appends two streams:+--+-- >>> (<>) = Stream.append+--+{-# DEPRECATED Stream "Please use StreamK instead." #-}+type Stream = StreamK++newtype StreamK m a =+    MkStream (forall r.+               State StreamK m a         -- state+            -> (a -> StreamK m a -> m r) -- yield+            -> (a -> m r)               -- singleton+            -> m r                      -- stop+            -> m r+            )++mkStream+    :: (forall r. State StreamK m a+        -> (a -> StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r)+    -> StreamK m a+mkStream = MkStream++-- | A terminal function that has no continuation to follow.+type StopK m = forall r. m r -> m r++-- | A monadic continuation, it is a function that yields a value of type "a"+-- and calls the argument (a -> m r) as a continuation with that value. We can+-- also think of it as a callback with a handler (a -> m r).  Category+-- theorists call it a codensity type, a special type of right kan extension.+type YieldK m a = forall r. (a -> m r) -> m r++_wrapM :: Monad m => m a -> YieldK m a+_wrapM m = (m >>=)++-- | Make an empty stream from a stop function.+fromStopK :: StopK m -> StreamK m a+fromStopK k = mkStream $ \_ _ _ stp -> k stp++-- | Make a singleton stream from a callback function. The callback function+-- calls the one-shot yield continuation to yield an element.+fromYieldK :: YieldK m a -> StreamK m a+fromYieldK k = mkStream $ \_ _ sng _ -> k sng++-- | Add a yield function at the head of the stream.+consK :: YieldK m a -> StreamK m a -> StreamK m a+consK k r = mkStream $ \_ yld _ _ -> k (`yld` r)++-- XXX Build a stream from a repeating callback function.++------------------------------------------------------------------------------+-- Construction+------------------------------------------------------------------------------++infixr 5 `cons`++-- faster than consM because there is no bind.++-- | A right associative prepend operation to add a pure value at the head of+-- an existing stream::+--+-- >>> s = 1 `StreamK.cons` 2 `StreamK.cons` 3 `StreamK.cons` StreamK.nil+-- >>> Stream.fold Fold.toList (StreamK.toStream s)+-- [1,2,3]+--+-- It can be used efficiently with 'Prelude.foldr':+--+-- >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil+--+-- Same as the following but more efficient:+--+-- >>> cons x xs = return x `StreamK.consM` xs+--+{-# INLINE_NORMAL cons #-}+cons :: a -> StreamK m a -> StreamK m a+cons a r = mkStream $ \_ yield _ _ -> yield a r++infixr 5 .:++-- | Operator equivalent of 'cons'.+--+-- @+-- > toList $ 1 .: 2 .: 3 .: nil+-- [1,2,3]+-- @+--+{-# INLINE (.:) #-}+(.:) :: a -> StreamK m a -> StreamK m a+(.:) = cons++-- | A stream that terminates without producing any output or side effect.+--+-- >>> Stream.fold Fold.toList (StreamK.toStream StreamK.nil)+-- []+--+{-# INLINE_NORMAL nil #-}+nil :: StreamK m a+nil = mkStream $ \_ _ _ stp -> stp++-- | A stream that terminates without producing any output, but produces a side+-- effect.+--+-- >>> Stream.fold Fold.toList (StreamK.toStream (StreamK.nilM (print "nil")))+-- "nil"+-- []+--+-- /Pre-release/+{-# INLINE_NORMAL nilM #-}+nilM :: Applicative m => m b -> StreamK m a+nilM m = mkStream $ \_ _ _ stp -> m *> stp++-- Create a singleton stream from a pure value.+--+-- >>> fromPure a = a `StreamK.cons` StreamK.nil+-- >>> fromPure = pure+-- >>> fromPure = StreamK.fromEffect . pure+--+{-# INLINE_NORMAL fromPure #-}+fromPure :: a -> StreamK m a+fromPure a = mkStream $ \_ _ single _ -> single a++-- Create a singleton stream from a monadic action.+--+-- >>> fromEffect m = m `StreamK.consM` StreamK.nil+--+-- >>> Stream.fold Fold.drain $ StreamK.toStream $ StreamK.fromEffect (putStrLn "hello")+-- hello+--+{-# INLINE_NORMAL fromEffect #-}+fromEffect :: Monad m => m a -> StreamK m a+fromEffect m = mkStream $ \_ _ single _ -> m >>= single++infixr 5 `consM`++-- NOTE: specializing the function outside the instance definition seems to+-- improve performance quite a bit at times, even if we have the same+-- SPECIALIZE in the instance definition.++-- | A right associative prepend operation to add an effectful value at the+-- head of an existing stream::+--+-- >>> s = putStrLn "hello" `StreamK.consM` putStrLn "world" `StreamK.consM` StreamK.nil+-- >>> Stream.fold Fold.drain (StreamK.toStream s)+-- hello+-- world+--+-- It can be used efficiently with 'Prelude.foldr':+--+-- >>> fromFoldableM = Prelude.foldr StreamK.consM StreamK.nil+--+-- Same as the following but more efficient:+--+-- >>> consM x xs = StreamK.fromEffect x `StreamK.append` xs+--+{-# INLINE consM #-}+{-# SPECIALIZE consM :: IO a -> StreamK IO a -> StreamK IO a #-}+consM :: Monad m => m a -> StreamK m a -> StreamK m a+consM m r = MkStream $ \_ yld _ _ -> m >>= (`yld` r)++-- XXX specialize to IO?+{-# INLINE consMBy #-}+consMBy :: Monad m =>+    (StreamK m a -> StreamK m a -> StreamK m a) -> m a -> StreamK m a -> StreamK m a+consMBy f m r = fromEffect m `f` r++------------------------------------------------------------------------------+-- Folding a stream+------------------------------------------------------------------------------++-- | Fold a stream by providing an SVar, a stop continuation, a singleton+-- continuation and a yield continuation. The stream would share the current+-- SVar passed via the State.+{-# INLINE_EARLY foldStreamShared #-}+foldStreamShared+    :: State StreamK m a+    -> (a -> StreamK m a -> m r)+    -> (a -> m r)+    -> m r+    -> StreamK m a+    -> m r+foldStreamShared s yield single stop (MkStream k) = k s yield single stop++-- | Fold a stream by providing a State, stop continuation, a singleton+-- continuation and a yield continuation. The stream will not use the SVar+-- passed via State.+{-# INLINE foldStream #-}+foldStream+    :: State StreamK m a+    -> (a -> StreamK m a -> m r)+    -> (a -> m r)+    -> m r+    -> StreamK m a+    -> m r+foldStream s yield single stop (MkStream k) =+    k (adaptState s) yield single stop++-------------------------------------------------------------------------------+-- foldr/build fusion+-------------------------------------------------------------------------------++-- XXX perhaps we can just use foldrSM/buildM everywhere as they are more+-- general and cover foldrS/buildS as well.++-- | The function 'f' decides how to reconstruct the stream. We could+-- reconstruct using a shared state (SVar) or without sharing the state.+--+{-# INLINE foldrSWith #-}+foldrSWith ::+    (forall r. State StreamK m b+        -> (b -> StreamK m b -> m r)+        -> (b -> m r)+        -> m r+        -> StreamK m b+        -> m r)+    -> (a -> StreamK m b -> StreamK m b)+    -> StreamK m b+    -> StreamK m a+    -> StreamK m b+foldrSWith f step final m = go m+    where+    go m1 = mkStream $ \st yld sng stp ->+        let run x = f st yld sng stp x+            stop = run final+            single a = run $ step a final+            yieldk a r = run $ step a (go r)+         -- XXX if type a and b are the same we do not need adaptState, can we+         -- save some perf with that?+         -- XXX since we are using adaptState anyway here we can use+         -- foldStreamShared instead, will that save some perf?+         in foldStream (adaptState st) yieldk single stop m1++-- XXX we can use rewrite rules just for foldrSWith, if the function f is the+-- same we can rewrite it.++-- | Fold sharing the SVar state within the reconstructed stream+{-# INLINE_NORMAL foldrSShared #-}+foldrSShared ::+       (a -> StreamK m b -> StreamK m b)+    -> StreamK m b+    -> StreamK m a+    -> StreamK m b+foldrSShared = foldrSWith foldStreamShared++-- XXX consM is a typeclass method, therefore rewritten already. Instead maybe+-- we can make consM polymorphic using rewrite rules.+-- {-# RULES "foldrSShared/id"     foldrSShared consM nil = \x -> x #-}+{-# RULES "foldrSShared/nil"+    forall k z. foldrSShared k z nil = z #-}+{-# RULES "foldrSShared/single"+    forall k z x. foldrSShared k z (fromPure x) = k x z #-}+-- {-# RULES "foldrSShared/app" [1]+--     forall ys. foldrSShared consM ys = \xs -> xs `conjoin` ys #-}++-- | Right fold to a streaming monad.+--+-- > foldrS StreamK.cons StreamK.nil === id+--+-- 'foldrS' can be used to perform stateless stream to stream transformations+-- like map and filter in general. It can be coupled with a scan to perform+-- stateful transformations. However, note that the custom map and filter+-- routines can be much more efficient than this due to better stream fusion.+--+-- >>> input = StreamK.fromStream $ Stream.fromList [1..5]+-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS StreamK.cons StreamK.nil input+-- [1,2,3,4,5]+--+-- Find if any element in the stream is 'True':+--+-- >>> step x xs = if odd x then StreamK.fromPure True else xs+-- >>> input = StreamK.fromStream (Stream.fromList (2:4:5:undefined)) :: StreamK IO Int+-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step (StreamK.fromPure False) input+-- [True]+--+-- Map (+2) on odd elements and filter out the even elements:+--+-- >>> step x xs = if odd x then (x + 2) `StreamK.cons` xs else xs+-- >>> input = StreamK.fromStream (Stream.fromList [1..5]) :: StreamK IO Int+-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step StreamK.nil input+-- [3,5,7]+--+-- /Pre-release/+{-# INLINE_NORMAL foldrS #-}+foldrS ::+       (a -> StreamK m b -> StreamK m b)+    -> StreamK m b+    -> StreamK m a+    -> StreamK m b+foldrS = foldrSWith foldStream++{-# RULES "foldrS/id"     foldrS cons nil = \x -> x #-}+{-# RULES "foldrS/nil"    forall k z.   foldrS k z nil  = z #-}+-- See notes in GHC.Base about this rule+-- {-# RULES "foldr/cons"+--  forall k z x xs. foldrS k z (x `cons` xs) = k x (foldrS k z xs) #-}+{-# RULES "foldrS/single" forall k z x. foldrS k z (fromPure x) = k x z #-}+-- {-# RULES "foldrS/app" [1]+--  forall ys. foldrS cons ys = \xs -> xs `conjoin` ys #-}++-------------------------------------------------------------------------------+-- foldrS with monadic cons i.e. consM+-------------------------------------------------------------------------------++{-# INLINE foldrSMWith #-}+foldrSMWith :: Monad m+    => (forall r. State StreamK m b+        -> (b -> StreamK m b -> m r)+        -> (b -> m r)+        -> m r+        -> StreamK m b+        -> m r)+    -> (m a -> StreamK m b -> StreamK m b)+    -> StreamK m b+    -> StreamK m a+    -> StreamK m b+foldrSMWith f step final m = go m+    where+    go m1 = mkStream $ \st yld sng stp ->+        let run x = f st yld sng stp x+            stop = run final+            single a = run $ step (return a) final+            yieldk a r = run $ step (return a) (go r)+         in foldStream (adaptState st) yieldk single stop m1++{-# INLINE_NORMAL foldrSM #-}+foldrSM :: Monad m+    => (m a -> StreamK m b -> StreamK m b)+    -> StreamK m b+    -> StreamK m a+    -> StreamK m b+foldrSM = foldrSMWith foldStream++-- {-# RULES "foldrSM/id"     foldrSM consM nil = \x -> x #-}+{-# RULES "foldrSM/nil"    forall k z.   foldrSM k z nil  = z #-}+{-# RULES "foldrSM/single" forall k z x. foldrSM k z (fromEffect x) = k x z #-}+-- {-# RULES "foldrSM/app" [1]+--  forall ys. foldrSM consM ys = \xs -> xs `conjoin` ys #-}++-- Like foldrSM but sharing the SVar state within the recostructed stream.+{-# INLINE_NORMAL foldrSMShared #-}+foldrSMShared :: Monad m+    => (m a -> StreamK m b -> StreamK m b)+    -> StreamK m b+    -> StreamK m a+    -> StreamK m b+foldrSMShared = foldrSMWith foldStreamShared++-- {-# RULES "foldrSM/id"     foldrSM consM nil = \x -> x #-}+{-# RULES "foldrSMShared/nil"+    forall k z. foldrSMShared k z nil = z #-}+{-# RULES "foldrSMShared/single"+    forall k z x. foldrSMShared k z (fromEffect x) = k x z #-}+-- {-# RULES "foldrSM/app" [1]+--  forall ys. foldrSM consM ys = \xs -> xs `conjoin` ys #-}++-------------------------------------------------------------------------------+-- build+-------------------------------------------------------------------------------++{-# INLINE_NORMAL build #-}+build :: forall m a. (forall b. (a -> b -> b) -> b -> b) -> StreamK m a+build g = g cons nil++{-# RULES "foldrM/build"+    forall k z (g :: forall b. (a -> b -> b) -> b -> b).+    foldrM k z (build g) = g k z #-}++{-# RULES "foldrS/build"+      forall k z (g :: forall b. (a -> b -> b) -> b -> b).+      foldrS k z (build g) = g k z #-}++{-# RULES "foldrS/cons/build"+      forall k z x (g :: forall b. (a -> b -> b) -> b -> b).+      foldrS k z (x `cons` build g) = k x (g k z) #-}++{-# RULES "foldrSShared/build"+      forall k z (g :: forall b. (a -> b -> b) -> b -> b).+      foldrSShared k z (build g) = g k z #-}++{-# RULES "foldrSShared/cons/build"+      forall k z x (g :: forall b. (a -> b -> b) -> b -> b).+      foldrSShared k z (x `cons` build g) = k x (g k z) #-}++-- build a stream by applying cons and nil to a build function+{-# INLINE_NORMAL buildS #-}+buildS ::+       ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)+    -> StreamK m a+buildS g = g cons nil++{-# RULES "foldrS/buildS"+      forall k z+        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+      foldrS k z (buildS g) = g k z #-}++{-# RULES "foldrS/cons/buildS"+      forall k z x+        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+      foldrS k z (x `cons` buildS g) = k x (g k z) #-}++{-# RULES "foldrSShared/buildS"+      forall k z+        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+      foldrSShared k z (buildS g) = g k z #-}++{-# RULES "foldrSShared/cons/buildS"+      forall k z x+        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+      foldrSShared k z (x `cons` buildS g) = k x (g k z) #-}++-- build a stream by applying consM and nil to a build function+{-# INLINE_NORMAL buildSM #-}+buildSM :: Monad m+    => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)+    -> StreamK m a+buildSM g = g consM nil++{-# RULES "foldrSM/buildSM"+     forall k z+        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+     foldrSM k z (buildSM g) = g k z #-}++{-# RULES "foldrSMShared/buildSM"+     forall k z+        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+     foldrSMShared k z (buildSM g) = g k z #-}++-- Disabled because this may not fire as consM is a class Op+{-+{-# RULES "foldrS/consM/buildSM"+      forall k z x (g :: (m a -> t m a -> t m a) -> t m a -> t m a)+    . foldrSM k z (x `consM` buildSM g)+    = k x (g k z)+#-}+-}++-- Build using monadic build functions (continuations) instead of+-- reconstructing a stream.+{-# INLINE_NORMAL buildM #-}+buildM :: Monad m+    => (forall r. (a -> StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r+       )+    -> StreamK m a+buildM g = mkStream $ \st yld sng stp ->+    g (\a r -> foldStream st yld sng stp (return a `consM` r)) sng stp++-- | Like 'buildM' but shares the SVar state across computations.+{-# INLINE_NORMAL sharedMWith #-}+sharedMWith :: Monad m+    => (m a -> StreamK m a -> StreamK m a)+    -> (forall r. (a -> StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r+       )+    -> StreamK m a+sharedMWith cns g = mkStream $ \st yld sng stp ->+    g (\a r -> foldStreamShared st yld sng stp (return a `cns` r)) sng stp++-------------------------------------------------------------------------------+-- augment+-------------------------------------------------------------------------------++{-# INLINE_NORMAL augmentS #-}+augmentS ::+       ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)+    -> StreamK m a+    -> StreamK m a+augmentS g xs = g cons xs++{-# RULES "augmentS/nil"+    forall (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+    augmentS g nil = buildS g+    #-}++{-# RULES "foldrS/augmentS"+    forall k z xs+        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+    foldrS k z (augmentS g xs) = g k (foldrS k z xs)+    #-}++{-# RULES "augmentS/buildS"+    forall (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)+           (h :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+    augmentS g (buildS h) = buildS (\c n -> g c (h c n))+    #-}++{-# INLINE_NORMAL augmentSM #-}+augmentSM :: Monad m =>+       ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)+    -> StreamK m a -> StreamK m a+augmentSM g xs = g consM xs++{-# RULES "augmentSM/nil"+    forall+        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+    augmentSM g nil = buildSM g+    #-}++{-# RULES "foldrSM/augmentSM"+    forall k z xs+        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+    foldrSM k z (augmentSM g xs) = g k (foldrSM k z xs)+    #-}++{-# RULES "augmentSM/buildSM"+    forall+        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)+        (h :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).+    augmentSM g (buildSM h) = buildSM (\c n -> g c (h c n))+    #-}++-------------------------------------------------------------------------------+-- Experimental foldrM/buildM+-------------------------------------------------------------------------------++-- | Lazy right fold with a monadic step function.+{-# INLINE_NORMAL foldrM #-}+foldrM :: (a -> m b -> m b) -> m b -> StreamK m a -> m b+foldrM step acc m = go m+    where+    go m1 =+        let stop = acc+            single a = step a acc+            yieldk a r = step a (go r)+        in foldStream defState yieldk single stop m1++{-# INLINE_NORMAL foldrMKWith #-}+foldrMKWith+    :: (State StreamK m a+        -> (a -> StreamK m a -> m b)+        -> (a -> m b)+        -> m b+        -> StreamK m a+        -> m b)+    -> (a -> m b -> m b)+    -> m b+    -> ((a -> StreamK m a -> m b) -> (a -> m b) -> m b -> m b)+    -> m b+foldrMKWith f step acc = go+    where+    go k =+        let stop = acc+            single a = step a acc+            yieldk a r = step a (go (\yld sng stp -> f defState yld sng stp r))+        in k yieldk single stop++{-+{-# RULES "foldrM/buildS"+      forall k z (g :: (a -> t m a -> t m a) -> t m a -> t m a)+    . foldrM k z (buildS g)+    = g k z+#-}+-}+-- XXX in which case will foldrM/buildM fusion be useful?+{-# RULES "foldrM/buildM"+    forall step acc (g :: (forall r.+           (a -> StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r+       )).+    foldrM step acc (buildM g) = foldrMKWith foldStream step acc g+    #-}++{-+{-# RULES "foldrM/sharedM"+    forall step acc (g :: (forall r.+           (a -> StreamK m a -> m r)+        -> (a -> m r)+        -> m r+        -> m r+       )).+    foldrM step acc (sharedM g) = foldrMKWith foldStreamShared step acc g+    #-}+-}++------------------------------------------------------------------------------+-- Left fold+------------------------------------------------------------------------------++-- | Strict left fold with an extraction function. Like the standard strict+-- left fold, but applies a user supplied extraction function (the third+-- argument) to the folded value at the end. This is designed to work with the+-- @foldl@ library. The suffix @x@ is a mnemonic for extraction.+--+-- Note that the accumulator is always evaluated including the initial value.+{-# INLINE foldlx' #-}+foldlx' :: forall m a b x. Monad m+    => (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> m b+foldlx' step begin done m = get $ go m begin+    where+    {-# NOINLINE get #-}+    get :: StreamK m x -> m b+    get m1 =+        -- XXX we are not strictly evaluating the accumulator here. Is this+        -- okay?+        let single = return . done+        -- XXX this is foldSingleton. why foldStreamShared?+         in foldStreamShared undefined undefined single undefined m1++    -- Note, this can be implemented by making a recursive call to "go",+    -- however that is more expensive because of unnecessary recursion+    -- that cannot be tail call optimized. Unfolding recursion explicitly via+    -- continuations is much more efficient.+    go :: StreamK m a -> x -> StreamK m x+    go m1 !acc = mkStream $ \_ yld sng _ ->+        let stop = sng acc+            single a = sng $ step acc a+            -- XXX this is foldNonEmptyStream+            yieldk a r = foldStream defState yld sng undefined $+                go r (step acc a)+        in foldStream defState yieldk single stop m1++-- | Strict left associative fold.+{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> b -> StreamK m a -> m b+foldl' step begin = foldlx' step begin id++------------------------------------------------------------------------------+-- Specialized folds+------------------------------------------------------------------------------++-- XXX use foldrM to implement folds where possible+-- XXX This (commented) definition of drain and mapM_ perform much better on+-- some benchmarks but worse on others. Need to investigate why, may there is+-- an optimization opportunity that we can exploit.+-- drain = foldrM (\_ xs -> return () >> xs) (return ())++--+-- > drain = foldl' (\_ _ -> ()) ()+-- > drain = mapM_ (\_ -> return ())+{-# INLINE drain #-}+drain :: Monad m => StreamK m a -> m ()+drain = foldrM (\_ xs -> xs) (return ())+{-+drain = go+    where+    go m1 =+        let stop = return ()+            single _ = return ()+            yieldk _ r = go r+         in foldStream defState yieldk single stop m1+-}++{-# INLINE null #-}+null :: Monad m => StreamK m a -> m Bool+-- null = foldrM (\_ _ -> return True) (return False)+null m =+    let stop      = return True+        single _  = return False+        yieldk _ _ = return False+    in foldStream defState yieldk single stop m++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++infixr 6 `append`++{-# INLINE append #-}+append :: StreamK m a -> StreamK m a -> StreamK m a+-- XXX This doubles the time of toNullAp benchmark, may not be fusing properly+-- serial xs ys = augmentS (\c n -> foldrS c n xs) ys+append m1 m2 = go m1+    where+    go m = mkStream $ \st yld sng stp ->+               let stop       = foldStream st yld sng stp m2+                   single a   = yld a m2+                   yieldk a r = yld a (go r)+               in foldStream st yieldk single stop m++-- join/merge/append streams depending on consM+{-# INLINE conjoin #-}+conjoin :: Monad m => StreamK m a -> StreamK m a -> StreamK m a+conjoin xs = augmentSM (\c n -> foldrSM c n xs)++instance Semigroup (StreamK m a) where+    (<>) = append++------------------------------------------------------------------------------+-- Monoid+------------------------------------------------------------------------------++instance Monoid (StreamK m a) where+    mempty = nil+    mappend = (<>)++-------------------------------------------------------------------------------+-- Functor+-------------------------------------------------------------------------------++-- IMPORTANT: This is eta expanded on purpose. This should not be eta+-- reduced. This will cause a lot of regressions, probably because of some+-- rewrite rules. Ideally don't run hlint on this file.+{-# INLINE_LATE mapFB #-}+mapFB :: forall b m a.+       (b -> StreamK m b -> StreamK m b)+    -> (a -> b)+    -> a+    -> StreamK m b+    -> StreamK m b+mapFB c f = \x ys -> c (f x) ys++{-# RULES+"mapFB/mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f . g)+"mapFB/id"    forall c.     mapFB c (\x -> x)   = c+    #-}++{-# INLINE map #-}+map :: (a -> b) -> StreamK m a -> StreamK m b+map f xs = buildS (\c n -> foldrS (mapFB c f) n xs)++-- XXX This definition might potentially be more efficient, but the cost in the+-- benchmark is dominated by unfoldrM cost so we cannot correctly determine+-- differences in the mapping cost. We should perhaps deduct the cost of+-- unfoldrM from the benchmarks and then compare.+{-+map f m = go m+    where+        go m1 =+            mkStream $ \st yld sng stp ->+            let single     = sng . f+                yieldk a r = yld (f a) (go r)+            in foldStream (adaptState st) yieldk single stp m1+-}++{-# INLINE_LATE mapMFB #-}+mapMFB :: Monad m => (m b -> t m b -> t m b) -> (a -> m b) -> m a -> t m b -> t m b+mapMFB c f x = c (x >>= f)++{-# RULES+    "mapMFB/mapMFB" forall c f g. mapMFB (mapMFB c f) g = mapMFB c (f >=> g)+    #-}+-- XXX These rules may never fire because pure/return type class rules will+-- fire first.+{-+"mapMFB/pure"    forall c.     mapMFB c (\x -> pure x)   = c+"mapMFB/return"  forall c.     mapMFB c (\x -> return x) = c+-}++-- This is experimental serial version supporting fusion.+--+-- XXX what if we do not want to fuse two concurrent mapMs?+-- XXX we can combine two concurrent mapM only if the SVar is of the same type+-- So for now we use it only for serial streams.+-- XXX fusion would be easier for monomoprhic stream types.+-- {-# RULES "mapM serial" mapM = mapMSerial #-}+{-# INLINE mapMSerial #-}+mapMSerial :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+mapMSerial f xs = buildSM (\c n -> foldrSMShared (mapMFB c f) n xs)++{-# INLINE mapMWith #-}+mapMWith ::+       (m b -> StreamK m b -> StreamK m b)+    -> (a -> m b)+    -> StreamK m a+    -> StreamK m b+mapMWith cns f = foldrSShared (\x xs -> f x `cns` xs) nil++{-+-- See note under map definition above.+mapMWith cns f = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a  = f a >>= sng+            yieldk a r = foldStreamShared st yld sng stp $ f a `cns` go r+         in foldStream (adaptState st) yieldk single stp m1+-}++-- XXX in fact use the Stream type everywhere and only use polymorphism in the+-- high level modules/prelude.+instance Monad m => Functor (StreamK m) where+    fmap = map++------------------------------------------------------------------------------+-- Lists+------------------------------------------------------------------------------++-- Serial streams can act like regular lists using the Identity monad++-- XXX Show instance is 10x slower compared to read, we can do much better.+-- The list show instance itself is really slow.++-- XXX The default definitions of "<" in the Ord instance etc. do not perform+-- well, because they do not get inlined. Need to add INLINE in Ord class in+-- base?++instance IsList (StreamK Identity a) where+    type (Item (StreamK Identity a)) = a++    {-# INLINE fromList #-}+    fromList = fromFoldable++    {-# INLINE toList #-}+    toList = Data.Foldable.foldr (:) []++-- XXX Fix these+{-+instance Eq a => Eq (StreamK Identity a) where+    {-# INLINE (==) #-}+    (==) xs ys = runIdentity $ eqBy (==) xs ys++instance Ord a => Ord (StreamK Identity a) where+    {-# INLINE compare #-}+    compare xs ys = runIdentity $ cmpBy compare xs ys++    {-# INLINE (<) #-}+    x < y =+        case compare x y of+            LT -> True+            _ -> False++    {-# INLINE (<=) #-}+    x <= y =+        case compare x y of+            GT -> False+            _ -> True++    {-# INLINE (>) #-}+    x > y =+        case compare x y of+            GT -> True+            _ -> False++    {-# INLINE (>=) #-}+    x >= y =+        case compare x y of+            LT -> False+            _ -> True++    {-# INLINE max #-}+    max x y = if x <= y then y else x++    {-# INLINE min #-}+    min x y = if x <= y then x else y+-}++instance Show a => Show (StreamK Identity a) where+    showsPrec p dl = showParen (p > 10) $+        showString "fromList " . shows (toList dl)++instance Read a => Read (StreamK Identity a) where+    readPrec = parens $ prec 10 $ do+        Ident "fromList" <- lexP+        fromList <$> readPrec++    readListPrec = readListPrecDefault++instance (a ~ Char) => IsString (StreamK Identity a) where+    {-# INLINE fromString #-}+    fromString = fromList++-------------------------------------------------------------------------------+-- Foldable+-------------------------------------------------------------------------------++-- | Lazy right associative fold.+{-# INLINE foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> StreamK m a -> m b+foldr step acc = foldrM (\x xs -> xs >>= \b -> return (step x b)) (return acc)++-- The default Foldable instance has several issues:+-- 1) several definitions do not have INLINE on them, so we provide+--    re-implementations with INLINE pragmas.+-- 2) the definitions of sum/product/maximum/minimum are inefficient as they+--    use right folds, they cannot run in constant memory. We provide+--    implementations using strict left folds here.++instance (Foldable m, Monad m) => Foldable (StreamK m) where++    {-# INLINE foldMap #-}+    foldMap f =+          fold+        . Streamly.Internal.Data.StreamK.Type.foldr (mappend . f) mempty++    {-# INLINE foldr #-}+    foldr f z t = appEndo (foldMap (Endo #. f) t) z++    {-# INLINE foldl' #-}+    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0+        where f' x k = oneShot $ \z -> k $! f z x++    {-# INLINE length #-}+    length = Data.Foldable.foldl' (\n _ -> n + 1) 0++    {-# INLINE elem #-}+    elem = any . (==)++    {-# INLINE maximum #-}+    maximum =+          fromMaybe (errorWithoutStackTrace "maximum: empty stream")+        . toMaybe+        . Data.Foldable.foldl' getMax Nothing'++        where++        getMax Nothing' x = Just' x+        getMax (Just' mx) x = Just' $! max mx x++    {-# INLINE minimum #-}+    minimum =+          fromMaybe (errorWithoutStackTrace "minimum: empty stream")+        . toMaybe+        . Data.Foldable.foldl' getMin Nothing'++        where++        getMin Nothing' x = Just' x+        getMin (Just' mn) x = Just' $! min mn x++    {-# INLINE sum #-}+    sum = Data.Foldable.foldl' (+) 0++    {-# INLINE product #-}+    product = Data.Foldable.foldl' (*) 1++-------------------------------------------------------------------------------+-- Traversable+-------------------------------------------------------------------------------++instance Traversable (StreamK Identity) where+    {-# INLINE traverse #-}+    traverse f xs =+        runIdentity+            $ Streamly.Internal.Data.StreamK.Type.foldr+                consA (pure mempty) xs++        where++        consA x ys = liftA2 cons (f x) ys++-------------------------------------------------------------------------------+-- Nesting+-------------------------------------------------------------------------------++-- | Detach a stream from an SVar+{-# INLINE unShare #-}+unShare :: StreamK m a -> StreamK m a+unShare x = mkStream $ \st yld sng stp ->+    foldStream st yld sng stp x++-- XXX the function stream and value stream can run in parallel+{-# INLINE crossApplyWith #-}+crossApplyWith ::+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> StreamK m (a -> b)+    -> StreamK m a+    -> StreamK m b+crossApplyWith par fstream stream = go1 fstream++    where++    go1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single f   = foldShared $ unShare (go2 f stream)+                yieldk f r = foldShared $ unShare (go2 f stream) `par` go1 r+            in foldStream (adaptState st) yieldk single stp m++    go2 f m =+        mkStream $ \st yld sng stp ->+            let single a   = sng (f a)+                yieldk a r = yld (f a) (go2 f r)+            in foldStream (adaptState st) yieldk single stp m++-- | Apply a stream of functions to a stream of values and flatten the results.+--+-- Note that the second stream is evaluated multiple times.+--+-- Definition:+--+-- >>> crossApply = StreamK.crossApplyWith StreamK.append+-- >>> crossApply = Stream.crossWith id+--+{-# INLINE crossApply #-}+crossApply ::+       StreamK m (a -> b)+    -> StreamK m a+    -> StreamK m b+crossApply fstream stream = go1 fstream++    where++    go1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single f   = foldShared $ go3 f stream+                yieldk f r = foldShared $ go2 f r stream+            in foldStream (adaptState st) yieldk single stp m++    go2 f r1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                stop = foldShared $ go1 r1+                single a   = yld (f a) (go1 r1)+                yieldk a r = yld (f a) (go2 f r1 r)+            in foldStream (adaptState st) yieldk single stop m++    go3 f m =+        mkStream $ \st yld sng stp ->+            let single a   = sng (f a)+                yieldk a r = yld (f a) (go3 f r)+            in foldStream (adaptState st) yieldk single stp m++{-# INLINE crossApplySnd #-}+crossApplySnd ::+       StreamK m a+    -> StreamK m b+    -> StreamK m b+crossApplySnd fstream stream = go1 fstream++    where++    go1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single _   = foldShared stream+                yieldk _ r = foldShared $ go2 r stream+            in foldStream (adaptState st) yieldk single stp m++    go2 r1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                stop = foldShared $ go1 r1+                single a   = yld a (go1 r1)+                yieldk a r = yld a (go2 r1 r)+            in foldStream st yieldk single stop m++{-# INLINE crossApplyFst #-}+crossApplyFst ::+       StreamK m a+    -> StreamK m b+    -> StreamK m a+crossApplyFst fstream stream = go1 fstream++    where++    go1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single f   = foldShared $ go3 f stream+                yieldk f r = foldShared $ go2 f r stream+            in foldStream st yieldk single stp m++    go2 f r1 m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                stop = foldShared $ go1 r1+                single _   = yld f (go1 r1)+                yieldk _ r = yld f (go2 f r1 r)+            in foldStream (adaptState st) yieldk single stop m++    go3 f m =+        mkStream $ \st yld sng stp ->+            let single _   = sng f+                yieldk _ r = yld f (go3 f r)+            in foldStream (adaptState st) yieldk single stp m++-- |+-- Definition:+--+-- >>> crossWith f m1 m2 = fmap f m1 `StreamK.crossApply` m2+--+-- Note that the second stream is evaluated multiple times.+--+{-# INLINE crossWith #-}+crossWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+crossWith f m1 m2 = fmap f m1 `crossApply` m2++-- | Given a @StreamK m a@ and @StreamK m b@ generate a stream with all possible+-- combinations of the tuple @(a, b)@.+--+-- Definition:+--+-- >>> cross = StreamK.crossWith (,)+--+-- The second stream is evaluated multiple times. If that is not desired it can+-- be cached in an 'Data.Array.Array' and then generated from the array before+-- calling this function. Caching may also improve performance if the stream is+-- expensive to evaluate.+--+-- See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused+-- alternative.+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE cross #-}+cross :: Monad m => StreamK m a -> StreamK m b -> StreamK m (a, b)+cross = crossWith (,)++-- XXX This is just concatMapWith with arguments flipped. We need to keep this+-- instead of using a concatMap style definition because the bind+-- implementation in Async and WAsync streams show significant perf degradation+-- if the argument order is changed.+{-# INLINE bindWith #-}+bindWith ::+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> StreamK m a+    -> (a -> StreamK m b)+    -> StreamK m b+bindWith par m1 f = go m1+    where+        go m =+            mkStream $ \st yld sng stp ->+                let foldShared = foldStreamShared st yld sng stp+                    single a   = foldShared $ unShare (f a)+                    yieldk a r = foldShared $ unShare (f a) `par` go r+                in foldStream (adaptState st) yieldk single stp m++-- XXX express in terms of foldrS?+-- XXX can we use a different stream type for the generated stream being+-- falttened so that we can combine them differently and keep the resulting+-- stream different?+-- XXX do we need specialize to IO?+-- XXX can we optimize when c and a are same, by removing the forall using+-- rewrite rules with type applications?++-- | Perform a 'concatMap' using a specified concat strategy. The first+-- argument specifies a merge or concat function that is used to merge the+-- streams generated by the map function.+--+{-# INLINE concatMapWith #-}+concatMapWith+    ::+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> StreamK m a+    -> StreamK m b+concatMapWith par f xs = bindWith par xs f++{-# INLINE concatMap #-}+concatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+concatMap = concatMapWith append++{-+-- Fused version.+-- XXX This fuses but when the stream is nil this performs poorly.+-- The filterAllOut benchmark degrades. Need to investigate and fix that.+{-# INLINE concatMap #-}+concatMap :: IsStream t => (a -> t m b) -> t m a -> t m b+concatMap f xs = buildS+    (\c n -> foldrS (\x b -> foldrS c b (f x)) n xs)++-- Stream polymorphic concatMap implementation+-- XXX need to use buildSM/foldrSMShared for parallel behavior+-- XXX unShare seems to degrade the fused performance+{-# INLINE_EARLY concatMap_ #-}+concatMap_ :: IsStream t => (a -> t m b) -> t m a -> t m b+concatMap_ f xs = buildS+     (\c n -> foldrSShared (\x b -> foldrSShared c b (unShare $ f x)) n xs)+-}++-- | Combine streams in pairs using a binary combinator, the resulting streams+-- are then combined again in pairs recursively until we get to a single+-- combined stream. The composition would thus form a binary tree.+--+-- For example, you can sort a stream using merge sort like this:+--+-- >>> s = StreamK.fromStream $ Stream.fromList [5,1,7,9,2]+-- >>> generate = StreamK.fromPure+-- >>> combine = StreamK.mergeBy compare+-- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.mergeMapWith combine generate s+-- [1,2,5,7,9]+--+-- Note that if the stream length is not a power of 2, the binary tree composed+-- by mergeMapWith would not be balanced, which may or may not be important+-- depending on what you are trying to achieve.+--+-- /Caution: the stream of streams must be finite/+--+-- /Pre-release/+--+{-# INLINE mergeMapWith #-}+mergeMapWith+    ::+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> StreamK m a+    -> StreamK m b+mergeMapWith combine f str = go (leafPairs str)++    where++    go stream =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single a   = foldShared $ unShare a+                yieldk a r = foldShared $ go1 a r+            in foldStream (adaptState st) yieldk single stp stream++    go1 a1 stream =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                stop = foldShared $ unShare a1+                single a = foldShared $ unShare a1 `combine` a+                yieldk a r =+                    foldShared $ go $ combine a1 a `cons` nonLeafPairs r+            in foldStream (adaptState st) yieldk single stop stream++    -- Exactly the same as "go" except that stop continuation extracts the+    -- stream.+    leafPairs stream =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single a   = sng (f a)+                yieldk a r = foldShared $ leafPairs1 a r+            in foldStream (adaptState st) yieldk single stp stream++    leafPairs1 a1 stream =+        mkStream $ \st yld sng _ ->+            let stop = sng (f a1)+                single a = sng (f a1 `combine` f a)+                yieldk a r = yld (f a1 `combine` f a) $ leafPairs r+            in foldStream (adaptState st) yieldk single stop stream++    -- Exactly the same as "leafPairs" except that it does not map "f"+    nonLeafPairs stream =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                single a   = sng a+                yieldk a r = foldShared $ nonLeafPairs1 a r+            in foldStream (adaptState st) yieldk single stp stream++    nonLeafPairs1 a1 stream =+        mkStream $ \st yld sng _ ->+            let stop = sng a1+                single a = sng (a1 `combine` a)+                yieldk a r = yld (a1 `combine` a) $ nonLeafPairs r+            in foldStream (adaptState st) yieldk single stop stream++{-+instance Monad m => Applicative (StreamK m) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = crossApplyFst++-- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,+-- the monad instance of StreamD is slower than StreamK after foldr/build+-- fusion.+instance Monad m => Monad (StreamK m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap+-}++{-+-- Like concatMap but generates stream using an unfold function. Similar to+-- unfoldMany but for StreamK.+concatUnfoldr :: IsStream t+    => (b -> t m (Maybe (a, b))) -> t m b -> t m a+concatUnfoldr = undefined+-}++------------------------------------------------------------------------------+-- concatIterate - Map and flatten Trees of Streams+------------------------------------------------------------------------------++-- | Yield an input element in the output stream, map a stream generator on it+-- and repeat the process on the resulting stream. Resulting streams are+-- flattened using the 'concatMapWith' combinator. This can be used for a depth+-- first style (DFS) traversal of a tree like structure.+--+-- Example, list a directory tree using DFS:+--+-- >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil)+-- >>> input = StreamK.fromPure (Left ".")+-- >>> ls = StreamK.concatIterateWith StreamK.append f input+--+-- Note that 'iterateM' is a special case of 'concatIterateWith':+--+-- >>> iterateM f = StreamK.concatIterateWith StreamK.append (StreamK.fromEffect . f) . StreamK.fromEffect+--+-- /Pre-release/+--+{-# INLINE concatIterateWith #-}+concatIterateWith ::+       (StreamK m a -> StreamK m a -> StreamK m a)+    -> (a -> StreamK m a)+    -> StreamK m a+    -> StreamK m a+concatIterateWith combine f = iterateStream++    where++    iterateStream = concatMapWith combine generate++    generate x = x `cons` iterateStream (f x)++-- | Like 'concatIterateWith' but uses the pairwise flattening combinator+-- 'mergeMapWith' for flattening the resulting streams. This can be used for a+-- balanced traversal of a tree like structure.+--+-- Example, list a directory tree using balanced traversal:+--+-- >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil)+-- >>> input = StreamK.fromPure (Left ".")+-- >>> ls = StreamK.mergeIterateWith StreamK.interleave f input+--+-- /Pre-release/+--+{-# INLINE mergeIterateWith #-}+mergeIterateWith ::+       (StreamK m a -> StreamK m a -> StreamK m a)+    -> (a -> StreamK m a)+    -> StreamK m a+    -> StreamK m a+mergeIterateWith combine f = iterateStream++    where++    iterateStream = mergeMapWith combine generate++    generate x = x `cons` iterateStream (f x)++------------------------------------------------------------------------------+-- Flattening Graphs+------------------------------------------------------------------------------++-- To traverse graphs we need a state to be carried around in the traversal.+-- For example, we can use a hashmap to store the visited status of nodes.++-- | Like 'iterateMap' but carries a state in the stream generation function.+-- This can be used to traverse graph like structures, we can remember the+-- visited nodes in the state to avoid cycles.+--+-- Note that a combination of 'iterateMap' and 'usingState' can also be used to+-- traverse graphs. However, this function provides a more localized state+-- instead of using a global state.+--+-- See also: 'mfix'+--+-- /Pre-release/+--+{-# INLINE concatIterateScanWith #-}+concatIterateScanWith+    :: Monad m+    => (StreamK m a -> StreamK m a -> StreamK m a)+    -> (b -> a -> m (b, StreamK m a))+    -> m b+    -> StreamK m a+    -> StreamK m a+concatIterateScanWith combine f initial stream =+    concatEffect $ do+        b <- initial+        iterateStream (b, stream)++    where++    iterateStream (b, s) = pure $ concatMapWith combine (generate b) s++    generate b a = a `cons` feedback b a++    feedback b a = concatEffect $ f b a >>= iterateStream++------------------------------------------------------------------------------+-- Either streams+------------------------------------------------------------------------------++-- Keep concating either streams as long as rights are generated, stop as soon+-- as a left is generated and concat the left stream.+--+-- See also: 'handle'+--+-- /Unimplemented/+--+{-+concatMapEitherWith+    :: (forall x. t m x -> t m x -> t m x)+    -> (a -> t m (Either (StreamK m b) b))+    -> StreamK m a+    -> StreamK m b+concatMapEitherWith = undefined+-}++-- XXX We should prefer using the Maybe stream returning signatures over this.+-- This API should perhaps be removed in favor of those.++-- | In an 'Either' stream iterate on 'Left's.  This is a special case of+-- 'concatIterateWith':+--+-- >>> concatIterateLeftsWith combine f = StreamK.concatIterateWith combine (either f (const StreamK.nil))+--+-- To traverse a directory tree:+--+-- >>> input = StreamK.fromPure (Left ".")+-- >>> ls = StreamK.concatIterateLeftsWith StreamK.append (StreamK.fromStream . Dir.readEither) input+--+-- /Pre-release/+--+{-# INLINE concatIterateLeftsWith #-}+concatIterateLeftsWith+    :: (b ~ Either a c)+    => (StreamK m b -> StreamK m b -> StreamK m b)+    -> (a -> StreamK m b)+    -> StreamK m b+    -> StreamK m b+concatIterateLeftsWith combine f =+    concatIterateWith combine (either f (const nil))++------------------------------------------------------------------------------+-- Interleaving+------------------------------------------------------------------------------++infixr 6 `interleave`++-- Additionally we can have m elements yield from the first stream and n+-- elements yielding from the second stream. We can also have time slicing+-- variants of positional interleaving, e.g. run first stream for m seconds and+-- run the second stream for n seconds.++-- | Note: When joining many streams in a left associative manner earlier+-- streams will get exponential priority than the ones joining later. Because+-- of exponentially high weighting of left streams it can be used with+-- 'concatMapWith' even on a large number of streams.+--+{-# INLINE interleave #-}+interleave :: StreamK m a -> StreamK m a -> StreamK m a+interleave m1 m2 = mkStream $ \st yld sng stp -> do+    let stop       = foldStream st yld sng stp m2+        single a   = yld a m2+        yieldk a r = yld a (interleave m2 r)+    foldStream st yieldk single stop m1++infixr 6 `interleaveFst`++-- | Like `interleave` but stops interleaving as soon as the first stream stops.+--+{-# INLINE interleaveFst #-}+interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a+interleaveFst m1 m2 = mkStream $ \st yld sng stp -> do+    let yieldFirst a r = yld a (yieldSecond r m2)+     in foldStream st yieldFirst sng stp m1++    where++    yieldSecond s1 s2 = mkStream $ \st yld sng stp -> do+            let stop       = foldStream st yld sng stp s1+                single a   = yld a s1+                yieldk a r = yld a (interleave s1 r)+             in foldStream st yieldk single stop s2++infixr 6 `interleaveMin`++-- | Like `interleave` but stops interleaving as soon as any of the two streams+-- stops.+--+{-# INLINE interleaveMin #-}+interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a+interleaveMin m1 m2 = mkStream $ \st yld _ stp -> do+    let stop       = stp+        -- "single a" is defined as "yld a (interleaveMin m2 nil)" instead of+        -- "sng a" to keep the behaviour consistent with the yield+        -- continuation.+        single a   = yld a (interleaveMin m2 nil)+        yieldk a r = yld a (interleaveMin m2 r)+    foldStream st yieldk single stop m1++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++-- |+-- >>> :{+-- unfoldr step s =+--     case step s of+--         Nothing -> StreamK.nil+--         Just (a, b) -> a `StreamK.cons` unfoldr step b+-- :}+--+-- Build a stream by unfolding a /pure/ step function @step@ starting from a+-- seed @s@.  The step function returns the next element in the stream and the+-- next seed value. When it is done it returns 'Nothing' and the stream ends.+-- For example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then Nothing+--         else Just (b, b + 1)+-- in StreamK.toList $ StreamK.unfoldr f 0+-- :}+-- [0,1,2]+--+{-# INLINE unfoldr #-}+unfoldr :: (b -> Maybe (a, b)) -> b -> StreamK m a+unfoldr next s0 = build $ \yld stp ->+    let go s =+            case next s of+                Just (a, b) -> yld a (go b)+                Nothing -> stp+    in go s0++{-# INLINE unfoldrMWith #-}+unfoldrMWith :: Monad m =>+       (m a -> StreamK m a -> StreamK m a)+    -> (b -> m (Maybe (a, b)))+    -> b+    -> StreamK m a+unfoldrMWith cns step = go++    where++    go s = sharedMWith cns $ \yld _ stp -> do+                r <- step s+                case r of+                    Just (a, b) -> yld a (go b)+                    Nothing -> stp++-- | Build a stream by unfolding a /monadic/ step function starting from a+-- seed.  The step function returns the next element in the stream and the next+-- seed value. When it is done it returns 'Nothing' and the stream ends. For+-- example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then return Nothing+--         else return (Just (b, b + 1))+-- in StreamK.toList $ StreamK.unfoldrM f 0+-- :}+-- [0,1,2]+--+{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> StreamK m a+unfoldrM = unfoldrMWith consM++-- | Generate an infinite stream by repeating a pure value.+--+-- /Pre-release/+{-# INLINE repeat #-}+repeat :: a -> StreamK m a+repeat a = let x = cons a x in x++-- | Like 'repeatM' but takes a stream 'cons' operation to combine the actions+-- in a stream specific manner. A serial cons would repeat the values serially+-- while an async cons would repeat concurrently.+--+-- /Pre-release/+repeatMWith :: (m a -> t m a -> t m a) -> m a -> t m a+repeatMWith cns = go++    where++    go m = m `cns` go m++{-# INLINE replicateMWith #-}+replicateMWith :: (m a -> StreamK m a -> StreamK m a) -> Int -> m a -> StreamK m a+replicateMWith cns n m = go n++    where++    go cnt = if cnt <= 0 then nil else m `cns` go (cnt - 1)++{-# INLINE fromIndicesMWith #-}+fromIndicesMWith ::+    (m a -> StreamK m a -> StreamK m a) -> (Int -> m a) -> StreamK m a+fromIndicesMWith cns gen = go 0++    where++    go i = mkStream $ \st stp sng yld -> do+        foldStreamShared st stp sng yld (gen i `cns` go (i + 1))++{-# INLINE iterateMWith #-}+iterateMWith :: Monad m =>+    (m a -> StreamK m a -> StreamK m a) -> (a -> m a) -> m a -> StreamK m a+iterateMWith cns step = go++    where++    go s = mkStream $ \st stp sng yld -> do+        !next <- s+        foldStreamShared st stp sng yld (return next `cns` go (step next))++{-# INLINE headPartial #-}+headPartial :: Monad m => StreamK m a -> m a+headPartial = foldrM (\x _ -> return x) (error "head of nil")++{-# INLINE tailPartial #-}+tailPartial :: StreamK m a -> StreamK m a+tailPartial m = mkStream $ \st yld sng stp ->+    let stop      = error "tail of nil"+        single _  = stp+        yieldk _ r = foldStream st yld sng stp r+    in foldStream st yieldk single stop m++-- | We can define cyclic structures using @let@:+--+-- >>> let (a, b) = ([1, b], head a) in (a, b)+-- ([1,1],1)+--+-- The function @fix@ defined as:+--+-- >>> fix f = let x = f x in x+--+-- ensures that the argument of a function and its output refer to the same+-- lazy value @x@ i.e.  the same location in memory.  Thus @x@ can be defined+-- in terms of itself, creating structures with cyclic references.+--+-- >>> f ~(a, b) = ([1, b], head a)+-- >>> fix f+-- ([1,1],1)+--+-- 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic+-- values.+--+-- Using 'mfix' for streams we can construct a stream in which each element of+-- the stream is defined in a cyclic fashion. The argument of the function+-- being fixed represents the current element of the stream which is being+-- returned by the stream monad. Thus, we can use the argument to construct+-- itself.+--+-- In the following example, the argument @action@ of the function @f@+-- represents the tuple @(x,y)@ returned by it in a given iteration. We define+-- the first element of the tuple in terms of the second.+--+-- >>> import System.IO.Unsafe (unsafeInterleaveIO)+--+-- >>> :{+-- main = Stream.fold (Fold.drainMapM print) $ StreamK.toStream $ StreamK.mfix f+--     where+--     f action = StreamK.unCross $ do+--         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act+--         x <- StreamK.mkCross $ StreamK.fromStream $ Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action]+--         y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [4,5]+--         return (x, y)+-- :}+--+-- Note: you cannot achieve this by just changing the order of the monad+-- statements because that would change the order in which the stream elements+-- are generated.+--+-- Note that the function @f@ must be lazy in its argument, that's why we use+-- 'unsafeInterleaveIO' on @action@ because IO monad is strict.+--+-- /Pre-release/+{-# INLINE mfix #-}+mfix :: Monad m => (m a -> StreamK m a) -> StreamK m a+mfix f = mkStream $ \st yld sng stp ->+    let single a  = foldStream st yld sng stp $ a `cons` ys+        yieldk a _ = foldStream st yld sng stp $ a `cons` ys+    in foldStream st yieldk single stp xs++    where++    -- fix the head element of the stream+    xs = fix  (f . headPartial)++    -- now fix the tail recursively+    ys = mfix (tailPartial . f)++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- |+-- >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil+--+-- Construct a stream from a 'Foldable' containing pure values:+--+{-# INLINE fromFoldable #-}+fromFoldable :: Foldable f => f a -> StreamK m a+fromFoldable = Prelude.foldr cons nil++{-# INLINE fromFoldableM #-}+fromFoldableM :: (Foldable f, Monad m) => f (m a) -> StreamK m a+fromFoldableM = Prelude.foldr consM nil++-------------------------------------------------------------------------------+-- Deconstruction+-------------------------------------------------------------------------------++{-# INLINE uncons #-}+uncons :: Applicative m => StreamK m a -> m (Maybe (a, StreamK m a))+uncons m =+    let stop = pure Nothing+        single a = pure (Just (a, nil))+        yieldk a r = pure (Just (a, r))+    in foldStream defState yieldk single stop m++{-# INLINE tail #-}+tail :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))+tail =+    let stop      = pure Nothing+        single _  = pure $ Just nil+        yieldk _ r = pure $ Just r+    in foldStream defState yieldk single stop++-- | Extract all but the last element of the stream, if any.+--+-- Note: This will end up buffering the entire stream.+--+-- /Pre-release/+{-# INLINE init #-}+init :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))+init = go1+    where+    go1 m1 = do+        (\case+            Nothing -> Nothing+            Just (h, t) -> Just $ go h t) <$> uncons m1+    go p m1 = mkStream $ \_ yld sng stp ->+        let single _ = sng p+            yieldk a x = yld p $ go a x+         in foldStream defState yieldk single stp m1++------------------------------------------------------------------------------+-- Reordering+------------------------------------------------------------------------------++-- | Lazy left fold to a stream.+{-# INLINE foldlS #-}+foldlS ::+    (StreamK m b -> a -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+foldlS step = go+    where+    go acc rest = mkStream $ \st yld sng stp ->+        let run x = foldStream st yld sng stp x+            stop = run acc+            single a = run $ step acc a+            yieldk a r = run $ go (step acc a) r+         in foldStream (adaptState st) yieldk single stop rest++{-# INLINE reverse #-}+reverse :: StreamK m a -> StreamK m a+reverse = foldlS (flip cons) nil++------------------------------------------------------------------------------+-- Running effects+------------------------------------------------------------------------------++-- | Run an action before evaluating the stream.+{-# INLINE before #-}+before :: Monad m => m b -> StreamK m a -> StreamK m a+before action stream =+    mkStream $ \st yld sng stp ->+        action >> foldStreamShared st yld sng stp stream++{-# INLINE concatEffect #-}+concatEffect :: Monad m => m (StreamK m a) -> StreamK m a+concatEffect action =+    mkStream $ \st yld sng stp ->+        action >>= foldStreamShared st yld sng stp++{-# INLINE concatMapEffect #-}+concatMapEffect :: Monad m => (b -> StreamK m a) -> m b -> StreamK m a+concatMapEffect f action =+    mkStream $ \st yld sng stp ->+        action >>= foldStreamShared st yld sng stp . f++------------------------------------------------------------------------------+-- Stream with a cross product style monad instance+------------------------------------------------------------------------------++-- | A newtype wrapper for the 'StreamK' type adding a cross product style+-- monad instance.+--+-- A 'Monad' bind behaves like a @for@ loop:+--+-- >>> :{+-- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do+--     x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2]+--     -- Perform the following actions for each x in the stream+--     return x+-- :}+-- [1,2]+--+-- Nested monad binds behave like nested @for@ loops:+--+-- >>> :{+-- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do+--     x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2]+--     y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [3,4]+--     -- Perform the following actions for each x, for each y+--     return (x, y)+-- :}+-- [(1,3),(1,4),(2,3),(2,4)]+--+newtype CrossStreamK m a = CrossStreamK {unCrossStreamK :: StreamK m a}+        deriving (Functor, Semigroup, Monoid, Foldable)++-- | Wrap the 'StreamK' type in a 'CrossStreamK' newtype to enable cross+-- product style applicative and monad instances.+--+-- This is a type level operation with no runtime overhead.+{-# INLINE mkCross #-}+mkCross :: StreamK m a -> CrossStreamK m a+mkCross = CrossStreamK++-- | Unwrap the 'StreamK' type from 'CrossStreamK' newtype.+--+-- This is a type level operation with no runtime overhead.+{-# INLINE unCross #-}+unCross :: CrossStreamK m a -> StreamK m a+unCross = unCrossStreamK++-- Pure (Identity monad) stream instances+deriving instance Traversable (CrossStreamK Identity)+deriving instance IsList (CrossStreamK Identity a)+deriving instance (a ~ Char) => IsString (CrossStreamK Identity a)+-- deriving instance Eq a => Eq (CrossStreamK Identity a)+-- deriving instance Ord a => Ord (CrossStreamK Identity a)++-- Do not use automatic derivation for this to show as "fromList" rather than+-- "fromList Identity".+instance Show a => Show (CrossStreamK Identity a) where+    {-# INLINE show #-}+    show (CrossStreamK xs) = show xs++instance Read a => Read (CrossStreamK Identity a) where+    {-# INLINE readPrec #-}+    readPrec = fmap CrossStreamK readPrec++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++-- Note: we need to define all the typeclass operations because we want to+-- INLINE them.+instance Monad m => Applicative (CrossStreamK m) where+    {-# INLINE pure #-}+    pure x = CrossStreamK (fromPure x)++    {-# INLINE (<*>) #-}+    (CrossStreamK s1) <*> (CrossStreamK s2) =+        CrossStreamK (crossApply s1 s2)++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (CrossStreamK s1) *> (CrossStreamK s2) =+        CrossStreamK (crossApplySnd s1 s2)++    {-# INLINE (<*) #-}+    (CrossStreamK s1) <* (CrossStreamK s2) =+        CrossStreamK (crossApplyFst s1 s2)++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++instance Monad m => Monad (CrossStreamK m) where+    return = pure++    -- Benchmarks better with CPS bind and pure:+    -- Prime sieve (25x)+    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)+    --+    {-# INLINE (>>=) #-}+    (>>=) (CrossStreamK m) f =+        CrossStreamK (bindWith append m (unCrossStreamK . f))++    {-# INLINE (>>) #-}+    (>>) = (*>)++------------------------------------------------------------------------------+-- Transformers+------------------------------------------------------------------------------++instance (MonadIO m) => MonadIO (CrossStreamK m) where+    liftIO x = CrossStreamK (fromEffect $ liftIO x)++instance MonadTrans CrossStreamK where+    {-# INLINE lift #-}+    lift x = CrossStreamK (fromEffect x)++instance (MonadThrow m) => MonadThrow (CrossStreamK m) where+    throwM = lift . throwM
src/Streamly/Internal/Data/Time/Clock.hs view
@@ -9,8 +9,7 @@ module Streamly.Internal.Data.Time.Clock     (     -- * System clock-      Clock(..)-    , getTime+      module Streamly.Internal.Data.Time.Clock.Type      -- * Async clock     , asyncClock@@ -30,12 +29,13 @@ import Control.Concurrent (threadDelay, ThreadId) import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, tryPutMVar) import Control.Monad (forever, when, void)-import Streamly.Internal.Data.Time.Clock.Type (Clock(..), getTime) import Streamly.Internal.Data.Time.Units     (MicroSecond64(..), fromAbsTime, addToAbsTime, toRelTime) import Streamly.Internal.Control.ForkIO (forkIOManaged)  import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed++import Streamly.Internal.Data.Time.Clock.Type  ------------------------------------------------------------------------------ -- Async clock
src/Streamly/Internal/Data/Time/Units.hs view
@@ -1,4 +1,5 @@-{-# LANGUAGE TypeInType #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE UnboxedTuples #-}  -- |@@ -52,7 +53,7 @@  import Data.Int import Foreign.Storable (Storable)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.Time.TimeSpec  -------------------------------------------------------------------------------
+ src/Streamly/Internal/Data/Unbox.hs view
@@ -0,0 +1,905 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UndecidableInstances #-}++-- |+-- Module      : Streamly.Internal.Data.Unbox+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unbox+    (+    -- ** Unbox type class+      Unbox(..)++    -- ** Peek and poke utilities+    , BoundedPtr (..)+    -- Peek+    , Peeker (..)+    , read+    , readUnsafe+    , skipByte+    , runPeeker+    -- Poke+    , pokeBoundedPtrUnsafe+    , pokeBoundedPtr++    -- ** Generic Deriving+    , PeekRep(..)+    , PokeRep(..)+    , SizeOfRep(..)+    , genericSizeOf+    , genericPeekByteIndex+    , genericPokeByteIndex+    ) where++#include "MachDeps.h"+#include "ArrayMacros.h"++import Control.Monad (void, when)+import Data.Complex (Complex((:+)))+import Data.Functor ((<&>))+import Data.Functor.Const (Const(..))+import Data.Functor.Identity (Identity(..))+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import Foreign.Ptr (IntPtr(..), WordPtr(..))+import GHC.Base (IO(..))+import GHC.Fingerprint.Type (Fingerprint(..))+import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))+import GHC.Real (Ratio(..))+import GHC.Stable (StablePtr(..))+import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))+#if MIN_VERSION_base(4,15,0)+import GHC.RTS.Flags (IoSubSystem(..))+#endif+import Streamly.Internal.Data.Builder (Builder (..))++import GHC.Generics+import GHC.Exts+import GHC.TypeLits+import Prelude hiding (read)++import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))+#ifdef DEBUG+import Streamly.Internal.Data.MutByteArray.Type (sizeOfMutableByteArray)+#endif++--------------------------------------------------------------------------------+-- The Unbox type class+--------------------------------------------------------------------------------++-- XXX generate error if the size is < 1++-- = Design notes =+--+-- == Fixed length data types ==+--+-- The main goal of the Unbox type class is to be used in arrays. Invariants+-- for the sizeOf value required for use in arrays:+--+-- * size is independent of the value, it is determined by the type only. So+-- that we can store values of the same type in fixed length array cells.+-- * recursive data types cannot be fixed length, therefore, cannot be+-- serialized using this type class.+-- * size cannot be zero. So that the length of an array storing the element+-- and the number of elements can be related.+--+-- Note, for general serializable types the size cannot be fixed e.g. we may+-- want to serialize a list. This type class can be considered a special case+-- of a more general serialization type class.+--+-- == Stream vs Array ==+--+-- In theory we could convert a type to and from a byte stream and use that+-- to implement boxing, unboxing. But composing a stream from parts of the+-- structure is much more inefficient than writing them to a memory location.+-- However, it should be possible to efficiently parse a Haskell type from an+-- array using chunk folds.+--+-- Also, this type class allows each primitive type to have its own specific+-- efficient implementation to read and write the type to the mutable byte+-- array using special GHC byte array operations. For example, see the Unbox+-- instances of Char, Int, Word types.+--+-- == MutableByteArray vs ForeignPtr ==+--+-- The Unbox typeclass uses MutableByteArray but could use ForeignPtr or+-- any other representation of memory. We could make this a multiparameter type+-- class if necessary.+--+-- If the type class would have to support reading and writing to a Ptr as well,+-- basically what Storable does. We will also need to touch the anchoring ptr at+-- the right points which is prone to errors. However, it should be simple to+-- implement unmanaged/read-only memory arrays by allowing a Ptr type in+-- ArrayContents, though it would require all instances to support reading from+-- a Ptr.+--+-- == Byte Offset vs Element Index ==+--+-- There is a reason for using byte offset instead of element index in read and+-- write operations in the type class. If we use element index, slicing of the+-- array becomes rigid. We can only slice the array at addresses that are+-- aligned with the type, therefore, we cannot slice at misaligned location and+-- then cast the slice into another type which does not necessarily align with+-- the original type.+--+-- == Alignment ==+--+-- As a side note, there seem to be no performance advantage of alignment+-- anymore, see+-- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/+--+-- = Unboxed Records =+--+-- Unboxed types can be treated as unboxed records. We can provide a more+-- convenient API to access different parts from the Unboxed representation+-- without having to unbox the entire type. The type can have nested parts+-- therefore, we will need a general way (some sort of lenses) to address the+-- parts.+--+-- = Lazy Boxing =+--+-- When converting an unboxed representation to a boxed representation we can+-- use lazy construction. Each constructor of the constructed computation may+-- just hold a lazy computation to actually construct it on demand. This could+-- be useful for larger structures where we may need only small parts of it.+--+-- Same thing can be done for serialize type class as well but it will require+-- size fields at each nesting level, aggregating the size upwards.++-- | The 'Unbox' type class provides operations for serialization (unboxing)+-- and deserialization (boxing) of fixed-length, non-recursive Haskell data+-- types to and from their byte stream representation.+--+-- Unbox uses fixed size encoding, therefore, size is independent of the value,+-- it must be determined solely by the type. This restriction makes types with+-- 'Unbox' instances suitable for storing in arrays. Note that sum types may+-- have multiple constructors of different sizes, the size of a sum type is+-- computed as the maximum required by any constructor.+--+-- The 'peekAt' operation reads as many bytes from the mutable byte+-- array as the @size@ of the data type and builds a Haskell data type from+-- these bytes. 'pokeAt' operation converts a Haskell data type to its+-- binary representation which consists of @size@ bytes and then stores+-- these bytes into the mutable byte array. These operations do not check the+-- bounds of the array, the user of the type class is expected to check the+-- bounds before peeking or poking.+--+-- IMPORTANT: The serialized data's byte ordering remains the same as the host+-- machine's byte order. Therefore, it can not be deserialized from host+-- machines with a different byte ordering.+--+-- Instances can be derived via Generics, Template Haskell, or written+-- manually. Note that the data type must be non-recursive. WARNING! Generic+-- and Template Haskell deriving, both hang for recursive data types. Deriving+-- via Generics is more convenient but Template Haskell should be preferred+-- over Generics for the following reasons:+--+-- 1. Instances derived via Template Haskell provide better and more reliable+-- performance.+-- 2. Generic deriving allows only 256 fields or constructor tags whereas+-- template Haskell has no limit.+--+-- Here is an example, for deriving an instance of this type class using+-- generics:+--+-- >>> import GHC.Generics (Generic)+-- >>> :{+-- data Object = Object+--     { _int0 :: Int+--     , _int1 :: Int+--     } deriving Generic+-- :}+--+-- >>> import Streamly.Data.MutByteArray (Unbox(..))+-- >>> instance Unbox Object+--+-- To derive the instance via Template Haskell:+--+-- @+-- import Streamly.Data.MutByteArray (deriveUnbox)+-- \$(deriveUnbox [d|instance Unbox Object|])+-- @+--+-- See 'Streamly.Data.MutByteArray.deriveUnbox' for more information on deriving+-- using Template Haskell.+--+-- If you want to write the instance manually:+--+-- >>> :{+-- instance Unbox Object where+--     sizeOf _ = 16+--     peekAt i arr = do+--        -- Check the array bounds+--         x0 <- peekAt i arr+--         x1 <- peekAt (i + 8) arr+--         return $ Object x0 x1+--     pokeAt i arr (Object x0 x1) = do+--        -- Check the array bounds+--         pokeAt i arr x0+--         pokeAt (i + 8) arr x1+-- :}+--+class Unbox a where+    -- | Get the size. Size cannot be zero, should be at least 1 byte.+    sizeOf :: Proxy a -> Int++    {-# INLINE sizeOf #-}+    default sizeOf :: (SizeOfRep (Rep a)) => Proxy a -> Int+    sizeOf = genericSizeOf++    -- | @peekAt byte-offset array@ reads an element of type @a@ from the+    -- the given the byte offset in the array.+    --+    -- IMPORTANT: The implementation of this interface may not check the bounds+    -- of the array, the caller must not assume that.+    peekAt :: Int -> MutByteArray -> IO a++    {-# INLINE peekAt #-}+    default peekAt :: (Generic a, PeekRep (Rep a)) =>+         Int -> MutByteArray -> IO a+    peekAt i arr = genericPeekByteIndex arr i++    peekByteIndex :: Int -> MutByteArray -> IO a+    peekByteIndex = peekAt++    -- | @pokeAt byte-offset array@ writes an element of type @a@ to the+    -- the given the byte offset in the array.+    --+    -- IMPORTANT: The implementation of this interface may not check the bounds+    -- of the array, the caller must not assume that.+    pokeAt :: Int -> MutByteArray -> a -> IO ()++    pokeByteIndex :: Int -> MutByteArray -> a -> IO ()+    pokeByteIndex = pokeAt++    {-# INLINE pokeAt #-}+    default pokeAt :: (Generic a, PokeRep (Rep a)) =>+        Int -> MutByteArray -> a -> IO ()+    pokeAt i arr = genericPokeByteIndex arr i++{-# DEPRECATED peekByteIndex "Use peekAt." #-}+{-# DEPRECATED pokeByteIndex "Use pokeAt." #-}++-- _size is the length from array start to the last accessed byte.+{-# INLINE checkBounds #-}+checkBounds :: String -> Int -> MutByteArray -> IO ()+checkBounds _label _size _arr = do+#ifdef DEBUG+    sz <- sizeOfMutableByteArray _arr+    if (_size > sz)+    then error+        $ _label+            ++ ": accessing array at offset = "+            ++ show (_size - 1)+            ++ " max valid offset = " ++ show (sz - 1)+    else return ()+#else+    return ()+#endif++#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \+instance Unbox _type where {                                                  \+; {-# INLINE peekAt #-}                                                       \+; peekAt off@(I# n) arr@(MutByteArray mbarr) =                                \+    checkBounds "peek" (off + sizeOf (Proxy :: Proxy _type)) arr              \+    >> (IO $ \s ->                                                            \+      case _readArray mbarr n s of                                            \+          { (# s1, i #) -> (# s1, _constructor i #) })                        \+; {-# INLINE pokeAt #-}                                                       \+; pokeAt off@(I# n) arr@(MutByteArray mbarr) (_constructor val) =             \+    checkBounds "poke" (off + sizeOf (Proxy :: Proxy _type)) arr              \+    >> (IO $ \s -> (# _writeArray mbarr n val s, () #))                       \+; {-# INLINE sizeOf #-}                                                       \+; sizeOf _ = _sizeOf                                                          \+}++#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType)    \+instance _constraint Unbox _type where                                        \+; {-# INLINE peekAt #-}                                                       \+; peekAt i arr =                                                              \+    checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr                \+    >> _constructor <$> peekAt i arr                                          \+; {-# INLINE pokeAt #-}                                                       \+; pokeAt i arr (_constructor a) =                                             \+    checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr                \+    >> pokeAt i arr a                                                         \+; {-# INLINE sizeOf #-}                                                       \+; sizeOf _ = SIZE_OF(_innerType)++#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType)     \+instance _constraint Unbox _type where {                                      \+; {-# INLINE peekAt #-}                                                       \+; peekAt i arr =                                                              \+      checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr >>           \+      peekAt i arr >>=                                                        \+        (\p1 -> peekAt (i + SIZE_OF(_innerType)) arr <&> _constructor p1)     \+; {-# INLINE pokeAt #-}                                                       \+; pokeAt i arr (_constructor p1 p2) =                                         \+      checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr >>           \+      pokeAt i arr p1 >>                                                      \+        pokeAt (i + SIZE_OF(_innerType)) arr p2                               \+; {-# INLINE sizeOf #-}                                                       \+; sizeOf _ = 2 * SIZE_OF(_innerType)                                          \+}++-------------------------------------------------------------------------------+-- Unbox instances for primitive types+-------------------------------------------------------------------------------++DERIVE_UNBOXED( Char+              , C#+              , readWord8ArrayAsWideChar#+              , writeWord8ArrayAsWideChar#+              , SIZEOF_HSCHAR)++DERIVE_UNBOXED( Int8+              , I8#+              , readInt8Array#+              , writeInt8Array#+              , 1)++DERIVE_UNBOXED( Int16+              , I16#+              , readWord8ArrayAsInt16#+              , writeWord8ArrayAsInt16#+              , 2)++DERIVE_UNBOXED( Int32+              , I32#+              , readWord8ArrayAsInt32#+              , writeWord8ArrayAsInt32#+              , 4)++DERIVE_UNBOXED( Int+              , I#+              , readWord8ArrayAsInt#+              , writeWord8ArrayAsInt#+              , SIZEOF_HSINT)++DERIVE_UNBOXED( Int64+              , I64#+              , readWord8ArrayAsInt64#+              , writeWord8ArrayAsInt64#+              , 8)++DERIVE_UNBOXED( Word+              , W#+              , readWord8ArrayAsWord#+              , writeWord8ArrayAsWord#+              , SIZEOF_HSWORD)++DERIVE_UNBOXED( Word8+              , W8#+              , readWord8Array#+              , writeWord8Array#+              , 1)++DERIVE_UNBOXED( Word16+              , W16#+              , readWord8ArrayAsWord16#+              , writeWord8ArrayAsWord16#+              , 2)++DERIVE_UNBOXED( Word32+              , W32#+              , readWord8ArrayAsWord32#+              , writeWord8ArrayAsWord32#+              , 4)++DERIVE_UNBOXED( Word64+              , W64#+              , readWord8ArrayAsWord64#+              , writeWord8ArrayAsWord64#+              , 8)++DERIVE_UNBOXED( Double+              , D#+              , readWord8ArrayAsDouble#+              , writeWord8ArrayAsDouble#+              , SIZEOF_HSDOUBLE)++DERIVE_UNBOXED( Float+              , F#+              , readWord8ArrayAsFloat#+              , writeWord8ArrayAsFloat#+              , SIZEOF_HSFLOAT)++-------------------------------------------------------------------------------+-- Unbox instances for derived types+-------------------------------------------------------------------------------++DERIVE_UNBOXED( (StablePtr a)+              , StablePtr+              , readWord8ArrayAsStablePtr#+              , writeWord8ArrayAsStablePtr#+              , SIZEOF_HSSTABLEPTR)++DERIVE_UNBOXED( (Ptr a)+              , Ptr+              , readWord8ArrayAsAddr#+              , writeWord8ArrayAsAddr#+              , SIZEOF_HSPTR)++DERIVE_UNBOXED( (FunPtr a)+              , FunPtr+              , readWord8ArrayAsAddr#+              , writeWord8ArrayAsAddr#+              , SIZEOF_HSFUNPTR)++DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)+DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)+#if MIN_VERSION_base(4,14,0)+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)+#endif+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)+DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)+DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a)+DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)++instance Unbox () where++    {-# INLINE peekAt #-}+    peekAt i arr =+      checkBounds "peek ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()++    {-# INLINE pokeAt #-}+    pokeAt i arr _ =+      checkBounds "poke ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()++    {-# INLINE sizeOf #-}+    sizeOf _ = 1++#if MIN_VERSION_base(4,15,0)+instance Unbox IoSubSystem where++    {-# INLINE peekAt #-}+    peekAt i arr =+        checkBounds+            "peek IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr+        >> toEnum <$> peekAt i arr++    {-# INLINE pokeAt #-}+    pokeAt i arr a =+        checkBounds+            "poke IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr+        >> pokeAt i arr (fromEnum a)++    {-# INLINE sizeOf #-}+    sizeOf _ = sizeOf (Proxy :: Proxy Int)+#endif++instance Unbox Bool where++    {-# INLINE peekAt #-}+    peekAt i arr = do+        checkBounds "peek Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr+        res <- peekAt i arr+        return $ res /= (0 :: Int8)++    {-# INLINE pokeAt #-}+    pokeAt i arr a =+        checkBounds "poke Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr+        >> if a+           then pokeAt i arr (1 :: Int8)+           else pokeAt i arr (0 :: Int8)++    {-# INLINE sizeOf #-}+    sizeOf _ = 1++--------------------------------------------------------------------------------+-- Generic deriving+--------------------------------------------------------------------------------++-- Utilities to build or parse a type safely and easily.++-- | A location inside a mutable byte array with the bound of the array. Is it+-- cheaper to just get the bound using the size of the array whenever needed?+data BoundedPtr =+    BoundedPtr+        MutByteArray          -- byte array+        Int                       -- current pos+        Int                       -- position after end++--------------------------------------------------------------------------------+-- Peeker monad+--------------------------------------------------------------------------------++-- | Chains peek functions that pass the current position to the next function+newtype Peeker a = Peeker (Builder BoundedPtr IO a)+    deriving (Functor, Applicative, Monad)++{-# INLINE readUnsafe #-}+readUnsafe :: Unbox a => Peeker a+readUnsafe = Peeker (Builder step)++    where++    {-# INLINE step #-}+    step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)+    step (BoundedPtr arr pos end) = do+        let next = pos + sizeOf (Proxy :: Proxy a)+#ifdef DEBUG+        when (next > end)+            $ error $ "readUnsafe: reading beyond limit. next = "+                ++ show next+                ++ " end = " ++ show end+#endif+        r <- peekAt pos arr+        return (r, BoundedPtr arr next end)++{-# INLINE read #-}+read :: Unbox a => Peeker a+read = Peeker (Builder step)++    where++    {-# INLINE step #-}+    step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)+    step (BoundedPtr arr pos end) = do+        let next = pos + sizeOf (Proxy :: Proxy a)+        when (next > end)+            $ error $ "read: reading beyond limit. next = "+                ++ show next+                ++ " end = " ++ show end+        r <- peekAt pos arr+        return (r, BoundedPtr arr next end)++{-# INLINE skipByte #-}+skipByte :: Peeker ()+skipByte = Peeker (Builder step)++    where++    {-# INLINE step #-}+    step :: BoundedPtr -> IO ((), BoundedPtr)+    step (BoundedPtr arr pos end) = do+        let next = pos + 1+#ifdef DEBUG+        when (next > end)+            $ error $ "skipByte: reading beyond limit. next = "+                ++ show next+                ++ " end = " ++ show end+#endif+        return ((), BoundedPtr arr next end)++{-# INLINE runPeeker #-}+runPeeker :: Peeker a -> BoundedPtr -> IO a+runPeeker (Peeker (Builder f)) ptr = fmap fst (f ptr)++--------------------------------------------------------------------------------+-- Poke utilities+--------------------------------------------------------------------------------++-- XXX Using a Poker monad may be useful when we have to compute the size to be+-- poked as we go and then poke the size at a previous location. For variable+-- sized object serialization we may also want to reallocate the array and+-- return the newly allocated array in the output.++-- Does not check writing beyond bound.+{-# INLINE pokeBoundedPtrUnsafe #-}+pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+pokeBoundedPtrUnsafe a (BoundedPtr arr pos end) = do+    let next = pos + sizeOf (Proxy :: Proxy a)+#ifdef DEBUG+    when (next > end)+        $ error $ "pokeBoundedPtrUnsafe: reading beyond limit. next = "+            ++ show next+            ++ " end = " ++ show end+#endif+    pokeAt pos arr a+    return (BoundedPtr arr next end)++{-# INLINE pokeBoundedPtr #-}+pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+pokeBoundedPtr a (BoundedPtr arr pos end) = do+    let next = pos + sizeOf (Proxy :: Proxy a)+    when (next > end) $ error "pokeBoundedPtr writing beyond limit"+    pokeAt pos arr a+    return (BoundedPtr arr next end)++--------------------------------------------------------------------------------+-- Check the number of constructors in a sum type+--------------------------------------------------------------------------------++-- Count the constructors of a sum type.+type family SumArity (a :: Type -> Type) :: Nat where+    SumArity (C1 _ _) = 1+    -- Requires UndecidableInstances+    SumArity (f :+: g) = SumArity f + SumArity g++type family TypeErrorMessage (a :: Symbol) :: Constraint where+    TypeErrorMessage a = TypeError ('Text a)++type family ArityCheck (b :: Bool) :: Constraint where+    ArityCheck 'True = ()+    ArityCheck 'False = TypeErrorMessage+        "Generic Unbox deriving does not support > 256 constructors."++-- Type constraint to restrict the sum type arity so that the constructor tag+-- can fit in a single byte.+-- Note that Arity starts from 1 and constructor tags start from 0. So if max+-- arity is 256 then max constructor tag would be 255.+-- XXX Use variable length encoding to support more than 256 constructors.+type MaxArity256 n = ArityCheck (n <=? 256)++--------------------------------------------------------------------------------+-- Generic Deriving of Unbox instance+--------------------------------------------------------------------------------++-- Unbox uses fixed size encoding, therefore, when a (sum) type has multiple+-- constructors, the size of the type is computed as the maximum required by+-- any constructor. Therefore, size is independent of the value, it can be+-- determined solely by the type.++-- | Implementation of sizeOf that works on the generic representation of an+-- ADT.+class SizeOfRep (f :: Type -> Type) where+    sizeOfRep :: f x -> Int++-- Meta information wrapper, go inside+instance SizeOfRep f => SizeOfRep (M1 i c f) where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = sizeOfRep (undefined :: f x)++-- Primitive type "a".+instance Unbox a => SizeOfRep (K1 i a) where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = sizeOf (Proxy :: Proxy a)++-- Void: data type without constructors. Values of this type cannot exist,+-- therefore the size is undefined. We should never be serializing structures+-- with elements of this type.+instance SizeOfRep V1 where+    {-# INLINE sizeOfRep #-}+    sizeOfRep = error "sizeOfRep: a value of a Void type must not exist"++-- Note that when a sum type has many unit constructors only a single byte is+-- required to encode the type as only the constructor tag is stored.+instance SizeOfRep U1 where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = 0++-- Product type+instance (SizeOfRep f, SizeOfRep g) => SizeOfRep (f :*: g) where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = sizeOfRep (undefined :: f x) + sizeOfRep (undefined :: g x)++-------------------------------------------------------------------------------++class SizeOfRepSum (f :: Type -> Type) where+    sizeOfRepSum :: f x -> Int++-- Constructor+instance SizeOfRep a => SizeOfRepSum (C1 c a) where+    {-# INLINE sizeOfRepSum #-}+    sizeOfRepSum = sizeOfRep++instance (SizeOfRepSum f, SizeOfRepSum g) => SizeOfRepSum (f :+: g) where+    {-# INLINE sizeOfRepSum #-}+    sizeOfRepSum _ =+        max (sizeOfRepSum (undefined :: f x)) (sizeOfRepSum (undefined :: g x))++-------------------------------------------------------------------------------++instance (MaxArity256 (SumArity (f :+: g)), SizeOfRepSum f, SizeOfRepSum g) =>+    SizeOfRep (f :+: g) where++    -- The size of a sum type is the max of any of the constructor size.+    -- sizeOfRepSum type class operation is used here instead of sizeOfRep so+    -- that we account the constructor index byte only for the first time and+    -- avoid including it for the subsequent sum constructors.+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ =+        -- One byte for the constructor id and then the constructor value.+        sizeOf (Proxy :: Proxy Word8) ++            max (sizeOfRepSum (undefined :: f x))+                (sizeOfRepSum (undefined :: g x))++-- Unit: constructors without arguments.+-- Theoretically the size can be 0, but we use 1 to simplify the implementation+-- of an array of unit type elements. With a non-zero size we can count the number+-- of elements in the array based on the size of the array. Otherwise we will+-- have to store a virtual length in the array, but keep the physical size of+-- the array as 0. Or we will have to make a special handling for zero sized+-- elements to make the size as 1. Or we can disallow arrays with elements+-- having size 0.+--+-- Some examples:+--+-- data B = B -- one byte+-- data A = A B -- one byte+-- data X = X1 | X2 -- one byte (constructor tag only)+--+{-# INLINE genericSizeOf #-}+genericSizeOf :: forall a. (SizeOfRep (Rep a)) => Proxy a -> Int+genericSizeOf _ =+    let s = sizeOfRep (undefined :: Rep a x)+      in if s == 0 then 1 else s++--------------------------------------------------------------------------------+-- Generic poke+--------------------------------------------------------------------------------++class PokeRep (f :: Type -> Type) where+    pokeRep :: f a -> BoundedPtr -> IO BoundedPtr++instance PokeRep f => PokeRep (M1 i c f) where+    {-# INLINE pokeRep #-}+    pokeRep f = pokeRep (unM1 f)++instance Unbox a => PokeRep (K1 i a) where+    {-# INLINE pokeRep #-}+    pokeRep a = pokeBoundedPtrUnsafe (unK1 a)++instance PokeRep V1 where+    {-# INLINE pokeRep #-}+    pokeRep = error "pokeRep: a value of a Void type should not exist"++instance PokeRep U1 where+    {-# INLINE pokeRep #-}+    pokeRep _ x = pure x++instance (PokeRep f, PokeRep g) => PokeRep (f :*: g) where+    {-# INLINE pokeRep #-}+    pokeRep (f :*: g) ptr = pokeRep f ptr >>= pokeRep g++-------------------------------------------------------------------------------++class KnownNat n => PokeRepSum (n :: Nat) (f :: Type -> Type) where+    -- "n" is the constructor tag to be poked.+    pokeRepSum :: Proxy n -> f a -> BoundedPtr -> IO BoundedPtr++instance (KnownNat n, PokeRep a) => PokeRepSum n (C1 c a) where+    {-# INLINE pokeRepSum #-}+    pokeRepSum _ x ptr = do+        let tag = fromInteger (natVal (Proxy :: Proxy n)) :: Word8+        pokeBoundedPtrUnsafe tag ptr >>= pokeRep x++instance (PokeRepSum n f, PokeRepSum (n + SumArity f) g)+         => PokeRepSum n (f :+: g) where+    {-# INLINE pokeRepSum #-}+    pokeRepSum _ (L1 x) ptr =+        pokeRepSum (Proxy :: Proxy n) x ptr+    pokeRepSum _ (R1 x) ptr =+        pokeRepSum (Proxy :: Proxy (n + SumArity f)) x ptr++-------------------------------------------------------------------------------++instance (MaxArity256 (SumArity (f :+: g)), PokeRepSum 0 (f :+: g)) =>+    PokeRep (f :+: g) where++    {-# INLINE pokeRep #-}+    pokeRep = pokeRepSum (Proxy :: Proxy 0)++{-# INLINE genericPokeObject #-}+genericPokeObject :: (Generic a, PokeRep (Rep a)) =>+    a -> BoundedPtr -> IO BoundedPtr+genericPokeObject a = pokeRep (from a)++genericPokeObj :: (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()+genericPokeObj a ptr = void $ genericPokeObject a ptr++{-# INLINE genericPokeByteIndex #-}+genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) =>+    MutByteArray -> Int -> a -> IO ()+genericPokeByteIndex arr index x = do+    -- XXX Should we use unsafe poke?+#ifdef DEBUG+    end <- sizeOfMutableByteArray arr+    genericPokeObj x (BoundedPtr arr index end)+#else+    genericPokeObj x (BoundedPtr arr index undefined)+#endif++--------------------------------------------------------------------------------+-- Generic peek+--------------------------------------------------------------------------------++class PeekRep (f :: Type -> Type) where+    -- Like pokeRep, we can use the following signature instead of using Peeker+    -- peekRep :: BoundedPtr -> IO (BoundedPtr, f a)+    peekRep :: Peeker (f x)++instance PeekRep f => PeekRep (M1 i c f) where+    {-# INLINE peekRep #-}+    peekRep = fmap M1 peekRep++instance Unbox a => PeekRep (K1 i a) where+    {-# INLINE peekRep #-}+    peekRep = fmap K1 readUnsafe++instance PeekRep V1 where+    {-# INLINE peekRep #-}+    peekRep = error "peekRep: a value of a Void type should not exist"++instance PeekRep U1 where+    {-# INLINE peekRep #-}+    peekRep = pure U1++instance (PeekRep f, PeekRep g) => PeekRep (f :*: g) where+    {-# INLINE peekRep #-}+    peekRep = (:*:) <$> peekRep <*> peekRep++-------------------------------------------------------------------------------++class KnownNat n => PeekRepSum (n :: Nat) (f :: Type -> Type) where+    -- "n" is the constructor tag to be matched.+    peekRepSum :: Proxy n -> Word8 -> Peeker (f a)++instance (KnownNat n, PeekRep a) => PeekRepSum n (C1 c a) where+    {-# INLINE peekRepSum #-}+    peekRepSum _ _ = peekRep+    {-+    -- These error checks are expensive, to avoid these+    -- we validate the max value of the tag in peekRep.+    -- XXX Add tests to cover all cases+    peekRepSum _ tag+        | tag == curTag = peekRep+        | tag > curTag =+            error $ "Unbox instance peek: Constructor tag index "+                ++ show tag ++ " out of range, max tag index is "+                ++ show curTag+        | otherwise = error "peekRepSum: bug"++        where++        curTag = fromInteger (natVal (Proxy :: Proxy n))+    -}++instance (PeekRepSum n f, PeekRepSum (n + SumArity f) g)+         => PeekRepSum n (f :+: g) where+    {-# INLINE peekRepSum #-}+    peekRepSum curProxy tag+        | tag < firstRightTag =+            L1 <$> peekRepSum curProxy tag+        | otherwise =+            R1 <$> peekRepSum (Proxy :: Proxy (n + SumArity f)) tag++        where++        firstRightTag = fromInteger (natVal (Proxy :: Proxy (n + SumArity f)))++-------------------------------------------------------------------------------++instance ( MaxArity256 (SumArity (f :+: g))+         , KnownNat (SumArity (f :+: g))+         , PeekRepSum 0 (f :+: g))+         => PeekRep (f :+: g) where+    {-# INLINE peekRep #-}+    peekRep = do+        tag :: Word8 <- readUnsafe+        -- XXX test with 256 and more constructors+        let arity :: Int =+                fromInteger (natVal (Proxy :: Proxy (SumArity (f :+: g))))+        when (fromIntegral tag >= arity)+            $ error $ "peek: Tag " ++ show tag+                ++ " is greater than the max tag " ++ show (arity - 1)+                ++ " for the data type"+        peekRepSum (Proxy :: Proxy 0) tag -- DataKinds++{-# INLINE genericPeeker #-}+genericPeeker :: (Generic a, PeekRep (Rep a)) => Peeker a+genericPeeker = to <$> peekRep++{-# INLINE genericPeekBoundedPtr #-}+genericPeekBoundedPtr :: (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a+genericPeekBoundedPtr = runPeeker genericPeeker++{-# INLINE genericPeekByteIndex #-}+genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) =>+    MutByteArray -> Int -> IO a+genericPeekByteIndex arr index = do+    -- XXX Should we use unsafe peek?+#ifdef DEBUG+    end <- sizeOfMutableByteArray arr+    genericPeekBoundedPtr (BoundedPtr arr index end)+#else+    genericPeekBoundedPtr (BoundedPtr arr index undefined)+#endif
+ src/Streamly/Internal/Data/Unbox/TH.hs view
@@ -0,0 +1,495 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Unbox.TH+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unbox.TH+    ( deriveUnbox++    -- th-helpers+    , DataCon(..)+    , DataType(..)+    , reifyDataType+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Word (Word16, Word32, Word64, Word8)+import Data.Proxy (Proxy(..))+import Data.List (elemIndex)++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Streamly.Internal.Data.Unbox++--------------------------------------------------------------------------------+-- th-utilities+--------------------------------------------------------------------------------++-- Note: We don't support template-haskell < 2.14 (GHC < 8.6)++-- The following are copied to remove the dependency on th-utilities.+-- The code has been copied from th-abstraction and th-utilities.++-- Some CPP macros in the following code are not required but are kept+-- anyway. They can be removed if deemed as a maintainance burden.++#if MIN_VERSION_template_haskell(2,17,0)+type TyVarBndr_ flag = TyVarBndr flag+#else+type TyVarBndr_ flag = TyVarBndr+#endif++-- | Case analysis for a 'TyVarBndr'. If the value is a @'PlainTV' n _@, apply+-- the first function to @n@; if it is @'KindedTV' n _ k@, apply the second+-- function to @n@ and @k@.+elimTV :: (Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r+#if MIN_VERSION_template_haskell(2,17,0)+elimTV ptv _ktv (PlainTV n _)    = ptv n+elimTV _ptv ktv (KindedTV n _ k) = ktv n k+#else+elimTV ptv _ktv (PlainTV n)    = ptv n+elimTV _ptv ktv (KindedTV n k) = ktv n k+#endif++-- | Extract the type variable name from a 'TyVarBndr', ignoring the+-- kind signature if one exists.+tvName :: TyVarBndr_ flag -> Name+tvName = elimTV id (\n _ -> n)++-- | Get the 'Name' of a 'TyVarBndr'+tyVarBndrName :: TyVarBndr_ flag -> Name+tyVarBndrName = tvName++-- | Simplified info about a 'DataD'. Omits deriving, strictness,+-- kind info, and whether it's @data@ or @newtype@.+data DataType = DataType+    { dtName :: Name+    , dtTvs :: [Name]+    , dtCxt :: Cxt+    , dtCons :: [DataCon]+    } deriving (Eq, Show, Ord) --, Data, Typeable, Generic)++-- | Simplified info about a 'Con'. Omits deriving, strictness, and kind+-- info. This is much nicer than consuming 'Con' directly, because it+-- unifies all the constructors into one.+data DataCon = DataCon+    { dcName :: Name+    , dcTvs :: [Name]+    , dcCxt :: Cxt+    , dcFields :: [(Maybe Name, Type)]+    } deriving (Eq, Show, Ord) --, Data, Typeable, Generic)+++-- | Convert a 'Con' to a list of 'DataCon'. The result is a list+-- because 'GadtC' and 'RecGadtC' can define multiple constructors.+conToDataCons :: Con -> [DataCon]+conToDataCons = \case+    NormalC name slots ->+        [DataCon name [] [] (map (\(_, ty) -> (Nothing, ty)) slots)]+    RecC name fields ->+        [DataCon name [] [] (map (\(n, _, ty) -> (Just n, ty)) fields)]+    InfixC (_, ty1) name (_, ty2) ->+        [DataCon name [] [] [(Nothing, ty1), (Nothing, ty2)]]+    ForallC tvs preds con ->+        map (\(DataCon name tvs0 preds0 fields) ->+            DataCon name (tvs0 ++ map tyVarBndrName tvs) (preds0 ++ preds) fields) (conToDataCons con)+#if MIN_VERSION_template_haskell(2,11,0)+    GadtC ns slots _ ->+        map (\dn -> DataCon dn [] [] (map (\(_, ty) -> (Nothing, ty)) slots)) ns+    RecGadtC ns fields _ ->+        map (\dn -> DataCon dn [] [] (map (\(fn, _, ty) -> (Just fn, ty)) fields)) ns+#endif++-- | Reify the given data or newtype declaration, and yields its+-- 'DataType' representation.+reifyDataType :: Name -> Q DataType+reifyDataType name = do+    info <- reify name+    case infoToDataType info of+        Nothing -> fail $ "Expected to reify a datatype. Instead got:\n" ++ pprint info+        Just x -> return x++infoToDataType :: Info -> Maybe DataType+infoToDataType info = case info of+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (DataD preds name tvs _kind cons _deriving) ->+#else+    TyConI (DataD preds name tvs cons _deriving) ->+#endif+        Just $ DataType name (map tyVarBndrName tvs) preds (concatMap conToDataCons cons)+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (NewtypeD preds name tvs _kind con _deriving) ->+#else+    TyConI (NewtypeD preds name tvs con _deriving) ->+#endif+        Just $ DataType name (map tyVarBndrName tvs) preds (conToDataCons con)+    _ -> Nothing++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++type Field = (Maybe Name, Type)++_arr :: Name+_arr = mkName "arr"++_tag :: Name+_tag = mkName "tag"++_initialOffset :: Name+_initialOffset = mkName "initialOffset"++_val :: Name+_val = mkName "val"++mkOffsetName :: Int -> Name+mkOffsetName i = mkName ("offset" ++ show i)++mkFieldName :: Int -> Name+mkFieldName i = mkName ("field" ++ show i)++--------------------------------------------------------------------------------+-- Domain specific helpers+--------------------------------------------------------------------------------++exprGetSize :: Type -> Q Exp+exprGetSize ty = appE (varE 'sizeOf) [|Proxy :: Proxy $(pure ty)|]++getTagSize :: Int -> Int+getTagSize numConstructors+    | numConstructors == 1 = 0+    | fromIntegral (maxBound :: Word8) >= numConstructors = 1+    | fromIntegral (maxBound :: Word16) >= numConstructors = 2+    | fromIntegral (maxBound :: Word32) >= numConstructors = 4+    | fromIntegral (maxBound :: Word64) >= numConstructors = 8+    | otherwise = error "Too many constructors"++getTagType :: Int -> Name+getTagType numConstructors+    | numConstructors == 1 = error "No tag for 1 constructor"+    | fromIntegral (maxBound :: Word8) >= numConstructors = ''Word8+    | fromIntegral (maxBound :: Word16) >= numConstructors = ''Word16+    | fromIntegral (maxBound :: Word32) >= numConstructors = ''Word32+    | fromIntegral (maxBound :: Word64) >= numConstructors = ''Word64+    | otherwise = error "Too many constructors"++mkOffsetDecls :: Int -> [Field] -> [Q Dec]+mkOffsetDecls tagSize fields =+    init+        ((:) (valD+                  (varP (mkOffsetName 0))+                  (normalB+                       [|$(litE (IntegerL (fromIntegral tagSize))) ++                         $(varE _initialOffset)|])+                  [])+             (map mkOffsetExpr (zip [1 ..] fields)))++    where++    mkOffsetExpr (i, (_, ty)) =+        valD+            (varP (mkOffsetName i))+            (normalB [|$(varE (mkOffsetName (i - 1))) + $(exprGetSize ty)|])+            []++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++isUnitType :: [DataCon] -> Bool+isUnitType [DataCon _ _ _ []] = True+isUnitType _ = False++mkSizeOfExpr :: Type -> [DataCon] -> Q Exp+mkSizeOfExpr headTy constructors =+    case constructors of+        [] ->+            [|error+                  ("Attempting to get size with no constructors (" +++                   $(lift (pprint headTy)) ++ ")")|]+        -- One constructor with no fields is a unit type. Size of a unit type is+        -- 1.+        [con@(DataCon _ _ _ fields)] ->+            case fields of+                [] -> litE (IntegerL 1)+                _ -> [|$(sizeOfConstructor con)|]+        _ -> [|$(litE (IntegerL (fromIntegral tagSize))) + $(sizeOfHeadDt)|]++    where++    tagSize = getTagSize (length constructors)+    sizeOfField (_, ty) = exprGetSize ty+    sizeOfConstructor (DataCon _ _ _ fields) =+        appE (varE 'sum) (listE (map sizeOfField fields))+    -- The size of any Unbox type is atleast 1+    sizeOfHeadDt =+        appE (varE 'maximum) (listE (map sizeOfConstructor constructors))++--------------------------------------------------------------------------------+-- Peek+--------------------------------------------------------------------------------++mkPeekExprOne :: Int -> DataCon -> Q Exp+mkPeekExprOne tagSize (DataCon cname _ _ fields) =+    case fields of+        [] -> [|pure $(conE cname)|]+        _ ->+            letE+                (mkOffsetDecls tagSize fields)+                (foldl+                     (\acc i -> [|$(acc) <*> $(peekField i)|])+                     [|$(conE cname) <$> $(peekField 0)|]+                     [1 .. (length fields - 1)])++    where++    peekField i = [|peekAt $(varE (mkOffsetName i)) $(varE _arr)|]++mkPeekExpr :: Type -> [DataCon] -> Q Exp+mkPeekExpr headTy cons =+    case cons of+        [] ->+            [|error+                  ("Attempting to peek type with no constructors (" +++                   $(lift (pprint headTy)) ++ ")")|]+        [con] -> mkPeekExprOne 0 con+        _ ->+            doE+                [ bindS+                      (varP _tag)+                      [|peekAt $(varE _initialOffset) $(varE _arr)|]+                , noBindS+                      (caseE+                           (sigE (varE _tag) (conT tagType))+                           (map peekMatch (zip [0 ..] cons) ++ [peekErr]))+                ]++    where++    lenCons = length cons+    tagType = getTagType lenCons+    tagSize = getTagSize lenCons+    peekMatch (i, con) =+        match (litP (IntegerL i)) (normalB (mkPeekExprOne tagSize con)) []+    peekErr =+        match+            wildP+            (normalB+                 [|error+                       ("Found invalid tag while peeking (" +++                        $(lift (pprint headTy)) ++ ")")|])+            []++--------------------------------------------------------------------------------+-- Poke+--------------------------------------------------------------------------------++mkPokeExprTag :: Name -> Int -> Q Exp+mkPokeExprTag tagType tagVal = pokeTag++    where++    pokeTag =+        [|pokeAt+              $(varE _initialOffset)+              $(varE _arr)+              $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]++mkPokeExprFields :: Int -> [Field] -> Q Exp+mkPokeExprFields tagSize fields = do+    case fields of+        [] -> [|pure ()|]+        _ ->+            letE+                (mkOffsetDecls tagSize fields)+                (doE $ map (noBindS . pokeField) [0 .. (numFields - 1)])++    where++    numFields = length fields+    pokeField i =+        [|pokeAt+              $(varE (mkOffsetName i))+              $(varE _arr)+              $(varE (mkFieldName i))|]++mkPokeMatch :: Name -> Int -> Q Exp -> Q Match+mkPokeMatch cname numFields exp0 =+    match+        (conP cname (map varP (map mkFieldName [0 .. (numFields - 1)])))+        (normalB exp0)+        []++mkPokeExpr :: Type -> [DataCon] -> Q Exp+mkPokeExpr headTy cons =+    case cons of+        [] ->+            [|error+                  ("Attempting to poke type with no constructors (" +++                   $(lift (pprint headTy)) ++ ")")|]+        [(DataCon _ _ _ [])] -> [|pure ()|]+        [(DataCon cname _ _ fields)] ->+            caseE+                (varE _val)+                [mkPokeMatch cname (length fields) (mkPokeExprFields 0 fields)]+        _ ->+            caseE+                (varE _val)+                (map (\(tagVal, (DataCon cname _ _ fields)) ->+                          mkPokeMatch+                              cname+                              (length fields)+                              (doE [ noBindS $ mkPokeExprTag tagType tagVal+                                   , noBindS $ mkPokeExprFields tagSize fields+                                   ]))+                     (zip [0 ..] cons))++    where++    lenCons = length cons+    tagType = getTagType lenCons+    tagSize = getTagSize lenCons++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++-- | A general function to derive Unbox instances where you can control which+-- Constructors of the datatype to consider and what the Context for the 'Unbox'+-- instance would be.+--+-- Consider the datatype:+-- @+-- data CustomDataType a b+--     = CDTConstructor1+--     | CDTConstructor2 Bool+--     | CDTConstructor3 Bool b+--     deriving (Show, Eq)+-- @+--+-- Usage:+-- @+-- $(deriveUnboxInternal+--       [AppT (ConT ''Unbox) (VarT (mkName "b"))]+--       (AppT+--            (AppT (ConT ''CustomDataType) (VarT (mkName "a")))+--            (VarT (mkName "b")))+--       [ DataCon 'CDTConstructor1 [] [] []+--       , DataCon 'CDTConstructor2 [] [] [(Nothing, (ConT ''Bool))]+--       , DataCon+--             'CDTConstructor3+--             []+--             []+--             [(Nothing, (ConT ''Bool)), (Nothing, (VarT (mkName "b")))]+--       ])+-- @+deriveUnboxInternal :: Type -> [DataCon] -> ([Dec] -> Q [Dec]) -> Q [Dec]+deriveUnboxInternal headTy cons mkDec = do+    sizeOfMethod <- mkSizeOfExpr headTy cons+    peekMethod <- mkPeekExpr headTy cons+    pokeMethod <- mkPokeExpr headTy cons+    let methods =+            -- INLINE on sizeOf actually worsens some benchmarks, and improves+            -- none+            [ -- PragmaD (InlineP 'sizeOf Inline FunLike AllPhases)+              FunD 'sizeOf [Clause [WildP] (NormalB sizeOfMethod) []]+            , PragmaD (InlineP 'peekAt Inline FunLike AllPhases)+            , FunD+                  'peekAt+                  [ Clause+                        (if isUnitType cons+                             then [WildP, WildP]+                             else [VarP _initialOffset, VarP _arr])+                        (NormalB peekMethod)+                        []+                  ]+            , PragmaD (InlineP 'pokeAt Inline FunLike AllPhases)+            , FunD+                  'pokeAt+                  [ Clause+                        (if isUnitType cons+                             then [WildP, WildP, WildP]+                             else [VarP _initialOffset, VarP _arr, VarP _val])+                        (NormalB pokeMethod)+                        []+                  ]+            ]+    mkDec methods++-- | Given an 'Unbox' instance declaration splice without the methods (e.g.+-- @[d|instance Unbox a => Unbox (Maybe a)|]@), generate an instance+-- declaration including all the type class method implementations.+--+-- Usage:+--+-- @+-- \$(deriveUnbox [d|instance Unbox a => Unbox (Maybe a)|])+-- @+deriveUnbox :: Q [Dec] -> Q [Dec]+deriveUnbox mDecs = do+    dec <- mDecs+    case dec of+        [InstanceD mo preds headTyWC []] -> do+            let headTy = unwrap dec headTyWC+                (mainTyName, subs) = getMainTypeName dec headTy+            dt <- reifyDataType mainTyName+            let tyVars = dtTvs dt+                mapper = mapperWith (VarT <$> tyVars) subs+                cons = map (modifyConVariables mapper) (dtCons dt)+            deriveUnboxInternal headTy cons (mkInst mo preds headTyWC)+        _ -> errorMessage dec++    where++    mapperWith l1 l2 a =+        case elemIndex a l1 of+            Nothing -> a+            -- XXX Capture this case and give a relavant error.+            Just i -> l2 !! i++    mapType f (AppT t1 t2) = AppT (mapType f t1) (mapType f t2)+    mapType f (InfixT t1 n t2) = InfixT (mapType f t1) n (mapType f t2)+    mapType f (UInfixT t1 n t2) = UInfixT (mapType f t1) n (mapType f t2)+    mapType f (ParensT t) = ParensT (mapType f t)+    mapType f v = f v++    modifyConVariables f con =+        con { dcFields = map (\(a, b) -> (a, mapType f b)) (dcFields con) }++    mkInst mo preds headTyWC methods =+        pure [InstanceD mo preds headTyWC methods]++    errorMessage dec =+        error $ unlines+            [ "Error: deriveUnbox:"+            , ""+            , ">> " ++ pprint dec+            , ""+            , "The supplied declaration not a valid instance declaration."+            , "Provide a valid Haskell instance declaration without a body."+            , ""+            , "Examples:"+            , "instance Unbox (Proxy a)"+            , "instance Unbox a => Unbox (Identity a)"+            , "instance Unbox (TableT Identity)"+            ]++    unwrap _ (AppT (ConT _) r) = r+    unwrap dec _ = errorMessage dec++    getMainTypeName dec = go []++        where++        go xs (ConT nm) = (nm, xs)+        go xs (AppT l r) = go (r:xs) l+        go _ _ = errorMessage dec
− src/Streamly/Internal/Data/Unboxed.hs 
@@ -1,855 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}---- | TODO: Implement TH based instance derivation for better performance.--module Streamly.Internal.Data.Unboxed-    ( Unbox(..)-    , peekWith-    , pokeWith-    , MutableByteArray(..)-    , touch-    , getMutableByteArray#-    , pin-    , unpin-    , newUnpinnedBytes-    , newPinnedBytes-    , newAlignedPinnedBytes-    , nil--    -- * Type Parser and Builder-    , BoundedPtr (..)--    , Peeker (..)-    , read-    , readUnsafe-    , skipByte-    , runPeeker--    , pokeBoundedPtrUnsafe-    , pokeBoundedPtr--    -- * Generic Unbox instances-    , genericSizeOf-    , genericPeekByteIndex-    , genericPokeByteIndex--    -- Classess used for generic deriving.-    , PeekRep(..)-    , PokeRep(..)-    , SizeOfRep(..)-    ) where--#include "MachDeps.h"-#include "ArrayMacros.h"--import Control.Monad (void, when)-import Data.Complex (Complex((:+)))-import Data.Functor ((<&>))-import Data.Functor.Const (Const(..))-import Data.Functor.Identity (Identity(..))-import Data.Kind (Type)-import Data.Proxy (Proxy (..))-import Foreign.Ptr (IntPtr(..), WordPtr(..))-import GHC.Base (IO(..))-import GHC.Fingerprint.Type (Fingerprint(..))-import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))-import GHC.Real (Ratio(..))-import GHC.Stable (StablePtr(..))-import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))-#if MIN_VERSION_base(4,15,0)-import GHC.RTS.Flags (IoSubSystem(..))-#endif-import Streamly.Internal.Data.Builder (Builder (..))-import System.IO.Unsafe (unsafePerformIO)--import GHC.Generics-import GHC.Exts-import GHC.TypeLits-import Prelude hiding (read)------------------------------------------------------------------------------------- The ArrayContents type------------------------------------------------------------------------------------- XXX can use UnliftedNewtypes-data MutableByteArray = MutableByteArray (MutableByteArray# RealWorld)--{-# INLINE getMutableByteArray# #-}-getMutableByteArray# :: MutableByteArray -> MutableByteArray# RealWorld-getMutableByteArray# (MutableByteArray mbarr) = mbarr--{-# INLINE touch #-}-touch :: MutableByteArray -> IO ()-touch (MutableByteArray contents) =-    IO $ \s -> case touch# contents s of s' -> (# s', () #)---- | Return the size of the array in bytes.-{-# INLINE sizeOfMutableByteArray #-}-sizeOfMutableByteArray :: MutableByteArray -> IO Int-sizeOfMutableByteArray (MutableByteArray arr) =-    IO $ \s ->-        case getSizeofMutableByteArray# arr s of-            (# s1, i #) -> (# s1, I# i #)------------------------------------------------------------------------------------- Creation-----------------------------------------------------------------------------------{-# NOINLINE nil #-}-nil :: MutableByteArray-nil = unsafePerformIO $ newUnpinnedBytes 0--{-# INLINE newUnpinnedBytes #-}-newUnpinnedBytes :: Int -> IO MutableByteArray-newUnpinnedBytes nbytes | nbytes < 0 =-  errorWithoutStackTrace "newUnpinnedBytes: size must be >= 0"-newUnpinnedBytes (I# nbytes) = IO $ \s ->-    case newByteArray# nbytes s of-        (# s', mbarr# #) ->-           let c = MutableByteArray mbarr#-            in (# s', c #)--{-# INLINE newPinnedBytes #-}-newPinnedBytes :: Int -> IO MutableByteArray-newPinnedBytes nbytes | nbytes < 0 =-  errorWithoutStackTrace "newPinnedBytes: size must be >= 0"-newPinnedBytes (I# nbytes) = IO $ \s ->-    case newPinnedByteArray# nbytes s of-        (# s', mbarr# #) ->-           let c = MutableByteArray mbarr#-            in (# s', c #)--{-# INLINE newAlignedPinnedBytes #-}-newAlignedPinnedBytes :: Int -> Int -> IO MutableByteArray-newAlignedPinnedBytes nbytes _align | nbytes < 0 =-  errorWithoutStackTrace "newAlignedPinnedBytes: size must be >= 0"-newAlignedPinnedBytes (I# nbytes) (I# align) = IO $ \s ->-    case newAlignedPinnedByteArray# nbytes align s of-        (# s', mbarr# #) ->-           let c = MutableByteArray mbarr#-            in (# s', c #)------------------------------------------------------------------------------------ Pinning & Unpinning----------------------------------------------------------------------------------{-# INLINE isPinned #-}-isPinned :: MutableByteArray -> Bool-isPinned (MutableByteArray arr#) =-    let pinnedInt = I# (isMutableByteArrayPinned# arr#)-     in pinnedInt == 1---{-# INLINE cloneMutableArrayWith# #-}-cloneMutableArrayWith#-    :: (Int# -> State# RealWorld -> (# State# RealWorld-                                     , MutableByteArray# RealWorld #))-    -> MutableByteArray# RealWorld-    -> State# RealWorld-    -> (# State# RealWorld, MutableByteArray# RealWorld #)-cloneMutableArrayWith# alloc# arr# s# =-    case getSizeofMutableByteArray# arr# s# of-        (# s1#, i# #) ->-            case alloc# i# s1# of-                (# s2#, arr1# #) ->-                    case copyMutableByteArray# arr# 0# arr1# 0# i# s2# of-                        s3# -> (# s3#, arr1# #)--{-# INLINE pin #-}-pin :: MutableByteArray -> IO MutableByteArray-pin arr@(MutableByteArray marr#) =-    if isPinned arr-    then return arr-    else IO-             $ \s# ->-                   case cloneMutableArrayWith# newPinnedByteArray# marr# s# of-                       (# s1#, marr1# #) -> (# s1#, MutableByteArray marr1# #)--{-# INLINE unpin #-}-unpin :: MutableByteArray -> IO MutableByteArray-unpin arr@(MutableByteArray marr#) =-    if not (isPinned arr)-    then return arr-    else IO-             $ \s# ->-                   case cloneMutableArrayWith# newByteArray# marr# s# of-                       (# s1#, marr1# #) -> (# s1#, MutableByteArray marr1# #)------------------------------------------------------------------------------------- The Unbox type class------------------------------------------------------------------------------------- XXX generate error if the size is < 1---- In theory we could convert a type to and from a byte stream and use that--- to implement boxing, unboxing. But that would be inefficient. This type--- class allows each primitive type to have its own specific efficient--- implementation to read and write the type to memory.------ This is a typeclass that uses MutableByteArray but could use ForeignPtr or--- any other representation of memory. We could make this a multiparameter type--- class if necessary.------ If the type class would have to support reading and writing to a Ptr as well,--- basically what Storable does. We will also need to touch the anchoring ptr at--- the right points which is prone to errors. However, it should be simple to--- implement unmanaged/read-only memory arrays by allowing a Ptr type in--- ArrayContents, though it would require all instances to support reading from--- a Ptr.------ There is a reason for using byte offset instead of element index in read and--- write operations in the type class. If we use element index slicing of the--- array becomes rigid. We can only slice the array at addresses that are--- aligned with the type, therefore, we cannot slice at misaligned location and--- then cast the slice into another type which does not ncessarily align with--- the original type.------ As a side note, there seem to be no performance advantage of alignment--- anymore, see--- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/------- The main goal of the Unbox type class is to be used in arrays. Invariants--- for the sizeOf value required for use in arrays:------ * size is independent of the value, it is determined by the type only. So--- that we can store values of the same type in fixed length array cells.--- * size cannot be zero. So that the length of an array storing the element--- and the number of elements can be related.------ Note, for general serializable types the size cannot be fixed e.g. we may--- want to serialize a list. This type class can be considered a special case--- of a more general serialization type class.---- | A type implementing the 'Unbox' interface supplies operations for reading--- and writing the type from and to a mutable byte array (an unboxed--- representation of the type) in memory. The read operation 'peekByteIndex'--- deserializes the boxed type from the mutable byte array. The write operation--- 'pokeByteIndex' serializes the boxed type to the mutable byte array.------ Instances can be derived via 'Generic'. Note that the data type must be--- non-recursive. Here is an example, for deriving an instance of this type--- class.------ >>> import GHC.Generics (Generic)--- >>> :{--- data Object = Object---     { _int0 :: Int---     , _int1 :: Int---     } deriving Generic--- :}------ WARNING! Generic deriving hangs for recursive data types.------ >>> import Streamly.Data.Array (Unbox(..))--- >>> instance Unbox Object------ If you want to write the instance manually:------ >>> :{--- instance Unbox Object where---     sizeOf _ = 16---     peekByteIndex i arr = do---         x0 <- peekByteIndex i arr---         x1 <- peekByteIndex (i + 8) arr---         return $ Object x0 x1---     pokeByteIndex i arr (Object x0 x1) = do---         pokeByteIndex i arr x0---         pokeByteIndex (i + 8) arr x1--- :}----class Unbox a where-    -- | Get the size. Size cannot be zero.-    sizeOf :: Proxy a -> Int--    default sizeOf :: (SizeOfRep (Rep a)) => Proxy a -> Int-    sizeOf = genericSizeOf--    -- | Read an element of type "a" from a MutableByteArray given the byte-    -- index.-    ---    -- IMPORTANT: The implementation of this interface may not check the bounds-    -- of the array, the caller must not assume that.-    peekByteIndex :: Int -> MutableByteArray -> IO a--    default peekByteIndex :: (Generic a, PeekRep (Rep a)) =>-         Int -> MutableByteArray -> IO a-    peekByteIndex i arr = genericPeekByteIndex arr i--    -- | Write an element of type "a" to a MutableByteArray given the byte-    -- index.-    ---    -- IMPORTANT: The implementation of this interface may not check the bounds-    -- of the array, the caller must not assume that.-    pokeByteIndex :: Int -> MutableByteArray -> a -> IO ()--    default pokeByteIndex :: (Generic a, PokeRep (Rep a)) =>-        Int -> MutableByteArray -> a -> IO ()-    pokeByteIndex i arr = genericPokeByteIndex arr i--#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \-instance Unbox _type where {                                         \-; {-# INLINE peekByteIndex #-}                                       \-; peekByteIndex (I# n) (MutableByteArray mbarr) = IO $ \s ->         \-      case _readArray mbarr n s of                                   \-          { (# s1, i #) -> (# s1, _constructor i #) }                \-; {-# INLINE pokeByteIndex #-}                                       \-; pokeByteIndex (I# n) (MutableByteArray mbarr) (_constructor val) = \-        IO $ \s -> (# _writeArray mbarr n val s, () #)               \-; {-# INLINE sizeOf #-}                                              \-; sizeOf _ = _sizeOf                                                 \-}--#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType)    \-instance _constraint Unbox _type where                                        \-; {-# INLINE peekByteIndex #-}                                                \-; peekByteIndex i arr = _constructor <$> peekByteIndex i arr                  \-; {-# INLINE pokeByteIndex #-}                                                \-; pokeByteIndex i arr (_constructor a) = pokeByteIndex i arr a                \-; {-# INLINE sizeOf #-}                                                       \-; sizeOf _ = SIZE_OF(_innerType)--#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \-instance _constraint Unbox _type where {                                  \-; {-# INLINE peekByteIndex #-}                                            \-; peekByteIndex i arr =                                                   \-      peekByteIndex i arr >>=                                             \-        (\p1 -> peekByteIndex (i + SIZE_OF(_innerType)) arr               \-            <&> _constructor p1)                                          \-; {-# INLINE pokeByteIndex #-}                                            \-; pokeByteIndex i arr (_constructor p1 p2) =                              \-      pokeByteIndex i arr p1 >>                                           \-        pokeByteIndex (i + SIZE_OF(_innerType)) arr p2                    \-; {-# INLINE sizeOf #-}                                                   \-; sizeOf _ = 2 * SIZE_OF(_innerType)                                      \-}------------------------------------------------------------------------------------ Unbox instances for primitive types----------------------------------------------------------------------------------DERIVE_UNBOXED( Char-              , C#-              , readWord8ArrayAsWideChar#-              , writeWord8ArrayAsWideChar#-              , SIZEOF_HSCHAR)--DERIVE_UNBOXED( Int8-              , I8#-              , readInt8Array#-              , writeInt8Array#-              , 1)--DERIVE_UNBOXED( Int16-              , I16#-              , readWord8ArrayAsInt16#-              , writeWord8ArrayAsInt16#-              , 2)--DERIVE_UNBOXED( Int32-              , I32#-              , readWord8ArrayAsInt32#-              , writeWord8ArrayAsInt32#-              , 4)--DERIVE_UNBOXED( Int-              , I#-              , readWord8ArrayAsInt#-              , writeWord8ArrayAsInt#-              , SIZEOF_HSINT)--DERIVE_UNBOXED( Int64-              , I64#-              , readWord8ArrayAsInt64#-              , writeWord8ArrayAsInt64#-              , 8)--DERIVE_UNBOXED( Word-              , W#-              , readWord8ArrayAsWord#-              , writeWord8ArrayAsWord#-              , SIZEOF_HSWORD)--DERIVE_UNBOXED( Word8-              , W8#-              , readWord8Array#-              , writeWord8Array#-              , 1)--DERIVE_UNBOXED( Word16-              , W16#-              , readWord8ArrayAsWord16#-              , writeWord8ArrayAsWord16#-              , 2)--DERIVE_UNBOXED( Word32-              , W32#-              , readWord8ArrayAsWord32#-              , writeWord8ArrayAsWord32#-              , 4)--DERIVE_UNBOXED( Word64-              , W64#-              , readWord8ArrayAsWord64#-              , writeWord8ArrayAsWord64#-              , 8)--DERIVE_UNBOXED( Double-              , D#-              , readWord8ArrayAsDouble#-              , writeWord8ArrayAsDouble#-              , SIZEOF_HSDOUBLE)--DERIVE_UNBOXED( Float-              , F#-              , readWord8ArrayAsFloat#-              , writeWord8ArrayAsFloat#-              , SIZEOF_HSFLOAT)------------------------------------------------------------------------------------ Unbox instances for derived types----------------------------------------------------------------------------------DERIVE_UNBOXED( (StablePtr a)-              , StablePtr-              , readWord8ArrayAsStablePtr#-              , writeWord8ArrayAsStablePtr#-              , SIZEOF_HSSTABLEPTR)--DERIVE_UNBOXED( (Ptr a)-              , Ptr-              , readWord8ArrayAsAddr#-              , writeWord8ArrayAsAddr#-              , SIZEOF_HSPTR)--DERIVE_UNBOXED( (FunPtr a)-              , FunPtr-              , readWord8ArrayAsAddr#-              , writeWord8ArrayAsAddr#-              , SIZEOF_HSFUNPTR)--DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)-DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)-DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)-#if MIN_VERSION_base(4,14,0)-DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)-#endif-DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)-DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)-DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a)-DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)--instance Unbox () where--    {-# INLINE peekByteIndex #-}-    peekByteIndex _ _ = return ()--    {-# INLINE pokeByteIndex #-}-    pokeByteIndex _ _ _ = return ()--    {-# INLINE sizeOf #-}-    sizeOf _ = 1--#if MIN_VERSION_base(4,15,0)-instance Unbox IoSubSystem where--    {-# INLINE peekByteIndex #-}-    peekByteIndex i arr = toEnum <$> peekByteIndex i arr--    {-# INLINE pokeByteIndex #-}-    pokeByteIndex i arr a = pokeByteIndex i arr (fromEnum a)--    {-# INLINE sizeOf #-}-    sizeOf _ = sizeOf (Proxy :: Proxy Int)-#endif--instance Unbox Bool where--    {-# INLINE peekByteIndex #-}-    peekByteIndex i arr = do-        res <- peekByteIndex i arr-        return $ res /= (0 :: Int8)--    {-# INLINE pokeByteIndex #-}-    pokeByteIndex i arr a =-        if a-        then pokeByteIndex i arr (1 :: Int8)-        else pokeByteIndex i arr (0 :: Int8)--    {-# INLINE sizeOf #-}-    sizeOf _ = 1------------------------------------------------------------------------------------- Functions-----------------------------------------------------------------------------------{-# INLINE peekWith #-}-peekWith :: Unbox a => MutableByteArray -> Int -> IO a-peekWith arr i = peekByteIndex i arr--{-# INLINE pokeWith #-}-pokeWith :: Unbox a => MutableByteArray -> Int -> a -> IO ()-pokeWith arr i = pokeByteIndex i arr------------------------------------------------------------------------------------- Generic deriving------------------------------------------------------------------------------------- Utilities to build or parse a type safely and easily.---- | A location inside a mutable byte array with the bound of the array. Is it--- cheaper to just get the bound using the size of the array whenever needed?-data BoundedPtr =-    BoundedPtr-        MutableByteArray          -- byte array-        Int                       -- current pos-        Int                       -- position after end------------------------------------------------------------------------------------- Peeker monad------------------------------------------------------------------------------------- | Chains peek functions that pass the current position to the next function-newtype Peeker a = Peeker (Builder BoundedPtr IO a)-    deriving (Functor, Applicative, Monad)--{-# INLINE readUnsafe #-}-readUnsafe :: Unbox a => Peeker a-readUnsafe = Peeker (Builder step)--    where--    {-# INLINE step #-}-    step :: forall a. Unbox a => BoundedPtr -> IO (BoundedPtr, a)-    step (BoundedPtr arr pos end) = do-        let next = pos + sizeOf (Proxy :: Proxy a)-        r <- peekByteIndex pos arr-        return (BoundedPtr arr next end, r)--{-# INLINE read #-}-read :: Unbox a => Peeker a-read = Peeker (Builder step)--    where--    {-# INLINE step #-}-    step :: forall a. Unbox a => BoundedPtr -> IO (BoundedPtr, a)-    step (BoundedPtr arr pos end) = do-        let next = pos + sizeOf (Proxy :: Proxy a)-        when (next > end) $ error "peekObject reading beyond limit"-        r <- peekByteIndex pos arr-        return (BoundedPtr arr next end, r)--{-# INLINE skipByte #-}-skipByte :: Peeker ()-skipByte = Peeker (Builder step)--    where--    {-# INLINE step #-}-    step :: BoundedPtr -> IO (BoundedPtr, ())-    step (BoundedPtr arr pos end) = do-        let next = pos + 1-        when (next > end)-            $ error $ "skipByte: reading beyond limit. next = "-                ++ show next-                ++ " end = " ++ show end-        return (BoundedPtr arr next end, ())--{-# INLINE runPeeker #-}-runPeeker :: Peeker a -> BoundedPtr -> IO a-runPeeker (Peeker (Builder f)) ptr = fmap snd (f ptr)------------------------------------------------------------------------------------- Poke utilities------------------------------------------------------------------------------------- XXX Using a Poker monad may be useful when we have to compute the size to be--- poked as we go and then poke the size at a previous location. For variable--- sized object serialization we may also want to reallocate the array and--- return the newly allocated array in the output.---- Does not check writing beyond bound.-{-# INLINE pokeBoundedPtrUnsafe #-}-pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr-pokeBoundedPtrUnsafe a (BoundedPtr arr pos end) = do-    let next = pos + sizeOf (Proxy :: Proxy a)-    pokeByteIndex pos arr a-    return (BoundedPtr arr next end)--{-# INLINE pokeBoundedPtr #-}-pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr-pokeBoundedPtr a (BoundedPtr arr pos end) = do-    let next = pos + sizeOf (Proxy :: Proxy a)-    when (next > end) $ error "pokeBoundedPtr writing beyond limit"-    pokeByteIndex pos arr a-    return (BoundedPtr arr next end)------------------------------------------------------------------------------------- Check the number of constructors in a sum type------------------------------------------------------------------------------------- Count the constructors of a sum type.-type family SumArity (a :: Type -> Type) :: Nat where-    SumArity (C1 _ _) = 1-    -- Requires UndecidableInstances-    SumArity (f :+: g) = SumArity f + SumArity g--type family TypeErrorMessage (a :: Symbol) :: Constraint where-    TypeErrorMessage a = TypeError ('Text a)--type family ArityCheck (b :: Bool) :: Constraint where-    ArityCheck 'True = ()-    ArityCheck 'False = TypeErrorMessage-        "Generic Unbox deriving does not support > 256 constructors."---- Type constraint to restrict the sum type arity so that the constructor tag--- can fit in a single byte.-type MaxArity256 n = ArityCheck (n <=? 255)------------------------------------------------------------------------------------- Generic Deriving of Unbox instance------------------------------------------------------------------------------------- Unbox uses fixed size encoding, therefore, when a (sum) type has multiple--- constructors, the size of the type is computed as the maximum required by--- any constructor. Therefore, size is independent of the value, it can be--- determined solely by the type.---- | Implementation of sizeOf that works on the generic representation of an--- ADT.-class SizeOfRep (f :: Type -> Type) where-    sizeOfRep :: f x -> Int---- Meta information wrapper, go inside-instance SizeOfRep f => SizeOfRep (M1 i c f) where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = sizeOfRep (undefined :: f x)---- Primitive type "a".-instance Unbox a => SizeOfRep (K1 i a) where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = sizeOf (Proxy :: Proxy a)---- Void: data type without constructors. Values of this type cannot exist,--- therefore the size is undefined. We should never be serializing structures--- with elements of this type.-instance SizeOfRep V1 where-    {-# INLINE sizeOfRep #-}-    sizeOfRep = error "sizeOfRep: a value of a Void type must not exist"---- Note that when a sum type has many unit constructors only a single byte is--- required to encode the type as only the constructor tag is stored.-instance SizeOfRep U1 where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = 0---- Product type-instance (SizeOfRep f, SizeOfRep g) => SizeOfRep (f :*: g) where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = sizeOfRep (undefined :: f x) + sizeOfRep (undefined :: g x)-----------------------------------------------------------------------------------class SizeOfRepSum (f :: Type -> Type) where-    sizeOfRepSum :: f x -> Int---- Constructor-instance SizeOfRep a => SizeOfRepSum (C1 c a) where-    {-# INLINE sizeOfRepSum #-}-    sizeOfRepSum = sizeOfRep--instance (SizeOfRepSum f, SizeOfRepSum g) => SizeOfRepSum (f :+: g) where-    {-# INLINE sizeOfRepSum #-}-    sizeOfRepSum _ =-        max (sizeOfRepSum (undefined :: f x)) (sizeOfRepSum (undefined :: g x))-----------------------------------------------------------------------------------instance (MaxArity256 (SumArity (f :+: g)), SizeOfRepSum f, SizeOfRepSum g) =>-    SizeOfRep (f :+: g) where--    -- The size of a sum type is the max of any of the constructor size.-    -- sizeOfRepSum type class operation is used here instead of sizeOfRep so-    -- that we add the constructor index byte only for the first time and avoid-    -- including it for the subsequent sum constructors.-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ =-        -- One byte for the constructor id and then the constructor value.-        sizeOf (Proxy :: Proxy Word8) +-            max (sizeOfRepSum (undefined :: f x))-                (sizeOfRepSum (undefined :: g x))---- Unit: constructors without arguments.--- Theoretically the size can be 0, but we use 1 to simplify the implementation--- of an array of unit type elements. With a non-zero size we can count the number--- of elements in the array based on the size of the array. Otherwise we will--- have to store a virtual length in the array, but keep the physical size of--- the array as 0. Or we will have to make a special handling for zero sized--- elements to make the size as 1. Or we can disallow arrays with elements--- having size 0.----{-# INLINE genericSizeOf #-}-genericSizeOf :: forall a. (SizeOfRep (Rep a)) => Proxy a -> Int-genericSizeOf _ =-    let s = sizeOfRep (undefined :: Rep a x)-      in if s == 0 then 1 else s------------------------------------------------------------------------------------- Generic poke-----------------------------------------------------------------------------------class PokeRep (f :: Type -> Type) where-    pokeRep :: f a -> BoundedPtr -> IO BoundedPtr--instance PokeRep f => PokeRep (M1 i c f) where-    {-# INLINE pokeRep #-}-    pokeRep f = pokeRep (unM1 f)--instance Unbox a => PokeRep (K1 i a) where-    {-# INLINE pokeRep #-}-    pokeRep a = pokeBoundedPtr (unK1 a)--instance PokeRep V1 where-    {-# INLINE pokeRep #-}-    pokeRep = error "pokeRep: a value of a Void type should not exist"--instance PokeRep U1 where-    {-# INLINE pokeRep #-}-    pokeRep _ x = pure x--instance (PokeRep f, PokeRep g) => PokeRep (f :*: g) where-    {-# INLINE pokeRep #-}-    pokeRep (f :*: g) ptr = pokeRep f ptr >>= pokeRep g-----------------------------------------------------------------------------------class KnownNat n => PokeRepSum (n :: Nat) (f :: Type -> Type) where-    -- "n" is the constructor tag to be poked.-    pokeRepSum :: Proxy n -> f a -> BoundedPtr -> IO BoundedPtr--instance (KnownNat n, PokeRep a) => PokeRepSum n (C1 c a) where-    {-# INLINE pokeRepSum #-}-    pokeRepSum _ x ptr = do-        pokeBoundedPtr (fromInteger (natVal (Proxy :: Proxy n)) :: Word8) ptr-            >>= pokeRep x--instance (KnownNat n, PokeRepSum n f, PokeRepSum (n + SumArity f) g)-         => PokeRepSum n (f :+: g) where-    {-# INLINE pokeRepSum #-}-    pokeRepSum _ (L1 x) ptr =-        pokeRepSum (Proxy :: Proxy n) x ptr-    pokeRepSum _ (R1 x) ptr =-        pokeRepSum (Proxy :: Proxy (n + SumArity f)) x ptr-----------------------------------------------------------------------------------instance (MaxArity256 (SumArity (f :+: g)), PokeRepSum 0 (f :+: g)) =>-    PokeRep (f :+: g) where--    {-# INLINE pokeRep #-}-    pokeRep = pokeRepSum (Proxy :: Proxy 0)--{-# INLINE genericPokeObject #-}-genericPokeObject :: (Generic a, PokeRep (Rep a)) =>-    a -> BoundedPtr -> IO BoundedPtr-genericPokeObject a = pokeRep (from a)--genericPokeObj :: (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()-genericPokeObj a ptr = void $ genericPokeObject a ptr--{-# INLINE genericPokeByteIndex #-}-genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) =>-    MutableByteArray -> Int -> a -> IO ()-genericPokeByteIndex arr index x = do-    -- XXX Should we use unsafe poke?-    end <- sizeOfMutableByteArray arr-    genericPokeObj x (BoundedPtr arr index end)------------------------------------------------------------------------------------- Generic peek-----------------------------------------------------------------------------------class PeekRep (f :: Type -> Type) where-    peekRep :: Peeker (f x)--instance PeekRep f => PeekRep (M1 i c f) where-    {-# INLINE peekRep #-}-    peekRep = fmap M1 peekRep--instance Unbox a => PeekRep (K1 i a) where-    {-# INLINE peekRep #-}-    peekRep = fmap K1 read--instance PeekRep V1 where-    {-# INLINE peekRep #-}-    peekRep = error "peekRep: a value of a Void type should not exist"--instance PeekRep U1 where-    {-# INLINE peekRep #-}-    peekRep = pure U1--instance (PeekRep f, PeekRep g) => PeekRep (f :*: g) where-    {-# INLINE peekRep #-}-    peekRep = (:*:) <$> peekRep <*> peekRep-----------------------------------------------------------------------------------class KnownNat n => PeekRepSum (n :: Nat) (f :: Type -> Type) where-    -- "n" is the constructor tag to be matched.-    peekRepSum :: Proxy n -> Word8 -> Peeker (f a)--instance (KnownNat n, PeekRep a) => PeekRepSum n (C1 c a) where-    {-# INLINE peekRepSum #-}-    peekRepSum _ tag-        | tag == curTag = peekRep-        | tag > curTag =-            error $ "Unbox instance peek: Constructor tag index "-                ++ show tag ++ " out of range, max tag index is "-                ++ show curTag-        | otherwise = error "peekRepSum: bug"--        where--        curTag = fromInteger (natVal (Proxy :: Proxy n))--instance (KnownNat n, PeekRepSum n f, PeekRepSum (n + SumArity f) g)-         => PeekRepSum n (f :+: g) where-    {-# INLINE peekRepSum #-}-    peekRepSum curProxy tag-        | tag < firstRightTag =-            L1 <$> peekRepSum curProxy tag-        | otherwise =-            R1 <$> peekRepSum (Proxy :: Proxy (n + SumArity f)) tag--        where--        firstRightTag = fromInteger (natVal (Proxy :: Proxy (n + SumArity f)))-----------------------------------------------------------------------------------instance (MaxArity256 (SumArity (f :+: g)), PeekRepSum 0 (f :+: g))-         => PeekRep (f :+: g) where-    {-# INLINE peekRep #-}-    peekRep = do-        tag <- read-        peekRepSum (Proxy :: Proxy 0) tag--{-# INLINE genericPeeker #-}-genericPeeker :: (Generic a, PeekRep (Rep a)) => Peeker a-genericPeeker = to <$> peekRep--{-# INLINE genericPeekBoundedPtr #-}-genericPeekBoundedPtr :: (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a-genericPeekBoundedPtr = runPeeker genericPeeker--{-# INLINE genericPeekByteIndex #-}-genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) =>-    MutableByteArray -> Int -> IO a-genericPeekByteIndex arr index = do-    -- XXX Should we use unsafe peek?-    end <- sizeOfMutableByteArray arr-    genericPeekBoundedPtr (BoundedPtr arr index end)
src/Streamly/Internal/Data/Unfold.hs view
@@ -16,28 +16,16 @@     -- $setup      -- * Unfold Type-      Step(..)-    , Unfold+      module Streamly.Internal.Data.Unfold.Type      -- * Unfolds     -- One to one correspondence with     -- "Streamly.Internal.Data.Stream.Generate"     -- ** Basic Constructors-    , mkUnfoldM-    , mkUnfoldrM-    , unfoldrM-    , unfoldr-    , functionM-    , function-    , identity     , nilM     , nil     , consM -    -- ** From Values-    , fromEffect-    , fromPure-     -- ** Generators     -- | Generate a monadic stream from a seed.     , repeatM@@ -46,39 +34,9 @@     , iterateM      -- ** Enumerations-    , Enumerable (..)--    -- ** Enumerate Num-    , enumerateFromNum-    , enumerateFromThenNum-    , enumerateFromStepNum--    -- ** Enumerating 'Bounded 'Integral' Types-    , enumerateFromIntegralBounded-    , enumerateFromThenIntegralBounded-    , enumerateFromToIntegralBounded-    , enumerateFromThenToIntegralBounded--    -- ** Enumerating 'Unounded Integral' Types-    , enumerateFromIntegral-    , enumerateFromThenIntegral-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    -- ** Enumerating 'Small Integral' Types-    , enumerateFromSmallBounded-    , enumerateFromThenSmallBounded-    , enumerateFromToSmall-    , enumerateFromThenToSmall--    -- ** Enumerating 'Fractional' Types-    , enumerateFromFractional-    , enumerateFromThenFractional-    , enumerateFromToFractional-    , enumerateFromThenToFractional+    , module Streamly.Internal.Data.Unfold.Enumeration      -- ** From Containers-    , fromList     , fromListM      -- ** From Memory@@ -91,11 +49,6 @@      -- * Combinators     -- ** Mapping on Input-    , lmap-    , lmapM-    , both-    , first-    , second     , discardFirst     , discardSecond     , swap@@ -110,11 +63,6 @@     -- input, but that might make the common case more inconvenient.      -- ** Mapping on Output-    , map-    , map2-    , mapM-    , mapM2-     , postscanlM'     , postscan     , scan@@ -126,8 +74,6 @@     , either      -- ** Filtering-    , takeWhileM-    , takeWhile     , take     , filter     , filterM@@ -135,24 +81,9 @@     , dropWhile     , dropWhileM -    -- ** Zipping-    , zipWithM-    , zipWith-     -- ** Cross product-    , crossWithM-    , crossWith-    , cross     , joinInnerGeneric-    , crossApply -    -- ** Nesting-    , ConcatState (..)-    , many-    , many2-    , concatMapM-    , bind-     -- ** Resource Management     -- | 'bracket' is the most general resource management operation, all other     -- operations can be expressed using it. These functions have IO suffix@@ -189,14 +120,14 @@ import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Internal.Data.IOFinalizer     (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..), Step(..))+import Streamly.Internal.Data.Stream.Type (Stream(..)) import Streamly.Internal.Data.SVar.Type (defState)  import qualified Control.Monad.Catch as MC import qualified Data.Tuple as Tuple import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.StreamK.Type as K import qualified Prelude  import Streamly.Internal.Data.Unfold.Enumeration@@ -210,6 +141,10 @@  #include "DocTestDataUnfold.hs" +-------------------------------------------------------------------------------+-- Input operations+-------------------------------------------------------------------------------+ -- | Convert an 'Unfold' into an unfold accepting a tuple as an argument, -- using the argument of the original fold as the second element of tuple and -- discarding the first element of the tuple.@@ -270,7 +205,7 @@ -- {-# INLINE_NORMAL fold #-} fold :: Monad m => Fold m b c -> Unfold m a b -> a -> m c-fold (Fold fstep initial extract) (Unfold ustep inject) a = do+fold (Fold fstep initial _ final) (Unfold ustep inject) a = do     res <- initial     case res of         FL.Partial x -> inject a >>= go SPEC x@@ -288,7 +223,7 @@                     FL.Partial fs1 -> go SPEC fs1 s                     FL.Done c -> return c             Skip s -> go SPEC fs s-            Stop -> extract fs+            Stop -> final fs  -- {-# ANN type FoldMany Fuse #-} data FoldMany s fs b a@@ -303,7 +238,7 @@ -- /Pre-release/ {-# INLINE_NORMAL foldMany #-} foldMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-foldMany (Fold fstep initial extract) (Unfold ustep inject1) =+foldMany (Fold fstep initial _ final) (Unfold ustep inject1) =     Unfold step inject      where@@ -334,14 +269,14 @@         case r of             Yield x s -> consume x s fs             Skip s -> return $ Skip (FoldManyFirst fs s)-            Stop -> return Stop+            Stop -> final fs >> return Stop     step (FoldManyLoop st fs) = do         r <- ustep st         case r of             Yield x s -> consume x s fs             Skip s -> return $ Skip (FoldManyLoop s fs)             Stop -> do-                b <- extract fs+                b <- final fs                 return $ Skip (FoldManyYield b FoldManyDone)     step (FoldManyYield b next) = return $ Yield b next     step FoldManyDone = return Stop@@ -382,7 +317,7 @@ -- /Pre-release/ {-# INLINE_NORMAL postscan #-} postscan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-postscan (Fold stepF initial extract) (Unfold stepU injectU) =+postscan (Fold stepF initial extract final) (Unfold stepU injectU) =     Unfold step inject      where@@ -405,7 +340,7 @@                         v <- extract fs1                         return $ Yield v (Just (fs1, s))             Skip s -> return $ Skip (Just (fs, s))-            Stop -> return Stop+            Stop -> final fs >> return Stop      step Nothing = return Stop @@ -413,7 +348,7 @@  {-# INLINE_NORMAL scanWith #-} scanWith :: Monad m => Bool -> Fold m b c -> Unfold m a b -> Unfold m a c-scanWith restart (Fold fstep initial extract) (Unfold stepU injectU) =+scanWith restart (Fold fstep initial extract final) (Unfold stepU injectU) =     Unfold step inject      where@@ -438,7 +373,7 @@         case res of             Yield x s -> runStep s (fstep fs x)             Skip s -> return $ Skip $ ScanDo s fs-            Stop -> return Stop+            Stop -> final fs >> return Stop     step ScanDone = return Stop  -- | Scan the output of an 'Unfold' to change it in a stateful manner.
src/Streamly/Internal/Data/Unfold/Enumeration.hs view
@@ -65,7 +65,6 @@ import Data.Word import Numeric.Natural import Data.Functor.Identity (Identity(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..)) import Streamly.Internal.Data.Unfold.Type import Prelude        hiding (map, mapM, takeWhile, take, filter, const, zipWith@@ -88,7 +87,7 @@ -- the value overflows it keeps enumerating in a cycle: -- -- @--- >>> Stream.fold Fold.toList $ Stream.take 10 $ Stream.unfold Unfold.enumerateFromStepNum (255::Word8,1)+-- >>> Stream.toList $ Stream.take 10 $ Stream.unfold Unfold.enumerateFromStepNum (255::Word8,1) -- [255,0,1,2,3,4,5,6,7,8] -- -- @@@ -125,7 +124,7 @@ -- -- Example: -- @--- >>> Stream.fold Fold.toList $ Stream.take 10 $ Stream.unfold enumerateFromThenNum (255::Word8,0)+-- >>> Stream.toList $ Stream.take 10 $ Stream.unfold enumerateFromThenNum (255::Word8,0) -- [255,0,1,2,3,4,5,6,7,8] -- -- @@@ -152,7 +151,7 @@ -- -- @ -- >>> enumerateFromNum = lmap (\from -> (from, 1)) Unfold.enumerateFromStepNum--- >>> Stream.fold Fold.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9)+-- >>> Stream.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9) -- [0.9,1.9,2.9,3.9,4.9,5.9] -- -- @@@ -162,7 +161,7 @@ -- -- @ -- >>> enumerateFromNum = lmap (\from -> (from, from + 1)) Unfold.enumerateFromThenNum--- >>> Stream.fold Fold.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9)+-- >>> Stream.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9) -- [0.9,1.9,2.9,3.8999999999999995,4.8999999999999995,5.8999999999999995] -- -- @@@ -284,7 +283,7 @@ -- specified upper limit rounded to the nearest integral value: -- -- @--- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromToFractional (0.1, 6.3)+-- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromToFractional (0.1, 6.3) -- [0.1,1.1,2.1,3.1,4.1,5.1,6.1] -- -- @@@ -389,24 +388,15 @@     -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or     -- generating an infinite stream when the type is not 'Bounded'.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom (0 :: Int)+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom (0 :: Int)     -- [0,1,2,3]     ---    -- @-    --     -- For 'Fractional' types, enumeration is numerically stable. However, no     -- overflow or underflow checks are performed.     ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom 1.1+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom 1.1     -- [1.1,2.1,3.1,4.1]     ---    -- @-    --     -- /Pre-release/     --     enumerateFrom :: Monad m => Unfold m a a@@ -415,27 +405,18 @@     -- @from@, enumerating the type up to the value @to@. If @to@ is smaller than     -- @from@ then an empty stream is returned.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromTo (0, 4)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (0, 4)     -- [0,1,2,3,4]     ---    -- @-    --     -- For 'Fractional' types, the last element is equal to the specified @to@     -- value after rounding to the nearest integral value.     ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4)     -- [1.1,2.1,3.1,4.1]     ---    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4.6)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4.6)     -- [1.1,2.1,3.1,4.1,5.1]     ---    -- @-    --     -- /Pre-release/     enumerateFromTo :: Monad m => Unfold m (a, a) a @@ -445,18 +426,12 @@     -- after @from@. For 'Bounded' types the stream ends when 'maxBound' is     -- reached, for unbounded types it keeps enumerating infinitely.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0, 2)+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0, 2)     -- [0,2,4,6]     ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0,(-2))+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0,(-2))     -- [0,-2,-4,-6]     ---    -- @-    --     -- /Pre-release/     enumerateFromThen :: Monad m => Unfold m (a, a) a @@ -465,17 +440,11 @@     -- @to@. Enumeration can occur downwards or upwards depending on whether @then@     -- comes before or after @from@.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, 2, 6)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, 2, 6)     -- [0,2,4,6]     ---    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, (-2), (-6))+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, (-2), (-6))     -- [0,-2,-4,-6]-    ---    -- @     --     -- /Pre-release/     enumerateFromThenTo :: Monad m => Unfold m (a, a, a) a
src/Streamly/Internal/Data/Unfold/Type.hs view
@@ -39,17 +39,13 @@  module Streamly.Internal.Data.Unfold.Type     (-    -- * Setup-    -- | To execute the code examples provided in this module in ghci, please-    -- run the following commands first.-    ---    -- $setup-     -- * General Notes     -- $notes      -- * Type-      Unfold (..)+    -- StreamD Step type re-exported+      Step(..)+    , Unfold (..)      -- * Basic Constructors     , mkUnfoldM@@ -116,7 +112,7 @@ import Data.Void (Void) import Fusion.Plugin.Types (Fuse(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Streamly.Internal.Data.Stream.Step (Step(..))  import Prelude hiding (map, mapM, concatMap, zipWith, takeWhile)
src/Streamly/Internal/FileSystem/Dir.hs view
@@ -6,7 +6,6 @@ -- -- License     : BSD3 -- Maintainer  : streamly@composewell.com--- Stability   : pre-release -- Portability : GHC  module Streamly.Internal.FileSystem.Dir@@ -83,15 +82,24 @@     ) where +import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class (MonadIO(..)) import Data.Bifunctor (bimap) import Data.Either (isRight, isLeft, fromLeft, fromRight)+import Data.Function ((&)) import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Unfold (Step(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import System.FilePath ((</>))-+#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)+import System.Posix (DirStream, openDirStream, readDirStream, closeDirStream)+#elif defined(mingw32_HOST_OS)+import qualified System.Win32 as Win32+#else+#error "Unsupported architecture"+#endif import qualified Streamly.Data.Unfold as UF-import qualified Streamly.Internal.Data.Unfold as UF (mapM2)+import qualified Streamly.Internal.Data.Unfold as UF (mapM2, bracketIO) import qualified Streamly.Data.Stream as S import qualified System.Directory as Dir @@ -231,17 +239,56 @@  -- XXX exception handling +#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)+{-# INLINE streamReader #-}+streamReader :: MonadIO m => Unfold m DirStream FilePath+streamReader = Unfold step return++    where++    step strm = do+        -- XXX Use readDirStreamMaybe+        file <- liftIO $ readDirStream strm+        case file of+            [] -> return Stop+            _ -> return $ Yield file strm++#elif defined(mingw32_HOST_OS)+openDirStream :: String -> IO (Win32.HANDLE, Win32.FindData)+openDirStream = Win32.findFirstFile++closeDirStream :: (Win32.HANDLE, Win32.FindData) -> IO ()+closeDirStream (h, _) = Win32.findClose h++{-# INLINE streamReader #-}+streamReader :: MonadIO m => Unfold m (Win32.HANDLE, Win32.FindData) FilePath+streamReader = Unfold step return++    where++    step (h, fdat) = do+        more <- liftIO $ Win32.findNextFile h fdat+        if more+        then do+            file <- liftIO $ Win32.getFindDataFileName fdat+            return $ Yield file (h, fdat)+        else return Stop+#endif+ --  | Read a directory emitting a stream with names of the children. Filter out --  "." and ".." entries. -- --  /Internal/ -- {-# INLINE reader #-}-reader :: MonadIO m => Unfold m FilePath FilePath+reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath reader =-    -- XXX use proper streaming read of the dir-      UF.filter (\x -> x /= "." && x /= "..")-    $ UF.lmapM (liftIO . Dir.getDirectoryContents) UF.fromList+-- XXX Instead of using bracketIO for each iteration of the loop we should+-- instead yield a buffer of dir entries in each iteration and then use an+-- unfold and concat to flatten those entries. That should improve the+-- performance.+      UF.bracketIO openDirStream closeDirStream streamReader+    & UF.filter (\x -> x /= "." && x /= "..")  -- XXX We can use a more general mechanism to filter the contents of a -- directory. We can just stat each child and pass on the stat information. We@@ -254,7 +301,7 @@ --  /Internal/ -- {-# INLINE eitherReader #-}-eitherReader :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath) eitherReader = UF.mapM2 classify reader      where@@ -264,7 +311,7 @@         return $ if r then Left x else Right x  {-# INLINE eitherReaderPaths #-}-eitherReaderPaths :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+eitherReaderPaths ::(MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath) eitherReaderPaths =     UF.mapM2 (\dir -> return . bimap (dir </>) (dir </>)) eitherReader @@ -274,7 +321,7 @@ --  /Internal/ -- {-# INLINE fileReader #-}-fileReader :: MonadIO m => Unfold m FilePath FilePath+fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader  -- | Read directories only. Filter out "." and ".." entries.@@ -282,19 +329,19 @@ --  /Internal/ -- {-# INLINE dirReader #-}-dirReader :: MonadIO m => Unfold m FilePath FilePath+dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath dirReader = fmap (fromLeft undefined) $ UF.filter isLeft eitherReader  -- | Raw read of a directory. -- -- /Pre-release/ {-# INLINE read #-}-read :: MonadIO m => FilePath -> Stream m FilePath+read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath read = S.unfold reader  {-# DEPRECATED toStream "Please use 'read' instead" #-} {-# INLINE toStream #-}-toStream :: MonadIO m => String -> Stream m String+toStream :: (MonadIO m, MonadCatch m) => String -> Stream m String toStream = read  -- | Read directories as Left and files as Right. Filter out "." and ".."@@ -302,18 +349,18 @@ -- -- /Pre-release/ {-# INLINE readEither #-}-readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath) readEither = S.unfold eitherReader  -- | Like 'readEither' but prefix the names of the files and directories with -- the supplied directory path. {-# INLINE readEitherPaths #-}-readEitherPaths :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath) readEitherPaths dir = fmap (bimap (dir </>) (dir </>)) $ readEither dir  {-# DEPRECATED toEither "Please use 'readEither' instead" #-} {-# INLINE toEither #-}-toEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+toEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath) toEither = readEither  -- | Read files only.@@ -321,12 +368,12 @@ --  /Internal/ -- {-# INLINE readFiles #-}-readFiles :: MonadIO m => FilePath -> Stream m FilePath+readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath readFiles = S.unfold fileReader  {-# DEPRECATED toFiles "Please use 'readFiles' instead" #-} {-# INLINE toFiles #-}-toFiles :: MonadIO m => FilePath -> Stream m FilePath+toFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath toFiles = readFiles  -- | Read directories only.@@ -334,12 +381,12 @@ --  /Internal/ -- {-# INLINE readDirs #-}-readDirs :: MonadIO m => FilePath -> Stream m FilePath+readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath readDirs = S.unfold dirReader  {-# DEPRECATED toDirs "Please use 'readDirs' instead" #-} {-# INLINE toDirs #-}-toDirs :: MonadIO m => String -> Stream m String+toDirs :: (MonadIO m, MonadCatch m) => String -> Stream m String toDirs = readDirs  {-@@ -397,7 +444,7 @@ -- @since 0.7.0 {-# INLINE fromStreamWithBufferOf #-} fromStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()-fromStreamWithBufferOf n h m = fromChunks h $ S.chunksOf n m+fromStreamWithBufferOf n h m = fromChunks h $ S.pinnedChunksOf n m -- fromStreamWithBufferOf n h m = fromChunks h $ AS.chunksOf n m  -- > write = 'writeWithBufferOf' A.defaultChunkSize@@ -448,7 +495,7 @@ -- @since 0.7.0 {-# INLINE writeWithBufferOf #-} writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWithBufferOf n h = FL.groupsOf n (writeNUnsafe n) (writeChunks h)+writeWithBufferOf n h = FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks h)  -- > write = 'writeWithBufferOf' A.defaultChunkSize --
src/Streamly/Internal/FileSystem/File.hs view
@@ -6,7 +6,6 @@ -- -- License     : BSD3 -- Maintainer  : streamly@composewell.com--- Stability   : pre-release -- Portability : GHC -- -- Read and write streams and arrays to and from files specified by their paths@@ -76,11 +75,11 @@     , fromChunks      -- ** Append To File-    , append-    , appendWith+    , writeAppend+    , writeAppendWith     -- , appendShared-    , appendArray-    , appendChunks+    , writeAppendArray+    , writeAppendChunks      -- * Deprecated     , readWithBufferOf@@ -104,10 +103,10 @@ import qualified System.IO as SIO  import Streamly.Data.Fold (groupsOf, drain)-import Streamly.Internal.Data.Array.Type (Array(..), writeNUnsafe)+import Streamly.Internal.Data.Array.Type (Array(..), pinnedWriteNUnsafe) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Data.Stream (Stream)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize)@@ -115,6 +114,7 @@ import qualified Streamly.Data.Array as A import qualified Streamly.Data.Stream as S import qualified Streamly.Data.Unfold as UF+import qualified Streamly.Internal.Data.Array.Type as IA (pinnedChunksOf) import qualified Streamly.Internal.Data.Unfold as UF (bracketIO) import qualified Streamly.Internal.Data.Fold.Type as FL     (Step(..), snoc, reduce)@@ -212,9 +212,9 @@ -- -- /Pre-release/ ---{-# INLINABLE appendArray #-}-appendArray :: FilePath -> Array a -> IO ()-appendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)+{-# INLINABLE writeAppendArray #-}+writeAppendArray :: FilePath -> Array a -> IO ()+writeAppendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)  ------------------------------------------------------------------------------- -- Stream of Arrays IO@@ -405,7 +405,7 @@ {-# INLINE fromBytesWith #-} fromBytesWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Stream m Word8 -> m ()-fromBytesWith n file xs = fromChunks file $ S.chunksOf n xs+fromBytesWith n file xs = fromChunks file $ IA.pinnedChunksOf n xs  {-# DEPRECATED fromBytesWithBufferOf "Please use 'fromBytesWith' instead"  #-} {-# INLINE fromBytesWithBufferOf #-}@@ -438,7 +438,7 @@ {-# INLINE writeChunks #-} writeChunks :: (MonadIO m, MonadCatch m)     => FilePath -> Fold m (Array a) ()-writeChunks path = Fold step initial extract+writeChunks path = Fold step initial extract final     where     initial = do         h <- liftIO (openFile path WriteMode)@@ -448,12 +448,15 @@     step (fld, h) x = do         r <- FL.snoc fld x `MC.onException` liftIO (hClose h)         return $ FL.Partial (r, h)-    extract (Fold _ initial1 extract1, h) = do++    extract _ = return ()++    final (Fold _ initial1 _ final1, h) = do         liftIO $ hClose h         res <- initial1         case res of-            FL.Partial fs -> extract1 fs-            FL.Done fb -> return fb+            FL.Partial fs -> final1 fs+            FL.Done () -> return ()  -- | @writeWith chunkSize handle@ writes the input stream to @handle@. -- Bytes in the input stream are collected into a buffer until we have a chunk@@ -464,7 +467,7 @@ writeWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Fold m Word8 () writeWith n path =-    groupsOf n (writeNUnsafe n) (writeChunks path)+    groupsOf n (pinnedWriteNUnsafe n) (writeChunks path)  {-# DEPRECATED writeWithBufferOf "Please use 'writeWith' instead"  #-} {-# INLINE writeWithBufferOf #-}@@ -488,10 +491,10 @@ -- -- /Pre-release/ ---{-# INLINE appendChunks #-}-appendChunks :: (MonadIO m, MonadCatch m)+{-# INLINE writeAppendChunks #-}+writeAppendChunks :: (MonadIO m, MonadCatch m)     => FilePath -> Stream m (Array a) -> m ()-appendChunks = fromChunksMode AppendMode+writeAppendChunks = fromChunksMode AppendMode  -- | Like 'append' but provides control over the write buffer. Output will -- be written to the IO device as soon as we collect the specified number of@@ -499,10 +502,11 @@ -- -- /Pre-release/ ---{-# INLINE appendWith #-}-appendWith :: (MonadIO m, MonadCatch m)+{-# INLINE writeAppendWith #-}+writeAppendWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Stream m Word8 -> m ()-appendWith n file xs = appendChunks file $ S.chunksOf n xs+writeAppendWith n file xs =+    writeAppendChunks file $ IA.pinnedChunksOf n xs  -- | Append a byte stream to a file. Combines the bytes in chunks of size up to -- 'A.defaultChunkSize' before writing.  If the file exists then the new data@@ -511,9 +515,9 @@ -- -- /Pre-release/ ---{-# INLINE append #-}-append :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()-append = appendWith defaultChunkSize+{-# INLINE writeAppend #-}+writeAppend :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+writeAppend = writeAppendWith defaultChunkSize  {- -- | Like 'append' but the file is not locked for exclusive writes.
src/Streamly/Internal/FileSystem/Handle.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ #include "inline.hs"  -- |@@ -25,6 +27,12 @@ -- module Streamly.Internal.FileSystem.Handle     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Singleton APIs       getChunk     , getChunkOf@@ -115,7 +123,7 @@ import Data.Function ((&)) import Data.Maybe (isNothing, fromJust) import Data.Word (Word8)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Internal.Data.Unbox (Unbox) import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek) import Prelude hiding (read) @@ -123,36 +131,26 @@ import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.Data.Array.Type-       (Array(..), writeNUnsafe, unsafeFreezeWithShrink, byteLength)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.Chunked (lpackArraysChunksOf)+       (Array(..), pinnedWriteNUnsafe, unsafeFreezeWithShrink, byteLength)+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Array.Stream (lpackArraysChunksOf) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize)  import qualified Streamly.Data.Fold as FL import qualified Streamly.Data.Array as A import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Stream.Chunked as AS-import qualified Streamly.Internal.Data.Array.Mut.Type as MArray+import qualified Streamly.Internal.Data.Array.Stream as AS+import qualified Streamly.Internal.Data.MutArray.Type as MArray import qualified Streamly.Internal.Data.Refold.Type as Refold import qualified Streamly.Internal.Data.Fold.Type as FL(refoldMany)-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as D     (Stream(..), Step(..)) import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (mkStream)+import qualified Streamly.Internal.Data.StreamK.Type as K (mkStream) --- $setup--- >>> import qualified Streamly.Data.Array as Array--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Data.Stream as Stream------ >>> import qualified Streamly.Internal.Data.Array.Type as Array (writeNUnsafe)--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold (first)--- >>> import qualified Streamly.Internal.FileSystem.Handle as Handle--- >>> import qualified Streamly.Internal.System.IO as IO (defaultChunkSize)+#include "DocTestFileSystemHandle.hs"  ------------------------------------------------------------------------------- -- References@@ -180,7 +178,7 @@ {-# INLINABLE getChunk #-} getChunk :: MonadIO m => Int -> Handle -> m (Array Word8) getChunk size h = liftIO $ do-    arr <- MArray.newPinnedBytes size+    arr <- MArray.pinnedNewBytes size     -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))     MArray.asPtrUnsafe arr $ \p -> do         n <- hGetBufSome h p size@@ -358,7 +356,7 @@ -- performed in sizes of -- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. ----- >>> reader = Unfold.many Array.reader chunkReader+-- >>> reader = Unfold.many Array.reader Handle.chunkReader -- {-# INLINE reader #-} reader :: MonadIO m => Unfold m Handle Word8@@ -425,15 +423,15 @@     => Int -> Handle -> Stream m (Array a) -> m () putChunksWith n h xs = putChunks h $ AS.compact n xs +-- > putBytesWith n h m = Handle.putChunks h $ A.pinnedChunksOf n m+ -- | @putBytesWith bufsize handle stream@ writes @stream@ to @handle@ -- in chunks of @bufsize@.  A write is performed to the IO device as soon as we -- collect the required input size. ----- >>> putBytesWith n h m = Handle.putChunks h $ Stream.chunksOf n m--- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()-putBytesWith n h m = putChunks h $ A.chunksOf n m+putBytesWith n h m = putChunks h $ A.pinnedChunksOf n m  -- | Write a byte stream to a file handle. Accumulates the input in chunks of -- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing.@@ -502,7 +500,7 @@ -- {-# INLINE writeWith #-} writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWith n h = FL.groupsOf n (writeNUnsafe n) (writeChunks h)+writeWith n h = FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks h)  -- | Same as 'writeWith' --@@ -520,7 +518,7 @@ writeMaybesWith :: (MonadIO m )     => Int -> Handle -> Fold m (Maybe Word8) () writeMaybesWith n h =-    let writeNJusts = FL.lmap fromJust $ A.writeN n+    let writeNJusts = FL.lmap fromJust $ A.pinnedWriteN n         writeOnNothing = FL.takeEndBy_ isNothing writeNJusts     in FL.many writeOnNothing (writeChunks h) @@ -530,7 +528,7 @@ {-# INLINE writerWith #-} writerWith :: MonadIO m => Int -> Refold m Handle Word8 () writerWith n =-    FL.refoldMany (FL.take n $ writeNUnsafe n) chunkWriter+    FL.refoldMany (FL.take n $ pinnedWriteNUnsafe n) chunkWriter  -- | Write a byte stream to a file handle. Accumulates the input in chunks of -- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing
− src/Streamly/Internal/Serialize/FromBytes.hs 
@@ -1,394 +0,0 @@--- |--- Module      : Streamly.Internal.Serialize.FromBytes--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Decode Haskell data types from byte streams.--module Streamly.Internal.Serialize.FromBytes-    (-    -- * Type class-      FromBytes (..)--    -- * Decoders-    , unit-    , bool-    , ordering-    , eqWord8 -- XXX rename to word8Eq-    , word8-    , word16be-    , word16le-    , word32be-    , word32le-    , word64be-    , word64le-    , word64host-    , int8-    , int16be-    , int16le-    , int32be-    , int32le-    , int64be-    , int64le-    , float32be-    , float32le-    , double64be-    , double64le-    , charLatin1-    )-where--import Control.Monad.IO.Class (MonadIO)-import Data.Bits ((.|.), unsafeShiftL)-import Data.Char (chr)-import Data.Int (Int8, Int16, Int32, Int64)-import GHC.Float (castWord32ToFloat, castWord64ToDouble)-import Data.Word (Word8, Word16, Word32, Word64)-import Streamly.Internal.Data.Parser (Parser)-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))-import qualified Streamly.Data.Array as A-import qualified Streamly.Internal.Data.Array as A-    (unsafeIndex, castUnsafe)-import qualified Streamly.Internal.Data.Parser as PR-    (fromPure, either, satisfy, takeEQ)-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-    (Parser(..), Initial(..), Step(..))---- Note: The () type does not need to have an on-disk representation in theory.--- But we use a concrete representation for it so that we count how many ()--- types we have. Or when we have an array of units the array a concrete--- length.---- | A value of type '()' is encoded as @0@ in binary encoding.------ @--- 0 ==> ()--- @------ /Pre-release/----{-# INLINE unit #-}-unit :: Monad m => Parser Word8 m ()-unit = eqWord8 0 *> PR.fromPure ()--{-# INLINE word8ToBool #-}-word8ToBool :: Word8 -> Either String Bool-word8ToBool 0 = Right False-word8ToBool 1 = Right True-word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)---- | A value of type 'Bool' is encoded as follows in binary encoding.------ @--- 0 ==> False--- 1 ==> True--- @------ /Pre-release/----{-# INLINE bool #-}-bool :: Monad m => Parser Word8 m Bool-bool = PR.either word8ToBool--{-# INLINE word8ToOrdering #-}-word8ToOrdering :: Word8 -> Either String Ordering-word8ToOrdering 0 = Right LT-word8ToOrdering 1 = Right EQ-word8ToOrdering 2 = Right GT-word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)---- | A value of type 'Ordering' is encoded as follows in binary encoding.------ @--- 0 ==> LT--- 1 ==> EQ--- 2 ==> GT--- @------ /Pre-release/----{-# INLINE ordering #-}-ordering :: Monad m => Parser Word8 m Ordering-ordering = PR.either word8ToOrdering---- XXX should go in a Word8 parser module?--- | Accept the input byte only if it is equal to the specified value.------ /Pre-release/----{-# INLINE eqWord8 #-}-eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8-eqWord8 b = PR.satisfy (== b)---- | Accept any byte.------ /Pre-release/----{-# INLINE word8 #-}-word8 :: Monad m => Parser Word8 m Word8-word8 = PR.satisfy (const True)---- | Big endian (MSB first) Word16-{-# INLINE word16beD #-}-word16beD :: Monad m => PRD.Parser Word8 m Word16-word16beD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial Nothing'--    step Nothing' a =-        -- XXX We can use a non-failing parser or a fold so that we do not-        -- have to buffer for backtracking which is inefficient.-        return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))-    step (Just' w) a =-        return $ PRD.Done 0 (w .|. fromIntegral a)--    extract _ = return $ PRD.Error "word16be: end of input"---- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and--- second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word16be #-}-word16be :: Monad m => Parser Word8 m Word16-word16be = word16beD---- | Little endian (LSB first) Word16-{-# INLINE word16leD #-}-word16leD :: Monad m => PRD.Parser Word8 m Word16-word16leD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial Nothing'--    step Nothing' a =-        return $ PRD.Continue 0 (Just' (fromIntegral a))-    step (Just' w) a =-        return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)--    extract _ = return $ PRD.Error "word16le: end of input"---- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and--- second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE word16le #-}-word16le :: Monad m => Parser Word8 m Word16-word16le = word16leD---- | Big endian (MSB first) Word32-{-# INLINE word32beD #-}-word32beD :: Monad m => PRD.Parser Word8 m Word32-word32beD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 24--    step (Tuple' w sh) a = return $-        if sh /= 0-        then-            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-             in PRD.Continue 0 (Tuple' w1 (sh - 8))-        else PRD.Done 0 (w .|. fromIntegral a)--    extract _ = return $ PRD.Error "word32beD: end of input"---- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32be #-}-word32be :: Monad m => Parser Word8 m Word32-word32be = word32beD---- | Little endian (LSB first) Word32-{-# INLINE word32leD #-}-word32leD :: Monad m => PRD.Parser Word8 m Word32-word32leD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 0--    step (Tuple' w sh) a = return $-        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-         in if sh /= 24-            then PRD.Continue 0 (Tuple' w1 (sh + 8))-            else PRD.Done 0 w1--    extract _ = return $ PRD.Error "word32leD: end of input"---- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32le #-}-word32le :: Monad m => Parser Word8 m Word32-word32le = word32leD---- | Big endian (MSB first) Word64-{-# INLINE word64beD #-}-word64beD :: Monad m => PRD.Parser Word8 m Word64-word64beD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 56--    step (Tuple' w sh) a = return $-        if sh /= 0-        then-            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-             in PRD.Continue 0 (Tuple' w1 (sh - 8))-        else PRD.Done 0 (w .|. fromIntegral a)--    extract _ = return $ PRD.Error "word64beD: end of input"---- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64be #-}-word64be :: Monad m => Parser Word8 m Word64-word64be = word64beD---- | Little endian (LSB first) Word64-{-# INLINE word64leD #-}-word64leD :: Monad m => PRD.Parser Word8 m Word64-word64leD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 0--    step (Tuple' w sh) a = return $-        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-         in if sh /= 56-            then PRD.Continue 0 (Tuple' w1 (sh + 8))-            else PRD.Done 0 w1--    extract _ = return $ PRD.Error "word64leD: end of input"---- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64le #-}-word64le :: Monad m => Parser Word8 m Word64-word64le = word64leD--{-# INLINE int8 #-}-int8 :: Monad m => Parser Word8 m Int8-int8 = fromIntegral <$> word8---- | Parse two bytes as a 'Int16', the first byte is the MSB of the Int16 and--- second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int16be #-}-int16be :: Monad m => Parser Word8 m Int16-int16be = fromIntegral <$> word16be---- | Parse two bytes as a 'Int16', the first byte is the LSB of the Int16 and--- second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE int16le #-}-int16le :: Monad m => Parser Word8 m Int16-int16le = fromIntegral <$> word16le---- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int32be #-}-int32be :: Monad m => Parser Word8 m Int32-int32be = fromIntegral <$> word32be---- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int32le #-}-int32le :: Monad m => Parser Word8 m Int32-int32le = fromIntegral <$> word32le---- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int64be #-}-int64be :: Monad m => Parser Word8 m Int64-int64be = fromIntegral <$> word64be---- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int64le #-}-int64le :: Monad m => Parser Word8 m Int64-int64le = fromIntegral <$> word64le--{-# INLINE float32be #-}-float32be :: MonadIO m => Parser Word8 m Float-float32be = castWord32ToFloat <$> word32be--{-# INLINE float32le #-}-float32le :: MonadIO m => Parser Word8 m Float-float32le = castWord32ToFloat <$> word32le--{-# INLINE double64be #-}-double64be :: MonadIO m => Parser Word8 m Double-double64be =  castWord64ToDouble <$> word64be--{-# INLINE double64le #-}-double64le :: MonadIO m => Parser Word8 m Double-double64le = castWord64ToDouble <$> word64le---- | Accept any byte.------ /Pre-release/----{-# INLINE charLatin1 #-}-charLatin1 :: Monad m => Parser Word8 m Char-charLatin1 = fmap (chr . fromIntegral) word8------------------------------------------------------------------------------------ Host byte order------------------------------------------------------------------------------------ | Parse eight bytes as a 'Word64' in the host byte order.------ /Pre-release/----{-# INLINE word64host #-}-word64host :: MonadIO m => Parser Word8 m Word64-word64host =-    fmap (A.unsafeIndex 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)------------------------------------------------------------------------------------ Type class----------------------------------------------------------------------------------class FromBytes a where-    -- | Decode a byte stream to a Haskell type.-    fromBytes :: Parser Word8 m a
− src/Streamly/Internal/Serialize/ToBytes.hs 
@@ -1,374 +0,0 @@--- |--- Module      : Streamly.Internal.Serialize.ToBytes--- Copyright   : (c) 2022 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Encode Haskell data types to byte streams.--module Streamly.Internal.Serialize.ToBytes-    (-    -- * Type class-      ToBytes (..)--    -- * Encoders-    , unit-    , bool-    , ordering-    , word8-    , word16be-    , word16le-    , word32be-    , word32le-    , word64be-    , word64le-    , word64host-    , int8-    , int16be-    , int16le-    , int32be-    , int32le-    , int64be-    , int64le-    , float32be-    , float32le-    , double64be-    , double64le-    , charLatin1-    , charUtf8-    )-where--#include "MachDeps.h"--import Data.Bits (shiftR)-import Data.Char (ord)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word8, Word16, Word32, Word64)-import GHC.Float (castDoubleToWord64, castFloatToWord32)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamD (Step(..))-import Streamly.Internal.Unicode.Stream (readCharUtf8)--import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD as D---- XXX Use StreamD directly?---- | A value of type '()' is encoded as @0@ in binary encoding.------ @--- 0 ==> ()--- @------ /Pre-release/----{-# INLINE unit #-}-unit :: Applicative m => Stream m Word8-unit = Stream.fromPure 0--{-# INLINE boolToWord8 #-}-boolToWord8 :: Bool -> Word8-boolToWord8 False = 0-boolToWord8 True = 1---- | A value of type 'Bool' is encoded as follows in binary encoding.------ @--- 0 ==> False--- 1 ==> True--- @------ /Pre-release/----{-# INLINE bool #-}-bool :: Applicative m => Bool -> Stream m Word8-bool = Stream.fromPure . boolToWord8--{-# INLINE orderingToWord8 #-}-orderingToWord8 :: Ordering -> Word8-orderingToWord8 LT = 0-orderingToWord8 EQ = 1-orderingToWord8 GT = 2---- | A value of type 'Ordering' is encoded as follows in binary encoding.------ @--- 0 ==> LT--- 1 ==> EQ--- 2 ==> GT--- @------ /Pre-release/----{-# INLINE ordering #-}-ordering :: Applicative m => Ordering -> Stream m Word8-ordering = Stream.fromPure . orderingToWord8---- | Stream a 'Word8'.------ /Pre-release/----{-# INLINE word8 #-}-word8 :: Applicative m => Word8 -> Stream m Word8-word8 = Stream.fromPure--data W16State = W16B1 | W16B2 | W16Done--{-# INLINE word16beD #-}-word16beD :: Applicative m => Word16 -> D.Stream m Word8-word16beD w = D.Stream step W16B1--    where--    step _ W16B1 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16B2-    step _ W16B2 = pure $ Yield (fromIntegral w :: Word8) W16Done-    step _ W16Done = pure Stop---- | Stream a 'Word16' as two bytes, the first byte is the MSB of the Word16--- and second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word16be #-}-word16be :: Monad m => Word16 -> Stream m Word8-word16be = word16beD---- | Little endian (LSB first) Word16-{-# INLINE word16leD #-}-word16leD :: Applicative m => Word16 -> D.Stream m Word8-word16leD w = D.Stream step W16B1--    where--    step _ W16B1 = pure $ Yield (fromIntegral w :: Word8) W16B2-    step _ W16B2 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16Done-    step _ W16Done = pure Stop---- | Stream a 'Word16' as two bytes, the first byte is the LSB of the Word16--- and second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE word16le #-}-word16le :: Monad m => Word16 -> Stream m Word8-word16le = word16leD--data W32State = W32B1 | W32B2 | W32B3 | W32B4 | W32Done---- | Big endian (MSB first) Word32-{-# INLINE word32beD #-}-word32beD :: Applicative m => Word32 -> D.Stream m Word8-word32beD w = D.Stream step W32B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W32B1 = yield 24 W32B2-    step _ W32B2 = yield 16 W32B3-    step _ W32B3 = yield 8 W32B4-    step _ W32B4 = pure $ Yield (fromIntegral w :: Word8) W32Done-    step _ W32Done = pure Stop---- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32be #-}-word32be :: Monad m => Word32 -> Stream m Word8-word32be = word32beD---- | Little endian (LSB first) Word32-{-# INLINE word32leD #-}-word32leD :: Applicative m => Word32 -> D.Stream m Word8-word32leD w = D.Stream step W32B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W32B1 = pure $ Yield (fromIntegral w :: Word8) W32B2-    step _ W32B2 = yield 8 W32B3-    step _ W32B3 = yield 16 W32B4-    step _ W32B4 = yield 24 W32Done-    step _ W32Done = pure Stop---- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32le #-}-word32le :: Monad m => Word32 -> Stream m Word8-word32le = word32leD--data W64State =-    W64B1 | W64B2 | W64B3 | W64B4 | W64B5 | W64B6 | W64B7 | W64B8 | W64Done---- | Big endian (MSB first) Word64-{-# INLINE word64beD #-}-word64beD :: Applicative m => Word64 -> D.Stream m Word8-word64beD w = D.Stream step W64B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W64B1 = yield 56 W64B2-    step _ W64B2 = yield 48 W64B3-    step _ W64B3 = yield 40 W64B4-    step _ W64B4 = yield 32 W64B5-    step _ W64B5 = yield 24 W64B6-    step _ W64B6 = yield 16 W64B7-    step _ W64B7 = yield  8 W64B8-    step _ W64B8 = pure $ Yield (fromIntegral w :: Word8) W64Done-    step _ W64Done = pure Stop---- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64be #-}-word64be :: Monad m => Word64 -> Stream m Word8-word64be = word64beD---- | Little endian (LSB first) Word64-{-# INLINE word64leD #-}-word64leD :: Applicative m => Word64 -> D.Stream m Word8-word64leD w = D.Stream step W64B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W64B1 = pure $ Yield (fromIntegral w :: Word8) W64B2-    step _ W64B2 = yield  8 W64B3-    step _ W64B3 = yield 16 W64B4-    step _ W64B4 = yield 24 W64B5-    step _ W64B5 = yield 32 W64B6-    step _ W64B6 = yield 40 W64B7-    step _ W64B7 = yield 48 W64B8-    step _ W64B8 = yield 56 W64Done-    step _ W64Done = pure Stop---- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64le #-}-word64le :: Monad m => Word64 -> Stream m Word8-word64le = word64leD--{-# INLINE int8 #-}-int8 :: Applicative m => Int8 -> Stream m Word8-int8 i = word8 (fromIntegral i :: Word8)---- | Stream a 'Int16' as two bytes, the first byte is the MSB of the Int16--- and second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int16be #-}-int16be :: Monad m => Int16 -> Stream m Word8-int16be i = word16be (fromIntegral i :: Word16)---- | Stream a 'Int16' as two bytes, the first byte is the LSB of the Int16--- and second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE int16le #-}-int16le :: Monad m => Int16 -> Stream m Word8-int16le i = word16le (fromIntegral i :: Word16)---- | Stream a 'Int32' as four bytes, the first byte is the MSB of the Int32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int32be #-}-int32be :: Monad m => Int32 -> Stream m Word8-int32be i = word32be (fromIntegral i :: Word32)--{-# INLINE int32le #-}-int32le :: Monad m => Int32 -> Stream m Word8-int32le i = word32le (fromIntegral i :: Word32)---- | Stream a 'Int64' as eight bytes, the first byte is the MSB of the Int64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int64be #-}-int64be :: Monad m => Int64 -> Stream m Word8-int64be i = word64be (fromIntegral i :: Word64)---- | Stream a 'Int64' as eight bytes, the first byte is the LSB of the Int64--- and last byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE int64le #-}-int64le :: Monad m => Int64 -> Stream m Word8-int64le i = word64le (fromIntegral i :: Word64)---- | Big endian (MSB first) Float-{-# INLINE float32be #-}-float32be :: Monad m => Float -> Stream m Word8-float32be = word32beD . castFloatToWord32---- | Little endian (LSB first) Float-{-# INLINE float32le #-}-float32le :: Monad m => Float -> Stream m Word8-float32le = word32leD . castFloatToWord32---- | Big endian (MSB first) Double-{-# INLINE double64be #-}-double64be :: Monad m => Double -> Stream m Word8-double64be = word64beD . castDoubleToWord64---- | Little endian (LSB first) Double-{-# INLINE double64le #-}-double64le :: Monad m => Double -> Stream m Word8-double64le = word64leD . castDoubleToWord64---- | Encode a Unicode character to stream of bytes in 0-255 range.----{-# INLINE charLatin1 #-}-charLatin1 :: Applicative m => Char -> Stream m Word8-charLatin1 = Stream.fromPure . fromIntegral . ord--{-# INLINE charUtf8 #-}-charUtf8 :: Monad m => Char -> Stream m Word8-charUtf8 = Stream.unfold readCharUtf8------------------------------------------------------------------------------------ Host byte order------------------------------------------------------------------------------------ | Stream a 'Word64' as eight bytes in the host byte order.------ /Pre-release/----{-# INLINE word64host #-}-word64host :: Monad m => Word64 -> Stream m Word8-word64host =-#ifdef WORDS_BIGENDIAN-    word64be-#else-    word64le-#endif------------------------------------------------------------------------------------ Type class----------------------------------------------------------------------------------class ToBytes a where-    -- | Convert a Haskell type to a byte stream.-    toBytes :: a -> Stream m Word8
src/Streamly/Internal/Unicode/Array.hs view
@@ -14,6 +14,12 @@ -- module Streamly.Internal.Unicode.Array     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Streams of Strings       lines     , words
src/Streamly/Internal/Unicode/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.Parser -- Copyright   : (c) 2021 Composewell Technologies@@ -12,6 +13,12 @@  module Streamly.Internal.Unicode.Parser     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Generic       char     , charIgnoreCase@@ -47,16 +54,23 @@      -- * Numeric     , signed+    , number+    , doubleParser     , double     , decimal     , hexadecimal++    -- * Utilities+    , mkDouble     ) where  import Control.Applicative (Alternative(..))-import Data.Bits (Bits, (.|.), shiftL)+import Data.Bits (Bits, (.|.), shiftL, (.&.)) import Data.Char (ord)-import Streamly.Internal.Data.Parser (Parser)+import Data.Ratio ((%))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Parser (Parser(..), Initial(..),  Step(..))  import qualified Data.Char as Char import qualified Streamly.Data.Fold as Fold@@ -69,6 +83,8 @@     , dropWhile     ) +#include "DocTestUnicodeParser.hs"+ -------------------------------------------------------------------------------- -- Character classification --------------------------------------------------------------------------------@@ -263,36 +279,346 @@ signed :: (Num a, Monad m) => Parser Char m a -> Parser Char m a signed p = (negate <$> (char '-' *> p)) <|> (char '+' *> p) <|> p --- | Parse a 'Double'.+-- XXX Change Multiplier to Sign+type Multiplier = Int++-- XXX We can use Int instead of Integer to make it twice as fast. But then we+-- will have to truncate the significant digits before overflow occurs.+type Number = Integer+type DecimalPlaces = Int+type PowerMultiplier = Int+type Power = Int++{-# ANN type ScientificParseState Fuse #-}+data ScientificParseState+  = SPInitial+  | SPSign !Multiplier+  | SPAfterSign !Multiplier !Number+  | SPDot !Multiplier !Number+  | SPAfterDot !Multiplier !Number !DecimalPlaces+  | SPExponent !Multiplier !Number !DecimalPlaces+  | SPExponentWithSign !Multiplier !Number !DecimalPlaces !PowerMultiplier+  | SPAfterExponent !Multiplier !Number !DecimalPlaces !PowerMultiplier !Power++-- | A generic parser for scientific notation of numbers. Returns (mantissa,+-- exponent) tuple. The result can be mapped to 'Double' or any other number+-- representation e.g. @Scientific@. ----- This parser accepts an optional leading sign character, followed by--- at most one decimal digit.  The syntax is similar to that accepted by--- the 'read' function, with the exception that a trailing @\'.\'@ is--- consumed.+-- For example, using the @scientific@ package:+-- >> parserScientific = uncurry Data.Scientific.scientific <$> 'number'+{-# INLINE number #-}+number :: Monad m => Parser Char m (Integer, Int)+number =  Parser (\s a -> return $ step s a) initial (return . extract)++    where++    intToInteger :: Int -> Integer+    intToInteger = fromIntegral++    combineNum buf num = buf * 10 + num++    {-# INLINE initial #-}+    initial = pure $ IPartial SPInitial++    exitSPInitial msg =+        "number: expecting sign or decimal digit, got " ++ msg+    exitSPSign msg =+        "number: expecting decimal digit, got " ++ msg+    exitSPAfterSign multiplier num = (intToInteger multiplier * num, 0)+    exitSPAfterDot multiplier num decimalPlaces =+        ( intToInteger multiplier * num+        , -decimalPlaces+        )+    exitSPAfterExponent mult num decimalPlaces powerMult powerNum =+        let e = powerMult * powerNum - decimalPlaces+         in (intToInteger mult * num, e)++    {-# INLINE step #-}+    step SPInitial val =+        case val of+          '+' -> Continue 0 (SPSign 1)+          '-' -> Continue 0 $ (SPSign (-1))+          _ -> do+              let num = ord val - 48+              if num >= 0 && num <= 9+              then Partial 0 $ SPAfterSign 1 (intToInteger num)+              else Error $ exitSPInitial $ show val+    step (SPSign multiplier) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            then Partial 0 $ SPAfterSign multiplier (intToInteger num)+            else Error $ exitSPSign $ show val+    step (SPAfterSign multiplier buf) val =+        case val of+            '.' -> Continue 0 $ SPDot multiplier buf+            'e' -> Continue 0 $ SPExponent multiplier buf 0+            'E' -> Continue 0 $ SPExponent multiplier buf 0+            _ ->+                let num = ord val - 48+                 in if num >= 0 && num <= 9+                    then+                        Partial 0+                            $ SPAfterSign multiplier (combineNum buf (intToInteger num))+                    else Done 1 $ exitSPAfterSign multiplier buf+    step (SPDot multiplier buf) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            then Partial 0 $ SPAfterDot multiplier (combineNum buf (intToInteger num)) 1+            else Done 2 $ exitSPAfterSign multiplier buf+    step (SPAfterDot multiplier buf decimalPlaces) val =+        case val of+            'e' -> Continue 0 $ SPExponent multiplier buf decimalPlaces+            'E' -> Continue 0 $ SPExponent multiplier buf decimalPlaces+            _ ->+                let num = ord val - 48+                 in if num >= 0 && num <= 9+                    then+                        Partial 0+                            $ SPAfterDot+                                  multiplier+                                  (combineNum buf (intToInteger num))+                                  (decimalPlaces + 1)+                    else Done 1 $ exitSPAfterDot multiplier buf decimalPlaces+    step (SPExponent multiplier buf decimalPlaces) val =+        case val of+          '+' -> Continue 0 (SPExponentWithSign multiplier buf decimalPlaces 1)+          '-' -> Continue 0 (SPExponentWithSign multiplier buf decimalPlaces (-1))+          _ -> do+              let num = ord val - 48+              if num >= 0 && num <= 9+              then Partial 0 $ SPAfterExponent multiplier buf decimalPlaces 1 num+              else Done 2 $ exitSPAfterDot multiplier buf decimalPlaces+    step (SPExponentWithSign mult buf decimalPlaces powerMult) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            then Partial 0 $ SPAfterExponent mult buf decimalPlaces powerMult num+            else Done 3 $ exitSPAfterDot mult buf decimalPlaces+    step (SPAfterExponent mult num decimalPlaces powerMult buf) val =+        let n = ord val - 48+         in if n >= 0 && n <= 9+            then+                Partial 0+                    $ SPAfterExponent+                          mult num decimalPlaces powerMult (combineNum buf n)+            else+                Done 1+                    $ exitSPAfterExponent mult num decimalPlaces powerMult buf++    {-# INLINE extract #-}+    extract SPInitial = Error $ exitSPInitial "end of input"+    extract (SPSign _) = Error $ exitSPSign "end of input"+    extract (SPAfterSign mult num) = Done 0 $ exitSPAfterSign mult num+    extract (SPDot mult num) = Done 1 $ exitSPAfterSign mult num+    extract (SPAfterDot mult num decimalPlaces) =+        Done 0 $ exitSPAfterDot mult num decimalPlaces+    extract (SPExponent mult num decimalPlaces) =+        Done 1 $ exitSPAfterDot mult num decimalPlaces+    extract (SPExponentWithSign mult num decimalPlaces _) =+        Done 2 $ exitSPAfterDot mult num decimalPlaces+    extract (SPAfterExponent mult num decimalPlaces powerMult powerNum) =+        Done 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum++type MantissaInt = Int+type OverflowPower = Int++{-# ANN type DoubleParseState Fuse #-}+data DoubleParseState+  = DPInitial+  | DPSign !Multiplier+  | DPAfterSign !Multiplier !MantissaInt !OverflowPower+  | DPDot !Multiplier !MantissaInt !OverflowPower+  | DPAfterDot !Multiplier !MantissaInt !OverflowPower+  | DPExponent !Multiplier !MantissaInt !OverflowPower+  | DPExponentWithSign !Multiplier !MantissaInt !OverflowPower !PowerMultiplier+  | DPAfterExponent !Multiplier !MantissaInt !OverflowPower !PowerMultiplier !Power++-- | A fast, custom parser for double precision flaoting point numbers. Returns+-- (mantissa, exponent) tuple. This is much faster than 'number' because it+-- assumes the number will fit in a 'Double' type and uses 'Int' representation+-- to store mantissa. ----- === Examples+-- Number larger than 'Double' may overflow. Int overflow is not checked in the+-- exponent. ----- Examples with behaviour identical to 'read', if you feed an empty--- continuation to the first result:+{-# INLINE doubleParser #-}+doubleParser :: Monad m => Parser Char m (Int, Int)+doubleParser =  Parser (\s a -> return $ step s a) initial (return . extract)++    where++    -- XXX Assuming Int = Int64++    -- Up to 58 bits Int won't overflow+    -- ghci> (2^59-1)*10+9 :: Int+    -- 5764607523034234879+    mask :: Word+    mask = 0x7c00000000000000 -- 58 bits, ignore the sign bit++    {-# INLINE combineNum #-}+    combineNum :: Int -> Int -> Int -> (Int, Int)+    combineNum mantissa power num =+         if fromIntegral mantissa .&. mask == 0+         then (mantissa * 10 + num, power)+         else (mantissa, power + 1)++    {-# INLINE initial #-}+    initial = pure $ IPartial DPInitial++    exitDPInitial msg =+        "number: expecting sign or decimal digit, got " ++ msg+    exitDPSign msg =+        "number: expecting decimal digit, got " ++ msg+    exitDPAfterSign multiplier num opower = (fromIntegral multiplier * num, opower)+    exitDPAfterDot multiplier num opow =+        (fromIntegral multiplier * num , opow)+    exitDPAfterExponent mult num opow powerMult powerNum =+        (fromIntegral mult * num, opow + powerMult * powerNum)++    {-# INLINE step #-}+    step DPInitial val =+        case val of+          '+' -> Continue 0 (DPSign 1)+          '-' -> Continue 0 $ (DPSign (-1))+          _ -> do+              let num = ord val - 48+              if num >= 0 && num <= 9+              then Partial 0 $ DPAfterSign 1 num 0+              else Error $ exitDPInitial $ show val+    step (DPSign multiplier) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            then Partial 0 $ DPAfterSign multiplier num 0+            else Error $ exitDPSign $ show val+    step (DPAfterSign multiplier buf opower) val =+        case val of+            '.' -> Continue 0 $ DPDot multiplier buf opower+            'e' -> Continue 0 $ DPExponent multiplier buf opower+            'E' -> Continue 0 $ DPExponent multiplier buf opower+            _ ->+                let num = ord val - 48+                 in if num >= 0 && num <= 9+                    then+                        let (buf1, power1) = combineNum buf opower num+                         in Partial 0+                            $ DPAfterSign multiplier buf1 power1+                    else Done 1 $ exitDPAfterSign multiplier buf opower+    step (DPDot multiplier buf opower) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            then+                let (buf1, power1) = combineNum buf opower num+                 in Partial 0 $ DPAfterDot multiplier buf1 (power1 - 1)+            else Done 2 $ exitDPAfterSign multiplier buf opower+    step (DPAfterDot multiplier buf opower) val =+        case val of+            'e' -> Continue 0 $ DPExponent multiplier buf opower+            'E' -> Continue 0 $ DPExponent multiplier buf opower+            _ ->+                let num = ord val - 48+                 in if num >= 0 && num <= 9+                    then+                        let (buf1, power1) = combineNum buf opower num+                         in Partial 0 $ DPAfterDot multiplier buf1 (power1 - 1)+                    else Done 1 $ exitDPAfterDot multiplier buf opower+    step (DPExponent multiplier buf opower) val =+        case val of+          '+' -> Continue 0 (DPExponentWithSign multiplier buf opower 1)+          '-' -> Continue 0 (DPExponentWithSign multiplier buf opower (-1))+          _ -> do+              let num = ord val - 48+              if num >= 0 && num <= 9+              then Partial 0 $ DPAfterExponent multiplier buf opower 1 num+              else Done 2 $ exitDPAfterDot multiplier buf opower+    step (DPExponentWithSign mult buf opower powerMult) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            then Partial 0 $ DPAfterExponent mult buf opower powerMult num+            else Done 3 $ exitDPAfterDot mult buf opower+    step (DPAfterExponent mult num opower powerMult buf) val =+        let n = ord val - 48+         in if n >= 0 && n <= 9+            then+                Partial 0+                    $ DPAfterExponent mult num opower powerMult (buf * 10 + n)+            else Done 1 $ exitDPAfterExponent mult num opower powerMult buf++    {-# INLINE extract #-}+    extract DPInitial = Error $ exitDPInitial "end of input"+    extract (DPSign _) = Error $ exitDPSign "end of input"+    extract (DPAfterSign mult num opow) = Done 0 $ exitDPAfterSign mult num opow+    extract (DPDot mult num opow) = Done 1 $ exitDPAfterSign mult num opow+    extract (DPAfterDot mult num opow) =+        Done 0 $ exitDPAfterDot mult num opow+    extract (DPExponent mult num opow) =+        Done 1 $ exitDPAfterDot mult num opow+    extract (DPExponentWithSign mult num opow _) =+        Done 2 $ exitDPAfterDot mult num opow+    extract (DPAfterExponent mult num opow powerMult powerNum) =+        Done 0 $ exitDPAfterExponent mult num opow powerMult powerNum++-- XXX We can have a `realFloat` parser instead to parse any RealFloat value.+-- And a integral parser to read any integral value.++-- XXX This is very expensive, takes much more time than the rest of the+-- parsing. Need to look into fromRational.++-- | @mkDouble mantissa exponent@ converts a mantissa and exponent to a+-- 'Double' value equivalent to @mantissa * 10^exponent@. It does not check for+-- overflow, powers more than 308 will overflow.+{-# INLINE mkDouble #-}+mkDouble :: Integer -> Int -> Double+mkDouble mantissa power =+    if power > 0+    then fromRational ((mantissa * 10 ^ power) % 1)+    else fromRational (mantissa % 10 ^ (-power))++-- | Parse a decimal 'Double' value. This parser accepts an optional sign (+ or+-- -) followed by at least one decimal digit. Decimal digits are optionally+-- followed by a decimal point and at least one decimal digit after the point.+-- This parser accepts the maximal valid input as long as it gives a valid+-- number. Specifcally a trailing decimal point is allowed but not consumed.+-- This function does not accept \"NaN\" or \"Infinity\" string representations+-- of double values. ----- > IS.parse double (IS.fromList "3")     == 3.0--- > IS.parse double (IS.fromList "3.1")   == 3.1--- > IS.parse double (IS.fromList "3e4")   == 30000.0--- > IS.parse double (IS.fromList "3.1e4") == 31000.0--- > IS.parse double (IS.fromList "3e")    == 30+-- Definition: ----- Examples with behaviour identical to 'read':+-- >>> double = uncurry Unicode.mkDouble <$> Unicode.number ----- > IS.parse (IS.fromList ".3")    == error "Parse failed"--- > IS.parse (IS.fromList "e3")    == error "Parse failed"+-- Examples: ----- Example of difference from 'read':+-- >>> p = Stream.parse Unicode.double . Stream.fromList ----- > IS.parse double (IS.fromList "3.foo") == 3.0+-- >>> p "-1.23e-123"+-- Right (-1.23e-123) ----- This function does not accept string representations of \"NaN\" or--- \"Infinity\".+-- Trailing input examples: ----- /Unimplemented/-double :: Parser Char m Double-double = undefined+-- >>> p "1."+-- Right 1.0+--+-- >>> p "1.2.3"+-- Right 1.2+--+-- >>> p "1e"+-- Right 1.0+--+-- >>> p "1e2.3"+-- Right 100.0+--+-- >>> p "1+2"+-- Right 1.0+--+-- Error cases:+--+-- >>> p ""+-- Left (ParseError "number: expecting sign or decimal digit, got end of input")+--+-- >>> p ".1"+-- Left (ParseError "number: expecting sign or decimal digit, got '.'")+--+-- >>> p "+"+-- Left (ParseError "number: expecting decimal digit, got end of input")+--+{-# INLINE double #-}+double :: Monad m => Parser Char m Double+double = fmap (\(m,e) -> mkDouble (fromIntegral m) e) doubleParser
src/Streamly/Internal/Unicode/Stream.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.Stream -- Copyright   : (c) 2018 Composewell Technologies@@ -11,6 +12,12 @@  module Streamly.Internal.Unicode.Stream     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Construction (Decoding)       decodeLatin1 @@ -102,13 +109,14 @@ import GHC.Ptr (Ptr (..), plusPtr) import System.IO.Unsafe (unsafePerformIO) import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Array.Mut.Type (MutableByteArray)+import Streamly.Internal.Data.MutArray.Type (MutByteArray) import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamD (Step (..))+import Streamly.Internal.Data.Parser (Parser)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream (Step (..)) import Streamly.Internal.Data.SVar.Type (adaptState) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unboxed (peekWith)+import Streamly.Internal.Data.Unbox (Unbox(peekAt)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) @@ -116,20 +124,13 @@ import qualified Streamly.Data.Unfold as Unfold import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Parser as Parser (Parser)-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Parser as ParserD+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D  import Prelude hiding (lines, words, unlines, unwords) --- $setup--- >>> :m--- >>> :set -XMagicHash--- >>> import Prelude hiding (lines, words, unlines, unwords)--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Unicode.Stream as Unicode--- >>> import Streamly.Internal.Unicode.Stream+#include "DocTestUnicodeStream.hs"  ------------------------------------------------------------------------------- -- Latin1 decoding@@ -523,8 +524,8 @@ -- workflow requires backtracking 1 element. This can be revisited once "Fold" -- supports backtracking. {-# INLINE writeCharUtf8' #-}-writeCharUtf8' :: Monad m => Fold m Word8 Char-writeCharUtf8' =  ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)+writeCharUtf8' :: Monad m => Parser Word8 m Char+writeCharUtf8' =  parseCharUtf8WithD ErrorOnCodingFailure  -- XXX The initial idea was to have "parseCharUtf8" and offload the error -- handling to another parser. So, say we had "parseCharUtf8'",@@ -556,7 +557,7 @@      where -    prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "+    prefix = "Streamly.Internal.Data.Stream.decodeUtf8With: "      {-# INLINE handleError #-}     handleError e s =@@ -684,9 +685,9 @@ #endif data FlattenState s     = OuterLoop s !(Maybe (DecodeState, CodePoint))-    | InnerLoopDecodeInit s MutableByteArray !Int !Int-    | InnerLoopDecodeFirst s MutableByteArray !Int !Int Word8-    | InnerLoopDecoding s MutableByteArray !Int !Int+    | InnerLoopDecodeInit s MutByteArray !Int !Int+    | InnerLoopDecodeFirst s MutByteArray !Int !Int Word8+    | InnerLoopDecoding s MutByteArray !Int !Int         !DecodeState !CodePoint     | YAndC !Char (FlattenState s)   -- These constructors can be                                      -- encoded in the UTF8DecodeState@@ -720,7 +721,7 @@         case cfm of             ErrorOnCodingFailure ->                 error $-                show "Streamly.Internal.Data.Stream.StreamD."+                show "Streamly.Internal.Data.Stream."                 ++ "decodeUtf8ArraysWith: Input Underflow"             TransliterateCodingFailure -> YAndC replacementChar D             DropOnCodingFailure -> D@@ -745,7 +746,7 @@         | p == end = do             return $ Skip $ OuterLoop st Nothing     step' _ _ (InnerLoopDecodeInit st contents p end) = do-        x <- liftIO $ peekWith contents p+        x <- liftIO $ peekAt p contents         -- Note: It is important to use a ">" instead of a "<=" test here for         -- GHC to generate code layout for default branch prediction for the         -- common case. This is fragile and might change with the compiler@@ -769,7 +770,7 @@                     Skip $                     transliterateOrError                         (-                           "Streamly.Internal.Data.Stream.StreamD."+                           "Streamly.Internal.Data.Stream."                         ++ "decodeUtf8ArraysWith: Invalid UTF8"                         ++ " codepoint encountered"                         )@@ -779,7 +780,7 @@     step' _ _ (InnerLoopDecoding st _ p end sv cp)         | p == end = return $ Skip $ OuterLoop st (Just (sv, cp))     step' table _ (InnerLoopDecoding st contents p end statePtr codepointPtr) = do-        x <- liftIO $ peekWith contents p+        x <- liftIO $ peekAt p contents         let (Tuple' sv cp) = decode1 table statePtr codepointPtr x         return $             case sv of@@ -792,7 +793,7 @@                     Skip $                     transliterateOrError                         (-                           "Streamly.Internal.Data.Stream.StreamD."+                           "Streamly.Internal.Data.Stream."                         ++ "decodeUtf8ArraysWith: Invalid UTF8"                         ++ " codepoint encountered"                         )@@ -1026,7 +1027,7 @@ -- | Fold each line of the stream using the supplied 'Fold' -- and stream the result. ----- >>> Stream.fold Fold.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")+-- >>> Stream.fold Fold.toList $ Unicode.lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n") -- ["lines","this","string","",""] -- -- > lines = Stream.splitOnSuffix (== '\n')@@ -1057,7 +1058,7 @@ -- | Fold each word of the stream using the supplied 'Fold' -- and stream the result. ----- >>>  Stream.fold Fold.toList $ words Fold.toList (Stream.fromList "fold these     words")+-- >>>  Stream.fold Fold.toList $ Unicode.words Fold.toList (Stream.fromList "fold these     words") -- ["fold","these","words"] -- -- > words = Stream.wordsBy isSpace
src/Streamly/Internal/Unicode/String.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.String -- Copyright   : (c) 2022 Composewell Technologies@@ -31,7 +32,14 @@ -- using Haskell functions.  module Streamly.Internal.Unicode.String-    ( str+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    str     ) where  @@ -49,11 +57,8 @@ import qualified Streamly.Data.Stream as Stream  (fromList, parse) import qualified Streamly.Internal.Unicode.Parser as Parser --- $setup--- >>> :m--- >>> :set -XQuasiQuotes--- >>> import Streamly.Internal.Unicode.String---+#include "DocTestUnicodeString.hs"+ -------------------------------------------------------------------------------- -- Parsing --------------------------------------------------------------------------------
src/Streamly/Unicode/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Unicode.Parser -- Copyright   : (c) 2021 Composewell Technologies@@ -12,9 +13,15 @@  module Streamly.Unicode.Parser     (-     -- * Single Chars+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup -     -- Any char+    -- * Single Chars++    -- Any char       char     , charIgnoreCase @@ -50,6 +57,7 @@     -- * Digit Sequences (Numbers)     , decimal     , hexadecimal+    , double      -- * Modifiers     , signed@@ -57,3 +65,5 @@ where  import Streamly.Internal.Unicode.Parser++#include "DocTestUnicodeParser.hs"
src/Streamly/Unicode/Stream.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Unicode.Stream -- Copyright   : (c) 2020 Composewell Technologies@@ -24,14 +25,11 @@ -- routines in this module and then written to IO devices or to arrays in -- memory. ----- If you have to store a 'Char' stream in memory you can convert it into a--- 'String' using 'Streamly.Data.Fold.toList' fold. The 'String' type can be--- more efficient than pinned arrays for short and short lived strings.------ For longer or long lived streams you can 'Streamly.Data.Stream.fold' the+-- If you have to store a 'Char' stream in memory you can+-- 'Streamly.Data.Stream.fold' the -- 'Char' stream as @Array Char@ using the array 'Streamly.Data.Array.write'--- fold.  The 'Array' type provides a more compact representation and pinned--- memory reducing GC overhead. If space efficiency is a concern you can use+-- fold.  The 'Array' type provides a more compact representation+-- reducing GC overhead. If space efficiency is a concern you can use -- 'encodeUtf8'' on the 'Char' stream before writing it to an 'Array' providing -- an even more compact representation. --@@ -69,12 +67,15 @@ -- Some experimental APIs to conveniently process text using the -- @Array Char@ represenation directly can be found in -- "Streamly.Internal.Unicode.Array".---- XXX an unpinned array representation can be useful to store short and short--- lived strings in memory. -- module Streamly.Unicode.Stream     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Construction (Decoding)       decodeLatin1     , decodeUtf8@@ -105,3 +106,5 @@  import Streamly.Internal.Unicode.Stream import Prelude hiding (lines, words, unlines, unwords)++#include "DocTestUnicodeStream.hs"
src/Streamly/Unicode/String.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Unicode.String -- Copyright   : (c) 2022 Composewell Technologies@@ -7,10 +8,23 @@ -- Portability : GHC -- -- Convenient template Haskell quasiquoters to format strings.+--+-- The 'str' quasiquoter retains newlines in the string when the line is split+-- across multiple lines. The @unwords . lines@ idiom can be used on the+-- resulting string to collapse it into a single line.  module Streamly.Unicode.String-    ( str+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    str     ) where  import Streamly.Internal.Unicode.String++#include "DocTestUnicodeString.hs"
streamly-core.cabal view
@@ -1,8 +1,11 @@ cabal-version:      2.2 name:               streamly-core-version:            0.1.0+version:            0.2.0 synopsis:           Streaming, parsers, arrays and more description:+  For upgrading to streamly-0.9.0+ please read the+  <https://github.com/composewell/streamly/blob/streamly-0.10.0/docs/User/Project/Upgrading-0.8-to-0.9.md Streamly-0.9.0 upgrade guide>.+  .   Streamly consists of two packages: "streamly-core" and "streamly".   <https://hackage.haskell.org/package/streamly-core streamly-core>   provides basic features, and depends only on GHC boot libraries (see@@ -27,8 +30,10 @@                    , GHC==8.8.4                    , GHC==8.10.7                    , GHC==9.0.2-                   , GHC==9.2.7-                   , GHC==9.4.4+                   , GHC==9.2.8+                   , GHC==9.4.7+                   , GHC==9.6.3+                   , GHC==9.8.1 author:              Composewell Technologies maintainer:          streamly@composewell.com copyright:           2017 Composewell Technologies@@ -48,9 +53,14 @@     src/DocTestDataMutArray.hs     src/DocTestDataMutArrayGeneric.hs     src/DocTestDataParser.hs+    src/DocTestDataParserK.hs     src/DocTestDataStream.hs     src/DocTestDataStreamK.hs     src/DocTestDataUnfold.hs+    src/DocTestUnicodeParser.hs+    src/DocTestUnicodeStream.hs+    src/DocTestUnicodeString.hs+    src/DocTestFileSystemHandle.hs      -- This is duplicated     src/Streamly/Internal/Data/Array/ArrayMacros.h@@ -70,6 +80,7 @@     Changelog.md     docs/*.md     docs/ApiChangelogs/0.1.0.txt+    docs/ApiChangelogs/0.1.0-0.2.0.txt  source-repository head     type: git@@ -90,16 +101,6 @@   manual: True   default: False -flag no-fusion-  description: Disable rewrite rules for stream fusion-  manual: True-  default: False--flag use-c-malloc-  description: Use C malloc instead of GHC malloc-  manual: True-  default: False- flag opt   description: off=GHC default, on=-O2   manual: True@@ -132,9 +133,6 @@ common compile-options     default-language: Haskell2010 -    if flag(no-fusion)-      cpp-options:    -DDISABLE_FUSION-     if flag(dev)       cpp-options:    -DDEVBUILD @@ -144,9 +142,6 @@     if flag(use-folds)       cpp-options:    -DUSE_FOLDS_EVERYWHERE -    if flag(use-c-malloc)-      cpp-options:    -DUSE_C_MALLOC-     ghc-options:    -Weverything                     -Wno-implicit-prelude                     -Wno-missing-deriving-strategies@@ -167,6 +162,10 @@         -Wno-redundant-bang-patterns         -Wno-operator-whitespace +    if impl(ghc >= 9.8)+      ghc-options:+        -Wno-missing-role-annotations+     if flag(has-llvm)       ghc-options: -fllvm @@ -226,6 +225,7 @@    -- For this to be effective it must come after the -O2 option   if flag(dev) || flag(debug) || !flag(opt)+    cpp-options: -DDEBUG     ghc-options: -fno-ignore-asserts  common threading-options@@ -289,81 +289,46 @@                      -- streamly-time                      , Streamly.Internal.Data.Time.TimeSpec                      , Streamly.Internal.Data.Time.Units-                     , Streamly.Internal.Data.Time.Clock.Type                      , Streamly.Internal.Data.Time.Clock                       -- streamly-core-stream-types                      , Streamly.Internal.Data.SVar.Type-                     , Streamly.Internal.Data.Stream.StreamK.Type-                     , Streamly.Internal.Data.Fold.Step                      , Streamly.Internal.Data.Refold.Type-                     , Streamly.Internal.Data.Fold.Type-                     , Streamly.Internal.Data.Stream.StreamD.Step-                     , Streamly.Internal.Data.Stream.StreamD.Type-                     , Streamly.Internal.Data.Unfold.Type-                     , Streamly.Internal.Data.Producer.Type                      , Streamly.Internal.Data.Producer-                     , Streamly.Internal.Data.Producer.Source-                     , Streamly.Internal.Data.Parser.ParserK.Type-                     , Streamly.Internal.Data.Parser.ParserD.Type-                     , Streamly.Internal.Data.Pipe.Type                       -- streamly-core-array-types-                     , Streamly.Internal.Data.Unboxed-                    -- Unboxed IORef-                     , Streamly.Internal.Data.IORef.Unboxed+                     , Streamly.Internal.Data.MutByteArray++                     -- streaming and parsing Haskell types to/from bytes+                     , Streamly.Internal.Data.Binary.Parser+                     , Streamly.Internal.Data.Binary.Stream+                      -- May depend on streamly-core-stream-                     , Streamly.Internal.Data.Array.Mut.Type-                     , Streamly.Internal.Data.Array.Mut-                     , Streamly.Internal.Data.Array.Type-                     , Streamly.Internal.Data.Array.Generic.Mut.Type+                     , Streamly.Internal.Data.MutArray+                     , Streamly.Internal.Data.MutArray.Generic                       -- streamly-core-streams-                     , Streamly.Internal.Data.Stream.StreamK+                     , Streamly.Internal.Data.StreamK                      -- StreamD depends on streamly-array-types-                     , Streamly.Internal.Data.Stream.StreamD.Generate-                     , Streamly.Internal.Data.Stream.StreamD.Eliminate-                     , Streamly.Internal.Data.Stream.StreamD.Nesting-                     , Streamly.Internal.Data.Stream.StreamD.Transform-                     , Streamly.Internal.Data.Stream.StreamD.Exception-                     , Streamly.Internal.Data.Stream.StreamD.Lift-                     , Streamly.Internal.Data.Stream.StreamD.Top                      , Streamly.Internal.Data.Stream.StreamD-                     , Streamly.Internal.Data.Stream.Common                      , Streamly.Internal.Data.Stream -                     , Streamly.Internal.Data.Parser.ParserD.Tee-                     , Streamly.Internal.Data.Parser.ParserD-                      -- streamly-core-data                      , Streamly.Internal.Data.Builder                      , Streamly.Internal.Data.Unfold-                     , Streamly.Internal.Data.Unfold.Enumeration-                     , Streamly.Internal.Data.Fold.Tee-                     , Streamly.Internal.Data.Fold                      , Streamly.Internal.Data.Fold.Chunked-                     , Streamly.Internal.Data.Fold.Window                      , Streamly.Internal.Data.Parser+                     , Streamly.Internal.Data.ParserK                      , Streamly.Internal.Data.Pipe -                     -- streamly-transformers (non-base)-                     , Streamly.Internal.Data.Stream.StreamD.Transformer-                     , Streamly.Internal.Data.Stream.StreamK.Transformer-                      -- streamly-containers (non-base)-                     , Streamly.Internal.Data.Stream.StreamD.Container-                     , Streamly.Internal.Data.Fold.Container--                     , Streamly.Internal.Data.Stream.Chunked+                     , Streamly.Internal.Data.Fold                       -- streamly-core-data-arrays                      , Streamly.Internal.Data.Array.Generic                      , Streamly.Internal.Data.Array-                     , Streamly.Internal.Data.Array.Mut.Stream--                     -- streamly-serde-                     , Streamly.Internal.Serialize.FromBytes-                     , Streamly.Internal.Serialize.ToBytes+                     , Streamly.Internal.Data.MutArray.Stream+                     , Streamly.Internal.Data.Array.Stream                      -- streamly-unicode-core                      , Streamly.Internal.Unicode.Stream@@ -377,8 +342,8 @@                      , Streamly.Internal.FileSystem.Dir                      -- Ring Arrays-                     , Streamly.Internal.Data.Ring.Unboxed                      , Streamly.Internal.Data.Ring+                     , Streamly.Internal.Data.Ring.Generic                       -- streamly-console                      , Streamly.Internal.Console.Stdio@@ -409,6 +374,7 @@                      -- streamly-core released modules in alphabetic order                      -- NOTE: these must be added to streamly.cabal as well                      , Streamly.Console.Stdio+                     , Streamly.Data.MutByteArray                      , Streamly.Data.Array                      , Streamly.Data.Array.Generic                      , Streamly.Data.MutArray@@ -425,27 +391,64 @@                      , Streamly.Unicode.Parser                      , Streamly.Unicode.Stream                      , Streamly.Unicode.String+    other-modules:+                      Streamly.Internal.Data.Fold.Step+                    , Streamly.Internal.Data.Fold.Type+                    , Streamly.Internal.Data.Fold.Combinators+                    , Streamly.Internal.Data.Fold.Container+                    , Streamly.Internal.Data.Fold.Tee+                    , Streamly.Internal.Data.Fold.Window +                    , Streamly.Internal.Data.Parser.Type+                    , Streamly.Internal.Data.Parser.Tee+                    , Streamly.Internal.Data.ParserK.Type++                    , Streamly.Internal.Data.Stream.Container+                    , Streamly.Internal.Data.Stream.Eliminate+                    , Streamly.Internal.Data.Stream.Exception+                    , Streamly.Internal.Data.Stream.Generate+                    , Streamly.Internal.Data.Stream.Lift+                    , Streamly.Internal.Data.Stream.Nesting+                    , Streamly.Internal.Data.Stream.Step+                    , Streamly.Internal.Data.Stream.Top+                    , Streamly.Internal.Data.Stream.Transform+                    , Streamly.Internal.Data.Stream.Transformer+                    , Streamly.Internal.Data.Stream.Type++                    , Streamly.Internal.Data.StreamK.Type+                    , Streamly.Internal.Data.StreamK.Transformer++                    , Streamly.Internal.Data.Pipe.Type++                    , Streamly.Internal.Data.Unfold.Type+                    , Streamly.Internal.Data.Unfold.Enumeration++                    , Streamly.Internal.Data.MutArray.Type++                    , Streamly.Internal.Data.Array.Type++                    -- Unboxed IORef+                    , Streamly.Internal.Data.IORef.Unboxed++                    , Streamly.Internal.Data.MutByteArray.Type+                    , Streamly.Internal.Data.Unbox+                    , Streamly.Internal.Data.Unbox.TH+                    , Streamly.Internal.Data.Serialize.Type+                    , Streamly.Internal.Data.Serialize.TH+                    , Streamly.Internal.Data.Serialize.TH.RecHeader+                    , Streamly.Internal.Data.Serialize.TH.Common+                    , Streamly.Internal.Data.Serialize.TH.Bottom++                    , Streamly.Internal.Data.Producer.Type+                    , Streamly.Internal.Data.Producer.Source++                    , Streamly.Internal.Data.Time.Clock.Type+     if flag(dev)       exposed-modules:-                        Streamly.Internal.Data.Stream.StreamK.Alt-                      , Streamly.Internal.Data.Stream.Type-                      , Streamly.Internal.Data.Stream.Eliminate-                      , Streamly.Internal.Data.Stream.Enumerate-                      , Streamly.Internal.Data.Stream.Generate-                      , Streamly.Internal.Data.Stream.Transform-                      , Streamly.Internal.Data.Stream.Bottom-                      , Streamly.Internal.Data.Stream.Exception-                      , Streamly.Internal.Data.Stream.Expand-                      , Streamly.Internal.Data.Stream.Lift-                      , Streamly.Internal.Data.Stream.Reduce-                      , Streamly.Internal.Data.Stream.Transformer-                      , Streamly.Internal.Data.Stream.StreamDK-                      , Streamly.Internal.Data.Stream.Zip-                      , Streamly.Internal.Data.Stream.Cross-                      , Streamly.Internal.Data.List-                      , Streamly.Data.Stream.Zip-                      --, Streamly.Internal.Data.Parser.ParserDK+                        Streamly.Internal.Data.StreamK.Alt+                        -- XXX Compilation needs to be fixed+                      -- , Streamly.Internal.Data.List      build-depends:                     -- streamly-base@@ -459,21 +462,33 @@                     -- packages depending on the "ghc" package (packages                     -- depending on doctest is a common example) can                     -- depend on streamly.-                       ghc-prim          >= 0.5.3 && < 0.10+                       ghc-prim          >= 0.5.3 && < 0.12                      , fusion-plugin-types >= 0.1 && < 0.2-                     , base              >= 4.12  && < 4.19+                     , base              >= 4.12  && < 4.20                      , exceptions        >= 0.8.0 && < 0.11                      , transformers      >= 0.5.5 && < 0.7                      , filepath          >= 1.4.2 && < 1.5                      -- streamly-unicode-core-                     , template-haskell  >= 2.14  && < 2.20+                     , template-haskell  >= 2.14  && < 2.22                       -- streamly-filesystem-core                      , directory         >= 1.3.3 && < 1.4                       -- XXX to be removed-                     , containers        >= 0.6.0 && < 0.7+                     , containers        >= 0.6.0 && < 0.8                      , heaps             >= 0.3   && < 0.5++    if impl(ghc >= 9.0)+      build-depends:  ghc-bignum >= 1.0  && < 2+    else+      build-depends:  integer-gmp >= 1.0 && < 1.2+     if !flag(use-unliftio)       build-depends:   monad-control     >= 1.0 && < 1.1++    if os(linux) || os (darwin)+      build-depends: unix              >= 2.7.0 && < 2.9++    if os(windows)+      build-depends: Win32            >= 2.6 && < 2.14