packages feed

streamly-core 0.2.3 → 0.3.0

raw patch · 169 files changed

+44066/−19121 lines, 169 filesdep −directorydep −unixdep ~Win32dep ~basedep ~containers

Dependencies removed: directory, unix

Dependency ranges changed: Win32, base, containers, template-haskell

Files

Changelog.md view
@@ -1,9 +1,66 @@ # Changelog -## 0.2.3 (Feb 2025)+## 0.3.0 -* Fix breakOn/lines in the Array module.-* Support GHC 9.12+See [0.2.2-0.3.0 API Changelog](/core/docs/ApiChangelogs/0.2.2-0.3.0.txt) for a+full list of deprecations, additions, and changes to the function signatures.++### Enhancements++* Added APIs for prompt cleanup of resources, allowing guaranteed+  cleanup as an alternative to GC-based cleanup.+* Added operations for fair nesting of inner and outer streams for+  exploring them equally, generally useful but especially useful for logic+  programming use cases.+* Introduced `Streamly.Data.Scanl` with a new `Scanl` type. Scans can+  split a stream into multiple streams, process them independently, and+  merge the results. The `Fold` type is now split into `Fold` and `Scanl`.+* Added `RingArray` module for high-performance, unboxed circular buffers.+* Added `Streamly.FileSystem.Path` module with a `Path` type for flexibly typed+  file system paths.+* Added `Streamly.FileSystem.DirIO` and `Streamly.FileSystem.FileIO` to replace+  the deprecated `Streamly.FileSystem.Dir` and `Streamly.FileSystem.File`. The+  new modules use Streamly’s native `Path` type instead of `FilePath`. `DirIO`+  APIs take a `ReadOptions` argument, and its directory read APIs do not follow+  symlinks by default.+* Removed `Storable` constraint from:+  - `Streamly.Data.Stream.isInfixOf`+  - `Streamly.Data.Array.writeLastN`++### Deprecations++Following APIs/modules are deprecated and renamed or replaced with new+APIs.++* `Streamly.FileSystem.Dir`, `Streamly.FileSystem.File` have been replaced by+  new modules.+* Renamed `writeN`-like APIs to `createOf`-like in Array modules.+* Renamed `new`-like APIs to `emptyOf`-like in Array modules.+* In the Fold module renamed `indexGeneric`, `lengthGeneric`, and `foldlM1'` to+  `genericIndex`, `genericLength`, and `foldl1M'` respectively.++### Internal API Changes++* In `Streamly.Internal.Data.Parser`, constructors `Partial`, `Continue`, and+  `Done` are deprecated and replaced with `SPartial`, `SContinue`, and `SDone`.+  Migration steps:+  * In parser step functions:+    - `Partial n` -> `SPartial (1-n)`+    - `Continue n` -> `SContinue (1-n)`+    - `Done n` -> `SDone (1-n)`+    - `Error` -> `SError`+  * Extract function now returns `Parser.Final` (instead of `Parser.Step`):+    - `Continue n` -> `FContinue (-n)`+    - `Done n` -> `FDone (-n)`+    - `Partial n` -> `FContinue (-n)`+    - `Error` -> `FError`+  * If `n` is used for decision-making, the logic must be updated accordingly.+    See docs for details.+* Internal (mut)array functions now use explicit IO callbacks instead of lifted+  callbacks.+* Removed `Storable` constraint from several ring buffer functions.+* Added `Streamly.Internal.Data.IORef` module exposing `IORef` and related+  functions.  ## 0.2.2 (Jan 2024)
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.2.3.+# Generated by GNU Autoconf 2.71 for streamly-core 0.3.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.2.3'-PACKAGE_STRING='streamly-core 0.2.3'+PACKAGE_VERSION='0.3.0'+PACKAGE_STRING='streamly-core 0.3.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.2.3 to adapt to many kinds of systems.+\`configure' configures streamly-core 0.3.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.2.3:";;+     short | recursive ) echo "Configuration of streamly-core 0.3.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.2.3+streamly-core configure 0.3.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.2.3, which was+It was created by streamly-core $as_me 0.3.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.2.3, which was+This file was extended by streamly-core $as_me 0.3.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.2.3+streamly-core config.status 0.3.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.2.3], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])+AC_INIT([streamly-core], [0.3.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.2.2-0.2.3.txt 
@@ -1,28 +0,0 @@-----------------------------------API Annotations------------------------------------[A] : Added-[R] : Removed-[C] : Changed-[O] : Old definition-[N] : New definition-[D] : Deprecated------------------------------------API diff------------------------------------------------------------------------Internal API diff------------------------------------[C] Streamly.Internal.Data.MutByteArray-    [D] unsafePinnedAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b-[C] Streamly.Internal.Data.MutArray-    [D] unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-    [D] memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-    [D] memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool-    [D] c_memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)
+ docs/ApiChangelogs/0.2.2-0.3.0.txt view
@@ -0,0 +1,1889 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Unicode.Stream+    [A] encodeUtf16le' :: Monad m => Stream m Char -> Stream m Word16+    [A] encodeUtf16le :: Monad m => Stream m Char -> Stream m Word16+    [A] decodeUtf16le' :: Monad m => Stream m Word16 -> Stream m Char+    [A] decodeUtf16le :: Monad m => Stream m Word16 -> Stream m Char+[A] Streamly.FileSystem.Path+    [A] EqCfg+    [A] type Path = PosixPath+    [A] type OsWord = Word8+    [A] validatePath :: MonadThrow m => Array OsWord -> m ()+    [A] unsafeJoin :: Path -> Path -> Path+    [A] toString :: Path -> [Char]+    [A] toArray :: Path -> Array OsWord+    [A] takeFileName :: Path -> Maybe Path+    [A] takeFileBase :: Path -> Maybe Path+    [A] takeExtension :: Path -> Maybe Path+    [A] takeDirectory :: Path -> Maybe Path+    [A] splitRoot :: Path -> Maybe (Path, Maybe Path)+    [A] splitPath :: Monad m => Path -> Stream m Path+    [A] splitFile :: Path -> Maybe (Maybe Path, Path)+    [A] splitExtension :: Path -> Maybe (Path, Path)+    [A] pathE :: String -> Q Exp+    [A] path :: QuasiQuoter+    [A] joinStr :: Path -> [Char] -> Path+    [A] join :: Path -> Path -> Path+    [A] isUnrooted :: Path -> Bool+    [A] isRooted :: Path -> Bool+    [A] ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg+    [A] ignoreCase :: Bool -> EqCfg -> EqCfg+    [A] fromString_ :: [Char] -> Path+    [A] fromString :: MonadThrow m => [Char] -> m Path+    [A] fromArray :: MonadThrow m => Array OsWord -> m Path+    [A] eqPath :: (EqCfg -> EqCfg) -> Path -> Path -> Bool+    [A] dropExtension :: Path -> Path+    [A] allowRelativeEquality :: Bool -> EqCfg -> EqCfg+[C] Streamly.FileSystem.Handle+    [C] writeChunks+        [O] writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()+        [N] writeChunks :: forall m (a :: Type). MonadIO m => Handle -> Fold m (Array a) ()+    [C] putChunk+        [O] putChunk :: MonadIO m => Handle -> Array a -> m ()+        [N] putChunk :: forall m (a :: Type). MonadIO m => Handle -> Array a -> m ()+[A] Streamly.FileSystem.FileIO+    [A] writeWith :: (MonadIO m, MonadCatch m) => Int -> Path -> Fold m Word8 ()+    [A] writeChunks :: (MonadIO m, MonadCatch m) => Path -> Fold m (Array a) ()+    [A] write :: (MonadIO m, MonadCatch m) => Path -> Fold m Word8 ()+    [A] withFile :: (MonadIO m, MonadCatch m) => Path -> IOMode -> (Handle -> Stream m a) -> Stream m a+    [A] readChunksWith :: (MonadIO m, MonadCatch m) => Int -> Path -> Stream m (Array Word8)+    [A] readChunks :: (MonadIO m, MonadCatch m) => Path -> Stream m (Array Word8)+    [A] read :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8+[D] Streamly.FileSystem.File+    [C] writeChunks+        [O] writeChunks :: (MonadIO m, MonadCatch m) => FilePath -> Fold m (Array a) ()+        [N] writeChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m) => FilePath -> Fold m (Array a) ()+[A] Streamly.FileSystem.DirIO+    [A] ReadOptions+    [A] readEither :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Path -> Stream m (Either Path Path)+    [A] read :: (MonadIO m, MonadCatch m) => Path -> Stream m Path+    [A] ignoreSymlinkLoops :: Bool -> ReadOptions -> ReadOptions+    [A] ignoreMissing :: Bool -> ReadOptions -> ReadOptions+    [A] ignoreInaccessible :: Bool -> ReadOptions -> ReadOptions+    [A] followSymlinks :: Bool -> ReadOptions -> ReadOptions+[D] Streamly.FileSystem.Dir+[C] Streamly.Data.Unfold+    [A] unfoldEach :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c+    [D] many :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c+    [A] carry :: Functor m => Unfold m a b -> Unfold m a (a, b)+[C] Streamly.Data.StreamK+    [A] toParserK :: Monad m => Parser a m b -> ParserK a m b+    [A] toList :: Monad m => StreamK m a -> m [a]+    [A] parsePos :: Monad m => ParserK a m b -> StreamK m a -> m (Either ParseErrorPos b)+    [D] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakPos :: forall m a b. Monad m => ParserK a m b -> StreamK m a -> m (Either ParseErrorPos b, StreamK m a)+    [D] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] filter :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] fairConcatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] fairConcatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] fairConcatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] concatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] concatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] concatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] bfsConcatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] bfsConcatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] bfsConcatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+[C] Streamly.Data.Stream+    [A] unionBy :: MonadIO m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [D] unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldEachSepBySeq :: Monad m => b -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEachEndBySeq :: Monad m => b -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] splitSepBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitSepBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [D] splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] scanl :: Monad m => Scanl m a b -> Stream m a -> Stream m b+    [D] scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b+    [D] scan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] postscanl :: Monad m => Scanl m a b -> Stream m a -> Stream m b+    [D] postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] parsePos :: Monad m => Parser a m b -> Stream m a -> m (Either ParseErrorPos b)+    [A] parseBreakPos :: Monad m => Parser a m b -> Stream m a -> m (Either ParseErrorPos b, Stream m a)+    [A] parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+    [A] isInfixOf :: (MonadIO m, Eq a, Enum a, Unbox a) => Stream m a -> Stream m a -> m Bool+    [D] intercalateSuffix :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [D] intercalate :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] finallyIO'' :: (MonadIO m, MonadCatch m) => AcquireIO -> IO b -> Stream m a -> Stream m a+    [A] finallyIO' :: MonadIO m => AcquireIO -> IO b -> Stream m a -> Stream m a+    [A] fairUnfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] fairCross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+    [A] fairConcatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+    [A] fairConcatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+    [A] fairConcatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+    [A] cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+    [A] concatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+    [A] concatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+    [D] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] bracketIO'' :: (MonadIO m, MonadCatch m) => AcquireIO -> IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+    [A] bracketIO' :: MonadIO m => AcquireIO -> IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+    [A] bfsUnfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+[A] Streamly.Data.Scanl+    [A] Scanl+    [A] unzip :: Monad m => Scanl m a x -> Scanl m b y -> Scanl m (a, b) (x, y)+    [A] uniqBy :: Monad m => (a -> a -> Bool) -> Scanl m a (Maybe a)+    [A] topBy :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> Int -> Scanl m a (MutArray a)+    [A] toSet :: (Monad m, Ord a) => Scanl m a (Set a)+    [A] toListRev :: Monad m => Scanl m a [a]+    [A] toList :: Monad m => Scanl m a [a]+    [A] toIntSet :: Monad m => Scanl m Int IntSet+    [A] the :: (Monad m, Eq a) => Scanl m a (Maybe a)+    [A] teeWith :: Monad m => (b -> c -> d) -> Scanl m a b -> Scanl m a c -> Scanl m a d+    [A] tee :: Monad m => Scanl m a b -> Scanl m a c -> Scanl m a (b, c)+    [A] takeEndBy_ :: Monad m => (a -> Bool) -> Scanl m a b -> Scanl m a b+    [A] takeEndBy :: Monad m => (a -> Bool) -> Scanl m a b -> Scanl m a b+    [A] take :: Monad m => Int -> Scanl m a b -> Scanl m a b+    [A] sum :: (Monad m, Num a) => Scanl m a a+    [A] sconcat :: (Monad m, Semigroup a) => a -> Scanl m a a+    [A] scanl :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+    [A] rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Scanl m a Int64+    [A] rollingHash :: (Monad m, Enum a) => Scanl m a Int64+    [A] rmapM :: Monad m => (b -> m c) -> Scanl m a b -> Scanl m a c+    [A] product :: (Monad m, Num a, Eq a) => Scanl m a a+    [A] postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Scanl m b c -> Scanl m a c+    [A] postscanl :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+    [A] partition :: Monad m => Scanl m b x -> Scanl m c x -> Scanl m (Either b c) x+    [A] nubInt :: Monad m => Scanl m Int (Maybe Int)+    [A] nub :: (Monad m, Ord a) => Scanl m a (Maybe a)+    [A] morphInner :: (forall x. m x -> n x) -> Scanl m a b -> Scanl n a b+    [A] mkScanr :: Monad m => (a -> b -> b) -> b -> Scanl m a b+    [A] mkScanlM :: Monad m => (b -> a -> m b) -> m b -> Scanl m a b+    [A] mkScanl1M :: Monad m => (a -> a -> m a) -> Scanl m a (Maybe a)+    [A] mkScanl1 :: Monad m => (a -> a -> a) -> Scanl m a (Maybe a)+    [A] mkScanl :: Monad m => (b -> a -> b) -> b -> Scanl m a b+    [A] minimumBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe a)+    [A] minimum :: (Monad m, Ord a) => Scanl m a (Maybe a)+    [A] mean :: (Monad m, Fractional a) => Scanl m a a+    [A] mconcat :: (Monad m, Monoid a) => Scanl m a a+    [A] maximumBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe a)+    [A] maximum :: (Monad m, Ord a) => Scanl m a (Maybe a)+    [A] mapMaybe :: Monad m => (a -> Maybe b) -> Scanl m b r -> Scanl m a r+    [A] lmapM :: Monad m => (a -> m b) -> Scanl m b r -> Scanl m a r+    [A] lmap :: (a -> b) -> Scanl m b r -> Scanl m a r+    [A] length :: Monad m => Scanl m a Int+    [A] latest :: Monad m => Scanl m a (Maybe a)+    [A] foldMapM :: (Monad m, Monoid b) => (a -> m b) -> Scanl m a b+    [A] foldMap :: (Monad m, Monoid b) => (a -> b) -> Scanl m a b+    [A] findIndices :: Monad m => (a -> Bool) -> Scanl m a (Maybe Int)+    [A] filterM :: Monad m => (a -> m Bool) -> Scanl m a r -> Scanl m a r+    [A] filter :: Monad m => (a -> Bool) -> Scanl m a r -> Scanl m a r+    [A] elemIndices :: (Monad m, Eq a) => a -> Scanl m a (Maybe Int)+    [A] drain :: Monad m => Scanl m a ()+    [A] distribute :: Monad m => [Scanl m a b] -> Scanl m a [b]+    [A] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (k -> m (Maybe (Scanl m a b))) -> Scanl m a (Maybe (k, b))+    [A] demux :: (Monad m, Ord k) => (a -> k) -> (k -> m (Maybe (Scanl m a b))) -> Scanl m a (Maybe (k, b))+    [A] deleteBy :: Monad m => (a -> a -> Bool) -> a -> Scanl m a (Maybe a)+    [A] countDistinctInt :: Monad m => Scanl m Int Int+    [A] countDistinct :: (Monad m, Ord a) => Scanl m a Int+    [A] classifyIO :: (MonadIO m, Ord k) => (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))+    [A] classify :: (MonadIO m, Ord k) => (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))+    [A] catRights :: Monad m => Scanl m b c -> Scanl m (Either a b) c+    [A] catMaybes :: Monad m => Scanl m a b -> Scanl m (Maybe a) b+    [A] catLefts :: Monad m => Scanl m a c -> Scanl m (Either a b) c+    [A] catEithers :: Scanl m a b -> Scanl m (Either a a) b+[A] Streamly.Data.RingArray+    [A] RingArray+    [A] unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a+    [A] unsafeGetHead :: (MonadIO m, Unbox a) => RingArray a -> m a+    [A] toMutArray :: (MonadIO m, Unbox a) => RingArray a -> m (MutArray a)+    [A] toList :: (MonadIO m, Unbox a) => RingArray a -> m [a]+    [A] scanRingsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m a (RingArray a)+    [A] ringsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (RingArray a)+    [A] replace_ :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a)+    [A] replace :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a, a)+    [A] readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a+    [A] reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a+    [A] readRev :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a+    [A] read :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a+    [A] putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> a -> m ()+    [A] moveReverse :: forall a. Unbox a => RingArray a -> RingArray a+    [A] moveForward :: forall a. Unbox a => RingArray a -> RingArray a+    [A] modifyIndex :: Int -> RingArray a -> (a -> (a, b)) -> m b+    [A] length :: forall a. Unbox a => RingArray a -> Int+    [A] insert :: RingArray a -> a -> m (RingArray a)+    [A] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m (Maybe a)+    [A] fold :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> RingArray a -> m b+    [A] eqArrayN :: RingArray a -> Array a -> Int -> IO Bool+    [A] eqArray :: RingArray a -> Array a -> IO Bool+    [A] createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (RingArray a)+    [A] castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)+    [A] castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)+    [A] cast :: forall a b. Unbox b => RingArray a -> Maybe (RingArray b)+    [A] byteLength :: RingArray a -> Int+    [A] asMutArray :: RingArray a -> (MutArray a, Int)+    [A] asBytes :: RingArray a -> RingArray Word8+[C] Streamly.Data.ParserK+    [D] adaptCG :: Monad m => Parser a m b -> ParserK (Array a) m b+    [D] adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [D] adapt :: Monad m => Parser a m b -> ParserK a m b+[C] Streamly.Data.Parser+    [A] ParseErrorPos+        [A] ParseErrorPos :: Int -> String -> ParseErrorPos+    [A] ParseError+        [A] ParseError :: String -> ParseError+[C] Streamly.Data.MutByteArray+    [D] pinnedNew :: Int -> IO MutByteArray+[C] Streamly.Data.MutArray.Generic+    [D] writeN :: MonadIO m => Int -> Fold m a (MutArray a)+    [D] write :: MonadIO m => Fold m a (MutArray a)+    [A] unsafePutIndex :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [A] unsafeModifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] unsafeGetIndex :: MonadIO m => Int -> MutArray a -> m a+    [D] putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [D] new :: MonadIO m => Int -> m (MutArray a)+    [D] modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [D] getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+    [A] chunksOf :: forall m a. MonadIO m => Int -> Stream m a -> Stream m (MutArray a)+[C] Streamly.Data.MutArray+    [D] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [D] writeAppend :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+    [D] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] unsafePutIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] unsafeModifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [D] putIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [D] pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [D] pinnedEmptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [D] new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [D] modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [D] getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] emptyOf' :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [D] appendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] append2 :: (MonadIO m, Unbox a) => MutArray a -> Fold m a (MutArray a)+    [D] append :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+[C] Streamly.Data.Fold+    [A] takeEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Fold m a b+    [A] takeEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Fold m a b+    [A] scanl :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+    [D] scanMaybe :: Monad m => Fold m a (Maybe b) -> Fold m b c -> Fold m a c+    [D] scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [A] postscanl :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+    [D] postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [A] foldtM' :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b+    [D] foldlM1' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+    [A] foldl1M' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+    [A] demuxerToMapIO :: (MonadIO m, Ord k) => (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)+    [A] demuxerToMap :: (Monad m, Ord k) => (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)+    [D] demuxToMapIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [D] demuxToMap :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [D] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [D] demux :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [D] classifyIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [D] classify :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+[C] Streamly.Data.Array.Generic+    [D] writeN :: MonadIO m => Int -> Fold m a (Array a)+    [D] write :: MonadIO m => Fold m a (Array a)+    [A] toParserK :: Monad m => Parser a m b -> ParserK (Array a) m b+    [A] parsePos :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b)+    [A] parseBreakPos :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b, StreamK m (Array a))+    [A] parseBreak :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parse :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] chunksOf :: forall m a. MonadIO m => Int -> Stream m a -> Stream m (Array a)+[C] Streamly.Data.Array+    [D] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] writeLastN :: (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+    [D] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] toParserK :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [A] serialize' :: Serialize a => a -> Array Word8+    [D] pinnedSerialize :: Serialize a => a -> Array Word8+    [A] parsePos :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b)+    [A] parseBreakPos :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b, StreamK m (Array a))+    [A] parseBreak :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parse :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [C] deserialize+        [O] deserialize :: Serialize a => Array Word8 -> a+        [N] deserialize :: Serialize a => Array Word8 -> (a, Array Word8)+    [A] createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+[A] Streamly.Control.Exception+    [A] AcquireIO+    [A] withAcquireIO :: (MonadIO m, MonadMask m) => (AcquireIO -> m a) -> m a+    [A] register :: AcquireIO -> IO () -> IO ()+    [A] hook :: AcquireIO -> IO () -> IO (IO ())+    [A] acquire :: AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())+[C] Streamly.Console.Stdio+    [A] readChunks :: MonadIO m => Stream m (Array Word8)+    [A] readChars :: MonadIO m => Stream m Char+    [A] read :: MonadIO m => Stream m Word8+    [A] putChunks :: MonadIO m => Stream m (Array Word8) -> m ()++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Unicode.Stream+    [A] swapByteOrder :: Word16 -> Word16+    [A] mkEvenW8Chunks :: Monad m => Stream m (Array Word8) -> Stream m (Array Word8)+    [C] encodeUtf16le'+        [O] encodeUtf16le' :: Stream m Char -> Stream m Word16+        [N] encodeUtf16le' :: Monad m => Stream m Char -> Stream m Word16+    [A] encodeUtf16le :: Monad m => Stream m Char -> Stream m Word16+    [C] decodeUtf16le'+        [O] decodeUtf16le' :: Stream m Word16 -> Stream m Char+        [N] decodeUtf16le' :: Monad m => Stream m Word16 -> Stream m Char+    [A] decodeUtf16le :: Monad m => Stream m Word16 -> Stream m Char+[A] Streamly.Internal.FileSystem.WindowsPath.SegNode+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Seg.Unrooted (Streamly.Internal.FileSystem.WindowsPath.Node.File Streamly.Internal.FileSystem.WindowsPath.WindowsPath))+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Seg.Unrooted (Streamly.Internal.FileSystem.WindowsPath.Node.Dir Streamly.Internal.FileSystem.WindowsPath.WindowsPath))+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Seg.Rooted (Streamly.Internal.FileSystem.WindowsPath.Node.File Streamly.Internal.FileSystem.WindowsPath.WindowsPath))+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Seg.Rooted (Streamly.Internal.FileSystem.WindowsPath.Node.Dir Streamly.Internal.FileSystem.WindowsPath.WindowsPath))+    [A] urfileE :: String -> Q Exp+    [A] urfile :: QuasiQuoter+    [A] urdirE :: String -> Q Exp+    [A] urdir :: QuasiQuoter+    [A] rtfileE :: String -> Q Exp+    [A] rtfile :: QuasiQuoter+    [A] rtdirE :: String -> Q Exp+    [A] rtdir :: QuasiQuoter+    [A] join :: (IsPath WindowsPath (a (Dir WindowsPath)), IsPath WindowsPath (b WindowsPath), IsPath WindowsPath (a (b WindowsPath))) => a (Dir WindowsPath) -> Unrooted (b WindowsPath) -> a (b WindowsPath)+[A] Streamly.Internal.FileSystem.WindowsPath.Seg+    [A] class IsSeg a+    [A] Streamly.Internal.FileSystem.WindowsPath.Seg.IsSeg+        [A] instance Streamly.Internal.FileSystem.WindowsPath.Seg.IsSeg (Streamly.Internal.FileSystem.WindowsPath.Seg.Unrooted a)+        [A] instance Streamly.Internal.FileSystem.WindowsPath.Seg.IsSeg (Streamly.Internal.FileSystem.WindowsPath.Seg.Rooted a)+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Seg.Unrooted Streamly.Internal.FileSystem.WindowsPath.WindowsPath)+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Seg.Rooted Streamly.Internal.FileSystem.WindowsPath.WindowsPath)+    [A] Unrooted+        [A] Unrooted :: a -> Unrooted a+    [A] Rooted+        [A] Rooted :: a -> Rooted a+    [A] urE :: String -> Q Exp+    [A] ur :: QuasiQuoter+    [A] rtE :: String -> Q Exp+    [A] rt :: QuasiQuoter+    [A] join :: (IsSeg (a WindowsPath), IsPath WindowsPath (a WindowsPath)) => a WindowsPath -> Unrooted WindowsPath -> a WindowsPath+[A] Streamly.Internal.FileSystem.WindowsPath.Node+    [A] class IsNode a+    [A] Streamly.Internal.FileSystem.WindowsPath.Node.IsNode+        [A] instance Streamly.Internal.FileSystem.WindowsPath.Node.IsNode (Streamly.Internal.FileSystem.WindowsPath.Node.File a)+        [A] instance Streamly.Internal.FileSystem.WindowsPath.Node.IsNode (Streamly.Internal.FileSystem.WindowsPath.Node.Dir a)+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Node.File Streamly.Internal.FileSystem.WindowsPath.WindowsPath)+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath (Streamly.Internal.FileSystem.WindowsPath.Node.Dir Streamly.Internal.FileSystem.WindowsPath.WindowsPath)+    [A] File+        [A] File :: a -> File a+    [A] Dir+        [A] Dir :: a -> Dir a+    [A] join :: (IsPath WindowsPath (a WindowsPath), IsNode (a WindowsPath)) => Dir WindowsPath -> a WindowsPath -> a WindowsPath+    [A] fileE :: String -> Q Exp+    [A] file :: QuasiQuoter+    [A] dirE :: String -> Q Exp+    [A] dir :: QuasiQuoter+[A] Streamly.Internal.FileSystem.WindowsPath+    [A] class IsPath a b+    [A] EqCfg+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath Streamly.Internal.FileSystem.WindowsPath.WindowsPath+    [A] WindowsPath+        [A] WindowsPath :: Array Word16 -> WindowsPath+    [A] wordToChar :: Word16 -> Char+    [A] validatePath' :: MonadThrow m => Array Word16 -> m ()+    [A] validatePath :: MonadThrow m => Array Word16 -> m ()+    [A] unsafeJoinPaths :: [WindowsPath] -> WindowsPath+    [A] unsafeJoin :: WindowsPath -> WindowsPath -> WindowsPath+    [A] unsafeFromString :: [Char] -> WindowsPath+    [A] unsafeFromPath :: IsPath a b => a -> b+    [A] unsafeFromArray :: Array Word16 -> WindowsPath+    [A] toString_ :: WindowsPath -> [Char]+    [A] toString :: WindowsPath -> [Char]+    [A] toPath :: IsPath a b => b -> a+    [A] toChars_ :: Monad m => WindowsPath -> Stream m Char+    [A] toChars :: Monad m => WindowsPath -> Stream m Char+    [A] toArray :: WindowsPath -> Array Word16+    [A] takeFileName :: WindowsPath -> Maybe WindowsPath+    [A] takeFileBase :: WindowsPath -> Maybe WindowsPath+    [A] takeExtension :: WindowsPath -> Maybe WindowsPath+    [A] takeDirectory :: WindowsPath -> Maybe WindowsPath+    [A] splitRoot :: WindowsPath -> Maybe (WindowsPath, Maybe WindowsPath)+    [A] splitPath_ :: Monad m => WindowsPath -> Stream m WindowsPath+    [A] splitPath :: Monad m => WindowsPath -> Stream m WindowsPath+    [A] splitLast :: WindowsPath -> (Maybe WindowsPath, WindowsPath)+    [A] splitFirst :: WindowsPath -> (WindowsPath, Maybe WindowsPath)+    [A] splitFile :: WindowsPath -> Maybe (Maybe WindowsPath, WindowsPath)+    [A] splitExtension :: WindowsPath -> Maybe (WindowsPath, WindowsPath)+    [A] showArray :: WindowsPath -> [Char]+    [A] separator :: Word16+    [A] replaceExtension :: WindowsPath -> WindowsPath -> WindowsPath+    [A] readArray :: [Char] -> WindowsPath+    [A] pathE :: String -> Q Exp+    [A] path :: QuasiQuoter+    [A] normalize :: EqCfg -> WindowsPath -> WindowsPath+    [A] joinStr :: WindowsPath -> [Char] -> WindowsPath+    [A] joinDir :: WindowsPath -> WindowsPath -> WindowsPath+    [A] join :: WindowsPath -> WindowsPath -> WindowsPath+    [A] isValidPath' :: Array Word16 -> Bool+    [A] isValidPath :: Array Word16 -> Bool+    [A] isUnrooted :: WindowsPath -> Bool+    [A] isSeparator :: Word16 -> Bool+    [A] isRooted :: WindowsPath -> Bool+    [A] ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg+    [A] ignoreCase :: Bool -> EqCfg -> EqCfg+    [A] hasTrailingSeparator :: WindowsPath -> Bool+    [A] fromString_ :: [Char] -> WindowsPath+    [A] fromString :: MonadThrow m => [Char] -> m WindowsPath+    [A] fromPath :: (IsPath a b, MonadThrow m) => a -> m b+    [A] fromChars :: MonadThrow m => Stream Identity Char -> m WindowsPath+    [A] fromArray :: MonadThrow m => Array Word16 -> m WindowsPath+    [A] extSeparator :: Word16+    [A] eqPathBytes :: WindowsPath -> WindowsPath -> Bool+    [A] eqPath :: (EqCfg -> EqCfg) -> WindowsPath -> WindowsPath -> Bool+    [A] encodeString :: [Char] -> Array Word16+    [A] dropTrailingSeparators :: WindowsPath -> WindowsPath+    [A] dropExtension :: WindowsPath -> WindowsPath+    [A] charToWord :: Char -> Word16+    [A] asCWString :: WindowsPath -> (CWString -> IO a) -> IO a+    [A] allowRelativeEquality :: Bool -> EqCfg -> EqCfg+    [A] addTrailingSeparator :: WindowsPath -> WindowsPath+    [A] addExtension :: WindowsPath -> WindowsPath -> WindowsPath+    [A] adapt :: (MonadThrow m, IsPath WindowsPath a, IsPath WindowsPath b) => a -> m b+[A] Streamly.Internal.FileSystem.Windows.ReadDir+[A] Streamly.Internal.FileSystem.Windows.File+[A] Streamly.Internal.FileSystem.PosixPath.SegNode+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Seg.Unrooted (Streamly.Internal.FileSystem.PosixPath.Node.File Streamly.Internal.FileSystem.PosixPath.PosixPath))+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Seg.Unrooted (Streamly.Internal.FileSystem.PosixPath.Node.Dir Streamly.Internal.FileSystem.PosixPath.PosixPath))+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Seg.Rooted (Streamly.Internal.FileSystem.PosixPath.Node.File Streamly.Internal.FileSystem.PosixPath.PosixPath))+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Seg.Rooted (Streamly.Internal.FileSystem.PosixPath.Node.Dir Streamly.Internal.FileSystem.PosixPath.PosixPath))+    [A] urfileE :: String -> Q Exp+    [A] urfile :: QuasiQuoter+    [A] urdirE :: String -> Q Exp+    [A] urdir :: QuasiQuoter+    [A] rtfileE :: String -> Q Exp+    [A] rtfile :: QuasiQuoter+    [A] rtdirE :: String -> Q Exp+    [A] rtdir :: QuasiQuoter+    [A] join :: (IsPath PosixPath (a (Dir PosixPath)), IsPath PosixPath (b PosixPath), IsPath PosixPath (a (b PosixPath))) => a (Dir PosixPath) -> Unrooted (b PosixPath) -> a (b PosixPath)+[A] Streamly.Internal.FileSystem.PosixPath.Seg+    [A] class IsSeg a+    [A] Streamly.Internal.FileSystem.PosixPath.Seg.IsSeg+        [A] instance Streamly.Internal.FileSystem.PosixPath.Seg.IsSeg (Streamly.Internal.FileSystem.PosixPath.Seg.Unrooted a)+        [A] instance Streamly.Internal.FileSystem.PosixPath.Seg.IsSeg (Streamly.Internal.FileSystem.PosixPath.Seg.Rooted a)+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Seg.Unrooted Streamly.Internal.FileSystem.PosixPath.PosixPath)+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Seg.Rooted Streamly.Internal.FileSystem.PosixPath.PosixPath)+    [A] Unrooted+        [A] Unrooted :: a -> Unrooted a+    [A] Rooted+        [A] Rooted :: a -> Rooted a+    [A] urE :: String -> Q Exp+    [A] ur :: QuasiQuoter+    [A] rtE :: String -> Q Exp+    [A] rt :: QuasiQuoter+    [A] join :: (IsSeg (a PosixPath), IsPath PosixPath (a PosixPath)) => a PosixPath -> Unrooted PosixPath -> a PosixPath+[A] Streamly.Internal.FileSystem.PosixPath.Node+    [A] class IsNode a+    [A] Streamly.Internal.FileSystem.PosixPath.Node.IsNode+        [A] instance Streamly.Internal.FileSystem.PosixPath.Node.IsNode (Streamly.Internal.FileSystem.PosixPath.Node.File a)+        [A] instance Streamly.Internal.FileSystem.PosixPath.Node.IsNode (Streamly.Internal.FileSystem.PosixPath.Node.Dir a)+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Node.File Streamly.Internal.FileSystem.PosixPath.PosixPath)+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath (Streamly.Internal.FileSystem.PosixPath.Node.Dir Streamly.Internal.FileSystem.PosixPath.PosixPath)+    [A] File+        [A] File :: a -> File a+    [A] Dir+        [A] Dir :: a -> Dir a+    [A] join :: (IsPath PosixPath (a PosixPath), IsNode (a PosixPath)) => Dir PosixPath -> a PosixPath -> a PosixPath+    [A] fileE :: String -> Q Exp+    [A] file :: QuasiQuoter+    [A] dirE :: String -> Q Exp+    [A] dir :: QuasiQuoter+[A] Streamly.Internal.FileSystem.PosixPath+    [A] class IsPath a b+    [A] EqCfg+    [A] Streamly.Internal.Data.Path.IsPath+        [A] instance Streamly.Internal.Data.Path.IsPath Streamly.Internal.FileSystem.PosixPath.PosixPath Streamly.Internal.FileSystem.PosixPath.PosixPath+    [A] PosixPath+        [A] PosixPath :: Array Word8 -> PosixPath+    [A] wordToChar :: Word8 -> Char+    [A] validatePath :: MonadThrow m => Array Word8 -> m ()+    [A] unsafeJoinPaths :: [PosixPath] -> PosixPath+    [A] unsafeJoin :: PosixPath -> PosixPath -> PosixPath+    [A] unsafeFromString :: [Char] -> PosixPath+    [A] unsafeFromPath :: IsPath a b => a -> b+    [A] unsafeFromArray :: Array Word8 -> PosixPath+    [A] toString_ :: PosixPath -> [Char]+    [A] toString :: PosixPath -> [Char]+    [A] toPath :: IsPath a b => b -> a+    [A] toChars_ :: Monad m => PosixPath -> Stream m Char+    [A] toChars :: Monad m => PosixPath -> Stream m Char+    [A] toArray :: PosixPath -> Array Word8+    [A] takeFileName :: PosixPath -> Maybe PosixPath+    [A] takeFileBase :: PosixPath -> Maybe PosixPath+    [A] takeExtension :: PosixPath -> Maybe PosixPath+    [A] takeDirectory :: PosixPath -> Maybe PosixPath+    [A] splitRoot :: PosixPath -> Maybe (PosixPath, Maybe PosixPath)+    [A] splitPath_ :: Monad m => PosixPath -> Stream m PosixPath+    [A] splitPath :: Monad m => PosixPath -> Stream m PosixPath+    [A] splitLast :: PosixPath -> (Maybe PosixPath, PosixPath)+    [A] splitFirst :: PosixPath -> (PosixPath, Maybe PosixPath)+    [A] splitFile :: PosixPath -> Maybe (Maybe PosixPath, PosixPath)+    [A] splitExtension :: PosixPath -> Maybe (PosixPath, PosixPath)+    [A] showArray :: PosixPath -> [Char]+    [A] separator :: Word8+    [A] replaceExtension :: PosixPath -> PosixPath -> PosixPath+    [A] readArray :: [Char] -> PosixPath+    [A] pathE :: String -> Q Exp+    [A] path :: QuasiQuoter+    [A] normalize :: EqCfg -> PosixPath -> PosixPath+    [A] joinStr :: PosixPath -> [Char] -> PosixPath+    [A] joinDir :: PosixPath -> PosixPath -> PosixPath+    [A] joinCStr' :: PosixPath -> CString -> IO PosixPath+    [A] joinCStr :: PosixPath -> CString -> IO PosixPath+    [A] join :: PosixPath -> PosixPath -> PosixPath+    [A] isValidPath :: Array Word8 -> Bool+    [A] isUnrooted :: PosixPath -> Bool+    [A] isSeparator :: Word8 -> Bool+    [A] isRooted :: PosixPath -> Bool+    [A] ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg+    [A] ignoreCase :: Bool -> EqCfg -> EqCfg+    [A] hasTrailingSeparator :: PosixPath -> Bool+    [A] fromString_ :: [Char] -> PosixPath+    [A] fromString :: MonadThrow m => [Char] -> m PosixPath+    [A] fromPath :: (IsPath a b, MonadThrow m) => a -> m b+    [A] fromChars :: MonadThrow m => Stream Identity Char -> m PosixPath+    [A] fromArray :: MonadThrow m => Array Word8 -> m PosixPath+    [A] extSeparator :: Word8+    [A] eqPathBytes :: PosixPath -> PosixPath -> Bool+    [A] eqPath :: (EqCfg -> EqCfg) -> PosixPath -> PosixPath -> Bool+    [A] encodeString :: [Char] -> Array Word8+    [A] dropTrailingSeparators :: PosixPath -> PosixPath+    [A] dropExtension :: PosixPath -> PosixPath+    [A] charToWord :: Char -> Word8+    [A] asCString :: PosixPath -> (CString -> IO a) -> IO a+    [A] allowRelativeEquality :: Bool -> EqCfg -> EqCfg+    [A] addTrailingSeparator :: PosixPath -> PosixPath+    [A] addExtension :: PosixPath -> PosixPath -> PosixPath+    [A] adapt :: (MonadThrow m, IsPath PosixPath a, IsPath PosixPath b) => a -> m b+[A] Streamly.Internal.FileSystem.Posix.ReadDir+    [A] DirStream+        [A] DirStream :: Ptr CDir -> DirStream+    [A] reader :: (MonadIO m, MonadCatch m) => Unfold m Path Path+    [A] readScanWith_ :: Scanl m (Path, CString) a -> (ReadOptions -> ReadOptions) -> Path -> Stream m a+    [A] readScanWith :: Scanl m (Path, CString, Ptr CDirent) a -> (ReadOptions -> ReadOptions) -> Path -> Stream m a+    [A] readPlusScanWith :: Scanl m (Path, CString, Ptr CStat) a -> (ReadOptions -> ReadOptions) -> Path -> Stream m a+    [A] readEitherChunks :: MonadIO m => (ReadOptions -> ReadOptions) -> [PosixPath] -> Stream m (Either [PosixPath] [PosixPath])+    [A] readEitherByteChunksAt :: MonadIO m => (ReadOptions -> ReadOptions) -> (PosixPath, [PosixPath]) -> Stream m (Either (PosixPath, [PosixPath]) (Array Word8))+    [A] readEitherByteChunks :: MonadIO m => (ReadOptions -> ReadOptions) -> [PosixPath] -> Stream m (Either [PosixPath] (Array Word8))+    [A] readDirStreamEither :: (ReadOptions -> ReadOptions) -> (PosixPath, DirStream) -> IO (Maybe (Either PosixPath PosixPath))+    [A] openDirStreamCString :: CString -> IO DirStream+    [A] openDirStream :: PosixPath -> IO DirStream+    [A] eitherReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)+    [A] closeDirStream :: DirStream -> IO ()+[A] Streamly.Internal.FileSystem.Posix.File+    [A] ()+    [A] OpenFlags+        [A] OpenFlags :: CInt -> OpenFlags+    [A] withFile :: PosixPath -> IOMode -> (Handle -> IO r) -> IO r+    [A] withBinaryFile :: PosixPath -> IOMode -> (Handle -> IO r) -> IO r+    [A] setUx :: FileMode -> FileMode+    [A] setUw :: FileMode -> FileMode+    [A] setUr :: FileMode -> FileMode+    [A] setTrunc :: Bool -> OpenFlags -> OpenFlags+    [A] setSync :: Bool -> OpenFlags -> OpenFlags+    [A] setSuid :: FileMode -> FileMode+    [A] setSticky :: FileMode -> FileMode+    [A] setSgid :: FileMode -> FileMode+    [A] setOx :: FileMode -> FileMode+    [A] setOw :: FileMode -> FileMode+    [A] setOr :: FileMode -> FileMode+    [A] setNonBlock :: Bool -> OpenFlags -> OpenFlags+    [A] setNoFollow :: Bool -> OpenFlags -> OpenFlags+    [A] setNoCtty :: Bool -> OpenFlags -> OpenFlags+    [A] setGx :: FileMode -> FileMode+    [A] setGw :: FileMode -> FileMode+    [A] setGr :: FileMode -> FileMode+    [A] setExcl :: Bool -> OpenFlags -> OpenFlags+    [A] setDirectory :: Bool -> OpenFlags -> OpenFlags+    [A] setCloExec :: Bool -> OpenFlags -> OpenFlags+    [A] setAppend :: Bool -> OpenFlags -> OpenFlags+    [A] openFile :: PosixPath -> IOMode -> IO Handle+    [A] openBinaryFile :: PosixPath -> IOMode -> IO Handle+    [A] openAt :: Maybe Fd -> PosixPath -> OpenFlags -> Maybe FileMode -> IO Fd+    [A] defaultOpenFlags :: OpenFlags+    [A] defaultCreateMode :: FileMode+    [A] clrUx :: FileMode -> FileMode+    [A] clrUw :: FileMode -> FileMode+    [A] clrUr :: FileMode -> FileMode+    [A] clrSuid :: FileMode -> FileMode+    [A] clrSticky :: FileMode -> FileMode+    [A] clrSgid :: FileMode -> FileMode+    [A] clrOx :: FileMode -> FileMode+    [A] clrOw :: FileMode -> FileMode+    [A] clrOr :: FileMode -> FileMode+    [A] clrGx :: FileMode -> FileMode+    [A] clrGw :: FileMode -> FileMode+    [A] clrGr :: FileMode -> FileMode+    [A] close :: Fd -> IO ()+[A] Streamly.Internal.FileSystem.Posix.Errno+    [A] throwErrnoPathIfRetry :: (a -> Bool) -> String -> PosixPath -> IO a -> IO a+    [A] throwErrnoPathIfNullRetry :: String -> PosixPath -> IO (Ptr a) -> IO (Ptr a)+    [A] throwErrnoPathIfMinus1Retry :: (Eq a, Num a) => String -> PosixPath -> IO a -> IO a+    [A] throwErrnoPath :: String -> PosixPath -> IO a+[A] Streamly.Internal.FileSystem.Path.SegNode+[A] Streamly.Internal.FileSystem.Path.Seg+[A] Streamly.Internal.FileSystem.Path.Node+[C] Streamly.Internal.FileSystem.Path+    [C] IsPath+        [O] class IsPath a+        [N] class IsPath a b+    [R] Rel+    [R] File+    [A] EqCfg+    [R] Dir+    [R] Abs+    [R] Streamly.Internal.FileSystem.Path.IsPath+    [R] GHC.Show.Show+    [R] GHC.Exception.Type.Exception+    [R] GHC.Classes.Eq+    [R] Path+    [A] type Path = PosixPath+    [A] type OsWord = Word8+    [A] type OsCString = CString+    [A] wordToChar :: OsWord -> Char+    [A] validatePath :: MonadThrow m => Array OsWord -> m ()+    [A] unsafeJoinPaths :: [Path] -> Path+    [A] unsafeJoin :: Path -> Path -> Path+    [A] unsafeFromString :: [Char] -> Path+    [A] unsafeFromPath :: IsPath a b => a -> b+    [A] unsafeFromArray :: Array OsWord -> Path+    [A] toString_ :: Path -> [Char]+    [C] toPath+        [O] toPath :: IsPath a => a -> Path+        [N] toPath :: IsPath a b => b -> a+    [R] toChunk :: Path -> Array Word8+    [A] toChars_ :: Monad m => Path -> Stream m Char+    [A] toArray :: Path -> Array OsWord+    [A] takeFileName :: Path -> Maybe Path+    [A] takeFileBase :: Path -> Maybe Path+    [A] takeExtension :: Path -> Maybe Path+    [A] takeDirectory :: Path -> Maybe Path+    [A] splitRoot :: Path -> Maybe (Path, Maybe Path)+    [A] splitPath_ :: Monad m => Path -> Stream m Path+    [A] splitPath :: Monad m => Path -> Stream m Path+    [A] splitLast :: Path -> (Maybe Path, Path)+    [A] splitFirst :: Path -> (Path, Maybe Path)+    [A] splitFile :: Path -> Maybe (Maybe Path, Path)+    [A] splitExtension :: Path -> Maybe (Path, Path)+    [A] showArray :: Path -> [Char]+    [A] separator :: OsWord+    [A] replaceExtension :: Path -> Path -> Path+    [R] relfile :: QuasiQuoter+    [R] reldir :: QuasiQuoter+    [R] rel :: QuasiQuoter+    [A] readArray :: [Char] -> Path+    [R] primarySeparator :: Char+    [A] pathE :: String -> Q Exp+    [A] normalize :: EqCfg -> Path -> Path+    [R] mkRelFile :: String -> Q Exp+    [R] mkRelDir :: String -> Q Exp+    [R] mkRel :: String -> Q Exp+    [R] mkPath :: String -> Q Exp+    [R] mkFile :: String -> Q Exp+    [R] mkDir :: String -> Q Exp+    [R] mkAbsFile :: String -> Q Exp+    [R] mkAbsDir :: String -> Q Exp+    [R] mkAbs :: String -> Q Exp+    [A] joinStr :: Path -> [Char] -> Path+    [A] joinDir :: Path -> Path -> Path+    [A] joinCStr' :: Path -> CString -> IO Path+    [A] joinCStr :: Path -> CString -> IO Path+    [A] join :: Path -> Path -> Path+    [A] isValidPath :: Array OsWord -> Bool+    [A] isUnrooted :: Path -> Bool+    [C] isSeparator+        [O] isSeparator :: Char -> Bool+        [N] isSeparator :: OsWord -> Bool+    [A] isRooted :: Path -> Bool+    [A] ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg+    [A] ignoreCase :: Bool -> EqCfg -> EqCfg+    [A] hasTrailingSeparator :: Path -> Bool+    [A] fromString_ :: [Char] -> Path+    [R] fromPathUnsafe :: IsPath a => Path -> a+    [C] fromPath+        [O] fromPath :: (IsPath a, MonadThrow m) => Path -> m a+        [N] fromPath :: (IsPath a b, MonadThrow m) => a -> m b+    [R] fromChunkUnsafe :: Array Word8 -> Path+    [R] fromChunk :: MonadThrow m => Array Word8 -> m Path+    [A] fromArray :: MonadThrow m => Array OsWord -> m Path+    [R] file :: QuasiQuoter+    [R] extendPath :: Path -> Path -> Path+    [R] extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) => a (Dir Path) -> Rel b -> a b+    [A] extSeparator :: OsWord+    [A] eqPathBytes :: Path -> Path -> Bool+    [A] eqPath :: (EqCfg -> EqCfg) -> Path -> Path -> Bool+    [A] encodeString :: [Char] -> Array OsWord+    [A] dropTrailingSeparators :: Path -> Path+    [A] dropExtension :: Path -> Path+    [R] dir :: QuasiQuoter+    [A] charToWord :: Char -> OsWord+    [A] asOsCString :: Path -> (OsCString -> IO a) -> IO a+    [A] allowRelativeEquality :: Bool -> EqCfg -> EqCfg+    [A] addTrailingSeparator :: Path -> Path+    [A] addExtension :: Path -> Path -> Path+    [R] adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b+    [A] adapt :: (MonadThrow m, IsPath Path a, IsPath Path b) => a -> m b+    [R] absfile :: QuasiQuoter+    [R] absdir :: QuasiQuoter+    [R] abs :: QuasiQuoter+[C] Streamly.Internal.FileSystem.Handle+    [C] writeChunks+        [O] writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()+        [N] writeChunks :: forall m (a :: Type). MonadIO m => Handle -> Fold m (Array a) ()+    [C] putChunks+        [O] putChunks :: MonadIO m => Handle -> Stream m (Array a) -> m ()+        [N] putChunks :: forall m (a :: Type). MonadIO m => Handle -> Stream m (Array a) -> m ()+    [C] putChunk+        [O] putChunk :: MonadIO m => Handle -> Array a -> m ()+        [N] putChunk :: forall m (a :: Type). MonadIO m => Handle -> Array a -> m ()+    [C] chunkWriter+        [O] chunkWriter :: MonadIO m => Refold m Handle (Array a) ()+        [N] chunkWriter :: forall m (a :: Type). MonadIO m => Refold m Handle (Array a) ()+[A] Streamly.Internal.FileSystem.FileIO+    [A] writeWith :: (MonadIO m, MonadCatch m) => Int -> Path -> Fold m Word8 ()+    [A] writeChunks :: (MonadIO m, MonadCatch m) => Path -> Fold m (Array a) ()+    [A] writeAppendWith :: (MonadIO m, MonadCatch m) => Int -> Path -> Stream m Word8 -> m ()+    [A] writeAppendChunks :: (MonadIO m, MonadCatch m) => Path -> Stream m (Array a) -> m ()+    [A] writeAppendArray :: Path -> Array a -> IO ()+    [A] writeAppend :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8 -> m ()+    [A] write :: (MonadIO m, MonadCatch m) => Path -> Fold m Word8 ()+    [A] withFile :: (MonadIO m, MonadCatch m) => Path -> IOMode -> (Handle -> Stream m a) -> Stream m a+    [A] readerWith :: (MonadIO m, MonadCatch m) => Unfold m (Int, Path) Word8+    [A] reader :: (MonadIO m, MonadCatch m) => Unfold m Path Word8+    [A] readChunksWith :: (MonadIO m, MonadCatch m) => Int -> Path -> Stream m (Array Word8)+    [A] readChunks :: (MonadIO m, MonadCatch m) => Path -> Stream m (Array Word8)+    [A] read :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8+    [A] putChunk :: Path -> Array a -> IO ()+    [A] fromChunks :: (MonadIO m, MonadCatch m) => Path -> Stream m (Array a) -> m ()+    [A] fromBytesWith :: (MonadIO m, MonadCatch m) => Int -> Path -> Stream m Word8 -> m ()+    [A] fromBytes :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8 -> m ()+    [A] chunkReaderWith :: (MonadIO m, MonadCatch m) => Unfold m (Int, Path) (Array Word8)+    [A] chunkReaderFromToWith :: (MonadIO m, MonadCatch m) => Unfold m (Int, Int, Int, Path) (Array Word8)+    [A] chunkReader :: (MonadIO m, MonadCatch m) => Unfold m Path (Array Word8)+[A] Streamly.Internal.FileSystem.File.Common+    [A] withFile :: Bool -> (Path -> IOMode -> IO Handle) -> Path -> IOMode -> (Handle -> IO r) -> IO r+    [A] openFile :: Bool -> (Path -> IOMode -> IO Handle) -> Path -> IOMode -> IO Handle+[D] Streamly.Internal.FileSystem.File+    [C] writeChunks+        [O] writeChunks :: (MonadIO m, MonadCatch m) => FilePath -> Fold m (Array a) ()+        [N] writeChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m) => FilePath -> Fold m (Array a) ()+    [C] writeAppendChunks+        [O] writeAppendChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+        [N] writeAppendChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+    [C] writeAppendArray+        [O] writeAppendArray :: FilePath -> Array a -> IO ()+        [N] writeAppendArray :: forall (a :: Type). FilePath -> Array a -> IO ()+    [C] putChunk+        [O] putChunk :: FilePath -> Array a -> IO ()+        [N] putChunk :: forall (a :: Type). FilePath -> Array a -> IO ()+    [C] fromChunks+        [O] fromChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+        [N] fromChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+[A] Streamly.Internal.FileSystem.DirIO+    [A] ReadOptions+        [A] [_ignoreENOENT] :: ReadOptions -> Bool+        [A] [_ignoreELOOP] :: ReadOptions -> Bool+        [A] [_ignoreEACCESS] :: ReadOptions -> Bool+        [A] [_followSymlinks] :: ReadOptions -> Bool+        [A] ReadOptions :: Bool -> Bool -> Bool -> Bool -> ReadOptions+    [A] reader :: (MonadIO m, MonadCatch m) => Unfold m Path Path+    [A] readFiles :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Path -> Stream m Path+    [A] readEitherPaths :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Path -> Stream m (Either Path Path)+    [A] readEitherChunks :: MonadIO m => (ReadOptions -> ReadOptions) -> [PosixPath] -> Stream m (Either [PosixPath] [PosixPath])+    [A] readEither :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Path -> Stream m (Either Path Path)+    [A] readDirs :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Path -> Stream m Path+    [A] read :: (MonadIO m, MonadCatch m) => Path -> Stream m Path+    [A] ignoreSymlinkLoops :: Bool -> ReadOptions -> ReadOptions+    [A] ignoreMissing :: Bool -> ReadOptions -> ReadOptions+    [A] ignoreInaccessible :: Bool -> ReadOptions -> ReadOptions+    [A] followSymlinks :: Bool -> ReadOptions -> ReadOptions+    [A] fileReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Unfold m Path Path+    [A] eitherReaderPaths :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)+    [A] eitherReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)+    [A] dirReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) -> Unfold m Path Path+    [A] defaultReadOptions :: ReadOptions+[D] Streamly.Internal.FileSystem.Dir+[C] Streamly.Internal.Data.Unfold+    [A] zipRepeat :: Functor m => Unfold m a b -> Unfold m (c, a) (c, b)+    [A] zipArrowWithM :: Monad m => (b -> c -> m d) -> Unfold m a1 b -> Unfold m a2 c -> Unfold m (a1, a2) d+    [A] zipArrowWith :: Monad m => (b -> c -> d) -> Unfold m a1 b -> Unfold m a2 c -> Unfold m (a1, a2) d+    [A] unfoldEachInterleave :: Monad m => Unfold m a b -> Unfold m c a -> Unfold m c b+    [A] unfoldEach :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c+    [A] supply :: a -> Unfold m a b -> Unfold m () b+    [A] scanlMany :: Monad m => Scanl m b c -> Unfold m a b -> Unfold m a c+    [A] scanl :: Monad m => Scanl m b c -> Unfold m a b -> Unfold m a c+    [D] scanMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c+    [D] scan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c+    [A] repeat :: Applicative m => Unfold m a a+    [D] mapM2 :: Monad m => (a -> b -> m c) -> Unfold m a b -> Unfold m a c+    [D] map2 :: Functor m => (a -> b -> c) -> Unfold m a b -> Unfold m a c+    [D] manyInterleave :: Monad m => Unfold m a b -> Unfold m c a -> Unfold m c b+    [D] many2 :: Monad m => Unfold m (a, b) c -> Unfold m a b -> Unfold m a c+    [D] many :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c+    [R] joinInnerGeneric :: Monad m => (b -> c -> Bool) -> Unfold m a b -> Unfold m a c -> Unfold m a (b, c)+    [A] interleave :: Monad m => Unfold m a c -> Unfold m b c -> Unfold m (a, b) c+    [A] innerJoin :: Monad m => (b -> c -> Bool) -> Unfold m a b -> Unfold m a c -> Unfold m a (b, c)+    [A] fromTuple :: Applicative m => Unfold m (a, a) a+    [A] fairCrossWithM :: Monad m => (b -> c -> m d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+    [A] fairCrossWith :: Monad m => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+    [A] fairCross :: Monad m => Unfold m a b -> Unfold m a c -> Unfold m a (b, c)+    [A] carry :: Functor m => Unfold m a b -> Unfold m a (a, b)+    [D] both :: a -> Unfold m a b -> Unfold m Void b+[C] Streamly.Internal.Data.StreamK+    [R] CrossStreamK+    [A] Nested+        [A] [unNested] :: Nested m a -> StreamK m a+        [A] Nested :: StreamK m a -> Nested m a+    [A] FairNested+        [A] [unFairNested] :: FairNested m a -> StreamK m a+        [A] FairNested :: StreamK m a -> FairNested m a+    [A] toParserK :: Monad m => Parser a m b -> ParserK a m b+    [A] tailNonEmpty :: StreamK m a -> StreamK m a+    [A] sortOn :: (Monad m, Ord b) => (a -> b) -> StreamK m a -> StreamK m a+    [A] parsePos :: Monad m => ParserK a m b -> StreamK m a -> m (Either ParseErrorPos b)+    [C] parseDBreak+        [O] parseDBreak :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+        [N] parseDBreak :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseErrorPos b, StreamK m a)+    [C] parseD+        [O] parseD :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseError b)+        [N] parseD :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseErrorPos b)+    [D] parseChunksGeneric :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [D] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakPos :: forall m a b. Monad m => ParserK a m b -> StreamK m a -> m (Either ParseErrorPos b, StreamK m a)+    [D] parseBreakChunksGeneric :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [D] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] morphInner :: (Monad m, Monad n) => (forall x. m x -> n x) -> StreamK m a -> StreamK n a+    [D] mkCross :: StreamK m a -> Nested m a+    [A] mapMAccum :: (s -> a -> m (s, b)) -> m s -> StreamK m a -> StreamK m b+    [A] localReaderT :: (r -> r) -> StreamK (ReaderT r m) a -> StreamK (ReaderT r m) a+    [A] interleaveSepBy :: StreamK m a -> StreamK m a -> StreamK m a+    [D] interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a+    [D] interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a+    [A] interleaveEndBy' :: StreamK m a -> StreamK m a -> StreamK m a+    [A] initNonEmpty :: Stream m a -> Stream m a+    [D] hoist :: (Monad m, Monad n) => (forall x. m x -> n x) -> StreamK m a -> StreamK n a+    [A] headNonEmpty :: Monad m => StreamK m a -> m a+    [A] fairConcatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] fairConcatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] fairConcatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] concatMapMAccum :: (StreamK m b -> StreamK m b -> StreamK m b) -> (s -> a -> m (s, StreamK m b)) -> m s -> StreamK m a -> StreamK m b+    [A] concatForWithM :: Monad m => (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] concatForWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] concatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] concatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [D] bindWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] bfsConcatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] bfsConcatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+    [A] bfsConcatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+[C] Streamly.Internal.Data.Stream+    [A] FairUnfoldState+        [A] FairUnfoldNext :: o -> ([i] -> [i]) -> [i] -> FairUnfoldState o i+        [A] FairUnfoldInit :: o -> ([i] -> [i]) -> FairUnfoldState o i+        [A] FairUnfoldDrain :: ([i] -> [i]) -> [i] -> FairUnfoldState o i+    [R] CrossStream+    [A] Nested+        [A] [unNested] :: Nested m a -> Stream m a+        [A] Nested :: Stream m a -> Nested m a+    [A] withReaderT :: Monad m => (r2 -> r1) -> Stream (ReaderT r1 m) a -> Stream (ReaderT r2 m) a+    [A] withAcquireIO' :: AcquireIO -> (AcquireIO -> Stream m a) -> Stream m a+    [A] withAcquireIO :: (MonadIO m, MonadCatch m) => (AcquireIO -> Stream m a) -> Stream m a+    [C] usingStateT+        [O] usingStateT :: Monad m => m s -> (Stream (StateT s m) a -> Stream (StateT s m) a) -> Stream m a -> Stream m a+        [N] usingStateT :: Monad m => m s -> (Stream (StateT s m) a -> Stream (StateT s m) b) -> Stream m a -> Stream m b+    [R] unionWithStreamGenericBy :: MonadIO m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [R] unionWithStreamAscBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] unionBy :: MonadIO m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] unfoldSched :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [D] unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [D] unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [D] unfoldIterateDfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [D] unfoldIterateBfsRev :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [D] unfoldIterateBfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldIterate :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [D] unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldEachSepBySeq :: Monad m => b -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEachSepByM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEachSepBy :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEachFoldBy :: Fold m b c -> Unfold m a b -> Stream m a -> Stream m c+    [A] unfoldEachEndBySeq :: Monad m => b -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEachEndByM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEachEndBy :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] unfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldCross :: Monad m => Unfold m (a, b) c -> Stream m a -> Stream m b -> Stream m c+    [C] unCross+        [O] unCross :: CrossStream m a -> Stream m a+        [N] unCross :: Nested m a -> Stream m a+    [R] transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b+    [A] takeEndBy_ :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] takeEndBySeq_ :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Stream m a -> Stream m a+    [A] takeEndBySeq :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Stream m a -> Stream m a+    [A] tailNonEmpty :: Monad m => Stream m a -> Stream m a+    [D] strideFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a+    [A] splitSepBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitSepBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitSepBySeqOneOf :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [R] splitOnSuffixSeqAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [C] splitOnSuffixSeq+        [O] 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+        [N] splitOnSuffixSeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b+    [D] splitOnSeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [R] splitOnPrefix :: (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [R] splitOnAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [D] splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitEndBySeqOneOf :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [A] splitEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitBeginBy_ :: (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitAt :: String -> Int -> [a] -> ([a], [a])+    [A] sortedUnionBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] sortedIntersectBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] sortedDeleteFirstsBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [R] slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] schedMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+    [A] schedMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+    [A] schedForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+    [A] schedFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+    [A] scanr :: Monad m => Scanr m a b -> Stream m a -> Stream m b+    [A] scanlMany :: Monad m => Scanl m a b -> Stream m a -> Stream m b+    [A] scanlBy :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [C] scanl+        [O] scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+        [N] scanl :: Monad m => Scanl m a b -> Stream m a -> Stream m b+    [D] scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b+    [D] scanMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [D] scan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] sampleFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a+    [D] reduceIterateBfs :: Monad m => (a -> a -> m a) -> Stream m a -> m (Maybe a)+    [A] postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Stream m a -> Stream m b+    [A] postscanlBy :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+    [C] postscanl+        [O] postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+        [N] postscanl :: Monad m => Scanl m a b -> Stream m a -> Stream m b+    [D] postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] pipe :: Monad m => Pipe m a b -> Stream m a -> Stream m b+    [A] parsePos :: Monad m => Parser a m b -> Stream m a -> m (Either ParseErrorPos b)+    [A] parseManyPos :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseErrorPos b)+    [D] parseManyD :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseIteratePos :: Monad m => (b -> Parser a m b) -> b -> Stream m a -> Stream m (Either ParseErrorPos b)+    [D] parseIterateD :: Monad m => (b -> Parser a m b) -> b -> Stream m a -> Stream m (Either ParseError b)+    [D] parseD :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)+    [A] parseBreakPos :: Monad m => Parser a m b -> Stream m a -> m (Either ParseErrorPos b, Stream m a)+    [D] parseBreakD :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+    [A] outerSortedJoin :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [A] outerOrdJoin :: (Ord k, MonadIO m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)+    [A] outerJoin :: MonadIO m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [A] ordNub :: (Monad m, Ord a) => Stream m a -> Stream m a+    [R] nub :: (Monad m, Ord a) => Stream m a -> Stream m a+    [D] mkCross :: Stream m a -> Nested m a+    [A] loopBy :: Monad m => Unfold m x b -> x -> Stream m a -> Stream m (a, b)+    [A] loop :: Monad m => Stream m b -> Stream m a -> Stream m (a, b)+    [A] localReaderT :: Monad m => (r -> r) -> Stream (ReaderT r m) a -> Stream (ReaderT r m) a+    [A] leftSortedJoin :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [A] leftOrdJoin :: (Ord k, Monad m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)+    [A] leftJoin :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [R] joinOuterGeneric :: MonadIO m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [R] joinOuterAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [R] joinOuter :: (Ord k, MonadIO m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)+    [R] joinLeftGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [R] joinLeftAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [R] joinLeft :: (Ord k, Monad m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)+    [R] joinInnerGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)+    [R] joinInnerAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)+    [R] joinInner :: (Monad m, Ord k) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)+    [C] isInfixOf+        [O] isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a) => Stream m a -> Stream m a -> m Bool+        [N] isInfixOf :: (MonadIO m, Eq a, Enum a, Unbox a) => Stream m a -> Stream m a -> m Bool+    [R] intersperseMWith :: Int -> m a -> Stream m a -> Stream m a+    [D] intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a+    [D] intersperseMSuffixWith :: forall m a. Monad m => Int -> m a -> Stream m a -> Stream m a+    [D] intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a+    [D] intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseEveryM :: Int -> m a -> Stream m a -> Stream m a+    [A] intersperseEndByM_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseEndByM :: forall m a. Monad m => m a -> Stream m a -> Stream m a+    [A] intersperseEndByEveryM :: forall m a. Monad m => Int -> m a -> Stream m a -> Stream m a+    [A] intersperseBeginByM_ :: Monad m => m b -> Stream m a -> Stream m a+    [R] intersectBySorted :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] intersectBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [D] interposeSuffixM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [D] interposeSuffix :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [D] interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [D] interpose :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interleaveSepBy' :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveSepBy :: Monad m => Stream m a -> Stream m a -> Stream m a+    [D] interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a+    [D] interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a+    [D] interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveEndBy' :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveEndBy :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveBeginBy :: Stream m a -> Stream m a -> Stream m a+    [D] intercalateSuffix :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] intercalateSepBy :: Monad m => Unfold m b c -> Stream m b -> Unfold m a c -> Stream m a -> Stream m c+    [A] intercalateEndBy :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [D] intercalate :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] innerSortedJoin :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)+    [A] innerOrdJoin :: (Monad m, Ord k) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)+    [A] innerJoin :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)+    [A] initNonEmpty :: Monad m => Stream m a -> Stream m a+    [A] init :: Monad m => Stream m a -> m (Maybe (Stream m a))+    [D] indexOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] indexEndBy_ :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] indexEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [D] gintercalateSuffix :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [D] gintercalate :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [A] fromW16CString# :: Monad m => Addr# -> Stream m Word16+    [A] fromCString# :: Monad m => Addr# -> Stream m Word8+    [D] fromByteStr# :: Monad m => Addr# -> Stream m Word8+    [A] foldManySepBy :: Fold m a b -> Fold m a b -> Stream m a -> Stream m b+    [R] foldIterateBfs :: Fold m a (Either a a) -> Stream m a -> m (Maybe a)+    [A] finallyIO'' :: (MonadIO m, MonadCatch m) => AcquireIO -> IO b -> Stream m a -> Stream m a+    [A] finallyIO' :: MonadIO m => AcquireIO -> IO b -> Stream m a -> Stream m a+    [R] filterInStreamGenericBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [R] filterInStreamAscBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] fairUnfoldSched :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] fairUnfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] fairSchedMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+    [A] fairSchedMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+    [A] fairSchedForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+    [A] fairSchedFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+    [A] fairCrossWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+    [A] fairCrossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] fairCross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+    [A] fairConcatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+    [A] fairConcatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+    [A] fairConcatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+    [A] fairConcatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+    [R] deleteInStreamGenericBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [R] deleteInStreamAscBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] deleteFirstsBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [D] concatIterateDfs :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [D] concatIterateBfsRev :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [D] concatIterateBfs :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatIterate :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+    [A] concatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+    [A] bracketIO'' :: (MonadIO m, MonadCatch m) => AcquireIO -> IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+    [A] bracketIO' :: MonadIO m => AcquireIO -> IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+    [A] bfsUnfoldIterate :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] bfsUnfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] bfsReduceIterate :: Monad m => (a -> a -> m a) -> Stream m a -> m (Maybe a)+    [A] bfsFoldIterate :: Fold m a (Either a a) -> Stream m a -> m (Maybe a)+    [A] bfsConcatIterate :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] altBfsUnfoldIterate :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] altBfsUnfoldEach :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] altBfsConcatIterate :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+[A] Streamly.Internal.Data.Scanr+    [A] Scanr+        [A] Scanr :: (s -> a -> m (Step s b)) -> s -> Scanr m a b+    [A] GHC.Base.Functor+        [A] instance GHC.Base.Functor m => GHC.Base.Functor (Streamly.Internal.Data.Scanr.Scanr m a)+    [A] GHC.Base.Applicative+        [A] instance GHC.Base.Monad m => GHC.Base.Applicative (Streamly.Internal.Data.Scanr.Scanr m a)+    [A] Control.Category.Category+        [A] instance GHC.Base.Monad m => Control.Category.Category (Streamly.Internal.Data.Scanr.Scanr m)+    [A] Control.Arrow.Arrow+        [A] instance GHC.Base.Monad m => Control.Arrow.Arrow (Streamly.Internal.Data.Scanr.Scanr m)+    [A] teeWithMay :: Monad m => (Maybe b -> Maybe c -> d) -> Scanr m a b -> Scanr m a c -> Scanr m a d+    [A] teeWith :: Monad m => (b -> c -> d) -> Scanr m a b -> Scanr m a c -> Scanr m a d+    [A] tee :: Monad m => Scanr m a b -> Scanr m a c -> Scanr m a (b, c)+    [A] sum :: (Monad m, Num a) => Scanr m a a+    [A] length :: Monad m => Scanr m a Int+    [A] identity :: Monad m => Scanr m a a+    [A] functionM :: Monad m => (a -> m b) -> Scanr m a b+    [A] function :: Monad m => (a -> b) -> Scanr m a b+    [A] filterM :: Monad m => (a -> m Bool) -> Scanr m a a+    [A] filter :: Monad m => (a -> Bool) -> Scanr m a a+    [A] compose :: Monad m => Scanr m b c -> Scanr m a b -> Scanr m a c+[A] Streamly.Internal.Data.Scanl+    [A] Step+        [A] Partial :: !s -> Step s b+        [A] Done :: !b -> Step s b+    [A] Scanl+        [A] Scanl :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> (s -> m b) -> Scanl m a b+    [A] Incr+        [A] Replace :: !a -> !a -> Incr a+        [A] Insert :: !a -> Incr a+    [A] zipStreamWithM :: (a -> b -> m c) -> Stream m a -> Scanl m c x -> Scanl m b x+    [A] zipStream :: Monad m => Stream m a -> Scanl m (a, b) x -> Scanl m b x+    [A] with :: (Scanl m (s, a) b -> Scanl m a b) -> (((s, a) -> c) -> Scanl m (s, a) b -> Scanl m (s, a) b) -> ((s, a) -> c) -> Scanl m a b -> Scanl m a b+    [A] windowRange :: forall m a. (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (Maybe (a, a))+    [A] windowMinimum :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (Maybe a)+    [A] windowMaximum :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (Maybe a)+    [A] unzipWithM :: Monad m => (a -> m (b, c)) -> Scanl m b x -> Scanl m c y -> Scanl m a (x, y)+    [A] unzipWith :: Monad m => (a -> (b, c)) -> Scanl m b x -> Scanl m c y -> Scanl m a (x, y)+    [A] unzip :: Monad m => Scanl m a x -> Scanl m b y -> Scanl m (a, b) (x, y)+    [A] uniqBy :: Monad m => (a -> a -> Bool) -> Scanl m a (Maybe a)+    [A] uniq :: (Monad m, Eq a) => Scanl m a (Maybe a)+    [A] unfoldMany :: Monad m => Unfold m a b -> Scanl m b c -> Scanl m a c+    [A] topBy :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> Int -> Scanl m a (MutArray a)+    [A] top :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (MutArray a)+    [A] toStreamRev :: (Monad m, Monad n) => Scanl m a (Stream n a)+    [A] toStreamKRev :: Monad m => Scanl m a (StreamK n a)+    [A] toStreamK :: Monad m => Scanl m a (StreamK n a)+    [A] toStream :: (Monad m, Monad n) => Scanl m a (Stream n a)+    [A] toSet :: (Monad m, Ord a) => Scanl m a (Set a)+    [A] toListRev :: Monad m => Scanl m a [a]+    [A] toList :: Monad m => Scanl m a [a]+    [A] toIntSet :: Monad m => Scanl m Int IntSet+    [A] the :: (Monad m, Eq a) => Scanl m a (Maybe a)+    [A] teeWith :: Monad m => (b -> c -> d) -> Scanl m a b -> Scanl m a c -> Scanl m a d+    [A] tee :: Monad m => Scanl m a b -> Scanl m a c -> Scanl m a (b, c)+    [A] takingEndBy_ :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+    [A] takingEndByM_ :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+    [A] takingEndByM :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+    [A] takingEndBy :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+    [A] taking :: Monad m => Int -> Scanl m a (Maybe a)+    [A] takeEndBy_ :: Monad m => (a -> Bool) -> Scanl m a b -> Scanl m a b+    [A] takeEndBy :: Monad m => (a -> Bool) -> Scanl m a b -> Scanl m a b+    [A] take :: Monad m => Int -> Scanl m a b -> Scanl m a b+    [A] sum :: (Monad m, Num a) => Scanl m a a+    [A] sconcat :: (Monad m, Semigroup a) => a -> Scanl m a a+    [A] scanlMany :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+    [A] scanl :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+    [A] sampleFromthen :: Monad m => Int -> Int -> Scanl m a b -> Scanl m a b+    [A] rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Scanl m a b+    [A] rollingMap :: Monad m => (Maybe a -> a -> b) -> Scanl m a b+    [A] rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Scanl m a Int64+    [A] rollingHashFirstN :: (Monad m, Enum a) => Int -> Scanl m a Int64+    [A] rollingHash :: (Monad m, Enum a) => Scanl m a Int64+    [A] rmapM :: Monad m => (b -> m c) -> Scanl m a b -> Scanl m a c+    [A] repeated :: Scanl m a (Maybe a)+    [A] rangeBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe (a, a))+    [A] range :: (Monad m, Ord a) => Scanl m a (Maybe (a, a))+    [A] prune :: (a -> Bool) -> Scanl m a (Maybe a)+    [A] product :: (Monad m, Num a, Eq a) => Scanl m a a+    [A] postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Scanl m b c -> Scanl m a c+    [A] postscanl :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+    [A] pipe :: Monad m => Pipe m a b -> Scanl m b c -> Scanl m a c+    [A] partitionByM :: Monad m => (a -> m (Either b c)) -> Scanl m b x -> Scanl m c x -> Scanl m a x+    [A] partitionBy :: Monad m => (a -> Either b c) -> Scanl m b x -> Scanl m c x -> Scanl m a x+    [A] partition :: Monad m => Scanl m b x -> Scanl m c x -> Scanl m (Either b c) x+    [A] nubInt :: Monad m => Scanl m Int (Maybe Int)+    [A] nub :: (Monad m, Ord a) => Scanl m a (Maybe a)+    [A] morphInner :: (forall x. m x -> n x) -> Scanl m a b -> Scanl n a b+    [A] mkScantM :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Scanl m a b+    [A] mkScant :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Scanl m a b+    [A] mkScanrM :: Monad m => (a -> b -> m b) -> m b -> Scanl m a b+    [A] mkScanr :: Monad m => (a -> b -> b) -> b -> Scanl m a b+    [A] mkScanlM :: Monad m => (b -> a -> m b) -> m b -> Scanl m a b+    [A] mkScanl1M :: Monad m => (a -> a -> m a) -> Scanl m a (Maybe a)+    [A] mkScanl1 :: Monad m => (a -> a -> a) -> Scanl m a (Maybe a)+    [A] mkScanl :: Monad m => (b -> a -> b) -> b -> Scanl m a b+    [A] minimumBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe a)+    [A] minimum :: (Monad m, Ord a) => Scanl m a (Maybe a)+    [A] mean :: (Monad m, Fractional a) => Scanl m a a+    [A] mconcat :: (Monad m, Monoid a) => Scanl m a a+    [A] maximumBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe a)+    [A] maximum :: (Monad m, Ord a) => Scanl m a (Maybe a)+    [A] mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Scanl m b r -> Scanl m a r+    [A] mapMaybe :: Monad m => (a -> Maybe b) -> Scanl m b r -> Scanl m a r+    [A] mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)+    [A] lmapM :: Monad m => (a -> m b) -> Scanl m b r -> Scanl m a r+    [A] lmap :: (a -> b) -> Scanl m b r -> Scanl m a r+    [A] length :: Monad m => Scanl m a Int+    [A] latest :: Monad m => Scanl m a (Maybe a)+    [A] indexingWith :: Monad m => Int -> (Int -> Int) -> Scanl m a (Maybe (Int, a))+    [A] indexingRev :: Monad m => Int -> Scanl m a (Maybe (Int, a))+    [A] indexing :: Monad m => Scanl m a (Maybe (Int, a))+    [A] indexed :: Monad m => Scanl m (Int, a) b -> Scanl m a b+    [A] incrSumInt :: forall m a. (Monad m, Integral a) => Scanl m (Incr a) a+    [A] incrSum :: forall m a. (Monad m, Num a) => Scanl m (Incr a) a+    [A] incrScanWith :: forall m a b. (MonadIO m, Unbox a) => Int -> Scanl m (Incr a, RingArray a) b -> Scanl m a b+    [A] incrScan :: forall m a b. (MonadIO m, Unbox a) => Int -> Scanl m (Incr a) b -> Scanl m a b+    [A] incrRollingMapM :: Monad m => (Maybe a -> a -> m (Maybe b)) -> Scanl m (Incr a) (Maybe b)+    [A] incrRollingMap :: Monad m => (Maybe a -> a -> Maybe b) -> Scanl m (Incr a) (Maybe b)+    [A] incrPowerSumFrac :: (Monad m, Floating a) => a -> Scanl m (Incr a) a+    [A] incrPowerSum :: (Monad m, Num a) => Int -> Scanl m (Incr a) a+    [A] incrMean :: forall m a. (Monad m, Fractional a) => Scanl m (Incr a) a+    [A] incrCount :: (Monad m, Num b) => Scanl m (Incr a) b+    [A] genericLength :: (Monad m, Num b) => Scanl m a b+    [A] generalizeInner :: Monad m => Scanl Identity a b -> Scanl m a b+    [A] functionM :: Monad m => (a -> m (Maybe b)) -> Scanl m a (Maybe b)+    [A] fromRefold :: Refold m c a b -> c -> Scanl m a b+    [A] foldMapM :: (Monad m, Monoid b) => (a -> m b) -> Scanl m a b+    [A] foldMap :: (Monad m, Monoid b) => (a -> b) -> Scanl m a b+    [A] findIndices :: Monad m => (a -> Bool) -> Scanl m a (Maybe Int)+    [A] filtering :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+    [A] filterM :: Monad m => (a -> m Bool) -> Scanl m a r -> Scanl m a r+    [A] filter :: Monad m => (a -> Bool) -> Scanl m a r -> Scanl m a r+    [A] elemIndices :: (Monad m, Eq a) => a -> Scanl m a (Maybe Int)+    [A] droppingWhileM :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+    [A] droppingWhile :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+    [A] dropping :: Monad m => Int -> Scanl m a (Maybe a)+    [A] drainN :: Monad m => Int -> Scanl m a ()+    [A] drainMapM :: Monad m => (a -> m b) -> Scanl m a ()+    [A] drain :: Monad m => Scanl m a ()+    [A] distribute :: Monad m => [Scanl m a b] -> Scanl m a [b]+    [A] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (k -> m (Maybe (Scanl m a b))) -> Scanl m a (Maybe (k, b))+    [A] demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (Key f -> m (Maybe (Scanl m a b))) -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] demuxGeneric :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (Key f -> m (Maybe (Scanl m a b))) -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] demux :: (Monad m, Ord k) => (a -> k) -> (k -> m (Maybe (Scanl m a b))) -> Scanl m a (Maybe (k, b))+    [A] deleteBy :: Monad m => (a -> a -> Bool) -> a -> Scanl m a (Maybe a)+    [A] defaultSalt :: Int64+    [A] cumulativeScan :: Scanl m (Incr a) b -> Scanl m a b+    [A] countDistinctInt :: Monad m => Scanl m Int Int+    [A] countDistinct :: (Monad m, Ord a) => Scanl m a Int+    [A] constM :: Applicative m => m b -> Scanl m a b+    [A] const :: Applicative m => b -> Scanl m a b+    [A] classifyIO :: (MonadIO m, Ord k) => (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))+    [A] classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] classify :: (MonadIO m, Ord k) => (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))+    [A] chainStepM :: Applicative m => (s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)+    [A] catRights :: Monad m => Scanl m b c -> Scanl m (Either a b) c+    [A] catMaybes :: Monad m => Scanl m a b -> Scanl m (Maybe a) b+    [A] catLefts :: Monad m => Scanl m a c -> Scanl m (Either a b) c+    [A] catEithers :: Scanl m a b -> Scanl m (Either a a) b+    [A] bottomBy :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> Int -> Scanl m a (MutArray a)+    [A] bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (MutArray a)+[A] Streamly.Internal.Data.RingArray.Generic+    [A] RingArray+        [A] [ringMax] :: RingArray a -> !Int+        [A] [ringHead] :: RingArray a -> !Int+        [A] [ringArr] :: RingArray a -> MutArray a+        [A] RingArray :: MutArray a -> !Int -> !Int -> RingArray a+    [A] unsafeInsertRingWith :: RingArray a -> a -> IO Int+    [A] toStreamWith :: Int -> RingArray a -> Stream m a+    [A] toMutArray :: MonadIO m => Int -> Int -> RingArray a -> m (MutArray a)+    [A] seek :: MonadIO m => Int -> RingArray a -> m (RingArray a)+    [A] emptyOf :: MonadIO m => Int -> m (RingArray a)+    [A] createOf :: MonadIO m => Int -> Fold m a (RingArray a)+    [A] copyToMutArray :: MonadIO m => Int -> Int -> RingArray a -> m (MutArray a)+[A] Streamly.Internal.Data.RingArray+    [A] RingArray+        [A] [ringSize] :: RingArray a -> {-# UNPACK #-} !Int+        [A] [ringHead] :: RingArray a -> {-# UNPACK #-} !Int+        [A] [ringContents] :: RingArray a -> {-# UNPACK #-} !MutByteArray+        [A] RingArray :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> RingArray a+    [A] unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a+    [A] unsafeGetHead :: (MonadIO m, Unbox a) => RingArray a -> m a+    [A] unsafeCastMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> RingArray a+    [A] unsafeCastMutArray :: forall a. Unbox a => MutArray a -> RingArray a+    [A] unsafeCast :: RingArray a -> RingArray b+    [A] toMutArray :: (MonadIO m, Unbox a) => RingArray a -> m (MutArray a)+    [A] toList :: (MonadIO m, Unbox a) => RingArray a -> m [a]+    [A] showRing :: (Unbox a, Show a) => RingArray a -> IO String+    [A] scanRingsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m a (RingArray a)+    [A] scanFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> Int -> Scanl m a b+    [A] scanCustomFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) => (RingArray a -> m b) -> Int -> Scanl m a b+    [A] ringsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (RingArray a)+    [A] replace_ :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a)+    [A] replace :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a, a)+    [A] readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a+    [A] reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a+    [A] readRev :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a+    [A] read :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a+    [A] putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> a -> m ()+    [A] moveReverse :: forall a. Unbox a => RingArray a -> RingArray a+    [A] moveForward :: forall a. Unbox a => RingArray a -> RingArray a+    [A] moveBy :: forall a. Unbox a => Int -> RingArray a -> RingArray a+    [A] modifyIndex :: Int -> RingArray a -> (a -> (a, b)) -> m b+    [A] length :: forall a. Unbox a => RingArray a -> Int+    [A] insert :: RingArray a -> a -> m (RingArray a)+    [A] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m (Maybe a)+    [A] foldlM' :: forall m a b. (MonadIO m, Unbox a) => (b -> a -> m b) -> b -> RingArray a -> m b+    [A] fold :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> RingArray a -> m b+    [A] eqArrayN :: RingArray a -> Array a -> Int -> IO Bool+    [A] eqArray :: RingArray a -> Array a -> IO Bool+    [A] createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (RingArray a)+    [A] castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)+    [A] castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)+    [A] cast :: forall a b. Unbox b => RingArray a -> Maybe (RingArray b)+    [A] byteLength :: RingArray a -> Int+    [A] asMutArray_ :: RingArray a -> MutArray a+    [A] asMutArray :: RingArray a -> (MutArray a, Int)+    [A] asBytes :: RingArray a -> RingArray Word8+[R] Streamly.Internal.Data.Ring.Generic+[R] Streamly.Internal.Data.Ring+[C] Streamly.Internal.Data.Producer+    [C] parse+        [O] parse :: Monad m => Parser a m b -> Producer m (Source s a) a -> Source s a -> m (Either ParseError b, Source s a)+        [N] parse :: Monad m => Parser a m b -> Producer m (Source s a) a -> Source s a -> m (Either ParseErrorPos b, Source s a)+[C] Streamly.Internal.Data.Pipe+    [C] Step+        [A] YieldP :: ps -> b -> Step cs ps b+        [A] YieldC :: cs -> b -> Step cs ps b+        [R] Yield :: a -> s -> Step s a+        [A] Stop :: Step cs ps b+        [A] SkipP :: ps -> Step cs ps b+        [A] SkipC :: cs -> Step cs ps b+        [R] Continue :: s -> Step s a+    [R] PipeState+    [C] Pipe+        [C] Pipe+            [O] Pipe :: (s1 -> a -> m (Step (PipeState s1 s2) b)) -> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b+            [N] Pipe :: (cs -> a -> m (Step cs ps b)) -> (ps -> m (Step cs ps b)) -> cs -> Pipe m a b+    [R] zipWith :: Monad m => (a -> b -> c) -> Pipe m i a -> Pipe m i b -> Pipe m i c+    [A] teeMerge :: Monad m => Pipe m a b -> Pipe m a b -> Pipe m a b+    [R] tee :: Monad m => Pipe m a b -> Pipe m a b -> Pipe m a b+    [A] scanFold :: Monad m => Fold m a b -> Pipe m a b+    [A] identity :: Monad m => Pipe m a a+    [A] fromStream :: Monad m => Stream m a -> Pipe m () a+    [A] fromScanr :: Monad m => Scanr m a b -> Pipe m a b+    [A] fromFold :: Monad m => Fold m a b -> Pipe m a b+    [A] filterM :: Monad m => (a -> m Bool) -> Pipe m a a+    [A] filter :: Monad m => (a -> Bool) -> Pipe m a a+[A] Streamly.Internal.Data.Path+    [A] class IsPath a b+    [A] GHC.Show.Show+        [A] instance GHC.Show.Show Streamly.Internal.Data.Path.PathException+    [A] GHC.Exception.Type.Exception+        [A] instance GHC.Exception.Type.Exception Streamly.Internal.Data.Path.PathException+    [A] GHC.Classes.Eq+        [A] instance GHC.Classes.Eq Streamly.Internal.Data.Path.PathException+    [A] PathException+        [A] InvalidPath :: String -> PathException+    [A] unsafeFromPath :: IsPath a b => a -> b+    [A] toPath :: IsPath a b => b -> a+    [A] fromPath :: (IsPath a b, MonadThrow m) => a -> m b+[C] Streamly.Internal.Data.ParserK+    [C] Step+        [C] Partial+            [O] Partial :: !Int -> (Input a -> m (Step a m r)) -> Step a m r+            [N] Partial :: !Int -> StepParser a m r -> Step a m r+        [C] Continue+            [O] Continue :: !Int -> (Input a -> m (Step a m r)) -> Step a m r+            [N] Continue :: !Int -> StepParser a m r -> Step a m r+    [C] ParserK+        [C] [runParser]+            [O] [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)+            [N] [runParser] :: ParserK a m b -> forall r. (ParseResult b -> Int -> StepParser a m r) -> Int -> Int -> StepParser a m r+        [C] MkParser+            [O] 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+            [N] MkParser :: (forall r. (ParseResult b -> Int -> StepParser a m r) -> Int -> Int -> StepParser a m r) -> ParserK a m b+    [A] toParserK :: Monad m => Parser a m b -> ParserK a m b+    [A] toParser :: Monad m => ParserK a m b -> Parser a m b+    [A] parserDone :: Applicative m => ParseResult b -> Int -> Input a -> m (Step a m b)+    [A] chainr1 :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a+    [A] chainr :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a+    [A] chainl1 :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a+    [A] chainl :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a+    [D] adaptCG :: Monad m => Parser a m b -> ParserK (Array a) m b+    [D] adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [D] adapt :: Monad m => Parser a m b -> ParserK a m b+[C] Streamly.Internal.Data.Parser+    [C] Step+        [A] SPartial :: !Int -> !s -> Step s b+        [A] SError :: !String -> Step s b+        [A] SDone :: !Int -> !b -> Step s b+        [A] SContinue :: !Int -> !s -> Step s b+        [R] Partial :: !Int -> !s -> Step s b+        [R] Error :: !String -> Step s b+        [R] Done :: !Int -> !b -> Step s b+        [R] Continue :: !Int -> !s -> Step s b+    [C] Parser+        [C] Parser+            [O] Parser :: (s -> a -> m (Step s b)) -> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b+            [N] Parser :: (s -> a -> m (Step s b)) -> m (Initial s b) -> (s -> m (Final s b)) -> Parser a m b+    [A] ParseErrorPos+        [A] ParseErrorPos :: Int -> String -> ParseErrorPos+    [A] Final+        [A] FError :: !String -> Final s b+        [A] FDone :: !Int -> !b -> Final s b+        [A] FContinue :: !Int -> !s -> Final s b+    [C] ParseError+    [D] takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [D] takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [C] takeEndBy_+        [O] takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b+        [N] takeEndBy_ :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeBeginBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeBeginBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] mapCount :: (Int -> Int) -> Step s b -> Step s b+    [A] localReaderT :: (r -> r) -> Parser a (ReaderT r m) b -> Parser a (ReaderT r m) b+    [R] extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)+    [A] bimapMorphOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Final s b -> Step s1 b1+[C] Streamly.Internal.Data.MutByteArray+    [A] unsafePutSlice :: MonadIO m => MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()+    [A] unsafePutPtrN :: MonadIO m => Ptr Word8 -> MutByteArray -> Int -> Int -> m ()+    [A] unsafePinnedCloneSlice :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] unsafeCloneSliceAs :: MonadIO m => PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray+    [A] unsafeCloneSlice :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] unsafeByteCmp :: MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int+    [C] unsafeAsPtr+        [O] unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+        [N] unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> IO b) -> m b+    [A] touch :: MutByteArray -> IO ()+    [D] sizeOfMutableByteArray :: MutByteArray -> IO Int+    [A] reallocSliceAs :: PinnedState -> Int -> MutByteArray -> Int -> Int -> IO MutByteArray+    [D] putSliceUnsafe :: MonadIO m => MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()+    [D] pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray+    [D] pinnedNew :: Int -> IO MutByteArray+    [D] pinnedCloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [D] newBytesAs :: PinnedState -> Int -> IO MutByteArray+    [A] newAs :: PinnedState -> Int -> IO MutByteArray+    [A] new' :: Int -> IO MutByteArray+    [A] length :: MutByteArray -> IO Int+    [A] largeObjectThreshold :: Int+    [D] getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld+    [A] getMutByteArray# :: MutByteArray -> MutableByteArray# RealWorld+    [D] cloneSliceUnsafeAs :: MonadIO m => PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray+    [D] cloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] blockSize :: Int+[C] Streamly.Internal.Data.MutArray.Generic+    [C] MutArray+        [R] [arrTrueLen] :: MutArray a -> {-# UNPACK #-} !Int+        [R] [arrLen] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrEnd] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrBound] :: MutArray a -> {-# UNPACK #-} !Int+    [D] writeN :: MonadIO m => Int -> Fold m a (MutArray a)+    [D] write :: MonadIO m => Fold m a (MutArray a)+    [A] unsafeSnoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] unsafeSliceOffLen :: Int -> Int -> MutArray a -> MutArray a+    [A] unsafePutSlice :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+    [A] unsafePutIndex :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [A] unsafeModifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] unsafeGetIndexWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+    [A] unsafeGetIndex :: MonadIO m => Int -> MutArray a -> m a+    [D] strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+    [D] snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] sliceOffLen :: Int -> Int -> MutArray a -> MutArray a+    [D] putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+    [D] putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [D] new :: MonadIO m => Int -> m (MutArray a)+    [D] modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] initializeOfFilledUpto :: MonadIO m => Int -> Int -> a -> m (MutArray a)+    [D] getSliceUnsafe :: Int -> Int -> MutArray a -> MutArray a+    [D] getSlice :: Int -> Int -> MutArray a -> MutArray a+    [D] getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+    [D] getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+    [A] dropAround :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+[C] Streamly.Internal.Data.MutArray+    [R] IORef+    [D] writeNWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [D] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeIORef :: Unbox a => IORef a -> a -> IO ()+    [D] writeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [D] writeAppend :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+    [D] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] vacate :: MutArray a -> MutArray a+    [A] unsafeSplice :: MonadIO m => MutArray a -> MutArray a -> m (MutArray a)+    [A] unsafeSnoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] unsafeSliceOffLen :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [A] unsafePutIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] unsafePokeSkip :: Int -> MutArray Word8 -> MutArray Word8+    [D] unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] unsafePeekSkip :: Int -> MutArray Word8 -> MutArray Word8+    [A] unsafePeek :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (a, MutArray Word8)+    [A] unsafeModifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] unsafeGetIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] unsafeCreateWithPtr' :: MonadIO m => Int -> (Ptr Word8 -> IO Int) -> m (MutArray Word8)+    [A] unsafeCreateWithOf :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [R] unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] unsafeCreateOf' :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] unsafeCast :: MutArray a -> MutArray b+    [A] unsafeBreakAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+    [C] unsafeAsPtr+        [O] unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+        [N] unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> Int -> IO b) -> m b+    [A] unsafeAppendPtrN :: MonadIO m => MutArray Word8 -> Ptr Word8 -> Int -> m (MutArray Word8)+    [D] unsafeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] unsafeAppendMax :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> Fold m a (MutArray a)+    [A] toMutByteArray :: MutArray a -> (MutByteArray, Int, Int)+    [D] strip :: forall a m. (Unbox a, MonadIO m) => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] splitterFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [D] splitOn :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [A] splitEndBy_ :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [A] splitEndBy :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [D] splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+    [D] spliceUnsafe :: MonadIO m => MutArray a -> MutArray a -> m (MutArray a)+    [D] snocUnsafe :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [D] snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] snocGrowBy :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)+    [D] slicerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [A] sliceOffLen :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [D] sliceIndexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] serializePtrN :: MutArray Word8 -> Ptr a -> Int -> m (MutArray Word8)+    [A] serialize :: forall m a. (MonadIO m, Serialize a) => MutArray Word8 -> a -> m (MutArray Word8)+    [A] scanCompactMin' :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m (MutArray a) (Maybe (MutArray a))+    [A] scanCompactMin :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m (MutArray a) (Maybe (MutArray a))+    [A] revDropWhile :: forall a m. (Unbox a, MonadIO m) => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] revBreakEndBy_ :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+    [A] revBreakEndBy :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+    [A] reallocBytesWith :: forall m a. (MonadIO m, Unbox a) => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)+    [A] reallocBytes :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] readIORef :: Unbox a => IORef a -> IO a+    [A] rangeBy :: (a -> a -> Ordering) -> MutArray a -> IO (Maybe (a, a))+    [D] putIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [D] pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> Stream m a+    [D] pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+    [A] pokeMay :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (Maybe (MutArray Word8))+    [D] pokeAppendMay :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (Maybe (MutArray Word8))+    [D] pokeAppend :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (MutArray Word8)+    [A] poke :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (MutArray Word8)+    [D] pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)+    [D] pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [D] pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [D] pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [D] pinnedEmptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [D] pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [D] pinnedCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [D] pinnedClone :: MonadIO m => MutArray a -> m (MutArray a)+    [D] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [D] peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (a, MutArray Word8)+    [D] peekUncons :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (Maybe a, MutArray Word8)+    [D] peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+    [A] peek :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (Maybe a, MutArray Word8)+    [D] pPinnedCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [D] pCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [D] newIORef :: forall a. Unbox a => a -> IO (IORef a)+    [D] newArrayWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int -> IO MutByteArray) -> Int -> Int -> m (MutArray a)+    [D] new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [D] modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [D] modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()+    [D] lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [D] lCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] isPower2 :: Int -> Bool+    [A] indexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] growTo :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] growBy :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] grow :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] getSliceUnsafe :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [D] getSlice :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [D] getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] fromW16CString# :: MonadIO m => Addr# -> m (MutArray Word16)+    [A] fromMutByteArray :: MonadIO m => MutByteArray -> Int -> Int -> 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] fromCString# :: MonadIO m => Addr# -> m (MutArray Word8)+    [D] fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)+    [A] free :: forall a. Unbox a => MutArray a -> Int+    [A] foldRev :: (MonadIO m, Unbox a) => Fold m a b -> MutArray a -> m b+    [A] fold :: (MonadIO m, Unbox a) => Fold m a b -> MutArray a -> m b+    [D] fPinnedCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [D] fCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] emptyWithAligned :: forall m a. (MonadIO m, Unbox a) => (Int -> Int -> IO MutByteArray) -> Int -> Int -> m (MutArray a)+    [A] emptyOf' :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] dropWhile :: forall a m. (Unbox a, MonadIO m) => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] dropAround :: forall a m. (Unbox a, MonadIO m) => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] deserializePtrN :: MutArray Word8 -> (Ptr a -> Int -> m b) -> m (a, MutArray Word8)+    [A] deserialize :: (MonadIO m, Serialize a) => MutArray Word8 -> m (a, MutArray Word8)+    [A] createWithOf :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [D] createWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] createOfWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (MutArray a)+    [A] createOf' :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] createMinOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] createCompactMin' :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] createCompactMin :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] createCompactMax' :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [A] createCompactMax :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [A] create' :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] compactSepByByte_ :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [D] compactOnByteSuffix :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [D] compactOnByte :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [A] compactMin :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactMax' :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactMax :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [D] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [D] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactExact :: Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactEndByLn_ :: MonadIO m => Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [A] compactEndByByte_ :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [R] compactEQ :: Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [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] chunksEndByLn' :: MonadIO m => Stream m Word8 -> Stream m (MutArray Word8)+    [A] chunksEndByLn :: MonadIO m => Stream m Word8 -> Stream m (MutArray Word8)+    [A] chunksEndBy' :: forall m a. (MonadIO m, Unbox a) => (a -> Bool) -> Stream m a -> Stream m (MutArray a)+    [A] chunksEndBy :: forall m a. (MonadIO m, Unbox a) => (a -> Bool) -> Stream m a -> Stream m (MutArray a)+    [D] castUnsafe :: MutArray a -> MutArray b+    [A] capacity :: forall a. Unbox a => MutArray a -> Int+    [D] breakOn :: MonadIO m => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+    [A] breakEndBy_ :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+    [A] breakEndByWord8_ :: MonadIO m => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+    [A] breakEndBy :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+    [A] breakAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+    [A] asCWString :: MutArray a -> (CWString -> IO b) -> IO b+    [A] asCString :: MutArray a -> (CString -> IO b) -> IO b+    [A] appendStreamN :: (MonadIO m, Unbox a) => Int -> MutArray a -> Stream m a -> m (MutArray a)+    [A] appendStream :: (MonadIO m, Unbox a) => MutArray a -> Stream m a -> m (MutArray a)+    [A] appendPtrN :: MonadIO m => MutArray Word8 -> Ptr Word8 -> Int -> m (MutArray Word8)+    [D] appendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] appendMax :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> Fold m a (MutArray a)+    [A] appendGrowBy :: (MonadIO m, Unbox a) => Int -> MutArray a -> Fold m a (MutArray a)+    [A] appendCString# :: MonadIO m => MutArray Word8 -> Addr# -> m (MutArray Word8)+    [A] appendCString :: MonadIO m => MutArray Word8 -> Ptr a -> m (MutArray Word8)+    [A] append2 :: (MonadIO m, Unbox a) => MutArray a -> Fold m a (MutArray a)+    [D] append :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+[A] Streamly.Internal.Data.IORef+    [A] IORef+    [A] writeIORef :: Unbox a => IORef a -> a -> IO ()+    [A] readIORef :: Unbox a => IORef a -> IO a+    [A] pollIORefInt :: MonadIO m => IORef Int -> Stream m Int+    [A] pollGenericIORef :: (MonadIO m, Unbox a) => IORef a -> Stream m a+    [A] newIORef :: forall a. Unbox a => a -> IO (IORef a)+    [A] modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()+[C] Streamly.Internal.Data.Fold+    [C] windowRange+        [O] windowRange :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))+        [N] windowRange :: forall m a. (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (Maybe (a, a))+    [C] windowMinimum+        [O] windowMinimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+        [N] windowMinimum :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (Maybe a)+    [C] windowMaximum+        [O] windowMaximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+        [N] windowMaximum :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (Maybe a)+    [R] transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c+    [C] toContainerIO+        [O] toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+        [N] toContainerIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+    [C] toContainer+        [O] toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+        [N] toContainer :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+    [C] takeEndBySeq_+        [O] takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Fold m a b+        [N] takeEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Fold m a b+    [C] takeEndBySeq+        [O] takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Fold m a b+        [N] takeEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Fold m a b+    [A] scanlMany :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+    [A] scanl :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+    [D] scanMaybe :: Monad m => Fold m a (Maybe b) -> Fold m b c -> Fold m a c+    [D] scanMany :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [D] scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [A] rollingMap :: Monad m => (Maybe a -> a -> b) -> Fold m a b+    [A] rangeBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe (a, a))+    [A] range :: (Monad m, Ord a) => Fold m a (Maybe (a, a))+    [A] postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Fold m b c -> Fold m a c+    [A] postscanl :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+    [D] postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [A] pipe :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c+    [A] onException :: MonadCatch m => m x -> Fold m a b -> Fold m a b+    [R] lengthGeneric :: (Monad m, Num b) => Fold m a b+    [D] indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))+    [D] indexingRev :: Monad m => Int -> Fold m a (Maybe (Int, a))+    [D] indexing :: Monad m => Fold m a (Maybe (Int, a))+    [R] indexGeneric :: (Integral i, Monad m) => i -> Fold m a (Maybe a)+    [A] ifThen :: Monad m => m Bool -> Fold m a b -> Fold m a b -> Fold m a b+    [A] genericLength :: (Monad m, Num b) => Fold m a b+    [A] genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)+    [A] fromScanl :: Scanl m a b -> Fold m a b+    [D] foldlM1' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+    [A] foldl1M' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+    [A] finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Fold m a b -> Fold m a b+    [A] finalM :: Monad m => Fold m a b -> m b+    [D] extractM :: Monad m => Fold m a b -> m b+    [A] distributeScan :: Monad m => m [Fold m a b] -> Scanl m a [b]+    [A] demuxerToMapIO :: (MonadIO m, Ord k) => (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)+    [A] demuxerToMap :: (Monad m, Ord k) => (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)+    [A] demuxerToContainerIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)+    [A] demuxerToContainer :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Fold m a (f b)+    [D] demuxToMapIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [D] demuxToMap :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [D] demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)+    [D] demuxToContainer :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)+    [A] demuxScanIO :: (MonadIO m, Ord k) => (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Scanl m a (Maybe (k, b))+    [A] demuxScanGenericIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] demuxScanGeneric :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (Key f -> m (Maybe (Fold m a b))) -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] demuxScan :: (Monad m, Ord k) => (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Scanl m a (Maybe (k, b))+    [C] demuxKvToMap+        [O] demuxKvToMap :: (Monad m, Ord k) => (k -> m (Fold m a b)) -> Fold m (k, a) (Map k b)+        [N] demuxKvToMap :: (Monad m, Ord k) => (k -> m (Maybe (Fold m a b))) -> Fold m (k, a) (Map k b)+    [C] demuxKvToContainer+        [O] demuxKvToContainer :: (Monad m, IsMap f, Traversable f) => (Key f -> m (Fold m a b)) -> Fold m (Key f, a) (f b)+        [N] demuxKvToContainer :: (Monad m, IsMap f, Traversable f) => (Key f -> m (Maybe (Fold m a b))) -> Fold m (Key f, a) (f b)+    [D] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [D] 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))+    [D] 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))+    [D] demux :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [A] classifyScanIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))+    [A] classifyScanGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] classifyScanGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))+    [A] classifyScan :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))+    [D] classifyIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [D] 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))+    [D] 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))+    [D] classify :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO x -> (x -> IO c) -> (x -> Fold m a b) -> Fold m a b+    [A] before :: Monad m => m x -> Fold m a b -> Fold m a b+[A] Streamly.Internal.Data.CString+    [A] splicePtrN :: MutByteArray -> Ptr Word8 -> Int -> IO Int+    [A] spliceCString :: MutByteArray -> CString -> IO Int+    [A] splice :: MutByteArray -> MutByteArray -> IO Int+    [A] putCString :: MutByteArray -> Int -> CString -> IO Int+    [A] length :: MutByteArray -> IO Int+[C] Streamly.Internal.Data.Array.Generic+    [C] Array+        [R] [arrLen] :: Array a -> {-# UNPACK #-} !Int+        [A] [arrEnd] :: Array a -> {-# UNPACK #-} !Int+    [R] GHC.Show.Show+    [R] GHC.Read.Read+    [R] GHC.Classes.Ord+    [R] GHC.Classes.Eq+    [R] writeWith :: MonadIO m => Int -> Fold m a (Array a)+    [D] writeN :: MonadIO m => Int -> Fold m a (Array a)+    [R] writeLastN :: MonadIO m => Int -> Fold m a (Array a)+    [D] write :: MonadIO m => Fold m a (Array a)+    [A] unsafeThaw :: Array a -> MutArray a+    [A] unsafeSliceOffLen :: Int -> Int -> Array a -> Array a+    [A] unsafeGetIndex :: Int -> Array a -> a+    [A] unsafeFreeze :: MutArray a -> Array a+    [A] toParserK :: Monad m => Parser a m b -> ParserK (Array a) m b+    [D] strip :: (a -> Bool) -> Array a -> Array a+    [A] parsePos :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b)+    [A] parseBreakPos :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b, StreamK m (Array a))+    [A] parseBreak :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parse :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [D] getSliceUnsafe :: Int -> Int -> Array a -> Array a+    [D] getIndexUnsafe :: Int -> Array a -> a+    [A] fromCString# :: MonadIO m => Addr# -> m (Array Word8)+    [D] fromByteStr# :: Addr# -> Array Word8+    [A] dropAround :: (a -> Bool) -> Array a -> Array a+    [A] createWith :: MonadIO m => Int -> Fold m a (Array a)+    [A] createOfLast :: MonadIO m => Int -> Fold m a (Array a)+[C] Streamly.Internal.Data.Array+    [D] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] writeLastN :: (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+    [D] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] unsnoc :: Unbox a => Array a -> Maybe (Array a, a)+    [A] unsafeSliceOffLen :: forall a. Unbox a => Int -> Int -> Array a -> Array a+    [A] unsafeReader :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+    [D] unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [C] unsafePinnedAsPtr+        [O] unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> m b) -> m b+        [N] unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> Int -> IO b) -> m b+    [D] unsafeIndexIO :: forall a. Unbox a => Int -> Array a -> IO a+    [A] unsafeGetIndexRevIO :: forall a. Unbox a => Int -> Array a -> IO a+    [A] unsafeGetIndexRev :: forall a. Unbox a => Int -> Array a -> a+    [A] unsafeGetIndexIO :: forall a. Unbox a => Int -> Array a -> IO a+    [A] unsafeGetIndex :: forall a. Unbox a => Int -> Array a -> a+    [A] unsafeFromForeignPtr :: MonadIO m => ForeignPtr Word8 -> Int -> m (Array Word8)+    [A] unsafeCreateOf' :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] unsafeCast :: Array a -> Array b+    [A] unsafeBreakAt :: Unbox a => Int -> Array a -> (Array a, Array a)+    [A] unsafeAsForeignPtr :: MonadIO m => Array a -> (ForeignPtr a -> Int -> IO b) -> m b+    [A] uncons :: Unbox a => Array a -> Maybe (a, Array a)+    [A] toParserK :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [A] tail :: Unbox a => Array a -> Array a+    [A] splitterFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Array a)+    [D] splitOn :: (Monad m, Unbox a) => (a -> Bool) -> Array a -> Stream m (Array a)+    [A] splitEndBy_ :: (Monad m, Unbox a) => (a -> Bool) -> Array a -> Stream m (Array a)+    [A] splitEndBy :: (MonadIO m, Unbox a) => (a -> Bool) -> Array a -> Stream m (Array a)+    [D] splitAt :: Unbox a => Int -> Array a -> (Array a, Array a)+    [D] slicerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Array a)+    [D] sliceIndexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Int, Int)+    [A] serialize' :: Serialize a => a -> Array Word8+    [A] scanCompactMin' :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m (Array a) (Maybe (Array a))+    [A] scanCompactMin :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m (Array a) (Maybe (Array a))+    [A] revDropWhile :: Unbox a => (a -> Bool) -> Array a -> Array a+    [A] revBreakEndBy_ :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+    [A] revBreakEndBy :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+    [D] readerUnsafe :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+    [D] pinnedSerialize :: Serialize a => a -> Array Word8+    [D] pinnedFromListN :: Unbox a => Int -> [a] -> Array a+    [D] pinnedFromList :: Unbox a => [a] -> Array a+    [D] pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [D] pinnedCompactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [R] pinnedClone :: MonadIO m => Array a -> m (Array a)+    [D] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] parsePos :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b)+    [A] parseBreakPos :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b, StreamK m (Array a))+    [R] parseBreakChunksK :: forall m a b. (MonadIO m, Unbox a) => Parser a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parse :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] listEq :: (Unbox a, Ord a) => [a] -> Array a -> Bool+    [A] listCmp :: (Unbox a, Ord a) => [a] -> Array a -> Ordering+    [D] lPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [D] lCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [D] interposeSuffix :: forall m a. (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [D] interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [D] intercalateSuffix :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a+    [A] init :: Unbox a => Array a -> Array a+    [A] indexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Int, Int)+    [A] head :: Unbox a => Array a -> Maybe a+    [D] getSliceUnsafe :: forall a. Unbox a => Int -> Int -> Array a -> Array a+    [D] getIndexUnsafe :: forall a. Unbox a => Int -> Array a -> a+    [A] fromW16CString# :: MonadIO m => Addr# -> m (Array Word16)+    [A] fromW16CString :: MonadIO m => Ptr Word8 -> m (Array Word16)+    [C] fromPtrN+        [O] fromPtrN :: Int -> Ptr Word8 -> Array Word8+        [N] fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (Array Word8)+    [A] fromListN' :: Unbox a => Int -> [a] -> Array a+    [A] fromList' :: Unbox a => [a] -> Array a+    [A] fromCString# :: MonadIO m => Addr# -> m (Array Word8)+    [A] fromCString :: MonadIO m => Ptr Word8 -> m (Array Word8)+    [D] fromByteStr# :: Addr# -> Array Word8+    [D] fromByteStr :: Ptr Word8 -> Array Word8+    [A] foldRev :: Unbox a => Fold Identity a b -> Array a -> b+    [A] foldM :: (Monad m, Unbox a) => Fold m a b -> Array a -> m b+    [D] foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+    [A] foldBreak :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+    [D] fold :: (Monad m, Unbox a) => Fold m a b -> Array a -> m b+    [D] fPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [D] fCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] dropWhile :: Unbox a => (a -> Bool) -> Array a -> Array a+    [A] dropAround :: Unbox a => (a -> Bool) -> Array a -> Array a+    [C] deserialize+        [O] deserialize :: Serialize a => Array Word8 -> a+        [N] deserialize :: Serialize a => Array Word8 -> (a, Array Word8)+    [A] createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+    [A] createOf' :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] createCompactMin' :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] createCompactMin :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] create' :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] concatSepBy :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] concatEndBySeq :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a+    [A] concatEndBy :: forall m a. (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] compactSepByByte_ :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [D] compactOnByteSuffix :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [D] compactOnByte :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] compactMin :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] compactMax' :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] compactMax :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [D] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [D] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] compactEndByLn_ :: MonadIO m => Stream m (Array Word8) -> Stream m (Array Word8)+    [A] compactEndByByte_ :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [R] 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] chunksEndByLn' :: MonadIO m => Stream m Word8 -> Stream m (Array Word8)+    [A] chunksEndByLn :: MonadIO m => Stream m Word8 -> Stream m (Array Word8)+    [A] chunksEndBy' :: forall m a. (MonadIO m, Unbox a) => (a -> Bool) -> Stream m a -> Stream m (Array a)+    [A] chunksEndBy :: forall m a. (MonadIO m, Unbox a) => (a -> Bool) -> Stream m a -> Stream m (Array a)+    [D] castUnsafe :: Array a -> Array b+    [D] breakOn :: MonadIO m => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))+    [A] breakEndBy_ :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+    [A] breakEndByWord8_ :: MonadIO m => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))+    [A] breakEndBy :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+    [A] breakAt :: Unbox a => Int -> Array a -> (Array a, Array a)+    [A] asCWString :: Array a -> (CWString -> IO b) -> IO b+[C] Streamly.Internal.Control.Exception+    [A] Priority+        [A] Priority2 :: Priority+        [A] Priority1 :: Priority+    [A] GHC.Show.Show+        [A] instance GHC.Show.Show Streamly.Internal.Control.Exception.Priority+    [A] AcquireIO+        [A] AcquireIO :: (forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ())) -> AcquireIO+    [A] withAcquireIO :: (MonadIO m, MonadMask m) => (AcquireIO -> m a) -> m a+    [A] releaser :: MonadIO m => IORef (a, IntMap (IO b), IntMap (IO b)) -> m ()+    [A] registerWith :: Priority -> AcquireIO -> IO () -> IO ()+    [A] register :: AcquireIO -> IO () -> IO ()+    [A] hook :: AcquireIO -> IO () -> IO (IO ())+    [A] allocator :: MonadIO m => IORef (Int, IntMap (IO ()), IntMap (IO ())) -> Priority -> IO a -> (a -> IO b) -> m (a, m ())+    [A] acquire_ :: AcquireIO -> IO b -> (b -> IO c) -> IO b+    [A] acquireWith :: Priority -> AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())+    [A] acquire :: AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())
docs/Changelog.md view
@@ -1,9 +1,66 @@ # Changelog -## 0.2.3 (Feb 2025)+## 0.3.0 -* Fix breakOn/lines in the Array module.-* Support GHC 9.12+See [0.2.2-0.3.0 API Changelog](/core/docs/ApiChangelogs/0.2.2-0.3.0.txt) for a+full list of deprecations, additions, and changes to the function signatures.++### Enhancements++* Added APIs for prompt cleanup of resources, allowing guaranteed+  cleanup as an alternative to GC-based cleanup.+* Added operations for fair nesting of inner and outer streams for+  exploring them equally, generally useful but especially useful for logic+  programming use cases.+* Introduced `Streamly.Data.Scanl` with a new `Scanl` type. Scans can+  split a stream into multiple streams, process them independently, and+  merge the results. The `Fold` type is now split into `Fold` and `Scanl`.+* Added `RingArray` module for high-performance, unboxed circular buffers.+* Added `Streamly.FileSystem.Path` module with a `Path` type for flexibly typed+  file system paths.+* Added `Streamly.FileSystem.DirIO` and `Streamly.FileSystem.FileIO` to replace+  the deprecated `Streamly.FileSystem.Dir` and `Streamly.FileSystem.File`. The+  new modules use Streamly’s native `Path` type instead of `FilePath`. `DirIO`+  APIs take a `ReadOptions` argument, and its directory read APIs do not follow+  symlinks by default.+* Removed `Storable` constraint from:+  - `Streamly.Data.Stream.isInfixOf`+  - `Streamly.Data.Array.writeLastN`++### Deprecations++Following APIs/modules are deprecated and renamed or replaced with new+APIs.++* `Streamly.FileSystem.Dir`, `Streamly.FileSystem.File` have been replaced by+  new modules.+* Renamed `writeN`-like APIs to `createOf`-like in Array modules.+* Renamed `new`-like APIs to `emptyOf`-like in Array modules.+* In the Fold module renamed `indexGeneric`, `lengthGeneric`, and `foldlM1'` to+  `genericIndex`, `genericLength`, and `foldl1M'` respectively.++### Internal API Changes++* In `Streamly.Internal.Data.Parser`, constructors `Partial`, `Continue`, and+  `Done` are deprecated and replaced with `SPartial`, `SContinue`, and `SDone`.+  Migration steps:+  * In parser step functions:+    - `Partial n` -> `SPartial (1-n)`+    - `Continue n` -> `SContinue (1-n)`+    - `Done n` -> `SDone (1-n)`+    - `Error` -> `SError`+  * Extract function now returns `Parser.Final` (instead of `Parser.Step`):+    - `Continue n` -> `FContinue (-n)`+    - `Done n` -> `FDone (-n)`+    - `Partial n` -> `FContinue (-n)`+    - `Error` -> `FError`+  * If `n` is used for decision-making, the logic must be updated accordingly.+    See docs for details.+* Internal (mut)array functions now use explicit IO callbacks instead of lifted+  callbacks.+* Removed `Storable` constraint from several ring buffer functions.+* Added `Streamly.Internal.Data.IORef` module exposing `IORef` and related+  functions.  ## 0.2.2 (Jan 2024)
docs/Readme.md view
@@ -1,1 +1,2 @@-Please refer to the "streamly" package for tutorials and other documentation.+Please refer to the [streamly](/docs/User/Tutorials/using-streamly.md)+package for tutorials and other documentation.
− src/DocTestDataArray.hs 
@@ -1,22 +0,0 @@-{- $setup->>> :m->>> :set -XFlexibleContexts->>> :set -XMagicHash->>> import Data.Function ((&))->>> import Data.Functor.Identity (Identity(..))->>> import System.IO.Unsafe (unsafePerformIO)-->>> import Streamly.Data.Array (Array)->>> import Streamly.Data.Stream (Stream)-->>> import qualified Streamly.Data.Array as Array->>> import qualified Streamly.Data.Fold as Fold->>> import qualified Streamly.Data.ParserK as ParserK->>> import qualified Streamly.Data.Stream as Stream->>> import qualified Streamly.Data.StreamK as StreamK--For APIs that have not been released yet.-->>> import qualified Streamly.Internal.Data.Array as Array->>> import qualified Streamly.Internal.Data.Stream as Stream--}
− src/DocTestDataFold.hs 
@@ -1,27 +0,0 @@-{- $setup->>> :m->>> :set -XFlexibleContexts->>> import Control.Monad (void)->>> import qualified Data.Foldable as Foldable->>> import Data.Function ((&))->>> import Data.Functor.Identity (Identity, runIdentity)->>> import Data.IORef (newIORef, readIORef, writeIORef)->>> import Data.Maybe (fromJust, isJust)->>> import Data.Monoid (Endo(..), Last(..), Sum(..))-->>> import Streamly.Data.Array (Array)->>> import Streamly.Data.Fold (Fold, Tee(..))->>> import Streamly.Data.Stream (Stream)-->>> import qualified Streamly.Data.Array as Array->>> import qualified Streamly.Data.Fold as Fold->>> import qualified Streamly.Data.MutArray as MutArray->>> import qualified Streamly.Data.Parser as Parser->>> import qualified Streamly.Data.Stream as Stream->>> import qualified Streamly.Data.StreamK as StreamK->>> import qualified Streamly.Data.Unfold as Unfold--For APIs that have not been released yet.-->>> import qualified Streamly.Internal.Data.Fold as Fold--}
− src/DocTestDataMutArray.hs 
@@ -1,10 +0,0 @@-{- $setup->>> :m->>> import qualified Streamly.Data.Fold as Fold->>> import qualified Streamly.Data.MutArray as MutArray->>> import qualified Streamly.Data.Stream as Stream--For APIs that have not been released yet.-->>> import Streamly.Internal.Data.MutArray as MutArray--}
− src/DocTestDataMutArrayGeneric.hs 
@@ -1,10 +0,0 @@-{- $setup->>> :m->>> import qualified Streamly.Data.Fold as Fold->>> import qualified Streamly.Data.MutArray.Generic as MutArray->>> import qualified Streamly.Data.Stream as Stream--For APIs that have not been released yet.-->>> import Streamly.Internal.Data.MutArray.Generic as MutArray--}
− src/DocTestDataParser.hs 
@@ -1,20 +0,0 @@-{- $setup->>> :m->>> import Control.Applicative ((<|>))->>> import Data.Bifunctor (second)->>> import Data.Char (isSpace)->>> import qualified Data.Foldable as Foldable->>> import qualified Data.Maybe as Maybe-->>> import Streamly.Data.Fold (Fold)->>> 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--For APIs that have not been released yet.-->>> import qualified Streamly.Internal.Data.Fold as Fold->>> import qualified Streamly.Internal.Data.Parser as Parser--}
− src/DocTestDataParserK.hs 
@@ -1,15 +0,0 @@-{- $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 
@@ -1,37 +0,0 @@-{- $setup-->>> :m->>> import Control.Concurrent (threadDelay)->>> import Control.Monad (void)->>> import Control.Monad.IO.Class (MonadIO (liftIO))->>> import Control.Monad.Trans.Class (lift)->>> import Control.Monad.Trans.Identity (runIdentityT)->>> import Data.Either (fromLeft, fromRight, isLeft, isRight, either)->>> import Data.Maybe (fromJust, isJust)->>> import Data.Function (fix, (&))->>> import Data.Functor.Identity (runIdentity)->>> import Data.IORef->>> import Data.Semigroup (cycle1)->>> import GHC.Exts (Ptr (Ptr))->>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))-->>> hSetBuffering stdout LineBuffering->>> effect n = print n >> return n-->>> import Streamly.Data.Stream (Stream)->>> 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--For APIs that have not been released yet.-->>> import qualified Streamly.Internal.Data.Fold as Fold->>> import qualified Streamly.Internal.Data.Parser as Parser->>> import qualified Streamly.Internal.Data.Stream as Stream->>> import qualified Streamly.Internal.Data.Unfold as Unfold->>> import qualified Streamly.Internal.FileSystem.Dir as Dir--}
− src/DocTestDataStreamK.hs 
@@ -1,21 +0,0 @@-{- $setup-->>> :m->>> import Control.Concurrent (threadDelay)->>> import Data.Function (fix, (&))->>> import Data.Semigroup (cycle1)-->>> effect n = print n >> return n-->>> import Streamly.Data.StreamK (StreamK)->>> import qualified Streamly.Data.Fold as Fold->>> import qualified Streamly.Data.Parser as Parser->>> import qualified Streamly.Data.Stream as Stream->>> import qualified Streamly.Data.StreamK as StreamK->>> import qualified Streamly.FileSystem.Dir as Dir--For APIs that have not been released yet.-->>> import qualified Streamly.Internal.Data.StreamK as StreamK->>> import qualified Streamly.Internal.FileSystem.Dir as Dir--}
− src/DocTestDataUnfold.hs 
@@ -1,12 +0,0 @@-{- $setup-->>> :m->>> import Streamly.Data.Unfold (Unfold)->>> 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.Unfold as Unfold--}
− src/DocTestFileSystemHandle.hs 
@@ -1,15 +0,0 @@-{- $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 (unsafeCreateOf)->>> 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 
@@ -1,9 +0,0 @@-{- $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 
@@ -1,12 +0,0 @@-{- $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 
@@ -1,5 +0,0 @@-{- $setup->>> :m->>> :set -XQuasiQuotes->>> import Streamly.Internal.Unicode.String--}
src/Streamly/Console/Stdio.hs view
@@ -7,14 +7,37 @@ -- Stability   : released -- Portability : GHC ----- Combinators to work with standard input, output and error streams.+-- Combinators to work with standard input, output, and error streams. This+-- module supports reading and writing binary data or UTF-8 encoded text only.+-- However, it is possible to use specific encoders and decoders to implement+-- other encodings. --+-- These streaming APIs use the stdin and stdout handles for reading from and+-- writing to the console. The reads and writes are buffered, meaning each+-- stream has its own buffer. Be cautious when switching between these APIs and+-- handle-based APIs (e.g., readChars, getLine), between different stream APIs+-- (e.g., readChars, readChunks), or even between different calls to the same+-- API (e.g., readChars, readChars). If you switch from one stream to another,+-- you should drain the first stream completely if you care about preserving+-- any buffered data.+-- -- See also: "Streamly.Internal.Console.Stdio" +-- XXX put examples of repeatM getLine from stream module+-- XXX put examples of using parseBreak or foldBreak.+ module Streamly.Console.Stdio     (+    -- * Streams (stdin)+      read+    , readChars+    , readChunks++    -- * Streams (srdout)+    , putChunks+     -- * Unfolds (stdin)-      reader+    , reader     , chunkReader      -- * Write (stdout)@@ -27,4 +50,5 @@     ) where +import Prelude hiding (read) import Streamly.Internal.Console.Stdio
+ src/Streamly/Control/Exception.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Control.Exception+-- Copyright   : (c) 2025 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Exception handling and resource managment operations complementing+-- the "Control.Exception" module in base package.++module Streamly.Control.Exception+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+    --+    -- * Resource Management+    -- | Exception safe, thread safe resource managment operations, similar to+    -- but more powerful than the @bracket@ and @finally@ operations available+    -- in the base package.+    --+    -- These operations support allocation and free only in the IO monad,+    -- hence the IO suffix.+    --+      AcquireIO+    , withAcquireIO+    , acquire+    , register+    , hook+    )+where++import Streamly.Internal.Control.Exception++#include "DocTestControlException.hs"
src/Streamly/Data/Array.hs view
@@ -55,7 +55,7 @@     -- ** From Stream     , createOf     , create-    , writeLastN    -- drop old (ring buffer)+    , createOfLast -- drop old (ring buffer)      -- ** From List     , fromListN@@ -74,6 +74,14 @@     , reader     , readerRev +    -- * Stream of Arrays+    , chunksOf+    , toParserK+    , parse+    , parseBreak+    , parsePos+    , parseBreakPos+     -- * Casting     , cast     , asBytes@@ -84,7 +92,7 @@     , getIndex      -- * Serialization-    , pinnedSerialize+    , serialize'     , deserialize      -- * Re-exports@@ -92,13 +100,13 @@     , Serialize(..)      -- * Deprecated+    , pinnedSerialize     , writeN      -- drop new     , write       -- full buffer+    , writeLastN     ) where -#include "inline.hs"- import Streamly.Internal.Data.Array import Streamly.Internal.Data.MutByteArray (Unbox(..), Serialize(..)) @@ -126,7 +134,7 @@ -- -- Convert array to stream, transform, and fold back to array: ----- >>> amap f arr = Array.read arr & fmap f & Stream.fold Array.create+-- >>> amap f arr = Array.read arr & fmap f & Stream.fold (Array.createOf (Array.length arr)) -- >>> amap (+1) (Array.fromList [1,2,3::Int]) -- fromList [2,3,4] --@@ -153,13 +161,17 @@ -- See the 'fromPureStream' unreleased API to generate an array from an -- Identity stream safely without using MonadIO constraint. -------- Note that 'Identity' streams can be generalized to IO streams:+-- >>> fromPureStream = Stream.fold Array.create . Stream.generalizeInner ----- >>> pure = Stream.fromList [1,2,3] :: Stream Identity Int--- >>> generally = Stream.morphInner (return . runIdentity)--- >>> Stream.fold Array.create (generally pure :: Stream IO Int)+-- >>> stream = Stream.fromList [1,2,3] :: Stream Identity Int+-- >>> fromPureStream stream -- fromList [1,2,3]+--+-- == Performance Considerations+--+-- If you are consuming an array piecemeal (uncons, unsnoc) or by slicing,+-- immutable Array type may be a tiny bit better than MutArray because it uses+-- a smaller constructor size. -- -- == Programming Tips --
src/Streamly/Data/Array/Generic.hs view
@@ -33,6 +33,14 @@     , reader     -- , A.readerRev +    -- * Stream of Arrays+    , chunksOf+    , toParserK+    , parse+    , parseBreak+    , parsePos+    , parseBreakPos+     -- * Random Access     , length     , getIndex
src/Streamly/Data/Fold.hs view
@@ -7,9 +7,27 @@ -- Stability   : released -- Portability : GHC ----- Fast, composable stream consumers with ability to terminate, supporting--- stream fusion.+-- The 'Fold' type represents a consumer of a sequence of values, the+-- corresponding dual type is 'Streamly.Data.Stream.Stream' which represents a+-- producer. Both types can perform equivalent transformations on a stream. But+-- only 'Fold' can be used to compose multiple consumers and only 'Stream' can+-- be used to compose multiple producers. --+-- The 'Fold' type represents stream consumers as state machines, that fuse+-- together when composed statically, eliminating function calls or+-- intermediate constructor allocations. Stream fusion helps generate tight,+-- efficient loops similar to the code generated by low-level languages like C.+-- Folds are suitable for high-performance looping operations.+--+-- Operations in this module are designed to be composed statically rather than+-- dynamically. They are inlined to enable static fusion. More importantly,+-- they are not designed to be used recursively. Recursive use will break+-- fusion and will lead to quadratic performance slowdown. For dynamic or+-- recursive composition use the continuation passing style (CPS) operations+-- from the "Streamly.Data.ParserK" module. 'Fold' and+-- 'Streamly.Data.ParserK.ParserK' types are interconvertible via the+-- 'Streamly.Data.Parser.Parser' type.+-- -- == Using Folds -- -- This module provides elementary folds and fold combinators that can be used@@ -110,9 +128,9 @@ -- == 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.+-- are required for 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'+-- required for composition of consumers (e.g.  'splitWith', 'partition' -- or 'teeWith'). -- -- Streams are producers, transformations on streams happen on the output side:@@ -144,20 +162,6 @@ -- 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@@ -171,22 +175,38 @@     --     -- $setup -    -- * Running A Fold-      drive-    -- XXX Should we have a stream returning function in fold module?-    -- , breakStream-     -- * Fold Type -    , Fold -- (..)+      Fold -- (..)     , Tee (..) +    -- * Running A Fold+    -- | 'Streamly.Data.Strem.fold' and 'drive' are the basic fold runners.+    -- Folds can also be used a incremental builders. The 'addOne' and+    -- 'addStream' combinators can be used to incrementally build any type of+    -- structure using a fold, including arrays or a stream of arrays.++    , drive+    -- XXX should rename to "extract". can use "Fold.drive Stream.nil" instead,+    -- for now.+    -- , extractM+    -- , reduce+    , addOne+    -- , snocl+    -- XXX Can we use something like concatEffect to implement snocM?+    -- , snocM+    -- , snoclM+    , addStream+    , duplicate+    -- , isClosed+     -- * Constructors     , foldl'     , foldlM'     , foldl1'-    , foldlM1'+    , foldl1M'     , foldr'+    , foldtM'      -- * Folds     -- ** Accumulators@@ -261,35 +281,12 @@     , and     , or -    -- * Incremental builders-    -- | Mutable arrays ("Streamly.Data.MutArray") are basic builders. You can-    -- use the 'Streamly.Data.MutArray.snoc' or-    -- 'Streamly.Data.MutArray.writeAppend' operations to incrementally build-    -- mutable arrays. The 'addOne' and 'addStream' combinators can be used to-    -- incrementally build any type of structure using a fold, including arrays-    -- or a stream of arrays.-    ---    -- Use pinned arrays if you are going to use the data for IO.--    -- XXX should rename to "extract". can use "Fold.drive Stream.nil" instead,-    -- for now.-    -- , extractM-    -- , reduce-    , addOne-    -- , snocl-    -- XXX Can we use something like concatEffect to implement snocM?-    -- , snocM-    -- , snoclM-    , addStream-    , duplicate-    -- , isClosed--    -- * Combinators-    -- | Combinators are modifiers of folds.  In the type @Fold m a b@, @a@ is-    -- the input type and @b@ is the output type.  Transformations can be+    -- * Transformations+    -- | Transformations are modifiers of folds.  In the type @Fold m a b@, @a@+    -- is the input type and @b@ is the output type.  Transformations can be     -- applied either on the input side (contravariant) or on the output side-    -- (covariant).  Therefore, combinators are of one of the following general-    -- shapes:+    -- (covariant).  Therefore, transformations have one of the following+    -- general shapes:     --     -- * @... -> Fold m a b -> Fold m c b@ (input transformation)     -- * @... -> Fold m a b -> Fold m a c@ (output transformation)@@ -312,10 +309,7 @@     , lmap     , lmapM -    -- ** Scanning and Filtering-    , scan-    , postscan-    , scanMaybe+    -- ** Filtering     , filter     , filterM @@ -328,15 +322,36 @@      -- ** Trimming     , take-    -- , takeInterval     , takeEndBy     , takeEndBy_+    , takeEndBySeq+    , takeEndBySeq_ +    -- ** Key-value Collectors+    , toMap+    , toMapIO++    {-+    -- ** Key-value Scanners+    , classifyScan+    , classifyScanIO+    -}++    -- ** Transforming the Monad+    , morphInner++    -- * Combinators+    -- | Transformations that combine two or more folds.++    -- ** Scanning+    , scanl+    , postscanl+    -- , postscanlMaybe+     -- ** Splitting     , splitWith     , many     , groupsOf-    -- , intervalsOf      -- ** Parallel Distribution     -- | For applicative composition using distribution see@@ -358,28 +373,28 @@     --, partitionByMinM     --, partitionBy +    -- ** Unzipping+    , unzip++    -- * Dynamic Combinators+    -- | The fold to be used is generated dynamically based on the input or+    -- based on the output of the previous fold.+     -- ** Key-value Collectors-    , toMap-    , toMapIO-    , demuxToMap-    , demuxToMapIO+    , demuxerToMap+    , demuxerToMapIO +    {-     -- ** Key-value Scanners-    , classify-    , classifyIO-    , demux-    , demuxIO--    -- ** Unzipping-    , unzip+    , demuxScan+    , demuxScanIO+    -}      -- ** Nesting     , concatMap -    -- * Transforming the Monad-    , morphInner-     -- * Deprecated+    , foldlM1'     , chunksOf     , foldr     , drainBy@@ -390,6 +405,15 @@     , variance     , stdDev     , serialWith+    , classify+    , classifyIO+    , demux+    , demuxIO+    , demuxToMap+    , demuxToMapIO+    , scan+    , postscan+    , scanMaybe     ) where
src/Streamly/Data/MutArray.hs view
@@ -33,14 +33,14 @@      -- Uninitialized Arrays     , emptyOf-    , pinnedEmptyOf+    , emptyOf'      -- From containers     , fromListN     , fromList     , createOf     , create-    -- writeLastN+    -- createOfLast      -- * Pinning & Unpinning     , pin@@ -52,18 +52,18 @@      -- * Appending streams     , appendN-    , append+    , append2      -- * Inplace mutation     , putIndex-    , putIndexUnsafe+    , unsafePutIndex     , modifyIndex-    , modifyIndexUnsafe+    , unsafeModifyIndex     , modify      -- * Random access     , getIndex-    , getIndexUnsafe+    , unsafeGetIndex      -- * Conversion     , toList@@ -76,6 +76,11 @@     , reader     , readerRev +    -- * Stream of Arrays+    -- | Also see the "Streamly.Data.Stream.Prelude" module in the "streamly"+    -- package for chunking of a stream with timeout.+    , chunksOf+     -- * Casting     , cast     , asBytes@@ -87,6 +92,7 @@     , Unbox (..)      -- * Deprecated+    , pinnedEmptyOf     , newPinned     , new     , pinnedNew@@ -94,6 +100,10 @@     , write     , writeAppendN     , writeAppend+    , putIndexUnsafe+    , modifyIndexUnsafe+    , getIndexUnsafe+    , append     ) where @@ -104,7 +114,7 @@  #include "DocTestDataMutArray.hs" -{-# DEPRECATED newPinned "Please use pinnedNew instead." #-}+{-# DEPRECATED newPinned "Please use emptyOf' instead." #-} {-# INLINE newPinned #-} newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)-newPinned = pinnedNew+newPinned = emptyOf'
src/Streamly/Data/MutArray/Generic.hs view
@@ -34,14 +34,14 @@      -- * Inplace mutation     , putIndex-    , putIndexUnsafe+    , unsafePutIndex     , modifyIndex-    , modifyIndexUnsafe+    , unsafeModifyIndex     -- , modify      -- * Random reads     , getIndex-    , getIndexUnsafe+    , unsafeGetIndex      -- * Conversion     , toList@@ -54,6 +54,9 @@     , reader     -- , readerRev +    -- * Stream of Arrays+    , chunksOf+     -- * Size     , length @@ -61,6 +64,9 @@     , new     , writeN     , write+    , modifyIndexUnsafe+    , putIndexUnsafe+    , getIndexUnsafe     ) where
src/Streamly/Data/MutByteArray.hs view
@@ -5,12 +5,15 @@ -- 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.+-- This module implements 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. --+-- == Fast serialization with schema+-- -- 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@@ -18,11 +21,13 @@ -- properties with faster speed. For example, you can change the order of -- constructors or record fields without affecting serialized value. --+-- == Serialization with Array and MutArray+-- -- 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.Internal.Data.Array.pinnedSerialize'--- and 'Streamly.Internal.Data.Array.deserialize' from the+-- and 'Streamly.Internal.Data.Array.deserialize' in the -- "Streamly.Internal.Data.Array" module. -- -- == Mutable Byte Array@@ -32,8 +37,28 @@ -- 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+-- == Using with FFI --+-- For using an array with "safe" FFI functions or OS interfaces the array must+-- be pinned using 'pin' and then the array pointer can be accessed using+-- 'unsafeAsPtr'.+--+-- For using with "unsafe" FFI functions, the array can remain unpinned. The+-- safe way to do that is to directly pass the underlying 'MutableByteArray#+-- RealWorld' (using 'getMutByteArray#') to the FFI function wherever a pointer+-- to the array is required, it translates to the memory address of the payload+-- of the array.+--+-- For more details, see the FFI section in the GHC user guide. Here is a+-- relevant excerpt 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.++-- == Serialization 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@@ -47,7 +72,7 @@ -- 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+-- == Serialization 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
src/Streamly/Data/Parser.hs view
@@ -7,47 +7,68 @@ -- Stability   : pre-release -- Portability : GHC ----- Parsers are stream consumers like folds with the following differences:+-- Parsers are more powerful but less general than 'Streamly.Data.Fold.Fold's: -- -- * 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.+-- Streamly parsers support all operations offered by popular Haskell parser+-- libraries. Unlike other parser libraries, (1) streamly parsers can operate+-- on any Haskell type as input - not just bytes, (2) natively support+-- streaming, (3) and are faster. ----- == Using Parsers+-- == High Performance by Static Parser Fusion ----- 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.+-- Like folds, parsers are designed to utilize stream fusion, compiling to+-- efficient low-level code comparable to the speed of C. Parsers are suitable+-- for high-performance parsing of streams. ----- 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.+-- Operations in this module are designed to be composed statically rather than+-- dynamically. They are inlined to enable static fusion. More importantly,+-- they are not designed to be used recursively. Recursive use will break+-- fusion and lead to quadratic performance slowdown. For dynamic and+-- recursive compositions use the continuation passing style (CPS) operations+-- from the "Streamly.Data.ParserK" module. 'Parser' and+-- 'Streamly.Data.ParserK.ParserK' types are interconvertible. --+-- == How to parse a stream?+--+-- Parser combinators can be used to create a pipeline of parsers such+-- that the next parser consumes the result of the previous parser.+-- Such a composed pipeline of parsers can then be driven by one of many parser+-- drivers available in the Stream and Array modules.+--+-- Use Streamly.Data.Stream.'Streamly.Data.Stream.parse' or+-- Streamly.Data.Stream.'Streamly.Data.Stream.parseBreak' to run a parser on an+-- input stream and return the parsed result.+--+-- Use Streamly.Data.Stream.'Streamly.Data.Stream.parseMany' or+-- Streamly.Data.Stream.'Streamly.Data.Stream.parseIterate' to transform an+-- input data stream to an output stream of parsed data elements using a+-- parser.+-- -- == 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+-- general. "Streamly.Data.Parser" enables stream fusion and where possible it 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.+-- suitable and ParserK should be used instead. As a thumb rule, when recursion+-- or heavy nesting is needed use ParserK. ----- 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:+-- === Parser: suitable for non-recursive static fusion --+-- The 'Parser' type is suitable only for non-recursive static fusion. It could+-- be problematic for recursive definitions. To enable static fusion, parser+-- combinators 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@@ -55,20 +76,32 @@ -- >>> import Control.Applicative ((<|>)) -- -- >>> :{--- >>> p :: Monad m => Parser Char m String--- >>> p = Parser.satisfy (== '(') *> p <|> Parser.fromFold Fold.toList+-- >>> p, p1, p2 :: Monad m => Parser Char m String+-- >>> p1 = Parser.satisfy (== '(') *> p+-- >>> p2 = Parser.fromFold Fold.toList+-- >>> p = p1 <|> p2 -- >>> :} ----- Use ParserK when recursive use is required:+-- Another limitation of Parser type quadratic performance slowdown when too+-- many nested compositions are used. Especially Applicative, Monad,+-- Alternative instances, and sequenced parsing operations (e.g. nested 'one',+-- and 'splitWith') exhibit quadratic slowdown (O(n^2) complexity) when+-- combined @n@ times, roughly 8 or less sequenced parsers usually work fine.+-- READ THE DOCS OF APPLICATIVE, MONAD AND ALTERNATIVE INSTANCES. --+-- === ParserK: suitable for recursive definitions+--+-- ParserK is suitable for recursive definitions:+-- -- >>> import Streamly.Data.ParserK (ParserK)+-- >>> import Streamly.Data.StreamK (toParserK) -- >>> 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)+-- >>> p, p1, p2 :: Monad m => ParserK Char m String+-- >>> p1 = toParserK (Parser.satisfy (== '(')) *> p+-- >>> p2 = toParserK (Parser.fromFold Fold.toList)+-- >>> p = p1 <|> p2 -- >>> :} -- -- >>> StreamK.parse p $ StreamK.fromStream $ Stream.fromList "hello"@@ -82,58 +115,61 @@ -- 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.+-- == Parsers Galore! ----- == Streaming Parsers+-- Streamly provides all the parsing functionality provided by popular parsing+-- libraries, and much more with higher performance.+-- This module provides most of the elementary parsers and parser combinators.+-- Additionally, ----- With 'Streamly.Data.ParserK.ParserK' you can use the generic Alternative--- type class based parsers from the+-- * all the folds from the "Streamly.Data.Fold" module can be converted to+-- parsers using 'fromFold'.+-- * "Streamly.Unicode.Parser" module provides Char stream parsers.+-- * all the combinators 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.+-- package can be used with streamly ParserK.+-- * See "Streamly.Internal.Data.Parser" for many more unreleased but useful APIs. --+-- == Generic Parser Combinators+--+-- With 'Streamly.Data.ParserK.ParserK' you can use the 'Applicative' and+-- 'Control.Applicative.Alternative' type class based generic parser+-- combinators from the+-- <https://hackage.haskell.org/package/parser-combinators parser-combinators>+-- library or similar. However, if available, we recommend that you use the+-- equivalent functionality from this module where performance and streaming+-- behavior matters. -- 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.+-- There are two types of parser drivers available, @parse@ and @parseBreak@+-- drivers do not track stream position, whereas @parsePos@ and @parseBreakPos@+-- drivers track and report stream position information with slightly more+-- performance overhead. --+-- When an error occurs the stream position is reported, in case of byte streams+-- or unboxed array streams this is the byte position, in case of generic+-- element parsers or generic array parsers this is the element position in the+-- stream.+--+-- These parsers do not report a case specific error context (e.g. line number+-- or column). If you need line number or column information you can read the+-- stream again (if it is immutable) and this count the lines to translate the+-- reported byte position to line number and column. More elaborate support for+-- building arbitrary and custom error context information is planned to be+-- added 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@@ -149,11 +185,13 @@      -- * Parser Type       Parser+    , ParseError(..)+    , ParseErrorPos(..)      -- -- * Downgrade to Fold     -- , toFold -    -- * Parsers+    -- * Elementary Parsers     -- ** From Folds     , fromFold @@ -166,7 +204,7 @@     , peek     , eof -    -- ** Element parsers+    -- ** Single Elements      -- All of these can be expressed in terms of either     , one@@ -183,15 +221,15 @@     , listEqBy     , listEq -    -- * Combinators+    -- * Transformations     -- Mapping on output     -- , rmapM -    -- ** Mapping on input+    -- ** Map on input     , lmap     , lmapM -     -- * Map on output+     -- ** Map on output     , rmapM      -- ** Filtering@@ -200,6 +238,7 @@     -- ** Look Ahead     , lookAhead +    -- * Tokenizing Combinators     -- ** Tokenize by length     -- , takeBetween     , takeEQ@@ -230,12 +269,12 @@     -- -- * Alternative     -- , alt -    -- ** Splitting+    -- * Splitting     , many     , some     , manyTill -    -- ** De-interleaving+    -- * De-interleaving     , deintercalate     )
src/Streamly/Data/ParserK.hs view
@@ -8,72 +8,90 @@ -- Portability : GHC -- -- 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.+-- This (ParserK) module implements a Continuation Passing Style (CPS) wrapper+-- over the fused "Streamly.Data.Parser" module. It is a faster CPS parser than+-- attoparsec. ----- == Parser vs ParserK+-- The 'ParserK' type represents a stream-consumer as a composition of function+-- calls, therefore, a function call overhead is incurred at each composition.+-- It is reasonably fast in general but may be a few times slower than the+-- fused 'Streamly.Data.Parser.Parser' type. However, unlike fused parsers, it+-- allows for scalable dynamic composition, especially, 'ParserK' can be used+-- in recursive calls. Operations like 'splitWith' on 'ParserK' type have+-- linear (O(n)) performance with respect to the number of compositions. ----- '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.+-- 'ParserK' is preferred over the fused 'Streamly.Data.Parser.Parser' when+-- extensive applicative, alternative and monadic composition is required, or+-- when recursive or dynamic composition of parsers is required. 'ParserK' also+-- allows efficient parsing of a stream of byte arrays, it can also break the+-- input stream into a parse result and the remaining stream so that the stream+-- can be parsed independently in segments. ----- == Using ParserK+-- == How to parse a stream? ----- 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.+-- All the fused parsers from the "Streamly.Data.Parser" module can be+-- converted to the CPS ParserK, for use with different types of parser+-- drivers, using+-- the @toParserK@ combinators -+-- Streamly.Data.Array.'Streamly.Data.Array.toParserK',+-- Streamly.Data.StreamK.'Streamly.Data.StreamK.toParserK', and+-- Streamly.Data.Array.Generic.'Streamly.Data.Array.Generic.toParserK' ----- '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.+-- To parse a stream of unboxed arrays, use+-- Streamly.Data.Array.'Streamly.Data.Array.parse' for running the parser, this+-- is the preferred and most efficient way to parse chunked input. The+-- Streamly.Data.Array.'Streamly.Data.Array.parseBreak' function returns the+-- remaining stream as well along with the parse result. ----- == Monadic Composition+-- To parse a stream of boxed arrays, use+-- Streamly.Data.Array.Generic.'Streamly.Data.Array.Generic.parse' or+-- Streamly.Data.Array.Generic.'Streamly.Data.Array.Generic.parseBreak' to run+-- the parser. ----- Monad composition can be used for lookbehind parsers, we can dynamically--- compose new parsers based on the results of the previously parsed values.+-- To parse a stream of individual elements, use+-- Streamly.Data.StreamK.'Streamly.Data.StreamK.parse' and+-- Streamly.Data.StreamK.'Streamly.Data.StreamK.parseBreak' to run the parser. ----- If we have to parse "a9" or "9a" but not "99" or "aa" we can use the--- following non-monadic, backtracking parser:+-- == Applicative  Composition ----- >>> digits p1 p2 = ((:) <$> p1 <*> ((:) <$> p2 <*> pure []))+-- Applicative parsers are simpler but we cannot use lookbehind as we can in+-- the monadic parsers.+--+-- If we have to parse "9a" or "a9" but not "99" or "aa" we can use the+-- following Applicative, backtracking parser:+--+-- >>> -- parse p1 : p2 : []+-- >>> token p1 p2 = ((:) <$> p1 <*> ((:) <$> p2 <*> pure [])) -- >>> :{ -- backtracking :: Monad m => ParserK Char m String--- backtracking = ParserK.adapt $---     digits (Parser.satisfy isDigit) (Parser.satisfy isAlpha)+-- backtracking = StreamK.toParserK $+--     token (Parser.satisfy isDigit) (Parser.satisfy isAlpha) -- e.g. "9a" --     <|>---     digits (Parser.satisfy isAlpha) (Parser.satisfy isDigit)+--     token (Parser.satisfy isAlpha) (Parser.satisfy isDigit) -- e.g. "a9" -- :} ----- 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:+-- == Monadic Composition --+-- Monad composition can be used to implement lookbehind parsers, we can dynamically+-- compose new parsers based on the results of the previously parsed values.+--+-- In the previous example, 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 make dynamic decisions based on previously+-- parsed information and avoid redundant work:+-- -- >>> data DigitOrAlpha = Digit Char | Alpha Char -- -- >>> :{ -- lookbehind :: Monad m => ParserK Char m String -- lookbehind = do---     x1 <- ParserK.adapt $+--     x1 <- StreamK.toParserK $ --              Digit <$> Parser.satisfy isDigit --          <|> Alpha <$> Parser.satisfy isAlpha --     -- Note: the parse depends on what we parsed already---     x2 <- ParserK.adapt $+--     x2 <- StreamK.toParserK $ --           case x1 of --              Digit _ -> Parser.satisfy isAlpha --              Alpha _ -> Parser.satisfy isDigit@@ -99,13 +117,8 @@       ParserK      -- * Parsers-    -- ** Conversions-    , adapt-    , adaptC-    , adaptCG-    -- , toParser -    -- ** Without Input+    -- -- ** Without Input     , fromPure     , fromEffect     , die@@ -113,6 +126,9 @@     -- * Deprecated     , fromFold     , fromParser+    , adapt+    , adaptC+    , adaptCG     )  where@@ -122,18 +138,19 @@ import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.Array (Array) import qualified Streamly.Internal.Data.Parser as ParserD+import qualified Streamly.Internal.Data.Array as Array -import Streamly.Internal.Data.ParserK.Type+import Streamly.Internal.Data.ParserK  #include "DocTestDataParserK.hs" -{-# DEPRECATED fromFold "Please use \"ParserK.adaptC . Parser.fromFold\" instead." #-}+{-# DEPRECATED fromFold "Please use \"Array.toParserK . Parser.fromFold\" instead." #-} {-# INLINE fromFold #-} fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK (Array a) m b-fromFold = adaptC . ParserD.fromFold+fromFold = Array.toParserK . ParserD.fromFold -{-# DEPRECATED fromParser "Please use \"adaptC\" instead." #-}+{-# DEPRECATED fromParser "Please use \"Array.toParserK\" instead." #-} {-# INLINE fromParser #-} fromParser ::        (MonadIO m, Unbox a) => ParserD.Parser a m b -> ParserK (Array a) m b-fromParser = adaptC+fromParser = Array.toParserK
+ src/Streamly/Data/RingArray.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.RingArray+-- Copyright   : (c) 2025 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- This module provides APIs to create and use unboxed, mutable ring arrays of+-- fixed size. Ring arrays are useful to keep a circular buffer or a sliding+-- window of elements.+--+-- RingArrays are of fixed size but there is a way to expand the size of the+-- ring, you can copy the ring to a MutArray, expand the MutArray and the cast+-- it back to RingArray.+--+-- This module is designed to be imported qualified:+--+-- >>> import qualified Streamly.Data.RingArray as Ring+--+-- Please refer to "Streamly.Internal.Data.RingArray" for functions that have+-- not yet been released.+--++module Streamly.Data.RingArray+    ( RingArray++    -- * Construction+    , createOfLast+    , castMutArray -- XXX this is unsafeFreeze in Array module+    , castMutArrayWith+    -- , unsafeCastMutArray+    -- , unsafeCastMutArrayWith++    -- * Moving the Head+    , moveForward+    , moveReverse+    -- , moveBy++    -- * In-place Mutation+    , insert+    , replace+    , replace_+    , putIndex+    , modifyIndex++    -- * Random Access+    , getIndex+    , unsafeGetIndex+    , unsafeGetHead++    -- * Conversion+    , toList+    , toMutArray++    -- * Streams+    , read+    , readRev++    -- * Unfolds+    , reader+    , readerRev++    -- * Size+    , length+    , byteLength++    -- * Casting+    , cast+    -- , unsafeCast+    , asBytes+    , asMutArray+    -- , asMutArray_++    -- * Folds+    -- , foldlM'+    , fold++    -- * Stream of Rings+    , ringsOf+    , scanRingsOf++    -- * Fast Byte Comparisons+    , eqArray+    , eqArrayN++    ) where++import Streamly.Internal.Data.RingArray+import Prelude hiding (read, length)
+ src/Streamly/Data/Scanl.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Scanl+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--++module Streamly.Data.Scanl+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Scanl Type++      Scanl -- (..)++    -- * Constructors+    , mkScanl+    , mkScanlM+    , mkScanl1+    , mkScanl1M+    , mkScanr++    -- * Scans+    -- ** Accumulators+    -- | Scans that never terminate, these scans are much like strict left+    -- folds. 'mconcat' is the fundamental accumulator.  All other accumulators+    -- can be expressed in terms of 'mconcat' using a suitable Monoid.  Instead+    -- of writing scans we could write Monoids and turn them into scans.++    -- Monoids+    , sconcat+    , mconcat+    , foldMap+    , foldMapM++    -- Reducers+    , drain+    -- , drainMapM+    , length+    , countDistinct+    , countDistinctInt+    -- , frequency+    , sum+    , product+    , mean+    , rollingHash+    , rollingHashWithSalt++    -- Collectors+    , toList+    , toListRev+    , toSet+    , toIntSet+    , topBy++    -- ** Non-Empty Accumulators+    -- | Accumulators that do not have a default value, therefore, return+    -- 'Nothing' on an empty stream.+    , latest+    , maximumBy+    , maximum+    , minimumBy+    , minimum++    -- ** Filtering Scanners+    -- | Accumulators that are usually run as a scan using the 'potscanlMaybe'+    -- combinator.+    , findIndices+    , elemIndices+    , deleteBy+    -- , uniq+    , uniqBy+    , nub+    , nubInt++    -- ** Terminating Scans+    -- , satisfy+    -- , maybe++    , the++    -- * Transformations+    -- | Transformations are modifiers of scans.  In the type @Scan m a b@, @a@+    -- is the input type and @b@ is the output type.  Transformations can be+    -- applied either on the input side (contravariant) or on the output side+    -- (covariant).  Therefore, transformations have one of the following+    -- general shapes:+    --+    -- * @... -> Scanl m a b -> Scanl m c b@ (input transformation)+    -- * @... -> Scanl m a b -> Scanl m a c@ (output transformation)+    --+    -- The input side transformations are more interesting for scans.  Most of+    -- the following sections describe the input transformation operations on a+    -- scan. When an operation makes sense on both input and output side we use+    -- the prefix @l@ (for left) for input side operations and the prefix @r@+    -- (for right) for output side operations.++    -- ** Mapping on output+    -- | The 'Functor' instance of a scan maps on the output of the scan:+    --+    -- >>> Stream.toList $ Stream.scanl (fmap show Scanl.sum) (Stream.enumerateFromTo 1 10)+    -- ["0","1","3","6","10","15","21","28","36","45","55"]+    --+    , rmapM++    -- ** Mapping on Input+    , lmap+    , lmapM++    -- ** Filtering+    , filter+    , filterM++    -- -- ** Mapping Filters+    , mapMaybe+    , catMaybes+    , catLefts+    , catRights+    , catEithers++    -- ** Trimming+    , take+    , takeEndBy+    , takeEndBy_++    -- ** Key-value Scanners+    , classify+    , classifyIO++    -- ** Transforming the Monad+    , morphInner++    -- * Combinators+    -- | Transformations that combine two or more scans.++    -- ** Scanning+    , scanl+    , postscanl+    , postscanlMaybe++    -- ** Parallel Distribution+    -- | The 'Applicative' instance distributes the input to both scans.++    , teeWith+    --, teeWithFst+    --, teeWithMin+    , tee+    , distribute++    -- ** Partitioning+    -- | Direct items in the input stream to different scans using a binary+    -- scan selector.++    , partition+    --, partitionByM+    --, partitionByFstM+    --, partitionByMinM+    --, partitionBy++    -- ** Unzipping+    , unzip++    -- * Dynamic Combinators+    -- | The scan to be used is generated dynamically based on the input.++    -- ** Key-value Scanners+    , demux+    , demuxIO+    )+where++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, maybe)++import Streamly.Internal.Data.Scanl++#include "DocTestDataScanl.hs"
src/Streamly/Data/Stream.hs view
@@ -8,23 +8,130 @@ -- Stability   : released -- Portability : GHC ----- 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.+-- The 'Stream' type represents a producer of a sequence of values. Its dual,+-- 'Streamly.Data.Fold.Fold', represents a consumer. While both types support+-- similar transformations, the key difference is that only 'Stream' can+-- compose multiple producers, and only 'Fold' can compose multiple consumers. ----- 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'.+-- == Console Echo Example ----- Please refer to "Streamly.Internal.Data.Stream" for more functions that have--- not yet been released.+-- To get you started, here is an example of a program which reads lines from+-- console and writes them back to the console. ----- Checkout the <https://github.com/composewell/streamly-examples>--- repository for many more real world examples of stream programming.+-- >>> import Data.Function ((&))+-- >>> :{+-- echo =+--  Stream.repeatM getLine       -- Stream IO String+--      & Stream.mapM putStrLn   -- Stream IO ()+--      & Stream.fold Fold.drain -- IO ()+-- :}+--+-- This is a simple example of a declarative representation of an imperative+-- loop using streaming combinators.+-- In this example, 'repeatM' generates an infinite stream of 'String's by+-- repeatedly performing the 'getLine' IO action. 'mapM' then applies+-- 'putStrLn' on each element in the stream converting it to stream of '()'.+-- Finally, 'Streamly.Data.Fold.drain' 'fold's the stream to IO discarding the+-- () values, thus producing only effects.+--+-- This gives you an idea about how we can program declaratively by+-- representing loops using streams. Compare this declarative loopless approach+-- with an imperative approach using a @while@ loop for writing the same+-- program. In this module, you can find all "Data.List"-like functions and+-- many more powerful combinators to perform common programming tasks.+--+-- == Static Stream Fusion+--+-- The 'Stream' type represents streams as state machines. When composed+-- statically, these state machines fuse together at compile time, eliminating+-- intermediate data structures and function calls. This results in the+-- generation of tight, efficient loops comparable to those written in+-- low-level languages like C. For instance, in the earlier example, operations+-- like 'repeatM' and 'mapM' are written as separate fragments but fuse into a+-- single, optimized loop.+--+-- The primary goal of the 'Stream' type is to build highly efficient streams+-- via compile-time fusion of modular loop fragments. However, this technique+-- comes with trade-offs and should be used with care. Stream /construction/+-- operations such as 'cons', 'append', 'interleave', 'mergeBy', and 'zipWith'+-- work extremely well at a small scale. But at a large scale, their+-- performance degrades due to O(n^2) complexity, where @n@ is the number of+-- compositions.+--+-- Therefore, it's best to generate a fused stream in one go, if possible.+-- While using a small number of composition operations is absolutely fine,+-- avoid using large number of composition operations. For example, do not try+-- to construct a fused 'Stream' by using `cons` rescursively. However, you can+-- use 'Streamly.Data.StreamK.cons' and any other construction operations on+-- the CPS 'StreamK' type without any problem. The CPS construction operations+-- have linear (O(n)) performance characteristics and scale much better, though+-- they are not as efficient as fused streams due to function call overhead at+-- each step.+--+-- When used correctly, the fused 'Stream' type can be 10x to 100x faster+-- than CPS-based streams, depending on the use case.+--+-- __Rule of Thumb:__ Use the fused 'Stream' type when the number of+-- compositions is small and they are static or compile-time. Use the CPS-based+-- 'StreamK' type when the number of compositions is large or potentially+-- infinite, and they are dynamic or composed at runtime. Both types are fully+-- interconvertible, allowing you to choose the best tool for each part of your+-- pipeline.+--+-- == Better and Effectful Lists+--+-- This module offers operations analogous to standard Haskell lists from the+-- @base@ package. Streams can be viewed as a generalization of lists —+-- providing all the functionality of standard lists, plus additional+-- capabilities such as effectful operations and improved performance through+-- stream fusion. They can easily replace lists in most contexts, and go+-- beyond where lists fall short.+--+-- For instance, a common limitation of lists is the inability to perform IO+-- actions (e.g., printing) at arbitrary points during processing. Streams+-- naturally support such effectful operations.+--+-- As discussed in the fusion section above, while the 'Stream' type is not+-- consable and appendable at scale, the 'StreamK' type is consable and+-- appendable at scale.+--+-- == Non-determinism and List Transformers+--+-- Streamly does not provide a 'ListT' like Monad instance but it provides all+-- the equivalent functionality and more. We do not provide a Monad instance+-- for streams, as there are many possible ways to define the bind operation.+-- Instead, we offer bind-style operations such as 'concatFor', 'concatForM',+-- and their variants (e.g. fair interleaving and breadth-first nesting). These+-- can be used for convenient ListT-style stream composition. Additionally, we+-- provide applicative-style cross product operations like 'cross' and its+-- variants which are many times faster than the monad style operations.+--+-- == Logic Programming+--+-- Streamly does not provide a 'LogicT'-style Monad instance, but it offers all+-- the equivalent functionality—and more. Operations like 'fairCross' and+-- 'fairConcatFor' nest outer and inner streams fairly, ensuring that no stream+-- is starved when exploring cross products.+--+-- This enables balanced exploration across all dimensions in backtracking+-- problems, while also supporting infinite streams. It effectively replaces the+-- core functionality of 'LogicT' from the @logict@ package, with significantly+-- better performance. In particular, it avoids the quadratic slowdown seen with+-- @observeMany@, and the applicative 'fairCross' runs many times faster,+-- achieving loop nesting performance comparable to C. +-- == Additional Resources+--+-- The combinators in this module support /serial/ composition of streams.+-- For /concurrent/ composition of streams, refer to+-- "Streamly.Data.Stream.Prelude" in the @streamly@ package.+--+-- For more, yet unreleased functions, try: "Streamly.Internal.Data.Stream".+--+-- For real-world examples, visit:+-- <https://github.com/composewell/streamly-examples>.+--+ module Streamly.Data.Stream     (     -- * Setup@@ -51,12 +158,10 @@     -- >>> fromFoldableM = Stream.sequence . fromFoldable      -- ** 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.+    -- | These primitives are meant to statically fuse a small number of stream+    -- elements. The 'Stream' type is never constructed at large scale using+    -- these primitives. Use 'StreamK' if you need to construct a stream from+    -- primitives.     , nil     , nilM     , cons@@ -68,38 +173,38 @@     , unfoldr     , unfoldrM -    -- ** From Values-    -- | Generate a monadic stream from a seed value or values.+    -- ** Singleton     , fromPure     , fromEffect++    -- ** Iteration+    -- | Generate a monadic stream from a seed value or values.+    --+    , iterate+    , iterateM     , repeat     , repeatM     , replicate     , replicateM -    -- Note: Using enumeration functions e.g. 'Prelude.enumFromThen' turns out-    -- to be slightly faster than the idioms like @[from, then..]@.-    --     -- ** Enumeration-    -- | We can use the 'Enum' type class to enumerate a type producing a list-    -- and then convert it to a stream:+    -- | 'Enumerable' type class is to streams as 'Enum' is to lists. Enum+    -- provides functions to generate a list, Enumerable provides similar+    -- functions to generate a stream instead.     ---    -- @-    -- 'fromList' $ 'Prelude.enumFromThen' from then-    -- @+    -- It is much more efficient to use 'Enumerable' directly than enumerating+    -- to a list and converting it to stream. The following works but is not+    -- particularly efficient:     ---    -- However, this is not particularly efficient.-    -- The 'Enumerable' type class provides corresponding functions that-    -- generate a stream instead of a list, efficiently.+    -- >>> f from next = Stream.fromList $ Prelude.enumFromThen from next+    --+    -- Note: For lists, using enumeration functions e.g. 'Prelude.enumFromThen'+    -- turns out to be slightly faster than the idioms like @[from, then..]@.      , Enumerable (..)     , enumerate     , enumerateTo -    -- ** Iteration-    , iterate-    , iterateM-     -- ** From Containers     -- | Convert an input structure, container or source into a stream. All of     -- these can be expressed in terms of primitives.@@ -201,7 +306,9 @@      -- ** Parsing     , parse-    -- , parseBreak+    , parseBreak+    , parsePos+    , parseBreakPos      -- ** Lazy Right Folds     -- | Consuming a stream to build a right associated expression, suitable@@ -212,21 +319,57 @@     -- operations like mapping a function over the stream.     , foldrM     , foldr+    -- foldr1      -- ** Specific Folds-    -- | 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.-    ---    -- Useful idioms:+    -- | Streams are folded using folds in "Streamly.Data.Fold". Here are some+    -- idioms and equivalents of Data.List APIs using folds:     --     -- >>> foldlM' f a = Stream.fold (Fold.foldlM' f a)-    -- >>> foldl1 f = Stream.fold (Fold.foldl1' f)+    -- >>> 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+    -- >>> genericLength = Stream.fold Fold.genericLength     -- >>> head = Stream.fold Fold.one+    -- >>> last = Stream.fold Fold.latest+    -- >>> null = Stream.fold Fold.null+    -- >>> and = Stream.fold Fold.and+    -- >>> or = Stream.fold Fold.or+    -- >>> any p = Stream.fold (Fold.any p)+    -- >>> all p = Stream.fold (Fold.all p)+    -- >>> sum = Stream.fold Fold.sum+    -- >>> product = Stream.fold Fold.product+    -- >>> maximum = Stream.fold Fold.maximum+    -- >>> maximumBy cmp = Stream.fold (Fold.maximumBy cmp)+    -- >>> minimum = Stream.fold Fold.minimum+    -- >>> minimumBy cmp = Stream.fold (Fold.minimumBy cmp)+    -- >>> elem x = Stream.fold (Fold.elem x)+    -- >>> notElem x = Stream.fold (Fold.notElem x)+    -- >>> lookup x = Stream.fold (Fold.lookup x)+    -- >>> find p = Stream.fold (Fold.find p)+    -- >>> (!?) i = Stream.fold (Fold.index i)+    -- >>> genericIndex i = Stream.fold (Fold.genericIndex i)+    -- >>> elemIndex x = Stream.fold (Fold.elemIndex x)+    -- >>> findIndex p = Stream.fold (Fold.findIndex p)+    --+    -- Some equivalents of Data.List APIs from the Stream module:+    --+    -- >>> head = fmap (fmap fst) . Stream.uncons+    -- >>> tail = fmap (fmap snd) . Stream.uncons+    -- >>> tail = Stream.tail -- unreleased API+    -- >>> init = Stream.init -- unreleased API+    --+    -- A Stream based toList fold implementation is provided below because it+    -- has a better performance compared to the fold.++    -- Functions in Data.List, missing here:+    -- unsnoc = Stream.parseBreak (Parser.init Fold.toList)+    -- genericTake+    -- genericDrop+    -- genericSplitAt+    -- genericReplicate     , toList      -- * Mapping@@ -268,18 +411,27 @@     , scanl1M'     -} -    -- ** Scanning By 'Fold'+    -- ** Scanning By 'Scanl'     -- | 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+    -- >>> scanl' f z = Stream.scanl (Scanl.mkScanl f z)+    -- >>> scanlM' f z = Stream.scanl (Scanl.mkScanlM f z)+    -- >>> postscanl' f z = Stream.postscanl (Scanl.mkScanl f z)+    -- >>> postscanlM' f z = Stream.postscanl (Scanl.mkScanlM f z)+    -- >>> scanl1' f = Stream.catMaybes . Stream.scanl (Scanl.mkScanl1 f)+    -- >>> scanl1M' f = Stream.catMaybes . Stream.scanl (Scanl.mkScanl1M f)+    , scanl+    , postscanl     -- XXX postscan1 can be implemented using Monoids or Refolds.+    -- The following scans from Data.List are not provided.+    -- XXX scanl+    -- XXX scanl1+    -- XXX scanr+    -- XXX scanr1+    -- XXX mapAccumL+    -- XXX mapAccumR+    -- XXX inits+    -- XXX tails      -- ** Specific scans     -- Indexing can be considered as a special type of zipping where we zip a@@ -288,6 +440,8 @@      -- * Insertion     -- | Add elements to the stream.+    --+    -- >>> insert = Stream.insertBy compare      -- Inserting elements is a special case of interleaving/merging streams.     , insertBy@@ -318,24 +472,33 @@     , catEithers      -- ** Stateful Filters-    -- | 'scanMaybe' is the most general stateful filtering operation. The++    -- XXX Should use scanr instead of scanlMaybe for filtering.++    -- 'scanMaybe' is the most general stateful filtering operation. The     -- 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:+    -- Idioms and equivalents of Data.List APIs:     --     -- >>> deleteBy cmp x = Stream.scanMaybe (Fold.deleteBy cmp x)+    -- >>> deleteBy = Stream.deleteBy -- unreleased API+    -- >>> delete = deleteBy (==)     -- >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)     -- >>> elemIndices a = findIndices (== a)     -- >>> uniq = Stream.scanMaybe (Fold.uniqBy (==))-    , scanMaybe+    -- >>> partition p = Stream.fold (Fold.partition Fold.toList Fold.toList) . fmap (if p then Left else Right)+    -- >>> takeLast n s = Stream.fromEffect $ fmap Array.read $ Array.createOfLast n s+    -- , scanlMaybe     , take     , takeWhile     , takeWhileM     , drop     , dropWhile     , dropWhileM+    -- XXX write to an array in reverse and then read in reverse+    -- > dropWhileEnd = reverse . dropWhile p . reverse      -- XXX These are available as scans in folds. We need to check the     -- performance though. If these are common and we need convenient stream@@ -372,6 +535,9 @@     -- >>> s = s1 `Stream.append` s2      -- ** Appending+    -- | Equivalent of Data.List append:+    --+    -- >>> (++) = Stream.append     , append      -- ** Interleaving@@ -382,8 +548,14 @@     , mergeByM      -- ** Zipping+    -- | Idioms and equivalents of Data.List APIs:+    --+    -- >>> zip = Stream.zipWith (,)+    -- >>> unzip = Stream.fold (Fold.unzip Fold.toList Fold.toList)     , zipWith     , zipWithM+    -- XXX zipWith3,4,5,6,7+    -- XXX unzip3,4,5,6,7     -- , ZipStream (..)      -- ** Cross Product@@ -394,85 +566,152 @@     -- transformed stream at the end we can have a flipped version called     -- "crossMap" or "nestWith".     , crossWith-    -- , cross+    , cross+    -- , fairCrossWith+    , fairCross     -- , joinInner     -- , CrossStream (..)      -- * Unfold Each-    , unfoldMany-    , intercalate-    , intercalateSuffix+    -- Idioms and equivalents of Data.List APIs:+    --+    -- >>> cycle = Stream.unfoldEach Unfold.fromList . Stream.repeat+    -- >>> unlines = Stream.unfoldEachEndBy '\n'+    -- >>> unwords = Stream.unfoldEachSepBy ' '+    -- >>> unlines = Stream.unfoldEachEndBySeq "\n" Unfold.fromList+    -- >>> unwords = Stream.unfoldEachSepBySeq " " Unfold.fromList+    --+    , unfoldEach+    , bfsUnfoldEach+    , fairUnfoldEach+    , unfoldEachSepBySeq+    , unfoldEachEndBySeq      -- * Stream of streams-    -- | Stream operations like map and filter represent loop processing in+    -- | Stream operations like map and filter represent loops in     -- imperative programming terms. Similarly, the imperative concept of     -- nested loops are represented by streams of streams. The 'concatMap'     -- operation represents nested looping.-    -- A 'concatMap' operation loops over the input stream and then for each-    -- element of the input stream generates another stream and then loops over-    -- that inner stream as well producing effects and generating a single-    -- output stream.     ---    -- One dimension loops are just a special case of nested loops.  For-    -- example, 'concatMap' can degenerate to a simple map operation:+    -- A 'concatMap' operation loops over the input stream (outer loop),+    -- generating a stream from each element of the stream. Then it loops over+    -- each element of the generated streams (inner loop), collecting them in a+    -- single output stream.     ---    -- > map f m = S.concatMap (\x -> S.fromPure (f x)) m+    -- One dimension loops are just a special case of nested loops.  For+    -- example map and filter can be expressed using concatMap:     ---    -- Similarly, 'concatMap' can perform filtering by mapping an element to a-    -- 'nil' stream:+    -- >>> map f = Stream.concatMap (Stream.fromPure . f)+    -- >>> filter p = Stream.concatMap (\x -> if p x then Stream.fromPure x else Stream.nil)     ---    -- > filter p m = S.concatMap (\x -> if p x then S.fromPure x else S.nil) m+    -- Idioms and equivalents of Data.List APIs:     --+    -- >>> concat = Stream.concatMap id+    -- >>> cycle = Stream.concatMap Stream.fromList . Stream.repeat      , concatEffect     , concatMap     , concatMapM+    -- , bfsConcatMap+    , fairConcatMap +    , concatFor+    -- , bfsConcatFor+    , fairConcatFor++    , concatForM+    -- , bfsConcatForM+    , fairConcatForM+     -- * Repeated Fold-    -- | Useful idioms:+    -- | Idioms and equivalents of Data.List APIs:     ---    -- >>> 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 n = Stream.foldMany (Fold.take n Fold.toList)+    -- >>> groupBy eq = Stream.groupsWhile eq Fold.toList+    -- >>> groupBy eq = Stream.parseMany (Parser.groupBy eq Fold.toList)+    -- >>> groupsByRolling eq = Stream.parseMany (Parser.groupByRolling eq Fold.toList)+    -- >>> groups = groupBy (==)+    , foldMany     , groupsOf     , parseMany      -- * Splitting-    , splitOn+    -- | Idioms and equivalents of Data.List APIs:+    --+    -- >>> splitEndBy p f = Stream.foldMany (Fold.takeEndBy p f)+    -- >>> splitEndBy_ p f = Stream.foldMany (Fold.takeEndBy_ p f)+    -- >>> lines = splitEndBy_ (== '\n')+    -- >>> words = Stream.wordsBy isSpace+    -- >>> splitAt n = Stream.fold (Fold.splitAt n Fold.toList Fold.toList)+    -- >>> span p = Parser.splitWith (,) (Parser.takeWhile p Fold.toList) (Parser.fromFold Fold.toList)+    -- >>> break p = span (not . p)+    , splitSepBy_+    , splitSepBySeq_+    , splitEndBySeq+    , splitEndBySeq_     , wordsBy +    -- XXX Should use scanr instead+    -- >>> nub = Stream.fold Fold.toList . Stream.scanMaybe Fold.nub+     -- * Buffered Operations     -- | Operations that require buffering of the stream.     -- Reverse is essentially a left fold followed by an unfold.+    --+    -- Idioms and equivalents of Data.List APIs:+    --+    -- >>> nub = Stream.ordNub -- unreleased API+    -- >>> sortBy = StreamK.sortBy+    -- >>> sortOn f = StreamK.sortOn -- unreleased API+    -- >>> deleteFirstsBy = Stream.deleteFirstsBy -- unreleased+    -- >>> (\\) = Stream.deleteFirstsBy (==) -- unreleased+    -- >>> intersectBy = Stream.intersectBy -- unreleased+    -- >>> intersect = Stream.intersectBy (==) -- unreleased+    -- >>> unionBy = Stream.unionBy -- unreleased+    -- >>> union = Stream.unionBy (==) -- unreleased+    --     , reverse+    , unionBy+    -- XXX transpose: write the streams to arrays and then stream transposed.+    -- XXX subsequences+    -- XXX permutations+    -- , nub+    -- , ordNub+    -- , nubBy      -- * Multi-Stream folds     -- | Operations that consume multiple streams at the same time.     , eqBy     , cmpBy     , isPrefixOf+    , isInfixOf+    -- , isSuffixOf+    -- , isSuffixOfUnbox     , isSubsequenceOf      -- trimming sequences     , stripPrefix+    -- , stripSuffix+    -- , stripSuffixUnbox      -- Exceptions and resource management depend on the "exceptions" package     -- XXX We can have IO Stream operations not depending on "exceptions"     -- in Exception.Base      -- * Exceptions-    -- | 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.+    -- | __Scope__: Note that the stream exception handling routines+    -- (catch and handle) observe exceptions only in the stream segment (i.e.+    -- functions with the 'Stream' type) of the pipeline and not in the+    -- consumer segments (i.e. functions with 'Fold' or 'Parser' types). For+    -- example, if we are folding or parsing a stream - any exceptions in the+    -- fold or parser code won't be observed by the stream exception handlers.     --+    -- Exceptions in the fold code can be handled using similar exception+    -- handling routines found in the "Streamly.Data.Fold" module. To observe+    -- exceptions in the entire pipeline, you can wrap the stream elimination+    -- effect itself in a monad level exception handler (e.g. @Stream.fold+    -- Fold.drain `catch` ...@).+    --     -- 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@@ -483,25 +722,33 @@      -- * Resource Management     -- | '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-    -- the IO suffix in the "streamly" package.+    -- resource management 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 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.+    -- __Scope__: Note that these operations bracket only the stream-segment in+    -- a pipeline, they do not cover the stream-consumer (e.g. folds). This+    -- means that if an exception occurs in the consumer of the stream (e.g. in a+    -- fold or parser driven by the stream) then the exception won't be+    -- observed by the stream resource handlers, in such cases the resource+    -- stream 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.+    -- To observe exceptions in the entire pipline, put a monad level resource+    -- bracket around the stream elimination effect (e.g. around @(Stream.fold+    -- Fold.sum)@).+    --+    -- See also the "Streamly.Control.Exception" module for general+    -- resource management operations in non-stream as well as stream code.     , before     , afterIO     , finallyIO+    , finallyIO'+    , finallyIO''     , bracketIO+    -- XXX Expose the Control.Exception module as well.+    , bracketIO'+    , bracketIO''     , bracketIO3      -- * Transforming Inner Monad@@ -511,127 +758,33 @@     , runReaderT     , runStateT -    -- 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+    -- * Deprecated+    , scan+    , scanMaybe+    , postscan+    , splitOn+    , unfoldMany+    , intercalate+    , intercalateSuffix+    , chunksOf     ) where  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,-               notElem, maximum, minimum, head, last, tail, length, null,-               reverse, iterate, init, and, or, lookup, foldr1, (!!),-               scanl, scanl1, repeat, replicate, concatMap, span)+               mapM, scanl, sequence, reverse, iterate, foldr1, repeat, replicate,+               concatMap) +import Streamly.Internal.Data.Unbox (Unbox(..))+import Control.Monad.IO.Class (MonadIO(..))+ import qualified Streamly.Internal.Data.Array.Type as Array  #include "DocTestDataStream.hs" --- $overview------ Streamly is a framework for modular data flow based programming and--- declarative concurrency.  Powerful stream fusion framework in streamly--- allows high performance combinatorial programming even when using byte level--- streams.  Streamly API is similar to Haskell lists.------ == Console Echo Example------ In the following example, 'repeatM' generates an infinite stream of 'String'--- by repeatedly performing the 'getLine' IO action. 'mapM' then applies--- 'putStrLn' on each element in the stream converting it to stream of '()'.--- Finally, 'drain' folds the stream to IO discarding the () values, thus--- producing only effects.------ >>> import Data.Function ((&))------ >>> :{--- echo =---  Stream.repeatM getLine       -- Stream IO String---      & Stream.mapM putStrLn   -- Stream IO ()---      & Stream.fold Fold.drain -- IO ()--- :}------ This is a console echo program. It is an example of a declarative loop--- written using streaming combinators.  Compare it with an imperative @while@--- loop.------ Hopefully, this gives you an idea how we can program declaratively by--- representing loops using streams. In this module, you can find all--- "Data.List" like functions and many more powerful combinators to perform--- common programming tasks.------ == Stream Fusion------ 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.------ A typical stream pipeline consists of a stream producer, several stream--- 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 boxing of--- intermediate constructors, and thus forming a tight C like loop without any--- boxed data being used in the loop.------ Stream fusion works effectively when:------ * the stream pipeline is composed statically (known at compile time)--- * all the operations forming the loop are inlined--- * the loop is not recursively defined, recursion breaks inlining------ If these conditions cannot be met, the CPS style stream type 'StreamK' may--- turn out to be a better choice than the fused stream type 'Stream'.------ == Stream vs StreamK------ 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 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.------ Operations like 'cons' or 'append'; are typically recursively called to--- construct a lazy infinite stream. For such use cases the CPS style 'StreamK'--- 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, 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, 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.+{-# DEPRECATED chunksOf "Please use chunksOf from the Array module instead." #-}+{-# INLINE chunksOf #-}+chunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Stream m a -> Stream m (Array.Array a)+chunksOf = Array.chunksOf
src/Streamly/Data/StreamK.hs view
@@ -8,19 +8,9 @@ -- Stability   : released -- Portability : GHC ----- Streams represented as chains of functions calls using Continuation Passing--- Style (CPS), suitable for dynamically composing potentially large number of--- streams.------ 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.+-- Streams represented as chains of function calls using Continuation Passing+-- Style (CPS), suitable for dynamically and recursively composing potentially+-- large number of streams. The 'K' in 'StreamK' stands for Kontinuation. -- -- 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@@ -32,6 +22,43 @@ -- "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".+--+-- == Fused vs CPS Streams+--+-- 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 efficiently to 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.+--+-- = Overview+--+-- StreamK can be constructed like lists, except that they use 'nil' instead of+-- '[]' and 'cons' instead of ':'.+--+-- >>> import Streamly.Data.StreamK (StreamK, cons, consM, nil)+--+-- `cons` constructs a stream from pure values:+--+-- >>> stream = 1 `cons` 2 `cons` nil :: StreamK IO Int+--+-- Operations from "Streamly.Data.Stream" can be used for StreamK as well by+-- converting StreamK to Stream ('toStream'), and vice-versa ('fromStream').+--+-- >>> Stream.fold Fold.toList $ StreamK.toStream stream -- IO [Int]+-- [1,2]+--+-- Stream can also be constructed from effects not just pure values:+--+-- >>> effect n = print n >> return n+-- >>> stream = effect 1 `consM` effect 2 `consM` nil+-- >>> Stream.fold Fold.toList $ StreamK.toStream stream+-- 1+-- 2+-- [1,2]  -- Notes: --@@ -54,12 +81,14 @@     --     -- $setup -    -- * Overview-    -- $overview-     -- * Type       StreamK +    -- -- * Nested+    -- -- | List transformers and logic programming monads.+    -- , Nested(..) -- need to decide on mtl instances+    -- , FairNested(..) -- bind is not associative+     -- * Construction     -- ** Primitives     -- | Primitives to construct a stream from pure values or monadic actions.@@ -85,6 +114,9 @@     -- ** From Containers     , fromFoldable +    -- ** To Containers+    , toList+     -- * Elimination      -- ** Primitives@@ -95,15 +127,17 @@     -- , foldBreak      -- ** Parsing+    , toParserK     , parse     , parseBreak-    , parseBreakChunks-    , parseChunks+    , parsePos+    , parseBreakPos      -- * Transformation     , mapM     , dropWhile     , take+    , filter      -- * Combining Two Streams     -- | Unlike the operations in "Streamly.Data.Stream", these operations can@@ -141,8 +175,19 @@     -- >>> concatForFoldableWith f xs g = Prelude.foldr (f . g) StreamK.nil xs     --     , concatEffect-    -- , concatMap+    , concatMap+    , bfsConcatMap+    , fairConcatMap     , concatMapWith++    , concatFor+    , bfsConcatFor+    , fairConcatFor++    , concatForM+    , bfsConcatForM+    , fairConcatForM+     , mergeMapWith      -- * Buffered Operations@@ -158,37 +203,15 @@     -- | Please note that 'Stream' type does not observe any exceptions from     -- the consumer of the stream whereas 'StreamK' does.     , bracketIO++    -- * Deprecated+    , parseBreakChunks+    , parseChunks     ) where  import Streamly.Internal.Data.StreamK-import Prelude hiding (reverse, zipWith, mapM, dropWhile, take)+import Prelude hiding+    (reverse, zipWith, mapM, dropWhile, take, filter, concatMap)  #include "DocTestDataStreamK.hs"---- $overview------ Continuation passing style (CPS) stream implementation. The 'K' in 'StreamK'--- stands for Kontinuation.------ StreamK can be constructed like lists, except that they use 'nil' instead of--- '[]' and 'cons' instead of ':'.------ `cons` adds a pure value at the head of the stream:------ >>> import Streamly.Data.StreamK (StreamK, cons, consM, nil)--- >>> stream = 1 `cons` 2 `cons` nil :: StreamK IO Int------ You can use operations from "Streamly.Data.Stream" for StreamK as well by--- converting StreamK to Stream ('toStream'), and vice-versa ('fromStream').------ >>> Stream.fold Fold.toList $ StreamK.toStream stream -- IO [Int]--- [1,2]------ `consM` adds an effect at the head of the stream:------ >>> stream = effect 1 `consM` effect 2 `consM` nil--- >>> Stream.fold Fold.toList $ StreamK.toStream stream--- 1--- 2--- [1,2]
src/Streamly/Data/Unfold.hs view
@@ -11,7 +11,7 @@ -- Fast, composable stream producers with ability to terminate, supporting -- nested stream fusion. Nested stream operations like -- 'Streamly.Data.Stream.concatMap' in the "Streamly.Data.Stream" module do not--- fuse, however, the 'Streamly.Data.Stream.unfoldMany' operation, using the+-- fuse, however, the 'Streamly.Data.Stream.unfoldEach' operation, using the -- 'Unfold' type, is a fully fusible alternative to -- 'Streamly.Data.Stream.concatMap'. --@@ -67,6 +67,7 @@     , lmapM     , first     , second+    , carry      -- ** Mapping on Output     , mapM@@ -88,6 +89,9 @@     , crossWith      -- ** Nesting+    , unfoldEach++    -- * Deprecated     , many      )
src/Streamly/FileSystem/Dir.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module      : Streamly.FileSystem.Dir -- Copyright   : (c) 2018 Composewell Technologies@@ -12,6 +13,7 @@ -- something else.  module Streamly.FileSystem.Dir+{-# DEPRECATED "Please use \"Streamly.FileSystem.DirIO\" instead." #-}     (     -- * Streams       read
+ src/Streamly/FileSystem/DirIO.hs view
@@ -0,0 +1,41 @@+-- |+-- Module      : Streamly.FileSystem.DirIO+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC+--+-- High performance and streaming APIs for reading directories.+--+-- File system paths are specified using the 'Streamly.FileSystem.Path.Path'+-- type. If you want to convert between 'String' or 'FilePath' and 'Path' use+-- 'Streamly.FileSystem.Path.fromString_', 'Streamly.FileSystem.Path.toString'+-- from the "Streamly.FileSystem.Path" module..+--+-- >>> import qualified Streamly.FileSystem.DirIO as Dir+--++module Streamly.FileSystem.DirIO+    (+    -- * Configuration+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+    -- | Only the default ReadOptions are supported for Windows. Please use "id"+    -- as the configuration modifier.+      ReadOptions+#else+      ReadOptions+    , followSymlinks+    , ignoreMissing+    , ignoreSymlinkLoops+    , ignoreInaccessible+#endif+    -- * Streams+    , read+    , readEither+    )+where++import Streamly.Internal.FileSystem.DirIO+import Prelude hiding (read)
src/Streamly/FileSystem/File.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.FileSystem.File -- Copyright   : (c) 2019 Composewell Technologies@@ -19,9 +21,10 @@ -- the handle based APIs as there is no possibility of a file descriptor -- leakage. ----- >>> import qualified Streamly.FileSystem.File as File+-- >> import qualified Streamly.FileSystem.File as File -- module Streamly.FileSystem.File+{-# DEPRECATED "Please use \"Streamly.FileSystem.FileIO\" instead." #-}     (     -- * Streaming IO     -- | Stream data to or from a file or device sequentially.  When reading,
+ src/Streamly/FileSystem/FileIO.hs view
@@ -0,0 +1,67 @@+-- |+-- Module      : Streamly.FileSystem.FileIO+-- Copyright   : (c) 2019 Composewell Technologies+--+-- 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+-- in the file system. These APIs open the file handle, perform the requested+-- operation and close the handle. These are higher level and safer compared to+-- the handle based APIs as there is no possibility of a file descriptor+-- leakage.+--+-- Files are always opened in:+--+-- * __Binary mode__ — encoding, decoding, and newline translation should be+--   handled explicitly by the streaming APIs.+-- * __Unbuffered mode__ — buffering can be managed explicitly via streaming+--   APIs.+--+-- File system paths are specified using the 'Streamly.FileSystem.Path.Path'+-- type. If you want to convert between 'String' or 'FilePath' and 'Path' use+-- 'Streamly.FileSystem.Path.fromString_', 'Streamly.FileSystem.Path.toString'+-- from the "Streamly.FileSystem.Path" module..+--+-- >> import qualified Streamly.FileSystem.FileIO as File+--+module Streamly.FileSystem.FileIO+    (+    -- * Streaming IO+    -- | Stream data to or from a file or device sequentially.  When reading,+    -- the stream is lazy and generated on-demand as the consumer consumes it.+    -- Read IO requests to the IO device are performed in chunks limited to a+    -- maximum size of 32KiB, this is referred to as @defaultChunkSize@ in the+    -- documentation. One IO request may or may not read the full+    -- chunk. If the whole stream is not consumed, it is possible that we may+    -- read slightly more from the IO device than what the consumer needed.+    -- When writing, unless specified otherwise in the API, writes are+    -- collected into chunks of @defaultChunkSize@ before they are written to+    -- the IO device.++    -- Streaming APIs work for all kind of devices, seekable or non-seekable;+    -- including disks, files, memory devices, terminals, pipes, sockets and+    -- fifos. While random access APIs work only for files or devices that have+    -- random access or seek capability for example disks, memory devices.+    -- Devices like terminals, pipes, sockets and fifos do not have random+    -- access capability.++    -- ** File IO Using Handle+      withFile++    -- ** Streams+    , read+    , readChunksWith+    , readChunks++    -- ** Folds+    , write+    , writeWith+    , writeChunks+    )+where++import Streamly.Internal.FileSystem.FileIO+import Prelude hiding (read)
src/Streamly/FileSystem/Handle.hs view
@@ -14,7 +14,11 @@ -- Read and write byte streams and array streams to and from file handles -- ('Handle'). ----- The 'TextEncoding', 'NewLineMode', and 'Buffering' options of the underlying+-- Please set NoBuffering mode on the handle as buffering is explicitly+-- controlled by the streaming API and double buffering can sometimes cause+-- unexpected results.+--+-- Also note that the 'TextEncoding', 'NewLineMode' options of the underlying -- GHC 'Handle' are ignored by these APIs. Please use "Streamly.Unicode.Stream" -- module for encoding and decoding a byte stream, use stream splitting -- operations in "Streamly.Data.Stream" to create a stream of lines or to split
+ src/Streamly/FileSystem/Path.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.FileSystem.Path+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- File system paths that are extensible, high-performance and preserve the OS+-- and filesystem encoding.+--+-- The 'Path' type is built on top of Streamly's 'Array' type, leveraging all+-- its operations — including support for both pinned and unpinned+-- representations. The API integrates with streams, prioritizes safety,+-- flexibility, and performance. It supports configurable equality for+-- cross-platform compatibility and user-defined path matching. It is designed+-- for extensibility and fine-grained type safety as well. For type-safe+-- adaptations, see the "Streamly.Internal.FileSystem.Path.*" modules.+--+-- 'Path' is interconvertible with the 'OsPath' type from the @filepath@+-- package at zero runtime cost. While the API is mostly compatible with that+-- of the @filepath@ package, some differences exist due to a slightly+-- different design philosophy focused on better safety.+--+-- = Rooted vs Unrooted Paths+--+-- To ensure the safety of the path append operation, we distinguish between+-- rooted paths and free path segments or unrooted paths. A path that starts+-- from an explicit or implicit file system root is called a rooted path or an+-- anchored path. For example, @\/usr\/bin@ is a rooted path with @/@ as an+-- explicit root directory. Similarly, @.\/bin@ is a rooted path with the+-- current directoy \".\" as an implicit root. A path that is not rooted is+-- called an unrooted path or unanchored path; for example, @local\/bin@ is an+-- unrooted path.+--+-- This distinction ensures the safety of the path append operation. You can+-- append only an unrooted path to another path, it does not make sense to+-- append a rooted path to another path. The default append operation in the+-- Path module checks for this and fails if the operation is invalid.+--+-- Rooted vs unrooted distinction is a stricter form of relative vs absolute+-- path distinction. In this model, for better safety, paths relative to the+-- current directory are also treated in the same way as absolute paths, from+-- the perspective of a path append operation. This is because the  meaning of+-- current directory is context dependent and dynamic, therefore, appending it+-- to another path is not allowed. Only unrooted path segments (e.g.+-- @local/bin@) can be appended to any other path using safe operations.+--+-- = File vs. Directory Paths+--+-- By default, a path with a trailing separator (e.g. @local/@) is implicitly+-- considered a directory path. However, the absence of a trailing separator+-- does not indicate whether the path is a file or a directory — it could be+-- either. Therefore, when using the @Path@ type, the append operation allows+-- appending to paths even if they lack a trailing separator.+--+-- = Compatibility with the filepath package+--+-- Any path type can be converted to the 'FilePath' type from the @filepath@+-- package by using the 'toString' operation. Operations to convert to and from+-- the 'OsPath' type at zero cost are provided in the @streamly-filepath@+-- package. Zero-cost interconversion is possible because the 'Path' type uses+-- an underlying representation which is compatible with the 'OsPath' type.+--+-- = Path Creation Quasiquoter+--+-- The 'path' quasiquoter is useful in creating valid paths that are checked+-- during the compile time.++module Streamly.FileSystem.Path+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Type+      Path+    , OsWord++    -- * Construction+    , validatePath+    , fromArray+    , fromString+    , fromString_++    -- * Statically Verified String Literals+    -- | Quasiquoters.+    , path++    -- * Statically Verified Strings+    -- | Template Haskell expression splices.+    , pathE++    -- * Elimination+    , toArray+    -- , toChars -- need fromChars as well+    , toString+    -- , asOsCString++    -- * Path Info+    , isRooted+    , isUnrooted++    -- * Joining+    , unsafeJoin+    , join+    , joinStr++    -- * Splitting root+    , splitRoot++    -- * Splitting path components+    , splitPath+    -- , splitPath_++    -- * Splitting file extension+    , splitExtension+    , takeExtension+    , dropExtension+    -- , addExtension+    -- , replaceExtension++    -- * Splitting file and dir+    , splitFile+    , takeFileName+    , takeDirectory+    , takeFileBase++    -- * Equality+    , EqCfg+    , ignoreCase+    , ignoreTrailingSeparators+    , allowRelativeEquality++    , eqPath+    )+where++{- Documentation on typed paths. We can add this back into the module level+ documentation when we introduce the typed paths.++-- = Rooted Paths vs Branches+--+-- /Flexible typing/: you can choose the level of type safety you want. 'Path'+-- is the basic path type which can represent a file, directory, absolute or+-- relative path with no restrictions. Depending on how much type safety you+-- want, you can choose appropriate type wrappers or a combination of those to+-- wrap the 'Path' type in stricter types.++-- The "Streamly.FileSystem.Path.Seg" module provides explicit types for path+-- segments, distinguishing rooted paths from branches. Rooted paths use the+-- @Rooted Path@ type, and branches use the @Branch Path@ type. If you use the+-- generic 'Path' type, append may fail at run time if you attempt to append+-- a rooted path to another rooted path. In contrast, using the @Rooted Path@+-- and @Branch Path@ types guarantees compile-time safety, preventing such errors.++-- = File vs. Directory Paths+--+-- Independent of the rooted or branch distinction, you can also make a+-- type-level distinction between file and directory nodes using the+-- "Streamly.FileSystem.Path.Node" module. The type @File Path@ represents a+-- file, whereas @Dir Path@ represents a directory. This distinction provides+-- safety against appending to file type paths — append operations are not+-- allowed on paths of type 'File'.++-- = Flexible Typing+--+-- You can use the 'Rooted', 'Branch', 'Dir', and 'File' types independently by+-- importing only the required modules. If you want both types of distinctions,+-- you can use them together via the "Streamly.FileSystem.Path.SegNode" module.+-- For example, @Rooted (Dir Path)@ represents a rooted path that is a+-- directory. You can append other paths only to paths that have a 'Dir' type,+-- and only a path of type 'Branch' can be appended.+--+-- You may choose to use the basic 'Path' type or any combination of the safer+-- types. You can upgrade or downgrade the safety level by converting between+-- types using the @adapt@ operation. When converting from a less restrictive+-- type to a more restrictive one, run-time checks are performed, and the+-- conversion may fail. However, converting from a more restrictive type to a+-- less restrictive one is always allowed.+--+-- = Extensibility+--+-- You can define your own newtype wrappers similar to 'File' or 'Dir' to+-- provide custom restrictions if you want.+--++-}++import Streamly.Internal.FileSystem.Path++#include "DocTestFileSystemPath.hs"
+ src/Streamly/FileSystem/Path/Node.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Streamly.FileSystem.Path.Node+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Represent 'File' or 'Dir' type path nodes explicitly as separate types for+-- the safety of path append operation. A 'Dir' path is a branching or+-- intermediate node whereas a 'File' type is a terminal or leaf node. We+-- cannot append a path to a 'File' type path.+--+-- See the overview in the "Streamly.FileSystem.Path" module for more details.+--+module Streamly.FileSystem.Path.Node+    (+    -- * Types+      File+    , Dir+    , IsNode++    -- * Statically Verified Path Literals+    -- | Quasiquoters.+    , dir+    , file++    -- * Statically Verified Path Strings+    -- | Template Haskell expression splices.+    , dirE+    , fileE++    -- * Operations+    , join+    )+where++import Streamly.Internal.FileSystem.Path.Node
+ src/Streamly/FileSystem/Path/Seg.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Streamly.FileSystem.Path.Seg+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Represent 'Rooted' or 'Unrooted' type path segments explicitly as separate+-- types for the safety of path append operation. A Rooted path is an absolute+-- path or a path that is relative to the current directory with a leading dot.+-- Rooted paths cannot be appended to other paths.+--+-- See the overview in the "Streamly.FileSystem.Path" module for more details.+--+module Streamly.FileSystem.Path.Seg+    (+    -- * Types+      Rooted+    , Unrooted+    , IsSeg++    -- * Statically Verified Path Literals+    -- | Quasiquoters.+    , rt+    , ur++    -- * Statically Verified Path Strings+    -- | Template Haskell expression splices.+    , rtE+    , urE++    -- * Operations+    , join+    )+where++import Streamly.Internal.FileSystem.Path.Seg
+ src/Streamly/FileSystem/Path/SegNode.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Streamly.FileSystem.Path.SegNode+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Use 'Rooted' or 'Unrooted' path segment type annotations as well as 'File' and+-- 'Dir' node type annotations on the same path for the safety of path append+-- operation. A Rooted path cannot be appended to other paths, and you canno+-- append a path to a 'File' type path.+--+-- See the overview in the "Streamly.FileSystem.Path" module for more details.+--++module Streamly.FileSystem.Path.SegNode+    (+    -- * Statically Verified Path Literals+    -- | Quasiquoters.+      rtdir+    , urdir+    , rtfile+    , urfile++    -- * Statically Verified Path Strings+    -- | Template Haskell expression splices.+    , rtdirE+    , urdirE+    , rtfileE+    , urfileE++    -- * Operations+    , join+    )+where++import Streamly.Internal.FileSystem.Path.SegNode
src/Streamly/Internal/Console/Stdio.hs view
@@ -9,16 +9,25 @@  module Streamly.Internal.Console.Stdio     (-    -- * Streams+    -- * Singleton APIs+      -- getChunk+    -- , putChunk++    -- * Stream reads       read-    , readChars+    -- , readWith -- buffer     , readChunks-    -- , getChunksLn-    -- , getStringsWith -- get strings using the supplied decoding-    -- , getStrings -- get strings of complete chars,-                  -- leave any partial chars for next string-    -- , getStringsLn -- get lines decoded as char strings+    -- , readChunksWith -- buffer+    -- , readChunksLn -- chunks with line buffering -- repeatM Text.getLine +    -- -- ** Encoding specific+    -- , readCharsWith+    -- , readStringsLnWith++    -- ** UTF-8 decoded+    , readChars+    -- , readStringsLn -- strings with line buffering -- repeatM getLine+     -- * Unfolds     , reader     , chunkReader@@ -31,11 +40,18 @@      -- * Stream writes     , putBytes  -- Buffered (32K)-    , putChars     , putChunks -- Unbuffered++    -- ** Encoding specific+    -- , putCharsWith     , putStringsWith+    -- , putStringsLnWith++    -- ** UTF-8 encoded+    , putChars     , putStrings     , putStringsLn+    -- , putChunksLn     ) where @@ -53,7 +69,6 @@  import qualified Streamly.Internal.Data.Array as Array 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 import qualified Streamly.Internal.Unicode.Stream as Unicode@@ -194,7 +209,7 @@ -- folds as well as unfolds/streams. Non-backtracking (one-to-one, one-to-many, -- filters, reducers) transformations may be easy so we can possibly start with -- those.---+ -- | Write a stream of strings to standard output using the supplied encoding. -- Output is flushed to the device for each string. --@@ -224,5 +239,5 @@ putStringsLn :: MonadIO m => Stream m String -> m () putStringsLn =       putChunks-    . Stream.intersperseMSuffix (return $ Array.fromList [10])+    . Stream.intersperseEndByM (return $ Array.fromList [10])     . Unicode.encodeStrings Unicode.encodeUtf8
src/Streamly/Internal/Control/Exception.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Control.Exception -- Copyright   : (c) 2019 Composewell Technologies@@ -10,11 +11,50 @@ -- Additional "Control.Exception" utilities.  module Streamly.Internal.Control.Exception-    ( verify+    (+    -- * Verify+      verify     , verifyM++    -- * Resource Management+    -- | Exception safe, thread safe resource managment operations, similar to+    -- but more powerful than the @bracket@ and @finally@ operations available+    -- in the base package.+    --+    -- These operations support allocation and free only in the IO monad,+    -- hence the IO suffix.+    --+    , AcquireIO(..)+    , Priority(..)+    , allocator+    , releaser+    , withAcquireIO+    , acquireWith+    , acquire+    , acquire_+    , registerWith+    , register+    , hook     ) where +-- import Control.Concurrent (myThreadId)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Exception (mask_)+import Control.Monad.Catch (MonadMask)+import Data.IntMap.Strict (IntMap)+import Data.IORef (IORef, newIORef, atomicModifyIORef')++import qualified Control.Monad.Catch as MC+import qualified Data.IntMap.Strict as Map++#include "DocTestControlException.hs"++-------------------------------------------------------------------------------+-- Asserts+-------------------------------------------------------------------------------+ -- | Like 'assert' but is not removed by the compiler, it is always present in -- production code. --@@ -36,3 +76,252 @@ {-# INLINE verifyM #-} verifyM :: Applicative f => Bool -> f () verifyM predicate = verify predicate (pure ())++-------------------------------------------------------------------------------+-- Resource management+-------------------------------------------------------------------------------++-- XXX In a manual release mechanism of resources we always have the risk of+-- using the resource by some persisting thread even after it has been freed.+-- Ideally, we should use the GC to clean up resources because that way we do+-- not need to worry about references, we can pass around resources to other+-- threads and we get an automatic reference counting. Is it possible to use+-- compact regions to confine resource to smaller areas so that we can perform+-- a limited GC to free them? We can then just put gc sync barriers at points+-- where we want to ensure that resources are freed.++-- | Resources with 'Priority1' are freed before 'Priority2'. Priority is+-- especially introduced to take care of the case where we need to free+-- concurrency channels, so that all the workers of the channel are cleaned up+-- before we free the resources allocated by the workers of the channel.+-- Otherwise we might free the resources and workers may be trying to use them+-- and start misbehaving.+--+data Priority = Priority1 | Priority2 deriving Show++-- To keep the type signatures simple and to avoid inference problems we should+-- use this newtype. We cannot pass around a foralled type without wrapping+-- it in a newtype.++-- | @AcquireIO@ is used to acquire a resource safely such that it is+-- automatically released if not released manually.+--+-- See 'withAcquireIO'.+--+newtype AcquireIO = AcquireIO+    (forall b c. Priority -> IO b -> (b -> IO c) -> IO (b, IO ()))++-- | /Internal/.+allocator :: MonadIO m =>+       IORef (Int, IntMap (IO ()), IntMap (IO ()))+    -> Priority+    -> IO a+    -> (a -> IO b)+    -> m (a, m ())+allocator ref pri alloc free = do+    let insertResource r (i, mp1, mp2) =+            case pri of+                Priority1 ->+                    ((i + 1, Map.insert i (void $ free r) mp1, mp2), i)+                Priority2 ->+                    ((i + 1, mp1, Map.insert i (void $ free r) mp2), i)++    (r, index) <-+        liftIO $ mask_ $ do+            -- tid <- myThreadId+            r <- alloc+            idx <- atomicModifyIORef' ref (insertResource r)+            -- liftIO $ putStrLn $ "insert: " ++ show pri+            --      ++ " " ++ show idx ++ " " ++ show tid+            return (r, idx)++    let deleteResource (i, mp1, mp2) =+            case pri of+                Priority1 ->+                    let res = Map.lookup index mp1+                     in ((i, Map.delete index mp1, mp2), res)+                Priority2 ->+                    let res = Map.lookup index mp2+                     in ((i, mp1, Map.delete index mp2), res)++        release =+            -- IMPORTANT: do not use interruptible operations in this+            -- critical section. Even putStrLn can make tests fail.+            liftIO $ mask_ $ do+                -- tid <- myThreadId+                -- liftIO $ putStrLn $ "releasing index: " ++ show index+                --      ++ " " ++ show tid+                f <- atomicModifyIORef' ref deleteResource+                -- restoring exceptions makes it non-atomic, tests fail.+                -- Can use allowInterrupt in "free" if desired.+                sequence_ f+    return (r, release)++-- XXX can we ensure via GC that the resources that we are freeing are all+-- dead, there are no other references to them?++-- | We ensure that all async workers for concurrent streams are stopped+-- before we release the resources so that nobody could be using the+-- resource after they are freed.+--+-- The only other possibility, could be user issued forkIO not being+-- tracked by us, however, that would be a programming error and any such+-- threads could misbehave if we freed the resources from under them.+--+-- We use GC based hooks in 'Stream.bracketIO\'' so there could be async threads+-- spawned by GC, releasing resources concurrently with us. For that reason we+-- need to make sure that the "release" in the bracket end action is executed+-- only once in that case.+--+-- /Internal/.+releaser :: MonadIO m => IORef (a, IntMap (IO b), IntMap (IO b)) -> m ()+releaser ref =+    liftIO $ mask_ $ do+        -- Delete the map from the ref first so that anyone else (GC)+        -- releasing concurrently cannot find the map.+        -- liftIO $ putStrLn "cleaning up priority 1"+        mp1 <- atomicModifyIORef' ref+            (\(i, mp1,mp2) -> ((i, Map.empty, mp2), mp1))+        -- Note that the channel cleanup function is interruptible because+        -- it has blocking points.+        sequence_ mp1+        -- Now nobody would be changing mp2, we can read it safely+        -- liftIO $ putStrLn "cleaning up priority 2"+        mp2 <- atomicModifyIORef' ref+            (\(i, mp,mp2) -> ((i, mp, Map.empty), mp2))+        sequence_ mp2+        -- XXX We can now assert that the IORef has both maps empty.++-- | @withAcquireIO action@ runs the given @action@, providing it with a+-- an 'AcquireIO' reference called @ref@ as argument. @ref@ is used for resource+-- acquisition or hook registeration within the scope of @action@. An @acquire+-- ref alloc free@ call can be used within @action@ any number of times to+-- acquire resources that are automatically freed when the scope of @action@+-- ends or if an exception occurs at any time. @alloc@ is a function supplied+-- by the user to allocate a resource and @free@ is supplied to free the+-- allocated resource. @acquire@ returns @(resource, release)@ -- the acquired+-- @resource@ and a @release@ action to release it.+--+-- @acquire@ allocates a resource in an exception safe manner and sets up its+-- automatic release on exception or when the scope of @action@ ends. The+-- @release@ function returned by @acquire@ can be used to free the resource+-- manually at any time. @release@ is guaranteed to free the resource once and+-- only once even if it is called concurrently or multiple times.+--+-- Here is an example to allocate resources that are guaranteed to be released+-- automatically, and can be released manually as well:+--+-- >>> :{+-- close x h = do+--  putStrLn $ "closing: " ++ x+--  hClose h+-- :}+--+-- >>> :{+-- action ref =+--      Stream.fromList ["file1", "file2"]+--    & Stream.mapM+--        (\x -> do+--            (h, release) <- Exception.acquire ref (openFile x ReadMode) (close x)+--            -- use h here+--            threadDelay 1000000+--            when (x == "file1") $ do+--                putStrLn $ "Manually releasing: " ++ x+--                release+--            return x+--        )+--    & Stream.trace print+--    & Stream.fold Fold.drain+-- :}+--+-- >>> run = Exception.withAcquireIO action+--+-- In the above code, you should see the \"closing:\" message for both the+-- files, and only once for each file. Even if you interrupt the program with+-- CTRL-C you should still see the \"closing:\" message for the files opened+-- before the interrupt. Make sure you create "file1" and "file2" before+-- running this code snippet.+--+-- Cleanup is guaranteed to happen as soon as the scope of 'action'+-- finishes or if an exception occurs.+--+-- Here is an example for just registering hooks to be called eventually:+--+-- >>> :{+-- action ref =+--      Stream.fromList ["file1", "file2"]+--    & Stream.mapM+--        (\x -> do+--            Exception.register ref $ putStrLn $ "saw: " ++ x+--            threadDelay 1000000+--            return x+--        )+--    & Stream.trace print+--    & Stream.fold Fold.drain+-- :}+--+-- >>> run = Exception.withAcquireIO action+--+-- In the above code, even if you interrupt the program with CTRL-C you should+-- still see the "saw:" message for the elements seen before the interrupt.+--+-- The registered hooks are guaranteed to be invoked as soon as the scope of+-- 'action' finishes or if an exception occurs.+--+-- This function provides functionality similar to the @bracket@ function+-- available in the base library. However, it is more powerful as any number of+-- resources can be allocated and released within the scope of 'action'.+--+-- Exception safe, thread safe.+{-# INLINE withAcquireIO #-}+withAcquireIO :: (MonadIO m, MonadMask m) => (AcquireIO -> m a) -> m a+withAcquireIO action = do+    -- Assuming 64-bit int counter will never overflow+    ref <- liftIO $ newIORef (0 :: Int, Map.empty, Map.empty)+    action (AcquireIO (allocator ref)) `MC.finally` releaser ref++-- | Like 'acquire' but allows specifying a priority for releasing the+-- resource. 'Priority1' resources are released before 'Priority2'. This allows+-- us to specify a dependency between resource release.+{-# INLINE acquireWith #-}+acquireWith :: Priority -> AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())+acquireWith pri (AcquireIO f) = f pri++-- | @acquire ref alloc free@ is used in bracket-style safe resource allocation+-- functions, where @alloc@ is a function supplied by the user to allocate a+-- resource and @free@ is supplied to free it. @acquire@ returns a tuple+-- @(resource, release)@ where @resource@ is the allocated resource and+-- @release@ is an action that can be called later to release the resource.+-- Both @alloc@ and @free@ are invoked with async signals masked. You can use+-- @allowInterrupt@ from base package for allowing interrupts if required.+--+-- The @release@ action can be called multiple times or even concurrently from+-- multiple threads,  but it will release the resource only once. If @release@+-- is never called by the programmer it will be automatically called at the end+-- of the bracket scope.+--+acquire :: AcquireIO -> IO b -> (b -> IO c) -> IO (b, IO ())+acquire = acquireWith Priority2++-- | Like 'acquire' but does not return a release action. The resource is freed+-- automatically only.+acquire_ :: AcquireIO -> IO b -> (b -> IO c) -> IO b+acquire_ a b c = fmap fst $ acquire a b c++-- | Like 'register' but specifies a 'Priority' for calling the hook.+{-# INLINE registerWith #-}+registerWith :: Priority -> AcquireIO -> IO () -> IO ()+registerWith pri (AcquireIO f) g = void $ f pri (return ()) (\() -> g)++-- | Register a hook to be executed at the end of a bracket.+register :: AcquireIO -> IO () -> IO ()+register = registerWith Priority2++-- | Like 'register' but returns a hook release function as well. When the+-- returned hook release function is called, the hook is invoked and removed.+-- If the returned function is never called by the programmer then it is+-- automatically invoked at the end of the bracket. The hook is invoked once+-- and only once.+--+hook :: AcquireIO -> IO () -> IO (IO())+hook (AcquireIO f) g = fmap snd $ f Priority2 (return ()) (\() -> g)
src/Streamly/Internal/Data/Array.hs view
@@ -20,13 +20,9 @@      -- * Construction     -- Monadic Folds-    , writeLastN+    , createOfLast      -- * Random Access-    -- , (!!)-    , getIndex-    , getIndexRev-    , last           -- XXX getLastIndex?     -- , getIndicesFrom    -- read from a given position to the end of file     -- , getIndicesUpto    -- read from beginning up to the given position     -- , getIndicesFromTo@@ -35,9 +31,6 @@     , indexReader     , indexReaderFromThenTo -    -- * Size-    , null-     -- * Search     , binarySearch     , findIndicesOf@@ -49,67 +42,86 @@     -- * Casting     , cast     , asBytes-    , castUnsafe-    , asCStringUnsafe+    , unsafeCast+    , asCStringUnsafe -- XXX asCString+    , asCWString      -- * Subarrays-    , getSliceUnsafe-    -- , getSlice-    , sliceIndexerFromLen-    , slicerFromLen-    , splitOn+    -- , sliceOffLen+    , indexerFromLen+    , splitterFromLen      -- * Streaming Operations     , streamTransform      -- * Folding     , streamFold-    , fold+    , foldM+    , foldRev      -- * Stream of Arrays--    -- XXX these are probably not very useful to have in this module as we can-    -- express these idiomatically using streams.-    , interpose-    , interposeSuffix-    , intercalateSuffix+    , concatSepBy+    , concatEndBy+    , concatEndBySeq -    , compactLE-    , pinnedCompactLE-    , compactOnByte-    , compactOnByteSuffix+    , compactMax+    , compactMax'+    , compactSepByByte_+    , compactEndByByte_+    , compactEndByLn_ -    , foldBreakChunks+    -- * Parsing Stream of Arrays+    , foldBreakChunks -- Uses Stream, bad perf on break     , foldChunks-    , foldBreakChunksK-    , parseBreakChunksK+    , foldBreak+    -- , parseBreakChunksK -- XXX uses Parser. parseBreak is better?+    , toParserK+    , parseBreak+    , parseBreakPos+    , parse+    , parsePos      -- * Serialization     , encodeAs     , serialize-    , pinnedSerialize+    , serialize'     , deserialize      -- * Deprecated+    , slicerFromLen+    , sliceIndexerFromLen+    , castUnsafe+    , getSliceUnsafe+    , pinnedSerialize     , genSlicesFromLen     , getSlicesFromLen     , getIndices+    , writeLastN+    , interpose+    , interposeSuffix+    , intercalateSuffix+    , compactLE+    , pinnedCompactLE+    , compactOnByte+    , compactOnByteSuffix+    , splitOn+    , fold+    , foldBreakChunksK     ) where  #include "assert.hs"+#include "deprecation.h" #include "inline.hs" #include "ArrayMacros.h"  import Control.Monad.IO.Class (MonadIO(..)) -- import Data.Bifunctor (first) -- import Data.Either (fromRight)-import Data.Functor.Identity (Identity)+import Data.Functor.Identity (Identity(..)) import Data.Proxy (Proxy(..)) import Data.Word (Word8)-import Foreign.C.String (CString)-import Foreign.Ptr (castPtr)-import Foreign.Storable (Storable)+import Foreign.C.String (CString, CWString) import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Unbox (Unbox(..)) import Prelude hiding (length, null, last, map, (!!), read, concat)@@ -117,11 +129,13 @@ import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..), MutByteArray) import Streamly.Internal.Data.Serialize.Type (Serialize) import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser (Parser(..), Initial(..), ParseError(..))+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))+import Streamly.Internal.Data.ParserK.Type+    (ParserK, ParseResult(..), Input(..), Step(..)) import Streamly.Internal.Data.Stream (Stream(..))-import Streamly.Internal.Data.StreamK (StreamK)+import Streamly.Internal.Data.StreamK.Type (StreamK) import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3Fused'(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO) @@ -129,15 +143,14 @@ 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.Fold as FL-import qualified Streamly.Internal.Data.Ring as RB-import qualified Streamly.Internal.Data.Parser as Parser--- import qualified Streamly.Internal.Data.ParserK as ParserK+import qualified Streamly.Internal.Data.RingArray as RB+import qualified Streamly.Internal.Data.ParserDrivers as Drivers+import qualified Streamly.Internal.Data.Parser.Type as ParserD+import qualified Streamly.Internal.Data.ParserK.Type as ParserK import qualified Streamly.Internal.Data.Stream as D import qualified Streamly.Internal.Data.Stream as Stream-import qualified Streamly.Internal.Data.StreamK as StreamK+import qualified Streamly.Internal.Data.StreamK.Type as StreamK import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Prelude  import Streamly.Internal.Data.Array.Type @@ -167,74 +180,31 @@ -- pressure to GC.  ---------------------------------------------------------------------------------- Elimination------------------------------------------------------------------------------------ |------ >>> null arr = Array.byteLength arr == 0------ /Pre-release/-{-# INLINE null #-}-null :: Array a -> Bool-null arr = byteLength arr == 0---- | Like 'getIndex' but indexes the array in reverse from the end.------ /Pre-release/-{-# INLINE getIndexRev #-}-getIndexRev :: forall a. Unbox a => Int -> Array a -> Maybe a-getIndexRev i arr =-    unsafeInlineIO-        $ do-                let elemPtr = RINDEX_OF(arrEnd arr, i, a)-                if i >= 0 && elemPtr >= arrStart arr-                then Just <$> peekAt elemPtr (arrContents arr)-                else return Nothing---- |------ >>> last arr = Array.getIndexRev arr 0------ /Pre-release/-{-# INLINE last #-}-last :: Unbox a => Array a -> Maybe a-last = getIndexRev 0--------------------------------------------------------------------------------- -- Folds with Array as the container ------------------------------------------------------------------------------- --- XXX We should generate this from Ring.---- | @writeLastN n@ folds a maximum of @n@ elements from the end of the input+-- NOTE: We could possible write this in terms of "MutArray.createOfLast" but+-- this causes regression. This is probably because mapping inside "Fold.ifThen"+-- is more efficient than mapping over "Fold.ifTen".+--+-- | @createOfLast n@ folds a maximum of @n@ elements from the end of the input -- stream to an 'Array'. ---{-# INLINE writeLastN #-}-writeLastN ::-       (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)-writeLastN n-    | n <= 0 = fmap (const mempty) FL.drain-    | otherwise = unsafeFreeze <$> Fold step initial done done+{-# INLINE createOfLast #-}+createOfLast ::+       (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+createOfLast n = Fold.ifThen (pure (n <= 0)) (Fold.fromPure empty) lst      where -    step (Tuple3Fused' rb rh i) a = do-        rh1 <- liftIO $ RB.unsafeInsert rb rh a-        return $ FL.Partial $ Tuple3Fused' rb rh1 (i + 1)--    initial =-        let f (a, b) = FL.Partial $ Tuple3Fused' a b (0 :: Int)-         in fmap f $ liftIO $ RB.new n--    done (Tuple3Fused' rb rh i) = do-        arr <- MA.new n-        -- XXX We should write a read unfold for ring.-        foldFunc i rh MA.snocUnsafe arr rb+    lst =+        let f = fmap unsafeFreeze . RB.toMutArray+         in Fold.rmapM f $ RB.createOfLast n -    foldFunc i-        | i < n = RB.unsafeFoldRingM-        | otherwise = RB.unsafeFoldRingFullM+{-# DEPRECATED writeLastN "Please use createOfLast instead." #-}+{-# INLINE writeLastN #-}+writeLastN :: (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+writeLastN = createOfLast  ------------------------------------------------------------------------------- -- Random Access@@ -288,94 +258,62 @@ -- Slice ------------------------------------------------------------------------------- --- | /O(1)/ Slice an array in constant time.------ Caution: The bounds of the slice are not checked.------ /Unsafe/------ /Pre-release/-{-# INLINE getSliceUnsafe #-} getSliceUnsafe ::        forall a. Unbox a     => Int -- ^ starting index     -> Int -- ^ length of the slice     -> Array a     -> Array a-getSliceUnsafe index len (Array contents start e) =-    let size = SIZE_OF(a)-        start1 = start + (index * size)-        end1 = start1 + (len * size)-     in assert (end1 <= e) (Array contents start1 end1)+RENAME(getSliceUnsafe,unsafeSliceOffLen) --- | Split the array into a stream of slices using a predicate. The element--- matching the predicate is dropped.------ /Pre-release/-{-# INLINE splitOn #-} splitOn :: (Monad m, Unbox a) =>     (a -> Bool) -> Array a -> Stream m (Array a)-splitOn predicate arr =-    fmap (\(i, len) -> getSliceUnsafe i len arr)-        $ D.indexOnSuffix predicate (read arr)+RENAME(splitOn,splitEndBy_) -{-# INLINE sliceIndexerFromLen #-}-sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)+{-# INLINE indexerFromLen #-}+indexerFromLen, sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (Array a) (Int, Int)-sliceIndexerFromLen from len =-    Unfold.lmap unsafeThaw (MA.sliceIndexerFromLen from len)+indexerFromLen from len =+    Unfold.lmap unsafeThaw (MA.indexerFromLen from len)+RENAME(sliceIndexerFromLen,indexerFromLen) -{-# DEPRECATED genSlicesFromLen "Please use sliceIndexerFromLen instead." #-}+{-# DEPRECATED genSlicesFromLen "Please use indexerFromLen instead." #-} {-# INLINE genSlicesFromLen #-} genSlicesFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (Array a) (Int, Int)-genSlicesFromLen = sliceIndexerFromLen+genSlicesFromLen = indexerFromLen  -- | 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. -- -- /Pre-release//-{-# INLINE slicerFromLen #-}-slicerFromLen :: forall m a. (Monad m, Unbox a)+{-# INLINE splitterFromLen #-}+splitterFromLen, slicerFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (Array a) (Array a)-slicerFromLen from len =+splitterFromLen from len =     fmap unsafeFreeze-        $ Unfold.lmap unsafeThaw (MA.slicerFromLen from len)+        $ Unfold.lmap unsafeThaw (MA.splitterFromLen from len)+RENAME(slicerFromLen,splitterFromLen) -{-# DEPRECATED getSlicesFromLen "Please use slicerFromLen instead." #-}+{-# DEPRECATED getSlicesFromLen "Please use splitterFromLen instead." #-} {-# INLINE getSlicesFromLen #-} getSlicesFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (Array a) (Array a)-getSlicesFromLen = slicerFromLen+getSlicesFromLen = splitterFromLen  ------------------------------------------------------------------------------- -- Random reads and writes ------------------------------------------------------------------------------- --- XXX Change this to a partial function instead of a Maybe type? And use--- MA.getIndex instead.------ | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: forall a. Unbox a => Int -> Array a -> Maybe a-getIndex i arr =-    unsafeInlineIO-        $ do-                let elemPtr = INDEX_OF(arrStart arr, i, a)-                if i >= 0 && INDEX_VALID(elemPtr, arrEnd arr, a)-                then Just <$> peekAt elemPtr (arrContents arr)-                else return Nothing- -- | Given a stream of array indices, read the elements on those indices from -- the supplied Array. An exception is thrown if an index is out of bounds. --@@ -465,19 +403,20 @@ -- -- /Pre-release/ ---castUnsafe ::+unsafeCast, castUnsafe :: #ifdef DEVBUILD     Unbox b => #endif     Array a -> Array b-castUnsafe (Array contents start end) =+unsafeCast (Array contents start end) =     Array contents start end+RENAME(castUnsafe,unsafeCast)  -- | Cast an @Array a@ into an @Array Word8@. -- -- asBytes :: Array a -> Array Word8-asBytes = castUnsafe+asBytes = unsafeCast  -- | 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@@ -490,11 +429,10 @@         r = len `mod` SIZE_OF(b)      in if r /= 0         then Nothing-        else Just $ castUnsafe arr+        else Just $ unsafeCast arr --- | 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.+-- | Convert an array of any element type into a null terminated CString Ptr.+-- The array is copied to pinned memory. -- -- /Unsafe/ --@@ -503,24 +441,39 @@ -- /Pre-release/ -- asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b-asCStringUnsafe arr act = do-    let arr1 = asBytes arr <> fromList [0]-    -- unsafePinnedAsPtr makes sure the array is pinned-    unsafePinnedAsPtr arr1 $ \ptr -> act (castPtr ptr)+asCStringUnsafe arr = MA.asCString (unsafeThaw arr) +-- | Convert an array of any element type into a null terminated CWString Ptr.+-- The array is copied to pinned memory.+--+-- /Unsafe/+--+-- /O(n) Time: (creates a copy of the array)/+--+-- /Pre-release/+--+asCWString :: Array a -> (CWString -> IO b) -> IO b+asCWString arr = MA.asCWString (unsafeThaw arr)+ ------------------------------------------------------------------------------- -- Folds ------------------------------------------------------------------------------- --- XXX We can directly use toStreamD and D.fold here.+-- XXX Use runIdentity for pure fold+-- XXX Rename fold to foldM, we can then use "fold" for pure folds.+-- XXX We do not need an INLINE on fold?  -- | Fold an array using a 'Fold'. -- -- /Pre-release/-{-# INLINE fold #-}-fold :: forall m a b. (Monad m, Unbox a) => Fold m a b -> Array a -> m b-fold f arr = Stream.fold f (read arr)+{-# INLINE foldM #-}+fold, foldM :: (Monad m, Unbox a) => Fold m a b -> Array a -> m b+foldM f arr = Stream.fold f (read arr)+RENAME(fold,foldM) +foldRev :: Unbox a => Fold.Fold Identity a b -> Array a -> b+foldRev f arr = runIdentity $ Stream.fold f (readRev arr)+ -- | Fold an array using a stream fold operation. -- -- /Pre-release/@@ -537,7 +490,7 @@ encodeAs ps a =     unsafeInlineIO $ do         let len = Serialize.addSizeTo 0 a-        mbarr <- MBA.newBytesAs ps len+        mbarr <- MBA.newAs ps len         off <- Serialize.serializeAt 0 mbarr a         assertM(len == off)         pure $ Array mbarr 0 off@@ -555,22 +508,23 @@ -- to file or sending over the network. -- -- Properties:--- 1. Identity: @deserialize . pinnedSerialize == id@--- 2. Encoded equivalence: @pinnedSerialize a == pinnedSerialize a@-{-# INLINE pinnedSerialize #-}-pinnedSerialize :: Serialize a => a -> Array Word8-pinnedSerialize = encodeAs Pinned+--+-- 1. Identity: @deserialize . serialize' == id@+-- 2. Encoded equivalence: @serialize' a == serialize' a@+{-# INLINE serialize' #-}+pinnedSerialize, serialize' :: Serialize a => a -> Array Word8+serialize' = encodeAs Pinned+RENAME_PRIME(pinnedSerialize,serialize) +-- XXX We can deserialize it like MutArray, returning the remaining slice.+ -- | 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+deserialize :: Serialize a => Array Word8 -> (a, Array Word8)+deserialize arr =+    let (a, b) = unsafeInlineIO $ MA.deserialize (unsafeThaw arr)+     in (a, unsafeFreeze b)  ------------------------------------------------------------------------------- -- Streams of Arrays@@ -582,12 +536,15 @@  -- | Insert the given element between arrays and flatten. ----- >>> interpose x = Stream.interpose x Array.reader+-- >>> concatSepBy x = Stream.unfoldEachSepBy x Array.reader ---{-# INLINE interpose #-}-interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a-interpose x = D.interpose x reader+{-# INLINE concatSepBy #-}+concatSepBy, interpose :: (Monad m, Unbox a) =>+    a -> Stream m (Array a) -> Stream m a+concatSepBy x = D.unfoldEachSepBy x reader +RENAME(interpose,concatSepBy)+ data FlattenState s =       OuterLoop s     | InnerLoop s !MutByteArray !Int !Int@@ -595,14 +552,13 @@ -- | Insert the given element after each array and flatten. This is similar to -- unlines. ----- >>> interposeSuffix x = Stream.interposeSuffix x Array.reader+-- >>> concatEndBy x = Stream.unfoldEachEndBy x Array.reader ---{-# INLINE_NORMAL interposeSuffix #-}-interposeSuffix :: forall m a. (Monad m, Unbox a)+{-# INLINE_NORMAL concatEndBy #-}+concatEndBy, interposeSuffix :: forall m a. (Monad m, Unbox a)     => a -> Stream m (Array a) -> Stream m a--- This does not require MonadIO constraint.--- interposeSuffix x = D.interposeSuffix x reader-interposeSuffix sep (D.Stream step state) = D.Stream step' (OuterLoop state)+-- concatEndBy x = D.unfoldEachEndBy x reader+concatEndBy sep (D.Stream step state) = D.Stream step' (OuterLoop state)      where @@ -619,59 +575,85 @@         return $ D.Yield sep $ OuterLoop st      step' _ (InnerLoop st contents p end) = do-        x <- pure $ unsafeInlineIO $ peekAt p contents+        let !x = unsafeInlineIO $ peekAt p contents         return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end) +RENAME(interposeSuffix,concatEndBy)+ -- | Insert the given array after each array and flatten. ----- >>> intercalateSuffix = Stream.intercalateSuffix Array.reader+-- >>> concatEndBySeq x = Stream.unfoldEachEndBySeq x Array.reader ---{-# INLINE intercalateSuffix #-}-intercalateSuffix :: (Monad m, Unbox a)+{-# INLINE concatEndBySeq #-}+concatEndBySeq, intercalateSuffix :: (Monad m, Unbox a)     => Array a -> Stream m (Array a) -> Stream m a-intercalateSuffix = D.intercalateSuffix reader+concatEndBySeq x = D.unfoldEachEndBySeq x reader --- | @compactLE n@ coalesces adjacent arrays in the input stream+RENAME(intercalateSuffix,concatEndBySeq)++-- | @compactMax n@ coalesces adjacent arrays in the input stream -- only if the combined size would be less than or equal to n. -- -- Generates unpinned arrays irrespective of the pinning status of input -- arrays.-{-# INLINE_NORMAL compactLE #-}-compactLE :: (MonadIO m, Unbox a)+{-# INLINE_NORMAL compactMax #-}+compactMax, compactLE :: (MonadIO m, Unbox a)     => Int -> Stream m (Array a) -> Stream m (Array a)-compactLE n stream =-    D.map unsafeFreeze $ MA.compactLE n $ D.map unsafeThaw stream+compactMax n stream =+    D.map unsafeFreeze $ MA.compactMax n $ D.map unsafeThaw stream --- | Pinned version of 'compactLE'.-{-# INLINE_NORMAL pinnedCompactLE #-}-pinnedCompactLE :: (MonadIO m, Unbox a)+RENAME(compactLE,compactMax)++-- | Like 'compactMax' but generates pinned arrays.+{-# INLINE_NORMAL compactMax' #-}+compactMax', pinnedCompactLE :: (MonadIO m, Unbox a)     => Int -> Stream m (Array a) -> Stream m (Array a)-pinnedCompactLE n stream =-    D.map unsafeFreeze $ MA.pinnedCompactLE n $ D.map unsafeThaw stream+compactMax' n stream =+    D.map unsafeFreeze $ MA.compactMax' n $ D.map unsafeThaw stream --- | 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.+{-# DEPRECATED pinnedCompactLE "Please use compactMax' instead." #-}+{-# INLINE pinnedCompactLE #-}+pinnedCompactLE = compactMax'++-- | Split a stream of byte arrays on a given separator byte, dropping the+-- separator and coalescing all the arrays between two separators into a single+-- array. ---{-# INLINE compactOnByte #-}-compactOnByte+{-# INLINE compactSepByByte_ #-}+compactSepByByte_, compactOnByte     :: (MonadIO m)     => Word8     -> Stream m (Array Word8)     -> Stream m (Array Word8)-compactOnByte byte =-    fmap unsafeFreeze . MA.compactOnByte byte . fmap unsafeThaw+compactSepByByte_ byte =+    fmap unsafeFreeze . MA.compactSepByByte_ byte . fmap unsafeThaw --- | Like 'compactOnByte' considers the separator in suffix position instead of--- infix position.-{-# INLINE compactOnByteSuffix #-}-compactOnByteSuffix+RENAME(compactOnByte,compactSepByByte_)++-- | Like 'compactSepByByte_', but considers the separator in suffix position+-- instead of infix position.+{-# INLINE compactEndByByte_ #-}+compactEndByByte_, compactOnByteSuffix     :: (MonadIO m)     => Word8     -> Stream m (Array Word8)     -> Stream m (Array Word8)-compactOnByteSuffix byte =-    fmap unsafeFreeze . MA.compactOnByteSuffix byte . fmap unsafeThaw+compactEndByByte_ byte =+    fmap unsafeFreeze . MA.compactEndByByte_ byte . fmap unsafeThaw+-- compactEndByByte_ byte = chunksEndBy_ (== byte) . concat +RENAME(compactOnByteSuffix,compactEndByByte_)++-- XXX On windows we should compact on "\r\n". We can just compact on '\n' and+-- drop the last byte in each array if it is '\r'.++-- | Compact byte arrays on newline character, dropping the newline char.+{-# INLINE compactEndByLn_ #-}+compactEndByLn_ :: MonadIO m+    => Stream m (Array Word8)+    -> Stream m (Array Word8)+compactEndByLn_ = compactEndByByte_ 10+ ------------------------------------------------------------------------------- -- Folding Streams of Arrays -------------------------------------------------------------------------------@@ -720,11 +702,11 @@ -- | Fold a stream of arrays using a 'Fold'. This is equivalent to the -- following: ----- >>> foldChunks f = Stream.fold f . Stream.unfoldMany Array.reader+-- >>> foldChunks f = Stream.fold f . Stream.unfoldEach Array.reader -- foldChunks :: (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m b foldChunks f s = fmap fst (foldBreakChunks f s)--- foldStream f = Stream.fold f . Stream.unfoldMany reader+-- foldStream f = Stream.fold f . Stream.unfoldEach reader  -- | Fold a stream of arrays using a 'Fold' and return the remaining stream. --@@ -739,14 +721,14 @@ -- -- We can compare perf and remove this one or define it in terms of that. ---foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) =>+foldBreak, foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) =>     Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a)) {- foldBreakChunksK f s =       fmap (first (fromRight undefined))     $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s -}-foldBreakChunksK (Fold fstep initial _ final) stream = do+foldBreak (Fold fstep initial _ final) stream = do     res <- initial     case res of         Fold.Partial fs -> go fs stream@@ -776,6 +758,8 @@                 return $! (b, StreamK.cons arr st)             Fold.Partial fs1 -> goArray fs1 st fp next +RENAME(foldBreakChunksK,foldBreak)+ {- -- This can be generalized to any type provided it can be unfolded to a stream -- and it can be combined using a semigroup operation.@@ -858,16 +842,13 @@                     -- constructors every time.                     str = D.cons arr0 (D.cons arr1 (D.Stream step s))                 return (b, str)-            PR.Error err -> throwM $ ParseError err--}+            PR.SError err -> throwM $ ParseError err  -- | Parse an array stream using the supplied 'Parser'.  Returns the parse -- result and the unconsumed stream. Throws 'ParseError' if the parse fails. ----- The following alternative to this function allows composing the parser using--- the parser Monad:------ >>> parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p)+-- 'parseBreak' is an alternative to this function which allows composing the+-- parser using the parser Monad. -- -- We can compare perf and remove this one or define it in terms of that. --@@ -879,7 +860,6 @@     => Parser a m b     -> StreamK m (Array a)     -> m (Either ParseError b, StreamK m (Array a))--- parseBreakStreamK p = StreamK.parseBreakChunks (ParserK.adaptC p) parseBreakChunksK (Parser pstep initial extract) stream = do     res <- initial     case res of@@ -908,28 +888,34 @@         pRes <- pstep pst x         let next = INDEX_NEXT(cur,a)         case pRes of-            Parser.Partial 0 s ->+            Parser.SPartial 1 s ->                  goArray s [] st (Array contents next end)-            Parser.Partial n s -> do+            Parser.SPartial m s -> do+                assertM(m <= 1)+                let n = 1 - m                 assert (n <= Prelude.length (x:backBuf)) (return ())                 let src0 = Prelude.take n (x:backBuf)                     arr0 = fromListN n (Prelude.reverse src0)                     arr1 = Array contents next end                     src = arr0 <> arr1                 goArray s [] st src-            Parser.Continue 0 s ->+            Parser.SContinue 1 s ->                 goArray s (x:backBuf) st (Array contents next end)-            Parser.Continue n s -> do+            Parser.SContinue m s -> do+                assertM(m <= 1)+                let n = 1 - m                 assert (n <= Prelude.length (x:backBuf)) (return ())                 let (src0, buf1) = Prelude.splitAt n (x:backBuf)                     arr0 = fromListN n (Prelude.reverse src0)                     arr1 = Array contents next end                     src = arr0 <> arr1                 goArray s buf1 st src-            Parser.Done 0 b -> do+            Parser.SDone 1 b -> do                 let arr = Array contents next end                 return (Right b, StreamK.cons arr st)-            Parser.Done n b -> do+            Parser.SDone m b -> do+                assertM(m <= 1)+                let n = 1 - m                 assert (n <= Prelude.length (x:backBuf)) (return ())                 let src0 = Prelude.take n (x:backBuf)                     -- XXX Use fromListRevN once implemented@@ -938,11 +924,11 @@                     arr1 = Array contents next end                     str = StreamK.cons arr0 (StreamK.cons arr1 st)                 return (Right b, str)-            Parser.Error err -> do+            Parser.SError err -> do                 let n = Prelude.length backBuf                     arr0 = fromListN n (Prelude.reverse backBuf)                     arr1 = Array contents cur end-                    str = StreamK.cons arr0 (StreamK.cons arr1 stream)+                    str = StreamK.cons arr0 (StreamK.cons arr1 st)                 return (Left (ParseError err), str)      -- This is a simplified goArray@@ -953,41 +939,47 @@         pRes <- pstep pst x         let next = INDEX_NEXT(cur,a)         case pRes of-            Parser.Partial 0 s ->+            Parser.SPartial 0 s ->                  goExtract s [] (Array contents next end)-            Parser.Partial n s -> do+            Parser.SPartial m s -> do+                assertM(m <= 0)+                let n = negate m                 assert (n <= Prelude.length (x:backBuf)) (return ())                 let src0 = Prelude.take n (x:backBuf)                     arr0 = fromListN n (Prelude.reverse src0)                     arr1 = Array contents next end                     src = arr0 <> arr1                 goExtract s [] src-            Parser.Continue 0 s ->+            Parser.SContinue 0 s ->                 goExtract s backBuf (Array contents next end)-            Parser.Continue n s -> do+            Parser.SContinue m s -> do+                assertM(m <= 0)+                let n = negate m                 assert (n <= Prelude.length (x:backBuf)) (return ())                 let (src0, buf1) = Prelude.splitAt n (x:backBuf)                     arr0 = fromListN n (Prelude.reverse src0)                     arr1 = Array contents next end                     src = arr0 <> arr1                 goExtract s buf1 src-            Parser.Done 0 b -> do+            Parser.SDone 0 b -> do                 let arr = Array contents next end                 return (Right b, StreamK.fromPure arr)-            Parser.Done n b -> do+            Parser.SDone m b -> do+                assertM(m <= 0)+                let n = negate m                 assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf+                let src0 = Prelude.take n (x:backBuf)                     -- XXX Use fromListRevN once implemented                     -- arr0 = A.fromListRevN n src0                     arr0 = fromListN n (Prelude.reverse src0)                     arr1 = Array contents next end                     str = StreamK.cons arr0 (StreamK.fromPure arr1)                 return (Right b, str)-            Parser.Error err -> do+            Parser.SError err -> do                 let n = Prelude.length backBuf                     arr0 = fromListN n (Prelude.reverse backBuf)                     arr1 = Array contents cur end-                    str = StreamK.cons arr0 (StreamK.cons arr1 stream)+                    str = StreamK.cons arr0 (StreamK.fromPure arr1)                 return (Left (ParseError err), str)      -- This is a simplified goExtract@@ -995,24 +987,193 @@     goStop !pst backBuf = do         pRes <- extract pst         case pRes of-            Parser.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-            Parser.Continue 0 s ->+            Parser.SPartial _ _ -> error "Bug: parseBreak: Partial in extract"+            Parser.SContinue 0 s ->                 goStop s backBuf-            Parser.Continue n s -> do+            Parser.SContinue m s -> do+                assertM(m <= 0)+                let n = negate m                 assert (n <= Prelude.length backBuf) (return ())                 let (src0, buf1) = Prelude.splitAt n backBuf                     arr = fromListN n (Prelude.reverse src0)                 goExtract s buf1 arr-            Parser.Done 0 b ->+            Parser.SDone 0 b ->                 return (Right b, StreamK.nil)-            Parser.Done n b -> do+            Parser.SDone m b -> do+                assertM(m <= 0)+                let n = negate m                 assert (n <= Prelude.length backBuf) (return ())                 let src0 = Prelude.take n backBuf                     -- XXX Use fromListRevN once implemented                     -- arr0 = A.fromListRevN n src0                     arr0 = fromListN n (Prelude.reverse src0)                 return (Right b, StreamK.fromPure arr0)-            Parser.Error err -> do+            Parser.SError err -> do                 let n = Prelude.length backBuf                     arr0 = fromListN n (Prelude.reverse backBuf)                 return (Left (ParseError err), StreamK.fromPure arr0)+-}++-- | Run a 'ParserK' over a 'StreamK' of Arrays and return the parse result and+-- the remaining Stream.+{-# INLINE parseBreak #-}+parseBreak+    :: (Monad m, Unbox a)+    => ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseError b, StreamK m (Array a))+parseBreak = Drivers.parseBreakChunks++-- | Like 'parseBreak' but includes stream position information in the error+-- messages.+--+{-# INLINE parseBreakPos #-}+parseBreakPos+    :: (Monad m, Unbox a)+    => ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseErrorPos b, StreamK m (Array a))+parseBreakPos = Drivers.parseBreakChunksPos++{-# INLINE parse #-}+parse :: (Monad m, Unbox a) =>+    ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+parse f = fmap fst . parseBreak f++-- | Like 'parse' but includes stream position information in the error+-- messages.+--+{-# INLINE parsePos #-}+parsePos :: (Monad m, Unbox a) =>+    ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseErrorPos b)+parsePos f = fmap fst . parseBreakPos f++-------------------------------------------------------------------------------+-- Convert ParserD to ParserK+-------------------------------------------------------------------------------++{-# 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.Final 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 <= length arr)+                (cont (Success n b) (count + n - offset) (Chunk arr))++        {-# INLINE callParseCont #-}+        callParseCont constr n pst1 =+            assert (n < 0 || n >= 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)+                move n = cur + n * elemSize+                curOff = (cur - start) `div` elemSize+                nextOff = (next - start) `div` elemSize+            case pRes of+                ParserD.SDone 1 b ->+                    onDone nextOff b+                ParserD.SDone 0 b ->+                    onDone curOff b+                ParserD.SDone n b ->+                    onDone ((move n - start) `div` elemSize) b+                ParserD.SPartial 1 pst1 ->+                    go SPEC next pst1+                ParserD.SPartial 0 pst1 ->+                    go SPEC cur pst1+                ParserD.SPartial n pst1 ->+                    onBack (move n) elemSize onPartial pst1+                ParserD.SContinue 1 pst1 ->+                    go SPEC next pst1+                ParserD.SContinue 0 pst1 ->+                    go SPEC cur pst1+                ParserD.SContinue n pst1 ->+                    onBack (move n) elemSize onContinue pst1+                ParserD.SError err ->+                    onError curOff err++    {-# NOINLINE parseContNothing #-}+    parseContNothing !count !pst = do+        r <- extract pst+        case r of+            ParserD.FDone n b ->+                assert (n <= 0) (cont (Success n b) (count + n) None)+            ParserD.FContinue n pst1 ->+                assert (n <= 0)+                    (return $ Continue n (parseCont (count + n) pst1))+            ParserD.FError 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++    -- 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 'Parser' to 'ParserK' working on an Array stream.+--+-- /Pre-release/+--+{-# INLINE_LATE toParserK #-}+toParserK :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK (Array a) m b+toParserK (ParserD.Parser step initial extract) =+    ParserK.MkParser $ adaptCWith step initial extract
src/Streamly/Internal/Data/Array/Generic.hs view
@@ -7,336 +7,61 @@ -- Portability : GHC -- module Streamly.Internal.Data.Array.Generic-    ( Array(..)--    -- * Construction-    , nil-    , createOf-    , create-    , writeWith-    , writeLastN--    , fromStreamN-    , fromStream-    , fromPureStream-    , fromByteStr#--    , fromListN-    , fromList--    , chunksOf--    -- * Elimination-    , length-    , reader--    , toList-    , read-    , readRev--    , foldl'-    , foldr-    , streamFold-    , fold--    -- * Random Access-    , getIndexUnsafe-    , getIndex-    , getSliceUnsafe-    , strip+    (+    module Streamly.Internal.Data.Array.Generic.Type -    -- * Deprecated-    , writeN-    , write+    -- * Parsing Stream of Arrays+    , parse+    , parsePos+    , parseBreak+    , parseBreakPos     ) where -#include "inline.hs"--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.Type (Stream)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))+import Streamly.Internal.Data.StreamK.Type (StreamK) -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.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 qualified Streamly.Internal.Data.ParserDrivers as Drivers+import qualified Streamly.Internal.Data.ParserK.Type as ParserK  import Prelude hiding (Foldable(..), read)------------------------------------------------------------------------------------ Array Data Type----------------------------------------------------------------------------------data Array a =-    Array-        { 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.-        }--unsafeFreeze :: MArray.MutArray a -> Array a-unsafeFreeze (MArray.MutArray cont# arrS arrL _) = Array cont# arrS arrL--unsafeThaw :: Array a -> MArray.MutArray a-unsafeThaw (Array cont# arrS arrL) = MArray.MutArray cont# arrS arrL arrL--{-# NOINLINE nil #-}-nil :: Array a-nil = unsafePerformIO $ unsafeFreeze <$> MArray.nil------------------------------------------------------------------------------------ Construction - Folds----------------------------------------------------------------------------------{-# INLINE_NORMAL createOf #-}-createOf :: MonadIO m => Int -> Fold m a (Array a)-createOf = fmap unsafeFreeze <$> MArray.createOf---- XXX Deprecate in major--- {-# DEPRECATED writeN "Please use createOf instead." #-}-{-# INLINE writeN #-}-writeN :: MonadIO m => Int -> Fold m a (Array a)-writeN = createOf--{-# INLINE_NORMAL writeWith #-}-writeWith :: MonadIO m => Int -> Fold m a (Array a)-writeWith elemCount = unsafeFreeze <$> MArray.createWith elemCount---- | Fold the whole input to a single array.------ /Caution! Do not use this on infinite streams./----{-# INLINE create #-}-create :: MonadIO m => Fold m a (Array a)-create = fmap unsafeFreeze MArray.create---- XXX Deprecate in major--- {-# DEPRECATED write "Please use create instead." #-}-{-# INLINE write #-}-write :: MonadIO m => Fold m a (Array a)-write = create--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----------------------------------------------------------------------------------{-# INLINE fromStreamN #-}-fromStreamN :: MonadIO m => Int -> Stream m a -> m (Array a)-fromStreamN n = D.fold (writeN n)--{-# INLINE fromStream #-}-fromStream :: MonadIO m => Stream m a -> m (Array a)-fromStream = D.fold write---- XXX Consider foldr/build fusion in toList/fromList--{-# INLINABLE fromListN #-}-fromListN :: Int -> [a] -> Array a-fromListN n xs = unsafePerformIO $ fromStreamN n $ D.fromList xs--{-# INLINABLE fromList #-}-fromList :: [a] -> Array a-fromList xs = unsafePerformIO $ fromStream $ D.fromList xs------------------------------------------------------------------------------------ Elimination - Unfolds----------------------------------------------------------------------------------{-# INLINE length #-}-length :: Array a -> Int-length = arrLen--{-# INLINE_NORMAL reader #-}-reader :: Monad m => Unfold m (Array a) a-reader =-    Producer.simplify-        $ Producer.translate unsafeThaw unsafeFreeze-        $ MArray.producerWith (return . unsafeInlineIO)------------------------------------------------------------------------------------ Elimination - to streams----------------------------------------------------------------------------------{-# INLINE_NORMAL toList #-}-toList :: Array a -> [a]-toList arr = loop 0--    where--    len = length arr-    loop i | i == len = []-    loop i = getIndexUnsafe i arr : loop (i + 1)--{-# INLINE_NORMAL read #-}-read :: Monad m => Array a -> Stream m a-read arr@Array{..} =-    D.map (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)--{-# INLINE_NORMAL readRev #-}-readRev :: Monad m => Array a -> Stream m a-readRev arr@Array{..} =-    D.map (`getIndexUnsafe` arr)-        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0------------------------------------------------------------------------------------ Elimination - using Folds----------------------------------------------------------------------------------{-# INLINE_NORMAL foldl' #-}-foldl' :: (b -> a -> b) -> b -> Array a -> b-foldl' f z arr = unsafePerformIO $ D.foldl' f z $ read arr--{-# INLINE_NORMAL foldr #-}-foldr :: (a -> b -> b) -> b -> Array a -> b-foldr f z arr = unsafePerformIO $ D.foldr f z $ read arr--{-# INLINE fold #-}-fold :: Monad m => Fold m a b -> Array a -> m b-fold f arr = D.fold f (read arr)--{-# INLINE streamFold #-}-streamFold :: Monad m => (Stream m a -> m b) -> Array a -> m b-streamFold f arr = f (read arr)+import Streamly.Internal.Data.Array.Generic.Type  ---------------------------------------------------------------------------------- Random reads and writes+-- ParserK Chunked Generic ------------------------------------------------------------------------------- --- | /O(1)/ Lookup the element at the given index. Index starts from 0. Does--- not check the bounds.------ @since 0.8.0-{-# INLINE getIndexUnsafe #-}-getIndexUnsafe :: Int -> Array a -> a-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+{-# INLINE parseBreak #-}+parseBreak+    :: forall m a b. Monad m+    => ParserK.ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseError b, StreamK m (Array a))+parseBreak = Drivers.parseBreakChunksGeneric --- >>> 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]]+-- | Like 'parseBreak' but includes stream position information in the error+-- messages. ---{-# INLINE writeLastN #-}-writeLastN :: MonadIO m => Int -> Fold m a (Array a)-writeLastN n = FL.rmapM f (RB.writeLastN n)--    where--    f rb = do-        arr <- RB.copyToMutArray 0 n rb-        return $ unsafeFreeze arr--{-# INLINE getSliceUnsafe #-}-getSliceUnsafe :: Int -> Int -> Array a -> Array a-getSliceUnsafe offset len (Array cont off1 _) = Array cont (off1 + offset) len---- XXX This is not efficient as it copies the array. We should support array--- slicing so that we can just refer to the underlying array memory instead of--- copying.---- | Truncate the array at the beginning and end as long as the predicate--- holds true. Returns a slice of the original array.-{-# INLINE strip #-}-strip :: (a -> Bool) -> Array a -> Array a-strip p arr = unsafeFreeze $ unsafePerformIO $ MArray.strip p (unsafeThaw arr)------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------instance Eq a => Eq (Array a) where-    {-# INLINE (==) #-}-    arr1 == arr2 =-        unsafeInlineIO $! unsafeThaw arr1 `MArray.eq` unsafeThaw arr2--instance Ord a => Ord (Array a) where-    {-# INLINE compare #-}-    compare arr1 arr2 =-        unsafeInlineIO $! unsafeThaw arr1 `MArray.cmp` unsafeThaw arr2--    -- Default definitions defined in base do not have an INLINE on them, so we-    -- replicate them here with an INLINE.-    {-# 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 }--    -- These two default methods use '<=' rather than 'compare'-    -- because the latter is often more expensive-    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y+{-# INLINE parseBreakPos #-}+parseBreakPos+    :: forall m a b. Monad m+    => ParserK.ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseErrorPos b, StreamK m (Array a))+parseBreakPos = Drivers.parseBreakChunksGenericPos -instance Show a => Show (Array a) where-    {-# INLINE show #-}-    show arr = "fromList " ++ show (toList arr)+{-# INLINE parse #-}+parse ::+       (Monad m)+    => ParserK.ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseError b)+parse f = fmap fst . parseBreak f -instance Read a => Read (Array a) where-    {-# INLINE readPrec #-}-    readPrec = do-        fromListWord <- replicateM 9 ReadPrec.get-        if fromListWord == "fromList "-        then fromList <$> readPrec-        else ReadPrec.pfail+{-# INLINE parsePos #-}+parsePos ::+       (Monad m)+    => ParserK.ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either ParseErrorPos b)+parsePos f = fmap fst . parseBreakPos f
+ src/Streamly/Internal/Data/Array/Generic/Type.hs view
@@ -0,0 +1,495 @@+-- |+-- Module      : Streamly.Internal.Data.Array.Generic.Type+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+module Streamly.Internal.Data.Array.Generic.Type+    ( Array(..)++    -- * Conversion+    , unsafeFreeze+    , unsafeThaw++    -- * Construction+    , nil+    , createOf+    , create+    , createWith+    , createOfLast++    , fromStreamN+    , fromStream+    , fromPureStream+    , fromCString#++    , fromListN+    , fromList++    , chunksOf++    -- * Elimination+    , length+    , reader++    , toList+    , read+    , readRev++    , foldl'+    , foldr+    , streamFold+    , fold++    -- * Random Access+    , unsafeGetIndex+    , getIndex+    , unsafeSliceOffLen+    , dropAround++    -- * Parsing Stream of Arrays+    , toParserK++    -- * Deprecated+    , strip+    , getIndexUnsafe+    , getSliceUnsafe+    , writeN+    , write+    , fromByteStr#+    )+where++#include "inline.hs"+#include "assert.hs"+#include "deprecation.h"++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.Types (SPEC(..))+import GHC.IO (unsafePerformIO)+import Text.Read (readPrec)++import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.ParserK.Type+    (ParserK, ParseResult(..), Input(..), Step(..))+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.Fold.Type as FL+import qualified Streamly.Internal.Data.MutArray.Generic as MArray+import qualified Streamly.Internal.Data.Parser.Type as ParserD+import qualified Streamly.Internal.Data.ParserK.Type as ParserK+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.RingArray.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 (Foldable(..), read)++-------------------------------------------------------------------------------+-- Array Data Type+-------------------------------------------------------------------------------++data Array a =+    Array+        { arrContents# :: MutableArray# RealWorld a+          -- ^ The internal contents of the array representing the entire array.++        , arrStart :: {-# UNPACK #-}!Int+          -- ^ The starting index of this slice.++        , arrEnd :: {-# UNPACK #-}!Int+          -- ^ First invalid index of the array.+        }++unsafeFreeze :: MArray.MutArray a -> Array a+unsafeFreeze (MArray.MutArray cont# arrS arrE _) = Array cont# arrS arrE++unsafeThaw :: Array a -> MArray.MutArray a+unsafeThaw (Array cont# arrS arrE) = MArray.MutArray cont# arrS arrE arrE++{-# NOINLINE nil #-}+nil :: Array a+nil = unsafePerformIO $ unsafeFreeze <$> MArray.nil++-------------------------------------------------------------------------------+-- Construction - Folds+-------------------------------------------------------------------------------++{-# INLINE_NORMAL createOf #-}+createOf :: MonadIO m => Int -> Fold m a (Array a)+createOf = fmap unsafeFreeze <$> MArray.createOf++{-# DEPRECATED writeN "Please use createOf instead." #-}+{-# INLINE writeN #-}+writeN :: MonadIO m => Int -> Fold m a (Array a)+writeN = createOf++{-# INLINE_NORMAL createWith #-}+createWith :: MonadIO m => Int -> Fold m a (Array a)+createWith elemCount = unsafeFreeze <$> MArray.createWith elemCount++-- | Fold the whole input to a single array.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE create #-}+create :: MonadIO m => Fold m a (Array a)+create = fmap unsafeFreeze MArray.create++{-# DEPRECATED write "Please use create instead." #-}+{-# INLINE write #-}+write :: MonadIO m => Fold m a (Array a)+write = create++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++fromCString# :: MonadIO m => Addr# -> m (Array Word8)+fromCString# addr = fromStream $ D.fromCString# addr++{-# DEPRECATED fromByteStr# "Please use 'unsafePerformIO . fromCString#' instead" #-}+fromByteStr# :: Addr# -> Array Word8+fromByteStr# addr = fromPureStream (D.fromCString# 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+-------------------------------------------------------------------------------++{-# INLINE fromStreamN #-}+fromStreamN :: MonadIO m => Int -> Stream m a -> m (Array a)+fromStreamN n = D.fold (writeN n)++{-# INLINE fromStream #-}+fromStream :: MonadIO m => Stream m a -> m (Array a)+fromStream = D.fold write++-- XXX Consider foldr/build fusion in toList/fromList++{-# INLINABLE fromListN #-}+fromListN :: Int -> [a] -> Array a+fromListN n xs = unsafePerformIO $ fromStreamN n $ D.fromList xs++{-# INLINABLE fromList #-}+fromList :: [a] -> Array a+fromList xs = unsafePerformIO $ fromStream $ D.fromList xs++-------------------------------------------------------------------------------+-- Elimination - Unfolds+-------------------------------------------------------------------------------++{-# INLINE length #-}+length :: Array a -> Int+length arr = arrEnd arr - arrStart arr++{-# INLINE_NORMAL reader #-}+reader :: Monad m => Unfold m (Array a) a+reader =+    Producer.simplify+        $ Producer.translate unsafeThaw unsafeFreeze+        $ MArray.producerWith (return . unsafeInlineIO)++-------------------------------------------------------------------------------+-- Elimination - to streams+-------------------------------------------------------------------------------++{-# INLINE_NORMAL toList #-}+toList :: Array a -> [a]+toList arr = loop 0++    where++    len = length arr+    loop i | i == len = []+    loop i = unsafeGetIndex i arr : loop (i + 1)++{-# INLINE_NORMAL read #-}+read :: Monad m => Array a -> Stream m a+read arr =+    D.map (`unsafeGetIndex` arr) $ D.enumerateFromToIntegral 0 (length arr - 1)++{-# INLINE_NORMAL readRev #-}+readRev :: Monad m => Array a -> Stream m a+readRev arr =+    D.map (`unsafeGetIndex` arr)+        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0+    where+    arrLen = length arr++-------------------------------------------------------------------------------+-- Elimination - using Folds+-------------------------------------------------------------------------------++{-# INLINE_NORMAL foldl' #-}+foldl' :: (b -> a -> b) -> b -> Array a -> b+foldl' f z arr = unsafePerformIO $ D.foldl' f z $ read arr++{-# INLINE_NORMAL foldr #-}+foldr :: (a -> b -> b) -> b -> Array a -> b+foldr f z arr = unsafePerformIO $ D.foldr f z $ read arr++{-# INLINE fold #-}+fold :: Monad m => Fold m a b -> Array a -> m b+fold f arr = D.fold f (read arr)++{-# INLINE streamFold #-}+streamFold :: Monad m => (Stream m a -> m b) -> Array a -> m b+streamFold f arr = f (read arr)++-------------------------------------------------------------------------------+-- Random reads and writes+-------------------------------------------------------------------------------++-- | /O(1)/ Lookup the element at the given index. Index starts from 0. Does+-- not check the bounds.+--+-- @since 0.8.0+{-# INLINE unsafeGetIndex #-}+unsafeGetIndex, getIndexUnsafe :: Int -> Array a -> a+unsafeGetIndex i arr =+    unsafePerformIO $ MArray.unsafeGetIndex 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 =+    if i >= 0 && i < length arr+    then Just $ unsafeGetIndex 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.createOfLast 2)+--      & Stream.fold Fold.toList+--  :}+-- [fromList [],fromList [1],fromList [1,2],fromList [2,3],fromList [3,4],fromList [4,5]]+--+{-# INLINE createOfLast #-}+createOfLast :: MonadIO m => Int -> Fold m a (Array a)+createOfLast n = FL.rmapM f (RB.createOf n)++    where++    f rb = do+        arr <- RB.copyToMutArray 0 n rb+        return $ unsafeFreeze arr++{-# INLINE unsafeSliceOffLen #-}+unsafeSliceOffLen, getSliceUnsafe+    :: Int -> Int -> Array a -> Array a+unsafeSliceOffLen offset len =+    unsafeFreeze . MArray.unsafeSliceOffLen offset len . unsafeThaw++-- XXX This is not efficient as it copies the array. We should support array+-- slicing so that we can just refer to the underlying array memory instead of+-- copying.++-- | Truncate the array at the beginning and end as long as the predicate+-- holds true. Returns a slice of the original array.+{-# INLINE dropAround #-}+dropAround, strip :: (a -> Bool) -> Array a -> Array a+dropAround p arr =+    unsafeFreeze $ unsafePerformIO $ MArray.dropAround p (unsafeThaw arr)++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance Eq a => Eq (Array a) where+    {-# INLINE (==) #-}+    arr1 == arr2 =+        unsafeInlineIO $! unsafeThaw arr1 `MArray.eq` unsafeThaw arr2++instance Ord a => Ord (Array a) where+    {-# INLINE compare #-}+    compare arr1 arr2 =+        unsafeInlineIO $! unsafeThaw arr1 `MArray.cmp` unsafeThaw arr2++    -- Default definitions defined in base do not have an INLINE on them, so we+    -- replicate them here with an INLINE.+    {-# 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 }++    -- These two default methods use '<=' rather than 'compare'+    -- because the latter is often more expensive+    {-# 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 (Array a) where+    {-# INLINE show #-}+    show arr = "fromList " ++ show (toList arr)++instance Read a => Read (Array a) where+    {-# INLINE readPrec #-}+    readPrec = do+        fromListWord <- replicateM 9 ReadPrec.get+        if fromListWord == "fromList "+        then fromList <$> readPrec+        else ReadPrec.pfail++-------------------------------------------------------------------------------+-- Backward Compatibility+-------------------------------------------------------------------------------++RENAME(strip,dropAround)+RENAME(getSliceUnsafe,unsafeSliceOffLen)+RENAME(getIndexUnsafe,unsafeGetIndex)++--------------------------------------------------------------------------------+-- Convert Parser to Parserk on Generic Arrays+--------------------------------------------------------------------------------++{-# 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.Final 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)+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@(Array contents start end) = do+         if offset >= 0+         then go SPEC (start + offset) state+         else return $ Continue offset (parseCont count state)++        where++        {-# INLINE onDone #-}+        onDone n b =+            assert (n <= length arr)+                (cont (Success n b) (count + n - offset) (Chunk arr))++        {-# INLINE callParseCont #-}+        callParseCont constr n pst1 =+            assert (n < 0 || n >= 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 (end - start)  pst+        go !_ !cur !pst = do+            let !x = unsafeInlineIO $ MArray.unsafeGetIndexWith contents cur+            pRes <- pstep pst x+            let next = cur + 1+                -- XXX Change this to moveOff and remove curOff and nextOff+                move n = cur + n+                curOff = cur - start+                nextOff = next - start+            case pRes of+                ParserD.SDone 1 b ->+                    onDone nextOff b+                ParserD.SDone 0 b ->+                    onDone curOff b+                ParserD.SDone n b ->+                    onDone (move n - start) b+                ParserD.SPartial 1 pst1 ->+                    go SPEC next pst1+                ParserD.SPartial 0 pst1 ->+                    go SPEC cur pst1+                ParserD.SPartial n pst1 ->+                    onBack (move n) onPartial pst1+                ParserD.SContinue 1 pst1 ->+                    go SPEC next pst1+                ParserD.SContinue 0 pst1 ->+                    go SPEC cur pst1+                ParserD.SContinue n pst1 ->+                    onBack (move n) onContinue pst1+                ParserD.SError err ->+                    onError curOff err++    {-# NOINLINE parseContNothing #-}+    parseContNothing !count !pst = do+        r <- extract pst+        case r of+            ParserD.FDone n b ->+                assert (n <= 0) (cont (Success n b) (count + n) None)+            ParserD.FContinue n pst1 ->+                assert (n <= 1)+                    (return $ Continue n (parseCont (count + n) pst1))+            ParserD.FError 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++    {-# INLINE parseCont #-}+    parseCont !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr+    parseCont !cnt !pst None = parseContNothing cnt pst++-- | Convert a 'Parser' to 'ParserK' working on generic Array stream.+--+-- /Pre-release/+--+{-# INLINE_LATE toParserK #-}+toParserK :: Monad m => ParserD.Parser a m b -> ParserK (Array a) m b+toParserK (ParserD.Parser step initial extract) =+    ParserK.MkParser $ adaptCGWith step initial extract
src/Streamly/Internal/Data/Array/Stream.hs view
@@ -1,4 +1,5 @@ {-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-} -- | -- Module      : Streamly.Internal.Data.Array.Stream -- Copyright   : (c) 2019 Composewell Technologies@@ -293,8 +294,7 @@ parseBreak p s =     fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s) -}-parseBreak = Array.parseBreakChunksK--- parseBreak p = K.parseBreakChunks (ParserK.adaptC p)+parseBreak p = Array.parseBreak (Array.toParserK p)  ------------------------------------------------------------------------------- -- Elimination - Running Array Folds and parsers@@ -370,7 +370,7 @@                 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+            PR.SError err -> do                 let src0 = x:getList backBuf                     src = Prelude.reverse src0 ++ x:xs                     strm = D.append (D.fromList src) (D.Stream step s)@@ -408,7 +408,7 @@                 let src0 = takeArrayListRev n (x:getList backBuf)                     src = Prelude.reverse src0 ++ xs                 return (Right b, D.fromList src)-            PR.Error err -> do+            PR.SError err -> do                 let src0 = getList backBuf                     src = Prelude.reverse src0 ++ x:xs                 return (Left (ParseError err), D.fromList src)@@ -418,25 +418,24 @@     goStop backBuf pst = do         pRes <- extract pst         case pRes of-            PR.Partial _ _ -> error "Bug: runArrayParserDBreak: Partial in extract"-            PR.Continue 0 pst1 ->+            PR.FContinue 0 pst1 ->                 goStop backBuf pst1-            PR.Continue n pst1 -> do+            PR.FContinue 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+            PR.FDone 0 b -> return (Right b, D.nil)+            PR.FDone 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+            PR.FError err -> do                 let src0 = getList backBuf                     src = Prelude.reverse src0                 return (Left (ParseError err), D.fromList src)@@ -592,7 +591,7 @@                         return                             $ D.Skip                             $ ParseChunksYield (Right b) next-                    PR.Error err -> do+                    PR.SError err -> do                         let next = ParseChunksInitLeftOver []                         return                             $ D.Skip@@ -634,7 +633,7 @@                 return                     $ D.Skip                     $ ParseChunksYield (Right b) (ParseChunksInit src s)-            PR.Error err -> do+            PR.SError err -> do                 let next = ParseChunksInitLeftOver []                 return                     $ D.Skip@@ -672,7 +671,7 @@                 return                     $ D.Skip                     $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err -> do+            PR.SError err -> do                 let next = ParseChunksInitLeftOver []                 return                     $ D.Skip@@ -683,26 +682,25 @@     stepOuter _ (ParseChunksStop backBuf pst) = do         pRes <- extract pst         case pRes of-            PR.Partial _ _ -> error "runArrayFoldManyD: Partial in extract"-            PR.Continue 0 pst1 ->+            PR.FContinue 0 pst1 ->                 return $ D.Skip $ ParseChunksStop backBuf pst1-            PR.Continue n pst1 -> do+            PR.FContinue 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 ->+            PR.FDone 0 b ->                 return                     $ D.Skip                     $ ParseChunksYield (Right b) (ParseChunksInitLeftOver [])-            PR.Done n b -> do+            PR.FDone 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+            PR.FError err -> do                 let next = ParseChunksInitLeftOver []                 return                     $ D.Skip
src/Streamly/Internal/Data/Array/Type.hs view
@@ -1,4 +1,9 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-}+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module      : Streamly.Internal.Data.Array.Type -- Copyright   : (c) 2020 Composewell Technologies@@ -29,52 +34,77 @@      -- *** Casting     , unsafePinnedAsPtr+    , unsafeAsForeignPtr +    -- * Subarrays+    , unsafeSliceOffLen+     -- ** Construction     , empty -    -- *** Cloning-    -- XXX Why would we clone an immutable array?-    , clone-    , pinnedClone+    -- * Random Access+    -- , (!!)+    , getIndex+    , getIndexRev+    , head+    , last+    , init+    , tail+    , uncons+    , unsnoc      -- *** Slicing     -- | Get a subarray without copying-    , splitAt-    , breakOn -- XXX requires MonadIO+    , unsafeBreakAt+    , breakAt+    , breakEndByWord8_+    , breakEndBy+    , breakEndBy_+    , revBreakEndBy+    , revBreakEndBy_+    -- drop+    -- dropRev/dropEnd+    , dropAround+    , dropWhile+    , revDropWhile      -- *** Stream Folds     , unsafeMakePure     , createOf-    , pinnedCreateOf+    , createOf'     , unsafeCreateOf-    , unsafePinnedCreateOf+    , unsafeCreateOf'     , create-    , pinnedCreate+    , create'     , createWith      -- *** From containers     , fromListN-    , pinnedFromListN+    , fromListN'     , fromList-    , pinnedFromList+    , fromList'     , fromListRevN     , fromListRev     , fromStreamN     , fromStream     , fromPureStreamN     , fromPureStream-    , fromByteStr#-    , fromByteStr+    , fromCString#+    , fromCString+    , fromW16CString#+    , fromW16CString     , fromPtrN     , fromChunks     , fromChunksK+    , unsafeFromForeignPtr      -- ** Reading      -- *** Indexing-    , unsafeIndexIO -- XXX unsafeGetIndexIO-    , getIndexUnsafe -- XXX unsafeGetIndex+    , unsafeGetIndexIO+    , unsafeGetIndexRevIO+    , unsafeGetIndex+    , unsafeGetIndexRev      -- *** To Streams     , read@@ -87,11 +117,12 @@      -- *** Unfolds     , producer -- experimental-    , readerUnsafe+    , unsafeReader     , reader     , readerRev      -- *** Size+    , null     , length     , byteLength @@ -100,19 +131,29 @@     , foldr     , byteCmp     , byteEq+    , listCmp+    , listEq      -- ** Appending     , splice -- XXX requires MonadIO+    -- appendString+    -- appendCString/CString#      -- ** Streams of arrays     -- *** Chunk     -- | Group a stream into arrays.     , chunksOf-    , pinnedChunksOf+    , chunksOf'     , buildChunks+    , chunksEndBy+    , chunksEndBy'+    , chunksEndByLn+    , chunksEndByLn'      -- *** Split     -- | Split an array into slices.+    , splitEndBy+    , splitEndBy_      -- *** Concat     -- | Append the arrays in a stream to form a stream of elements.@@ -121,13 +162,15 @@      -- *** Compact     -- | Append the arrays in a stream to form a stream of larger arrays.-    , fCompactGE-    , fPinnedCompactGE-    , lCompactGE-    , lPinnedCompactGE-    , compactGE+    , createCompactMin+    , createCompactMin'+    , scanCompactMin+    , scanCompactMin'+    , compactMin      -- ** Deprecated+    , breakOn+    , splitAt     , asPtrUnsafe     , unsafeIndex     , bufferChunks@@ -149,35 +192,58 @@     , pinnedWriteNAligned     , write     , pinnedWrite+    , fromByteStr#+    , fromByteStr+    , fCompactGE+    , fPinnedCompactGE+    , lCompactGE+    , lPinnedCompactGE+    , compactGE+    , pinnedCreateOf+    , unsafePinnedCreateOf+    , pinnedCreate+    , pinnedFromListN+    , pinnedFromList+    , pinnedChunksOf+    , unsafeIndexIO+    , getIndexUnsafe+    , readerUnsafe     ) where  #include "ArrayMacros.h"+#include "deprecation.h" #include "inline.hs"  import Control.Exception (assert) import Control.Monad (replicateM, when) import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (ord) import Data.Functor.Identity (Identity(..)) import Data.Int (Int8, Int16, Int32, Int64) import Data.Proxy (Proxy(..)) import Data.Word (Word8, Word16, Word32, Word64) import GHC.Base (build)-import GHC.Exts (IsList, IsString(..), Addr#)+import GHC.Exts (IsList, IsString(..), Addr#, minusAddr#)+import GHC.Int (Int(..))+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))  import GHC.IO (unsafePerformIO)-import GHC.Ptr (Ptr(..))+import GHC.Ptr (Ptr(..), nullPtr) import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.MutArray.Type (MutArray) import Streamly.Internal.Data.MutByteArray.Type (MutByteArray) import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Scanl.Type (Scanl (..)) import Streamly.Internal.Data.Stream.Type (Stream) import Streamly.Internal.Data.StreamK.Type (StreamK) import Streamly.Internal.Data.Unbox (Unbox(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Text.Read (readPrec) -import Prelude hiding (Foldable(..), concat, read, unlines, splitAt)+import Prelude hiding+    ( Foldable(..), concat, head, init, last, read, tail, unlines, splitAt+    , dropWhile)  import qualified GHC.Exts as Exts import qualified Streamly.Internal.Data.Fold.Type as Fold@@ -186,6 +252,7 @@ import qualified Streamly.Internal.Data.StreamK.Type as K import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Scanl.Type as Scanl import qualified Streamly.Internal.Data.Unfold.Type as Unfold import qualified Text.ParserCombinators.ReadPrec as ReadPrec @@ -237,25 +304,70 @@ -- Utility functions ------------------------------------------------------------------------------- +-- XXX Rename this to "unsafeAsPtr"? -- | Use an @Array a@ as @Ptr a@. -- -- See 'MA.unsafePinnedAsPtr' in the Mutable array module for more details. -- -- /Unsafe/ --+-- 1. The accessor must not access the array beyond the specified length.+-- 2. The accessor must not mutate the array.+-- -- /Pre-release/ -- {-# INLINE unsafePinnedAsPtr #-}-unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> m b) -> m b+unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> Int -> IO b) -> m b unsafePinnedAsPtr arr f = do     let marr = unsafeThaw arr     pinned <- liftIO $ MA.pin marr     MA.unsafeAsPtr pinned f +-- | Use an @Array a@ as @ForeignPtr a@.+--+-- /Unsafe/ because of direct pointer operations. The user must ensure that they+-- are writing within the legal bounds of the array.+--+-- /Pre-release/+--+{-# INLINE unsafeAsForeignPtr #-}+unsafeAsForeignPtr+    :: MonadIO m => Array a -> (ForeignPtr a -> Int -> IO b) -> m b+unsafeAsForeignPtr arr0 f = do+    let marr = unsafeThaw arr0+    pinned <- liftIO $ MA.pin marr+    MA.unsafeAsPtr pinned (finner (MA.arrContents pinned))+    where+    finner arrContents_ (Ptr addr#) i =+        let fptrContents =+                PlainPtr (Unboxed.getMutByteArray# arrContents_)+            fptr = ForeignPtr addr# fptrContents+         in f fptr i++{-# INLINE mutableByteArrayContents# #-}+mutableByteArrayContents# :: Exts.MutableByteArray# s -> Addr#+#if __GLASGOW_HASKELL__ >= 902+mutableByteArrayContents# = Exts.mutableByteArrayContents#+#else+mutableByteArrayContents# x = Exts.byteArrayContents# (Exts.unsafeCoerce# x)+#endif++-- | @unsafeFromForeignPtr fptr len@ converts the "ForeignPtr" to an "Array".+--+unsafeFromForeignPtr+    :: MonadIO m => ForeignPtr Word8 -> Int -> m (Array Word8)+unsafeFromForeignPtr (ForeignPtr addr# _) i+    | Ptr addr# == nullPtr || i == 0 = pure empty+unsafeFromForeignPtr (ForeignPtr addr# (PlainPtr marr#)) len =+    let off = I# (addr# `minusAddr#` mutableByteArrayContents# marr#)+     in pure (Array (Unboxed.MutByteArray marr#) off (off + len))+unsafeFromForeignPtr (ForeignPtr addr# _) len =+    fromPtrN len (Ptr addr#)+ {-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-} {-# INLINE asPtrUnsafe #-} asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b-asPtrUnsafe = unsafePinnedAsPtr+asPtrUnsafe arr f = MA.unsafePinnedAsPtr (unsafeThaw arr) (\p _ -> f p)  ------------------------------------------------------------------------------- -- Freezing and Thawing@@ -276,14 +388,14 @@ -- /Pre-release/ {-# INLINE unsafeFreeze #-} unsafeFreeze :: MutArray a -> Array a-unsafeFreeze (MutArray ac as ae _) = Array ac as ae+unsafeFreeze (MA.MutArray ac as ae _) = Array ac as ae  -- | Similar to 'unsafeFreeze' but uses 'MA.rightSize' on the mutable array -- first. {-# INLINE unsafeFreezeWithShrink #-} unsafeFreezeWithShrink :: Unbox a => MutArray a -> Array a unsafeFreezeWithShrink arr = unsafePerformIO $ do-  MutArray ac as ae _ <- MA.rightSize arr+  MA.MutArray ac as ae _ <- MA.rightSize arr   return $ Array ac as ae  -- | Makes a mutable array using the underlying memory of the immutable array.@@ -296,7 +408,7 @@ -- /Pre-release/ {-# INLINE unsafeThaw #-} unsafeThaw :: Array a -> MutArray a-unsafeThaw (Array ac as ae) = MutArray ac as ae ae+unsafeThaw (Array ac as ae) = MA.MutArray ac as ae ae  ------------------------------------------------------------------------------- -- Pinning & Unpinning@@ -328,7 +440,12 @@ -- would make a copy on every splice operation, instead use the -- 'fromChunksK' operation to combine n immutable arrays. {-# INLINE splice #-}-splice :: MonadIO m => Array a -> Array a -> m (Array a)+splice :: (MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => Array a -> Array a -> m (Array a) splice arr1 arr2 =     unsafeFreeze <$> MA.spliceCopy (unsafeThaw arr1) (unsafeThaw arr2) @@ -341,10 +458,11 @@ 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+{-# INLINABLE fromListN' #-}+pinnedFromListN, fromListN' :: Unbox a => Int -> [a] -> Array a+fromListN' n xs =+    unsafePerformIO $ unsafeFreeze <$> MA.fromListN' n xs+RENAME_PRIME(pinnedFromListN,fromListN)  -- | 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@@ -362,9 +480,10 @@ 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+{-# INLINE fromList' #-}+pinnedFromList, fromList' :: Unbox a => [a] -> Array a+fromList' xs = unsafePerformIO $ unsafeFreeze <$> MA.fromList' xs+RENAME_PRIME(pinnedFromList,fromList)  -- | Create an 'Array' from a list in reverse order. The list must be of finite -- size.@@ -378,7 +497,7 @@ -- allocated to size N, if the stream terminates before N elements then the -- array may hold less than N elements. ----- >>> fromStreamN n = Stream.fold (Array.writeN n)+-- >>> fromStreamN n = Stream.fold (Array.createOf n) -- -- /Pre-release/ {-# INLINE_NORMAL fromStreamN #-}@@ -397,7 +516,7 @@ -- single array from a stream of unknown size. 'writeN' is at least twice -- as efficient when the size is already known. ----- >>> fromStream = Stream.fold Array.write+-- >>> fromStream = Stream.fold Array.create -- -- 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@@ -415,29 +534,115 @@ fromStreamD = fromStream  ---------------------------------------------------------------------------------- Cloning+-- Slice ------------------------------------------------------------------------------- -{-# INLINE clone #-}-clone ::-    ( MonadIO m-#ifdef DEVBUILD-    , Unbox a-#endif-    )-    => Array a -> m (Array a)-clone = fmap unsafeFreeze . MA.clone . unsafeThaw+-- | /O(1)/ Slice an array in constant time.+--+-- Caution: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE unsafeSliceOffLen #-}+unsafeSliceOffLen ::+       forall a. Unbox a+    => Int -- ^ starting index+    -> Int -- ^ length of the slice+    -> Array a+    -> Array a+unsafeSliceOffLen index len (Array contents start e) =+    let size = SIZE_OF(a)+        start1 = start + (index * size)+        end1 = start1 + (len * size)+     in assert (end1 <= e) (Array contents start1 end1) -{-# INLINE pinnedClone #-}-pinnedClone ::-    ( MonadIO m-#ifdef DEVBUILD-    , Unbox a-#endif-    )-    => Array a -> m (Array a)-pinnedClone = fmap unsafeFreeze . MA.pinnedClone . unsafeThaw+-------------------------------------------------------------------------------+-- Elimination+------------------------------------------------------------------------------- +-- |+--+-- >>> null arr = Array.byteLength arr == 0+--+-- Note that this may be faster than checking Array.length as length+-- calculation involves a division operation.+--+-- /Pre-release/+{-# INLINE null #-}+null :: Array a -> Bool+null arr = byteLength arr == 0++-- XXX Change this to a partial function instead of a Maybe type? And use+-- MA.getIndex instead.++-- | /O(1)/ Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: forall a. Unbox a => Int -> Array a -> Maybe a+getIndex i arr =+    unsafeInlineIO $ do+        let elemPtr = INDEX_OF(arrStart arr, i, a)+        if i >= 0 && INDEX_VALID(elemPtr, arrEnd arr, a)+        then Just <$> peekAt elemPtr (arrContents arr)+        else return Nothing++-- | Like 'getIndex' but indexes the array in reverse from the end.+--+-- /Pre-release/+{-# INLINE getIndexRev #-}+getIndexRev :: forall a. Unbox a => Int -> Array a -> Maybe a+getIndexRev i arr =+    unsafeInlineIO $ do+        let elemPtr = RINDEX_OF(arrEnd arr, i, a)+        if i >= 0 && elemPtr >= arrStart arr+        then Just <$> peekAt elemPtr (arrContents arr)+        else return Nothing++{-# INLINE head #-}+head :: Unbox a => Array a -> Maybe a+head = getIndex 0++{-# INLINE last #-}+last :: Unbox a => Array a -> Maybe a+last = getIndexRev 0++{-# INLINE unsafeTail #-}+unsafeTail :: forall a. Unbox a => Array a -> Array a+unsafeTail Array{..} = Array arrContents (arrStart + SIZE_OF(a)) arrEnd++{-# INLINE tail #-}+tail :: Unbox a => Array a -> Array a+tail arr@Array{..} =+    if arrEnd > arrStart+    then unsafeTail arr+    else arr++{-# INLINE uncons #-}+uncons :: Unbox a => Array a -> Maybe (a, Array a)+uncons arr =+    if null arr+    then Nothing+    else Just (unsafeGetIndex 0 arr, unsafeTail arr)++{-# INLINE unsafeInit #-}+unsafeInit :: forall a. Unbox a => Array a -> Array a+unsafeInit Array{..} = Array arrContents arrStart (arrEnd - SIZE_OF(a))++{-# INLINE init #-}+init :: Unbox a => Array a -> Array a+init arr@Array{..} =+    if arrEnd > arrStart+    then unsafeInit arr+    else arr++{-# INLINE unsnoc #-}+unsnoc :: Unbox a => Array a -> Maybe (Array a, a)+unsnoc arr =+    if null arr+    then Nothing+    else Just (unsafeTail arr, unsafeGetIndexRev 0 arr)+ ------------------------------------------------------------------------------- -- Streams of arrays -------------------------------------------------------------------------------@@ -457,7 +662,7 @@ -- -- Same as the following but may be more efficient: ----- >>> chunksOf n = Stream.foldMany (Array.writeN n)+-- >>> chunksOf n = Stream.foldMany (Array.createOf n) -- -- /Pre-release/ {-# INLINE_NORMAL chunksOf #-}@@ -466,18 +671,68 @@ 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)+{-# INLINE_NORMAL chunksOf' #-}+pinnedChunksOf, chunksOf' :: 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+chunksOf' n str = D.map unsafeFreeze $ MA.chunksOf' n str+RENAME_PRIME(pinnedChunksOf,chunksOf) +-- | Create arrays from the input stream using a predicate to find the end of+-- the chunk. When the predicate matches, the chunk ends, the matching element+-- is included in the chunk.+--+--  Definition:+--+-- >>> chunksEndBy p = Stream.foldMany (Fold.takeEndBy p Array.create)+--+{-# INLINE chunksEndBy #-}+chunksEndBy :: forall m a. (MonadIO m, Unbox a)+    => (a -> Bool) -> D.Stream m a -> D.Stream m (Array a)+chunksEndBy p = D.foldMany (Fold.takeEndBy p create)++-- | Like 'chunksEndBy' but creates pinned arrays.+--+{-# INLINE chunksEndBy' #-}+chunksEndBy' :: forall m a. (MonadIO m, Unbox a)+    => (a -> Bool) -> D.Stream m a -> D.Stream m (Array a)+chunksEndBy' p = D.foldMany (Fold.takeEndBy p create')++-- | Create chunks using newline as the separator, including it.+{-# INLINE chunksEndByLn #-}+chunksEndByLn :: (MonadIO m)+    => D.Stream m Word8 -> D.Stream m (Array Word8)+chunksEndByLn = chunksEndBy (== fromIntegral (ord '\n'))++-- | Like 'chunksEndByLn' but creates pinned arrays.+{-# INLINE chunksEndByLn' #-}+chunksEndByLn' :: (MonadIO m)+    => D.Stream m Word8 -> D.Stream m (Array Word8)+chunksEndByLn' = chunksEndBy' (== fromIntegral (ord '\n'))++-- XXX Remove MonadIO++{-# INLINE splitEndBy #-}+splitEndBy :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> Array a -> Stream m (Array a)+splitEndBy p arr = D.map unsafeFreeze $ MA.splitEndBy p (unsafeThaw arr)++-- | Split the array into a stream of slices using a predicate. The element+-- matching the predicate is dropped.+--+-- /Pre-release/+{-# INLINE splitEndBy_ #-}+splitEndBy_ :: (Monad m, Unbox a) =>+    (a -> Bool) -> Array a -> Stream m (Array a)+splitEndBy_ predicate arr =+    fmap (\(i, len) -> unsafeSliceOffLen i len arr)+        $ D.indexEndBy_ predicate (read arr)+ -- | Convert a stream of arrays into a stream of their elements. ----- >>> concat = Stream.unfoldMany Array.reader+-- >>> concat = Stream.unfoldEach Array.reader -- {-# INLINE_NORMAL concat #-} concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- XXX this requires MonadIO whereas the unfoldMany version does not concat = MA.concatWith (pure . unsafeInlineIO) . D.map unsafeThaw -- concat = D.unfoldMany reader @@ -490,7 +745,7 @@ -- | Convert a stream of arrays into a stream of their elements reversing the -- contents of each array before flattening. ----- >>> concatRev = Stream.unfoldMany Array.readerRev+-- >>> concatRev = Stream.unfoldEach Array.readerRev -- {-# INLINE_NORMAL concatRev #-} concatRev :: forall m a. (Monad m, Unbox a)@@ -514,41 +769,53 @@ -- arrays would have no capacity to append, therefore, a copy will be forced -- anyway. --- | Fold @fCompactGE n@ coalesces adjacent arrays in the input stream--- until the size becomes greater than or equal to n.+-- | Fold @createCompactMin n@ coalesces adjacent arrays in the input+-- stream until the size becomes greater than or equal to n. -- -- Generates unpinned arrays irrespective of the pinning status of input -- arrays.-{-# INLINE_NORMAL fCompactGE #-}-fCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)-fCompactGE n = fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.fCompactGE n+{-# INLINE_NORMAL createCompactMin #-}+createCompactMin, fCompactGE :: (MonadIO m, Unbox a) =>+    Int -> Fold m (Array a) (Array a)+createCompactMin n =+    fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.createCompactMin n --- | PInned version of 'fCompactGE'.-{-# INLINE_NORMAL fPinnedCompactGE #-}-fPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)-fPinnedCompactGE n =-    fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.fPinnedCompactGE n+RENAME(fCompactGE,createCompactMin) --- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until+-- | Pinned version of 'createCompactMin'.+{-# INLINE_NORMAL createCompactMin' #-}+createCompactMin', fPinnedCompactGE :: (MonadIO m, Unbox a) =>+    Int -> Fold m (Array a) (Array a)+createCompactMin' n =+    fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.createCompactMin' n++{-# DEPRECATED fPinnedCompactGE "Please use createCompactMin' instead." #-}+{-# INLINE fPinnedCompactGE #-}+fPinnedCompactGE = createCompactMin++-- | @compactBySize n stream@ coalesces adjacent arrays in the @stream@ until -- the size becomes greater than or equal to @n@. ----- >>> compactGE n = Stream.foldMany (Array.fCompactGE n)+-- >>> compactBySize n = Stream.foldMany (Array.createCompactMin n) -- -- Generates unpinned arrays irrespective of the pinning status of input -- arrays.-{-# INLINE compactGE #-}-compactGE ::+{-# INLINE compactMin #-}+compactMin, compactGE ::        (MonadIO m, Unbox a)     => Int -> Stream m (Array a) -> Stream m (Array a)-compactGE n stream =-    D.map unsafeFreeze $ MA.compactGE n $ D.map unsafeThaw stream+compactMin n stream =+    D.map unsafeFreeze $ MA.compactMin n $ D.map unsafeThaw stream --- | Like 'compactGE' but for transforming folds instead of stream.+RENAME(compactGE,compactMin)++-- | Like 'compactBySizeGE' but for transforming folds instead of stream. ----- >>> lCompactGE n = Fold.many (Array.fCompactGE n)+-- >>> lCompactBySizeGE n = Fold.many (Array.createCompactMin n) -- -- Generates unpinned arrays irrespective of the pinning status of input -- arrays.+{-# DEPRECATED lCompactGE "Please use scanCompactMin instead." #-} {-# INLINE_NORMAL lCompactGE #-} lCompactGE :: (MonadIO m, Unbox a)     => Int -> Fold m (Array a) () -> Fold m (Array a) ()@@ -556,23 +823,41 @@     Fold.lmap unsafeThaw $ MA.lCompactGE n (Fold.lmap unsafeFreeze fld)  -- | Pinned version of 'lCompactGE'.+{-# DEPRECATED lPinnedCompactGE "Please use scanCompactMin' instead." #-} {-# INLINE_NORMAL lPinnedCompactGE #-} lPinnedCompactGE :: (MonadIO m, Unbox a)     => Int -> Fold m (Array a) () -> Fold m (Array a) () lPinnedCompactGE n fld =     Fold.lmap unsafeThaw $ MA.lPinnedCompactGE n (Fold.lmap unsafeFreeze fld) +{-# INLINE scanCompactMin #-}+scanCompactMin :: forall m a. (MonadIO m, Unbox a)+    => Int -> Scanl m (Array a) (Maybe (Array a))+scanCompactMin n =+    Scanl.lmap unsafeThaw+        $ fmap (fmap unsafeFreeze)+        $ MA.scanCompactMin n++{-# INLINE scanCompactMin' #-}+scanCompactMin' :: forall m a. (MonadIO m, Unbox a)+    => Int -> Scanl m (Array a) (Maybe (Array a))+scanCompactMin' n =+    Scanl.lmap unsafeThaw+        $ fmap (fmap unsafeFreeze)+        $ MA.scanCompactMin' n+ ------------------------------------------------------------------------------- -- Splitting -------------------------------------------------------------------------------  -- Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m+{-# INLINE breakEndByWord8_ #-}+breakEndByWord8_, breakOn :: MonadIO m     => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))-breakOn sep arr = do+breakEndByWord8_ sep arr = do   (a, b) <- MA.breakOn sep (unsafeThaw arr)   return (unsafeFreeze a, unsafeFreeze <$> b)+RENAME(breakOn,breakEndByWord8_)  ------------------------------------------------------------------------------- -- Elimination@@ -581,20 +866,29 @@ -- | Return element at the specified index without checking the bounds. -- -- Unsafe because it does not check the bounds of the array.-{-# INLINE_NORMAL unsafeIndexIO #-}-unsafeIndexIO :: forall a. Unbox a => Int -> Array a -> IO a-unsafeIndexIO i arr = MA.getIndexUnsafe i (unsafeThaw arr)+{-# INLINE_NORMAL unsafeGetIndexIO #-}+unsafeGetIndexIO, unsafeIndexIO :: forall a. Unbox a => Int -> Array a -> IO a+unsafeGetIndexIO i arr = MA.unsafeGetIndex 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+{-# INLINE_NORMAL unsafeGetIndex #-}+unsafeGetIndex, getIndexUnsafe :: forall a. Unbox a => Int -> Array a -> a+unsafeGetIndex i arr = let !r = unsafeInlineIO $ unsafeGetIndexIO i arr in r -{-# DEPRECATED unsafeIndex "Please use 'getIndexUnsafe' instead" #-}+{-# DEPRECATED unsafeIndex "Please use 'unsafeGetIndex' instead" #-} {-# INLINE_NORMAL unsafeIndex #-} unsafeIndex :: forall a. Unbox a => Int -> Array a -> a-unsafeIndex = getIndexUnsafe+unsafeIndex = unsafeGetIndex +{-# INLINE_NORMAL unsafeGetIndexRevIO #-}+unsafeGetIndexRevIO :: forall a. Unbox a => Int -> Array a -> IO a+unsafeGetIndexRevIO i arr = MA.unsafeGetIndexRev i (unsafeThaw arr)++{-# INLINE_NORMAL unsafeGetIndexRev #-}+unsafeGetIndexRev :: forall a. Unbox a => Int -> Array a -> a+unsafeGetIndexRev i arr =+    let !r = unsafeInlineIO $ unsafeGetIndexRevIO i arr in r+ -- | /O(1)/ Get the byte length of the array. -- {-# INLINE byteLength #-}@@ -631,9 +925,9 @@ -- -- /Pre-release/ ---{-# INLINE_NORMAL readerUnsafe #-}-readerUnsafe :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a-readerUnsafe = Unfold step inject+{-# INLINE_NORMAL unsafeReader #-}+unsafeReader, readerUnsafe :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+unsafeReader = Unfold step inject     where      inject (Array contents start end) =@@ -719,15 +1013,87 @@ foldr :: Unbox a => (a -> b -> b) -> b -> Array a -> b foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr +-- | Like 'breakAt' but does not check whether the index is valid.+--+{-# INLINE unsafeBreakAt #-}+unsafeBreakAt :: Unbox a =>+    Int -> Array a -> (Array a, Array a)+unsafeBreakAt i arr = (unsafeFreeze a, unsafeFreeze b)++    where++    (a, b) = MA.unsafeBreakAt i (unsafeThaw arr)+ -- | Create two slices of an array without copying the original array. The -- specified index @i@ is the first index of the second slice. ---{-# INLINE splitAt #-}-splitAt :: Unbox a => Int -> Array a -> (Array a, Array a)-splitAt i arr = (unsafeFreeze a, unsafeFreeze b)-  where-    (a, b) = MA.splitAt i (unsafeThaw arr)+{-# INLINE breakAt #-}+breakAt, splitAt :: Unbox a => Int -> Array a -> (Array a, Array a)+breakAt i arr = (unsafeFreeze a, unsafeFreeze b) +    where++    (a, b) = MA.breakAt i (unsafeThaw arr)+RENAME(splitAt,breakAt)++{-# INLINE breakEndBy #-}+breakEndBy :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+breakEndBy p arr = (unsafeFreeze a, unsafeFreeze b)++    where++    (a, b) = unsafePerformIO $ MA.breakEndBy p (unsafeThaw arr)++{-# INLINE breakEndBy_ #-}+breakEndBy_ :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+breakEndBy_ p arr = (unsafeFreeze a, unsafeFreeze b)++    where++    (a, b) = unsafePerformIO $ MA.breakEndBy_ p (unsafeThaw arr)++{-# INLINE revBreakEndBy #-}+revBreakEndBy :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+revBreakEndBy p arr = (unsafeFreeze a, unsafeFreeze b)++    where++    (a, b) = unsafePerformIO $ MA.revBreakEndBy p (unsafeThaw arr)++{-# INLINE revBreakEndBy_ #-}+revBreakEndBy_ :: Unbox a => (a -> Bool) -> Array a -> (Array a, Array a)+revBreakEndBy_ p arr = (unsafeFreeze a, unsafeFreeze b)++    where++    (a, b) = unsafePerformIO $ MA.revBreakEndBy_ p (unsafeThaw arr)++-- XXX Remove unsafePerformIO++-- | Strip elements which match the predicate, from both ends.+--+-- /Pre-release/+{-# INLINE dropAround #-}+dropAround :: Unbox a => (a -> Bool) -> Array a -> Array a+dropAround eq arr =+    unsafeFreeze $ unsafePerformIO $ MA.dropAround eq (unsafeThaw arr)++-- | Strip elements which match the predicate, from the start of the array.+--+-- /Pre-release/+{-# INLINE dropWhile #-}+dropWhile :: Unbox a => (a -> Bool) -> Array a -> Array a+dropWhile eq arr =+    unsafeFreeze $ unsafePerformIO $ MA.dropWhile eq (unsafeThaw arr)++-- | Strip elements which match the predicate, from the end of the array.+--+-- /Pre-release/+{-# INLINE revDropWhile #-}+revDropWhile :: Unbox a => (a -> Bool) -> Array a -> Array a+revDropWhile eq arr =+    unsafeFreeze $ unsafePerformIO $ MA.revDropWhile eq (unsafeThaw arr)+ -- Use foldr/build fusion to fuse with list consumers -- This can be useful when using the IsList instance {-# INLINE_LATE toListFB #-}@@ -763,21 +1129,21 @@ createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a) createOf = fmap unsafeFreeze . MA.createOf --- XXX Deprecate in major--- {-# DEPRECATED writeN  "Please use createOf instead." #-}+{-# DEPRECATED writeN  "Please use createOf instead." #-} {-# INLINE writeN #-} writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a) writeN = createOf  -- | Like 'createOf' but creates a pinned array.-{-# INLINE_NORMAL pinnedCreateOf #-}-pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)-pinnedCreateOf = fmap unsafeFreeze . MA.pinnedCreateOf+{-# INLINE_NORMAL createOf' #-}+pinnedCreateOf, createOf' :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+createOf' = fmap unsafeFreeze . MA.createOf'+RENAME_PRIME(pinnedCreateOf,createOf) -{-# DEPRECATED pinnedWriteN  "Please use pinnedCreateOf instead." #-}+{-# DEPRECATED pinnedWriteN  "Please use createOf' instead." #-} {-# INLINE pinnedWriteN #-} pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)-pinnedWriteN = pinnedCreateOf+pinnedWriteN = createOf'  -- | @pinnedWriteNAligned alignment n@ folds a maximum of @n@ elements from the input -- stream to an 'Array' aligned to the given size.@@ -807,17 +1173,27 @@     => Int -> Fold m a (Array a) writeNUnsafe = unsafeCreateOf -{-# INLINE_NORMAL unsafePinnedCreateOf #-}-unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)+{-# INLINE_NORMAL unsafeCreateOf' #-}+unsafePinnedCreateOf, unsafeCreateOf' :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)-unsafePinnedCreateOf n = unsafeFreeze <$> MA.unsafePinnedCreateOf n+unsafeCreateOf' n = unsafeFreeze <$> MA.unsafeCreateOf' n+RENAME_PRIME(unsafePinnedCreateOf,unsafeCreateOf) -{-# DEPRECATED pinnedWriteNUnsafe  "Please use unsafePinnedCreateOf instead." #-}+{-# DEPRECATED pinnedWriteNUnsafe  "Please use unsafeCreateOf' instead." #-} {-# INLINE pinnedWriteNUnsafe #-} pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)-pinnedWriteNUnsafe = unsafePinnedCreateOf+pinnedWriteNUnsafe = unsafeCreateOf' +-- | A version of "create" that let's you pass in the initial capacity of the+-- array in terms of the number of elements.+--+-- Semantically @createWith 10@ and @createWith 100@ will behave in the same+-- way. @createWith 100@ will be more performant though.+--+-- > create = createWith elementCount+--+-- /Pre-release/ {-# INLINE_NORMAL createWith #-} createWith :: forall m a. (MonadIO m, Unbox a)     => Int -> Fold m a (Array a)@@ -838,21 +1214,21 @@ create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a) create = fmap unsafeFreeze MA.create --- XXX Deprecate in major--- {-# DEPRECATED write  "Please use create instead." #-}+{-# DEPRECATED write  "Please use create instead." #-} {-# INLINE write #-} write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a) write = create  -- | Like 'create' but creates a pinned array.-{-# INLINE pinnedCreate #-}-pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)-pinnedCreate = fmap unsafeFreeze MA.pinnedCreate+{-# INLINE create' #-}+pinnedCreate, create' :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+create' = fmap unsafeFreeze MA.create'+RENAME_PRIME(pinnedCreate,create) -{-# DEPRECATED pinnedWrite  "Please use pinnedCreate instead." #-}+{-# DEPRECATED pinnedWrite  "Please use create' instead." #-} {-# INLINE pinnedWrite #-} pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)-pinnedWrite = pinnedCreate+pinnedWrite = create'  -- | Fold "step" has a dependency on "initial", and each step is dependent on -- the previous invocation of step due to state passing, finally extract@@ -874,7 +1250,7 @@ -- could be unsafe and dangerous. This is dangerous especially when used with -- foldMany like operations. ----- >>> unsafePureWrite = Array.unsafeMakePure Array.write+-- >>> unsafePureWrite = Array.unsafeMakePure Array.create -- {-# INLINE unsafeMakePure #-} unsafeMakePure :: Monad m => Fold IO a b -> Fold m a b@@ -896,22 +1272,18 @@ -- >>> fromPureStream = Array.fromList . runIdentity . Stream.toList -- fromPureStream :: Unbox a => Stream Identity a -> Array a-fromPureStream x = unsafePerformIO $ fmap (unsafeFreeze) (MA.fromPureStream x)+fromPureStream x = unsafePerformIO $ fmap unsafeFreeze (MA.fromPureStream x) -- fromPureStream = runIdentity . D.fold (unsafeMakePure write) -- fromPureStream = fromList . runIdentity . D.toList --- XXX This should be monadic.---- | Copy an immutable 'Ptr Word8' sequence into an array.+-- | @fromPtrN len addr@ copies @len@ bytes from @addr@ into an array. The+-- memory pointed by @addr@ must be pinned or static. ----- /Unsafe:/ The caller is responsible for safe addressing.+-- /Unsafe:/ The caller is responsible to ensure that the pointer passed is+-- valid up to the given length. ----- Note that this should be evaluated strictly to ensure that we do not hold--- the reference to the pointer in a lazy thunk.-fromPtrN :: Int -> Ptr Word8 -> Array Word8-fromPtrN n addr = unsafePerformIO $ fmap unsafeFreeze (MA.fromPtrN n addr)---- XXX This should be monadic.+fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (Array Word8)+fromPtrN n addr = fmap unsafeFreeze (MA.fromPtrN n addr)  -- | Copy a null terminated immutable 'Addr#' Word8 sequence into an array. --@@ -920,21 +1292,41 @@ -- 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"#+-- Note, you can use lazy unsafePerformIO _only if_ the pointer is immutable.+--+-- >>> Array.toList $ unsafePerformIO $ Array.fromCString# "\1\2\3\0"# -- [1,2,3] ----- Note that this should be evaluated strictly to ensure that we do not hold--- the reference to the pointer in a lazy thunk.+fromCString# :: MonadIO m => Addr# -> m (Array Word8)+fromCString# addr = fmap unsafeFreeze (MA.fromCString# addr)++{-# DEPRECATED fromByteStr# "Please use fromCString# instead." #-} fromByteStr# :: Addr# -> Array Word8-fromByteStr# addr = unsafePerformIO $ fmap unsafeFreeze (MA.fromByteStr# addr)+fromByteStr# addr = unsafePerformIO $ fromCString# addr --- XXX This should be monadic.+-- | Copy a C string consisting of 16-bit wide chars and terminated by a 16-bit+-- null char, into a Word16 array. The null character is not copied.+--+-- Useful for copying UTF16 strings on Windows.+--+fromW16CString# :: MonadIO m => Addr# -> m (Array Word16)+fromW16CString# addr = fmap unsafeFreeze (MA.fromW16CString# addr) --- | Note that this should be evaluated strictly to ensure that we do not hold--- the reference to the pointer in a lazy thunk.+fromCString :: MonadIO m => Ptr Word8 -> m (Array Word8)+fromCString (Ptr addr#) = fromCString# addr#++{-# DEPRECATED fromByteStr "Please use fromCString instead." #-} fromByteStr :: Ptr Word8 -> Array Word8-fromByteStr (Ptr addr#) = fromByteStr# addr#+fromByteStr = unsafePerformIO . fromCString +-- | Copy a C string consisting of 16-bit wide chars and terminated by a 16-bit+-- null char, into a Word16 array. The null character is not copied.+--+-- Useful for copying UTF16 strings on Windows.+--+fromW16CString :: MonadIO m => Ptr Word8 -> m (Array Word16)+fromW16CString (Ptr addr#) = fromW16CString# addr#+ -- XXX implement fromChunks/fromChunkList instead?  -- | Convert an array stream to an array. Note that this requires peak memory@@ -994,6 +1386,16 @@     {-# INLINE toList #-}     toList = toList +-- | Compare an array with a list.+{-# INLINE listCmp #-}+listCmp :: (Unbox a, Ord a) => [a] -> Array a -> Ordering+listCmp xs arr = runIdentity $ D.cmpBy compare (D.fromList xs) (toStream arr)++-- | Check equality of an array with a list.+{-# INLINE listEq #-}+listEq :: (Unbox a, Ord a) => [a] -> Array a -> Bool+listEq xs arr = runIdentity $ D.eqBy (==) (D.fromList xs) (toStream arr)+ -- | Byte compare two arrays. 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.@@ -1145,3 +1547,11 @@ instance Unbox a => Monoid (Array a) where     mempty = nil     mappend = (<>)++-------------------------------------------------------------------------------+-- Backward Compatibility+-------------------------------------------------------------------------------++RENAME(unsafeIndexIO,unsafeGetIndexIO)+RENAME(getIndexUnsafe,unsafeGetIndex)+RENAME(readerUnsafe,unsafeReader)
src/Streamly/Internal/Data/Binary/Parser.hs view
@@ -57,11 +57,11 @@ import Streamly.Internal.Data.Tuple.Strict (Tuple' (..)) import qualified Streamly.Data.Array as A import qualified Streamly.Internal.Data.Array as A-    (getIndexUnsafe, castUnsafe)+    (unsafeGetIndex, unsafeCast) import qualified Streamly.Internal.Data.Parser as PR     (fromPure, either, satisfy, takeEQ) import qualified Streamly.Internal.Data.Parser as PRD-    (Parser(..), Initial(..), Step(..))+    (Parser(..), Initial(..), Step(..), Final(..))  -- 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 ()@@ -149,11 +149,11 @@     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))+        return $ PRD.SContinue 1 (Just' (fromIntegral a `unsafeShiftL` 8))     step (Just' w) a =-        return $ PRD.Done 0 (w .|. fromIntegral a)+        return $ PRD.SDone 1 (w .|. fromIntegral a) -    extract _ = return $ PRD.Error "word16be: end of input"+    extract _ = return $ PRD.FError "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).@@ -174,11 +174,11 @@     initial = return $ PRD.IPartial Nothing'      step Nothing' a =-        return $ PRD.Continue 0 (Just' (fromIntegral a))+        return $ PRD.SContinue 1 (Just' (fromIntegral a))     step (Just' w) a =-        return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)+        return $ PRD.SDone 1 (w .|. fromIntegral a `unsafeShiftL` 8) -    extract _ = return $ PRD.Error "word16le: end of input"+    extract _ = return $ PRD.FError "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).@@ -202,10 +202,10 @@         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)+             in PRD.SContinue 1 (Tuple' w1 (sh - 8))+        else PRD.SDone 1 (w .|. fromIntegral a) -    extract _ = return $ PRD.Error "word32beD: end of input"+    extract _ = return $ PRD.FError "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).@@ -228,10 +228,10 @@     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+            then PRD.SContinue 1 (Tuple' w1 (sh + 8))+            else PRD.SDone 1 w1 -    extract _ = return $ PRD.Error "word32leD: end of input"+    extract _ = return $ PRD.FError "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).@@ -255,10 +255,10 @@         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)+             in PRD.SContinue 1 (Tuple' w1 (sh - 8))+        else PRD.SDone 1 (w .|. fromIntegral a) -    extract _ = return $ PRD.Error "word64beD: end of input"+    extract _ = return $ PRD.FError "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).@@ -281,10 +281,10 @@     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+            then PRD.SContinue 1 (Tuple' w1 (sh + 8))+            else PRD.SDone 1 w1 -    extract _ = return $ PRD.Error "word64leD: end of input"+    extract _ = return $ PRD.FError "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).@@ -388,7 +388,7 @@ {-# INLINE word64host #-} word64host :: MonadIO m => Parser Word8 m Word64 word64host =-    fmap (A.getIndexUnsafe 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)+    fmap (A.unsafeGetIndex 0 . A.unsafeCast) $ PR.takeEQ 8 (A.createOf 8)  ------------------------------------------------------------------------------- -- Type class
src/Streamly/Internal/Data/Builder.hs view
@@ -19,6 +19,7 @@ #if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2) #endif+import Data.Bifunctor (first)  ------------------------------------------------------------------------------ -- The Builder type@@ -34,7 +35,7 @@ -- | 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 (\ (a, s) -> (f a, s)) . step1)+    fmap f (Builder step1) = Builder (fmap (first f) . step1)  {-# INLINE fromPure #-} fromPure :: Applicative m => b -> Builder s m b
+ src/Streamly/Internal/Data/CString.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE UnliftedFFITypes #-}++-- |+-- Module      : Streamly.Internal.Data.CString+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- MutByteArray representing null terminated c strings.+-- All APIs in this module are unsafe and caution must be used when using them.+-- Completely experimental. Everything is subject to change without notice.++module Streamly.Internal.Data.CString+    (+      splice+    , spliceCString+    , splicePtrN+    , putCString+    , length+    )++where++#ifdef DEBUG+#include "assert.hs"+#endif++import GHC.Ptr (Ptr(..), castPtr)+import Foreign.C (CString, CSize(..))+import GHC.Exts (MutableByteArray#, RealWorld)+import GHC.Word (Word8)++import Streamly.Internal.Data.MutByteArray.Type hiding (length)++import Prelude hiding (length)++-- XXX Use cstringLength# from GHC.CString in ghc-prim+foreign import ccall unsafe "string.h strlen" c_strlen+    :: MutableByteArray# RealWorld -> IO CSize++-- XXX Use cstringLength# from GHC.CString in ghc-prim+foreign import ccall unsafe "string.h strlen" c_strlen_pinned+    :: CString -> IO CSize++{-# INLINE length #-}+length :: MutByteArray -> IO Int+length (MutByteArray src#) = do+    fmap fromIntegral $ c_strlen src#++-- | Join two null terminated cstrings, the null byte of the first string is+-- overwritten. Does not check the destination length or source length.+-- Destination must have enough space to accomodate src.+--+-- Returns the offset of the null byte.+--+-- /Unsafe/+splice :: MutByteArray -> MutByteArray -> IO Int+splice dst@(MutByteArray dst#) src@(MutByteArray src#) = do+    srcLen <- fmap fromIntegral $ c_strlen src#+#ifdef DEBUG+    srcLen1 <- length src+    assertM(srcLen <= srcLen1)+#endif+    dstLen <- fmap fromIntegral $ c_strlen dst#+#ifdef DEBUG+    dstLen1 <- length dst+    assertM(dstLen <= dstLen1)+    assertM(dstLen + srcLen + 1 <= dstLen1)+#endif+    unsafePutSlice src 0 dst dstLen (srcLen + 1)+    return $ dstLen + srcLen++-- | Append specified number of bytes from a Ptr to a MutByteArray CString. The+-- null byte of CString is overwritten and the result is terminated with a null+-- byte.+{-# INLINE splicePtrN #-}+splicePtrN :: MutByteArray -> Ptr Word8 -> Int -> IO Int+splicePtrN dst@(MutByteArray dst#) src srcLen = do+    dstLen <- fmap fromIntegral $ c_strlen dst#+#ifdef DEBUG+    dstLen1 <- length dst+    assertM(dstLen <= dstLen1)+    assertM(dstLen + srcLen + 1 <= dstLen1)+#endif+    -- unsafePutSlice src 0 dst dstLen srcLen+    -- XXX unsafePutPtrN signature consistency with serialization routines+    -- XXX unsafePutSlice as well+    unsafePutPtrN src dst dstLen (srcLen + 1)+    return $ dstLen + srcLen++-- | Join a null terminated cstring MutByteByteArray with a null terminated+-- cstring Ptr.+{-# INLINE spliceCString #-}+spliceCString :: MutByteArray -> CString -> IO Int+spliceCString dst src = do+    srcLen <- fmap fromIntegral $ c_strlen_pinned src+    splicePtrN dst (castPtr src) srcLen++-- XXX this is CString serialization.++-- | @putCString dst dstOffset cstr@ writes the cstring cstr at dstOffset in+-- the dst MutByteArray. The result is terminated by a null byte.+{-# INLINE putCString #-}+putCString :: MutByteArray -> Int -> CString -> IO Int+putCString dst off src = do+    srcLen <- fmap fromIntegral $ c_strlen_pinned src+    unsafePutPtrN (castPtr src) dst off (srcLen + 1)+    return $ off + srcLen
src/Streamly/Internal/Data/Fold.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module      : Streamly.Internal.Data.Fold -- Copyright   : (c) 2019 Composewell Technologies@@ -21,11 +22,13 @@     , module Streamly.Internal.Data.Fold.Combinators     , module Streamly.Internal.Data.Fold.Container     , module Streamly.Internal.Data.Fold.Window+    , module Streamly.Internal.Data.Fold.Exception     ) where  import Streamly.Internal.Data.Fold.Combinators import Streamly.Internal.Data.Fold.Container+import Streamly.Internal.Data.Fold.Exception import Streamly.Internal.Data.Fold.Tee import Streamly.Internal.Data.Fold.Type import Streamly.Internal.Data.Fold.Window
src/Streamly/Internal/Data/Fold/Chunked.hs view
@@ -1,3 +1,6 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+ -- | -- Module      : Streamly.Internal.Data.Fold.Chunked -- Copyright   : (c) 2021 Composewell Technologies@@ -26,7 +29,7 @@ -- >> import qualified Streamly.Data.StreamK as StreamK -- -- >> f = ChunkFold.fromFold (Fold.take 7 Fold.toList)--- >> s = Stream.chunksOf 5 $ Stream.fromList "hello world"+-- >> s = Array.chunksOf 5 $ Stream.fromList "hello world" -- >> ArrayStream.runArrayFold f (StreamK.fromStream s) -- Right "hello w" --@@ -69,7 +72,7 @@ import Streamly.Internal.Data.Unbox (Unbox(..)) import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Array (Array(..))-import Streamly.Internal.Data.Parser (Initial(..), Step(..))+import Streamly.Internal.Data.Parser (Initial(..), Step(..), Final(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))  import qualified Streamly.Internal.Data.Array.Type as Array@@ -134,7 +137,7 @@                 Fold.Partial fs1 ->                     goArray SPEC next fs1 -    extract = fmap (Done 0) . ffinal+    extract = fmap (FDone 0) . ffinal  -- | Convert an element 'ParserD.Parser' into an array stream fold. If the -- parser fails the fold would throw an exception.@@ -175,7 +178,7 @@                     partial arrRem cur next elemSize Partial n fs1                 ParserD.Continue n fs1 -> do                     partial arrRem cur next elemSize Continue n fs1-                Error err -> return $ Error err+                SError err -> return $ SError err  -- | Convert an element 'Parser.Parser' into an array stream fold. If the -- parser fails the fold would throw an exception.@@ -317,8 +320,8 @@     iextract s = do         r <- extract1 s         return $ case r of-            Done _ b -> IDone b-            Error err -> IError err+            FDone _ b -> IDone b+            FError err -> IError err             _ -> error "Bug: ChunkFold take invalid state in initial"      initial = do@@ -340,10 +343,9 @@                 -- i2 == i1 == j == 0                 r <- extract1 s                 return $ case r of-                    Error err -> Error err-                    Done n1 b -> Done n1 b-                    Continue n1 s1 -> Continue n1 (Tuple' i2 s1)-                    Partial _ _ -> error "Partial in extract"+                    FError err -> SError err+                    FDone n1 b -> Done n1 b+                    FContinue n1 s1 -> Continue n1 (Tuple' i2 s1)      -- Tuple' (how many more items to take) (fold state)     step (Tuple' i r) arr = do@@ -356,7 +358,7 @@                 Partial j s -> partial i1 Partial j s                 Continue j s -> partial i1 Continue j s                 Done j b -> return $ Done j b-                Error err -> return $ Error err+                SError err -> return $ SError err         else do             let !(Array contents start _) = arr                 end = INDEX_OF(start,i,a)@@ -366,14 +368,14 @@             res <- step1 r arr1             case res of                 Partial 0 s ->-                    ParserD.bimapOverrideCount+                    ParserD.bimapMorphOverrideCount                         remaining (Tuple' 0) id <$> extract1 s                 Partial j s -> return $ Partial (remaining + j) (Tuple' j s)                 Continue 0 s ->-                    ParserD.bimapOverrideCount+                    ParserD.bimapMorphOverrideCount                         remaining (Tuple' 0) id <$> extract1 s                 Continue j s -> return $ Continue (remaining + j) (Tuple' j s)                 Done j b -> return $ Done (remaining + j) b-                Error err -> return $ Error err+                SError err -> return $ SError err      extract (Tuple' i r) = first (Tuple' i) <$> extract1 r
src/Streamly/Internal/Data/Fold/Combinators.hs view
@@ -32,7 +32,7 @@     , the     , mean     , rollingHash-    , defaultSalt+    , Scanl.defaultSalt     , rollingHashWithSalt     , rollingHashFirstN     -- , rollingHashLastN@@ -47,13 +47,13 @@     , maximum     , minimumBy     , minimum+    , rangeBy+    , range      -- *** 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@@ -66,14 +66,14 @@     -- 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+ -- , nthLast -- using RingArray array+    , rollingMap     , rollingMapM      -- *** Filters++    -- XXX deprecate these in favor of corresponding scans+     -- | Useful in combination with the 'scanMaybe' combinator.     , deleteBy     , uniqBy@@ -95,7 +95,7 @@     , drainN     -- , lastN     -- , (!!)-    , indexGeneric+    , genericIndex     , index     , findM     , find@@ -130,15 +130,11 @@     -- ** Utilities     , with -    -- ** Mapping on Input-    , transform-     -- ** Sliding Window     , slide2      -- ** Scanning Input-    , scan-    , scanMany+    , pipe     , indexed      -- ** Zipping Input@@ -181,6 +177,7 @@     -- ** Parallel Distribution     , tee     , distribute+    , distributeScan     -- , distributeFst     -- , distributeMin @@ -209,12 +206,14 @@      -- * Deprecated     , drainBy-    , last     , head     , sequence     , mapM     , variance     , stdDev+    , indexingWith+    , indexing+    , indexingRev     ) where @@ -229,21 +228,25 @@ import Data.Int (Int64) import Data.Proxy (Proxy(..)) import Data.Word (Word32)-import Foreign.Storable (Storable, peek)+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Scanl.Type (Scanl(..))+import Streamly.Internal.Data.Unbox (Unbox(..)) 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.Pipe.Type (Pipe (..))+import Streamly.Internal.Data.RingArray (RingArray(..))+-- import Streamly.Internal.Data.Scan (Scan (..)) import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))  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.RingArray as RingArray+import qualified Streamly.Internal.Data.Scanl.Combinators as Scanl+import qualified Streamly.Internal.Data.Scanl.Type as Scanl import qualified Streamly.Internal.Data.Stream.Type as StreamD  import Prelude hiding@@ -337,7 +340,7 @@ -- Example, build an array incrementally: -- -- >>> :{--- pure (Array.write :: Fold IO Int (Array Int))+-- pure (Array.create :: Fold IO Int (Array Int)) --     >>= Fold.addOne 1 --     >>= Fold.addStream (Stream.enumerateFromTo 2 4) --     >>= Fold.drive Stream.nil@@ -349,7 +352,7 @@ -- -- >>> :{ -- let f :: Fold IO Int (Stream Identity (Array Int))---     f = Fold.groupsOf 2 (Array.writeN 3) Fold.toStream+--     f = Fold.groupsOf 2 (Array.createOf 3) Fold.toStream -- in pure f --     >>= Fold.addOne 1 --     >>= Fold.addStream (Stream.enumerateFromTo 2 4)@@ -432,107 +435,54 @@ 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'.+-- | Attach a 'Pipe' on the input of a 'Fold'. -- -- /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) =+{-# INLINE pipe #-}+pipe :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c+pipe (Pipe consume produce 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+    step (Tuple' cs fs) x = do+        r <- consume cs x         go fs r          where          -- XXX use SPEC?-        go acc (Pipe.Yield b (Consume ps')) = do-            acc' <- fstep acc b+        go acc (Pipe.YieldC cs1 b) = do+            acc1 <- 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+                $ case acc1 of+                      Partial s -> Partial $ Tuple' cs1 s+                      Done b1 -> Done b1+        -- XXX this case is recursive may cause fusion issues.+        -- To remove recursion we will need a produce mode in folds which makes+        -- it similar to pipes except that it does not yield intermediate+        -- values..+        go acc (Pipe.YieldP ps1 b) = do+            acc1 <- fstep acc b+            r <- produce ps1+            case acc1 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'+                Done b1 -> return $ Done b1+        go acc (Pipe.SkipC cs1) =+            return $ Partial $ Tuple' cs1 acc+        -- XXX this case is recursive may cause fusion issues.+        go acc (Pipe.SkipP ps1) = do+            r <- produce ps1             go acc r+        -- XXX a Stop in consumer means we dropped the input.+        go acc Pipe.Stop = Done <$> ffinal acc      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 ------------------------------------------------------------------------------@@ -543,22 +493,13 @@ -- Example: -- -- >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.deleteBy (==) 3) input+--+-- >> Stream.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+deleteBy eq = fromScanl . Scanl.deleteBy eq  -- | Provide a sliding window of length 2 elements. --@@ -588,7 +529,8 @@ -- -- >>> input = Stream.fromList "//a//b" -- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.uniqBy f) input+--+-- >> Stream.toList $ Stream.scanMaybe (Fold.uniqBy f) input -- "/a/b" -- -- Space: @O(1)@@@ -597,14 +539,7 @@ -- {-# 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+uniqBy = fromScanl . Scanl.uniqBy  -- | See 'uniqBy'. --@@ -614,7 +549,7 @@ -- {-# INLINE uniq #-} uniq :: (Monad m, Eq a) => Fold m a (Maybe a)-uniq = uniqBy (==)+uniq = fromScanl Scanl.uniq  -- | Strip all leading and trailing occurrences of an element passing a -- predicate and make all other consecutive occurrences uniq.@@ -669,37 +604,13 @@ 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+the = fromScanl Scanl.the  ------------------------------------------------------------------------------ -- To Summary@@ -709,7 +620,7 @@ -- identity (@0@) when the stream is empty. Note that this is not numerically -- stable for floating point numbers. ----- >>> sum = Fold.cumulative Fold.windowSum+-- >>> sum = Fold.fromScanl (Scanl.cumulativeScan Scanl.incrSum) -- -- Same as following but numerically stable: --@@ -718,7 +629,7 @@ -- {-# INLINE sum #-} sum :: (Monad m, Num a) => Fold m a a-sum = Fold.cumulative Fold.windowSum+sum = fromScanl Scanl.sum  -- | Determine the product of all elements of a stream of numbers. Returns -- multiplicative identity (@1@) when the stream is empty. The fold terminates@@ -730,14 +641,7 @@ -- {-# 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+product = fromScanl Scanl.product  ------------------------------------------------------------------------------ -- To Summary (Maybe)@@ -803,6 +707,16 @@ minimum :: (Monad m, Ord a) => Fold m a (Maybe a) minimum = foldl1' min +{-# INLINE rangeBy #-}+rangeBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe (a, a))+rangeBy cmp = fromScanl (Scanl.rangeBy cmp)++-- | Find minimum and maximum elements i.e. (min, max).+--+{-# INLINE range #-}+range :: (Monad m, Ord a) => Fold m a (Maybe (a, a))+range = fromScanl Scanl.range+ ------------------------------------------------------------------------------ -- To Summary (Statistical) ------------------------------------------------------------------------------@@ -812,17 +726,7 @@ -- {-# 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+mean = fromScanl Scanl.mean  -- | Compute a numerically stable (population) variance over all elements in -- the input stream.@@ -868,18 +772,7 @@ -- {-# 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+rollingHashWithSalt = fromScanl . Scanl.rollingHashWithSalt  -- | Compute an 'Int' sized polynomial rolling hash of a stream. --@@ -887,7 +780,7 @@ -- {-# INLINE rollingHash #-} rollingHash :: (Monad m, Enum a) => Fold m a Int64-rollingHash = rollingHashWithSalt defaultSalt+rollingHash = fromScanl Scanl.rollingHash  -- | Compute an 'Int' sized polynomial rolling hash of the first n elements of -- a stream.@@ -897,7 +790,7 @@ -- /Pre-release/ {-# INLINE rollingHashFirstN #-} rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64-rollingHashFirstN n = take n rollingHash+rollingHashFirstN = fromScanl . Scanl.rollingHashFirstN  -- XXX Compare this with the implementation in Fold.Window, preferrably use the -- latter if performance is good.@@ -911,26 +804,14 @@ -- {-# 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+rollingMapM = fromScanl . Scanl.rollingMapM  -- | -- >>> 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)+rollingMap = fromScanl . Scanl.rollingMap  ------------------------------------------------------------------------------ -- Monoidal left folds@@ -949,7 +830,7 @@ -- {-# INLINE sconcat #-} sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-sconcat = foldl' (<>)+sconcat = fromScanl . Scanl.sconcat  -- | Monoid concat. Fold an input stream consisting of monoidal elements using -- 'mappend' and 'mempty'.@@ -966,7 +847,7 @@ mconcat ::     ( Monad m     , Monoid a) => Fold m a a-mconcat = sconcat mempty+mconcat = fromScanl Scanl.mconcat  -- | -- Definition:@@ -982,7 +863,7 @@ -- {-# INLINE foldMap #-} foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b-foldMap f = lmap f mconcat+foldMap = fromScanl . Scanl.foldMap  -- | -- Definition:@@ -998,36 +879,7 @@ -- {-# 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 (:)) []+foldMapM = fromScanl . Scanl.foldMapM  ------------------------------------------------------------------------------ -- Partial Folds@@ -1043,7 +895,7 @@ -- /Pre-release/ {-# INLINE drainN #-} drainN :: Monad m => Int -> Fold m a ()-drainN n = take n drain+drainN = fromScanl . Scanl.drainN  ------------------------------------------------------------------------------ -- To Elements@@ -1052,9 +904,9 @@ -- | 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)+{-# INLINE genericIndex #-}+genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)+genericIndex i = foldt' step (Partial 0) (const Nothing)      where @@ -1067,11 +919,11 @@ -- -- Definition: ----- >>> index = Fold.indexGeneric+-- >>> index = Fold.genericIndex -- {-# INLINE index #-} index :: Monad m => Int -> Fold m a (Maybe a)-index = indexGeneric+index = genericIndex  -- | Consume a single input and transform it using the supplied 'Maybe' -- returning function.@@ -1208,16 +1060,7 @@ -- {-# 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)+findIndices = fromScanl . Scanl.findIndices  -- | Returns the index of the latest element if the element matches the given -- value.@@ -1228,7 +1071,7 @@ -- {-# INLINE elemIndices #-} elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)-elemIndices a = findIndices (== a)+elemIndices = fromScanl . Scanl.elemIndices  -- | Returns the first index where a given value is found in the stream. --@@ -1337,7 +1180,7 @@ -- {-# INLINE and #-} and :: Monad m => Fold m Bool Bool-and = all (== True)+and = all id  -- | Returns 'True' if any element is 'True', 'False' otherwise --@@ -1347,7 +1190,7 @@ -- {-# INLINE or #-} or :: Monad m => Fold m Bool Bool-or = any (== True)+or = any id  ------------------------------------------------------------------------------ -- Grouping/Splitting@@ -1486,13 +1329,13 @@ -- Binary splitting on a separator ------------------------------------------------------------------------------ -data SplitOnSeqState acc a rb rh w ck =+data SplitOnSeqState mba acc a 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+    | SplitOnSeqKR !acc !Int !mba+    | SplitOnSeqKRLoop !acc !ck !mba !rh  -- XXX Need to add tests for takeEndBySeq, we have tests for takeEndBySeq_ . @@ -1500,17 +1343,22 @@ -- 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+-- >>> s = Stream.fromList "Gauss---Euler---Noether"+-- >>> f = Fold.takeEndBySeq (Array.fromList "---") Fold.toList -- >>> Stream.fold f s--- "hello there"+-- "Gauss---" -- -- >>> Stream.fold Fold.toList $ Stream.foldMany f s--- ["hello there",". How are"," you?"]+-- ["Gauss---","Euler---","Noether"] --+-- Uses Rabin-Karp algorithm for substring search.+--+-- See also: 'Streamly.Data.Stream.splitOnSeq' and+-- 'Streamly.Data.Stream.splitEndBySeq'.+-- -- /Pre-release/ {-# INLINE takeEndBySeq #-}-takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>+takeEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>        Array.Array a     -> Fold m a b     -> Fold m a b@@ -1520,6 +1368,9 @@     where      patLen = Array.length patArr+    patBytes = Array.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)      initial = do         res <- finitial@@ -1531,18 +1382,17 @@                     -- Done <$> ffinal acc                     return $ Partial $ SplitOnSeqEmpty acc                 | patLen == 1 -> do-                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr+                    pat <- liftIO $ Array.unsafeGetIndexIO 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+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MA.emptyOf patLen+                    return $ Partial $ SplitOnSeqKR acc 0 mba             Done b -> return $ Done b      -- Word pattern related-    maxIndex = patLen - 1-     elemBits = SIZE_OF(a) * 8      wordMask :: Word@@ -1603,31 +1453,44 @@                 | otherwise ->                     return $ Partial $ SplitOnSeqWordLoop s1 wrd1             Done b -> return $ Done b-    step (SplitOnSeqKR s idx rb rh) x = do+    step (SplitOnSeqKR s offset mba) x = do         res <- fstep s x         case res of             Partial s1 -> do-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                if idx == maxIndex+                liftIO $ pokeAt offset mba x+                if offset == maxOffset                 then do-                    let fld = Ring.unsafeFoldRing (Ring.ringBound rb)-                    let !ringHash = fld addCksum 0 rb-                    if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+                    let arr :: Array a = Array+                                { arrContents = mba+                                , arrStart = 0+                                , arrEnd = patBytes+                                }+                    let ringHash = Array.foldl' addCksum 0 arr+                    if ringHash == patHash && Array.byteEq arr patArr                     then Done <$> ffinal s1-                    else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1+                    else return $ Partial $ SplitOnSeqKRLoop s1 ringHash mba 0                 else-                    return $ Partial $ SplitOnSeqKR s1 (idx + 1) rb rh1+                    return $ Partial $ SplitOnSeqKR s1 (offset + SIZE_OF(a)) mba             Done b -> return $ Done b-    step (SplitOnSeqKRLoop s cksum rb rh) x = do+    step (SplitOnSeqKRLoop s cksum mba offset) x = do         res <- fstep s x         case res of             Partial s1 -> do-                old <- liftIO $ peek rh-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x+                let rb = RingArray+                        { ringContents = mba+                        , ringSize = patBytes+                        , ringHead = offset+                        }+                (rb1, old :: a) <- liftIO (RingArray.replace rb x)                 let ringHash = deltaCksum cksum old x-                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+                let rh1 = ringHead rb1+                matches <-+                    if ringHash == patHash+                    then liftIO $ RingArray.eqArray rb1 patArr+                    else return False+                if matches                 then Done <$> ffinal s1-                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1+                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash mba rh1             Done b -> return $ Done b      extractFunc fex state =@@ -1637,20 +1500,31 @@                     SplitOnSeqSingle s _ -> s                     SplitOnSeqWord s _ _ -> s                     SplitOnSeqWordLoop s _ -> s-                    SplitOnSeqKR s _ _ _ -> s+                    SplitOnSeqKR s _ _ -> s                     SplitOnSeqKRLoop s _ _ _ -> s         in fex st -    extract state = extractFunc fextract state+    extract = extractFunc fextract -    final state = extractFunc ffinal state+    final = extractFunc ffinal  -- | Like 'takeEndBySeq' but discards the matched sequence. --+-- >>> s = Stream.fromList "Gauss---Euler---Noether"+-- >>> f = Fold.takeEndBySeq_ (Array.fromList "---") Fold.toList+-- >>> Stream.fold f s+-- "Gauss"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany f s+-- ["Gauss","Euler","Noether"]+--+-- See also: 'Streamly.Data.Stream.splitOnSeq' and+-- 'Streamly.Data.Stream.splitEndBySeq_'.+-- -- /Pre-release/ -- {-# INLINE takeEndBySeq_ #-}-takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>+takeEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>        Array.Array a     -> Fold m a b     -> Fold m a b@@ -1660,6 +1534,9 @@     where      patLen = Array.length patArr+    patBytes = Array.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)      initial = do         res <- finitial@@ -1671,19 +1548,18 @@                     -- Done <$> ffinal acc                     return $ Partial $ SplitOnSeqEmpty acc                 | patLen == 1 -> do-                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr+                    pat <- liftIO $ Array.unsafeGetIndexIO 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+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MA.emptyOf patLen+                    return $ Partial $ SplitOnSeqKR acc 0 mba             Done b -> return $ Done b      -- Word pattern related-    maxIndex = patLen - 1-     elemBits = SIZE_OF(a) * 8      wordMask :: Word@@ -1746,26 +1622,39 @@                 | 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+    step (SplitOnSeqKR s offset mba) x = do+        liftIO $ pokeAt offset mba x+        if offset == maxOffset         then do-            let fld = Ring.unsafeFoldRing (Ring.ringBound rb)-            let !ringHash = fld addCksum 0 rb-            if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr+            let arr :: Array a = Array+                        { arrContents = mba+                        , arrStart = 0+                        , arrEnd = patBytes+                        }+            let ringHash = Array.foldl' addCksum 0 arr+            if ringHash == patHash && Array.byteEq arr 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+            else return $ Partial $ SplitOnSeqKRLoop s ringHash mba 0+        else return $ Partial $ SplitOnSeqKR s (offset + SIZE_OF(a)) mba+    step (SplitOnSeqKRLoop s cksum mba offset) x = do+        let rb = RingArray+                { ringContents = mba+                , ringSize = patBytes+                , ringHead = offset+                }+        (rb1, old :: a) <- liftIO (RingArray.replace rb x)         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+                let rh1 = ringHead rb1+                matches <-+                    if ringHash == patHash+                    then liftIO $ RingArray.eqArray rb1 patArr+                    else return False+                if matches                 then Done <$> ffinal s1-                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1+                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash mba rh1             Done b -> return $ Done b      -- XXX extract should return backtrack count as well. If the fold@@ -1783,28 +1672,45 @@                         Partial s1 -> consumeWord s1 (n - 1) wrd                         Done b -> return b -        let consumeRing s n rb rh =-                if n == 0+        let consumeArray s end mba offset =+                if offset == end                 then fex s                 else do-                    old <- liftIO $ peek rh-                    let rh1 = Ring.advance rb rh+                    old <- liftIO $ peekAt offset mba                     r <- fstep s old                     case r of-                        Partial s1 -> consumeRing s1 (n - 1) rb rh1+                        Partial s1 ->+                            consumeArray s1 end mba (offset + SIZE_OF(a))                         Done b -> return b +        let consumeRing s orig mba offset = do+                let rb :: RingArray a = RingArray+                            { ringContents = mba+                            , ringSize = patBytes+                            , ringHead = offset+                            }+                old <- RingArray.unsafeGetHead rb+                let rb1 = RingArray.moveForward rb+                r <- fstep s old+                case r of+                    Partial s1 ->+                        let rh = ringHead rb1+                         in if rh == orig+                            then fex s1+                            else consumeRing s1 orig mba rh+                    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+            SplitOnSeqKR s end mba -> consumeArray s end mba 0+            SplitOnSeqKRLoop s _ mba rh -> consumeRing s rh mba rh -    extract state = extractFunc fextract state+    extract = extractFunc fextract -    final state = extractFunc ffinal state+    final = extractFunc ffinal  ------------------------------------------------------------------------------ -- Distributing@@ -1834,7 +1740,7 @@  -- 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.+-- Unboxs 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.@@ -1861,6 +1767,51 @@ distribute :: Monad m => [Fold m a b] -> Fold m a [b] distribute = Prelude.foldr (teeWith (:)) (fromPure []) +-- XXX use mutable cells for better performance.++-- | Distribute the input to the folds returned by an effect. The effect is+-- executed every time an input is processed, and the folds returned by it are+-- added to the distribution list. The scan returns the results of the folds as+-- they complete. To avoid adding the same folds repeatedly, the action must+-- return the folds only once e.g. it can be implemented using modifyIORef+-- replacing the original value by an empty list before returning it.+--+-- >>> import Data.IORef+-- >>> ref <- newIORef [Fold.take 2 Fold.sum, Fold.take 2 Fold.length :: Fold IO Int Int]+-- >>> gen = atomicModifyIORef ref (\xs -> ([], xs))+-- >>> Stream.toList $ Stream.scanl (Fold.distributeScan gen) (Stream.enumerateFromTo 1 10)+-- [[],[],[],[2,3],[],[],[],[],[],[],[]]+--+{-# INLINE distributeScan #-}+distributeScan :: Monad m => m [Fold m a b] -> Scanl m a [b]+distributeScan getFolds = Scanl consume initial extract final++    where++    initial = return $ Partial (Tuple' [] [])++    run st [] _ = return $ Partial st+    run (Tuple' ys zs) (Fold step init extr fin : xs) a = do+        res <- init+        case res of+            Partial fs -> do+              r <- step fs a+              run (Tuple' (Fold step (return r) extr fin : ys) zs) xs a+            Done b -> do+              run (Tuple' ys (b : zs)) xs a++    consume (Tuple' st _) x = do+        xs <- getFolds+        xs1 <- Prelude.mapM reduce xs+        let st1 = st ++ xs1+        run (Tuple' [] []) st1 x++    extract (Tuple' _ done) = return done++    final (Tuple' st done) = do+        Prelude.mapM_ finalM st+        return done+ ------------------------------------------------------------------------------ -- Partitioning ------------------------------------------------------------------------------@@ -1902,6 +1853,8 @@ -- -- Example, send input to the two folds in a proportion of 2:1: --+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial -- >>> :{ -- proportionately m n = do --  ref <- newIORef $ cycle $ concat [replicate m Left, replicate n Right]@@ -2112,6 +2065,7 @@  -- | Pair each element of a fold input with its index, starting from index 0. --+{-# DEPRECATED indexingWith "Use Scanl.indexingWith instead" #-} {-# INLINE indexingWith #-} indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a)) indexingWith i f = fmap toMaybe $ foldl' step initial@@ -2124,26 +2078,28 @@     step (Just' (n, _)) a = Just' (f n, a)  -- |--- >>> indexing = Fold.indexingWith 0 (+ 1)+-- >> indexing = Fold.indexingWith 0 (+ 1) --+{-# DEPRECATED indexing "Use Scanl.indexing instead" #-} {-# INLINE indexing #-} indexing :: Monad m => Fold m a (Maybe (Int, a)) indexing = indexingWith 0 (+ 1)  -- |--- >>> indexingRev n = Fold.indexingWith n (subtract 1)+-- >> indexingRev n = Fold.indexingWith n (subtract 1) --+{-# DEPRECATED indexingRev "Use Scanl.indexingRev instead" #-} {-# 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+-- >>> indexed = Fold.postscanlMaybe Scanl.indexing -- {-# INLINE indexed #-} indexed :: Monad m => Fold m (Int, a) b -> Fold m a b-indexed = scanMaybe indexing+indexed = postscanlMaybe Scanl.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@@ -2217,7 +2173,7 @@ -- /Pre-release/ {-# INLINE toStream #-} toStream :: (Monad m, Monad n) => Fold m a (Stream n a)-toStream = fmap StreamD.fromList toList+toStream = fromScanl Scanl.toStream  -- This is more efficient than 'toStream'. toStream is exactly the same as -- reversing the stream after toStreamRev.@@ -2235,7 +2191,7 @@ --  xn : ... : x2 : x1 : [] {-# INLINE toStreamRev #-} toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)-toStreamRev = fmap StreamD.fromList toListRev+toStreamRev = fromScanl Scanl.toStreamRev  -- 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.@@ -2277,32 +2233,7 @@        (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+bottomBy cmp = fromScanl . Scanl.bottomBy cmp  -- | Get the top @n@ elements using the supplied comparison function. --@@ -2338,7 +2269,7 @@ -- /Pre-release/ {-# INLINE top #-} top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)-top = bottomBy $ flip compare+top = fromScanl . Scanl.top  -- | Fold the input stream to bottom n elements. --@@ -2353,7 +2284,7 @@ -- /Pre-release/ {-# INLINE bottom #-} bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)-bottom = bottomBy compare+bottom = fromScanl . Scanl.bottom  ------------------------------------------------------------------------------ -- Interspersed parsing
src/Streamly/Internal/Data/Fold/Container.hs view
@@ -1,3 +1,11 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-}++{-# OPTIONS_GHC -Wno-deprecations #-}+ -- | -- Module      : Streamly.Internal.Data.Fold.Container -- Copyright   : (c) 2019 Composewell Technologies@@ -14,8 +22,8 @@     , toIntSet     , countDistinct     , countDistinctInt-    , nub-    , nubInt+    , nub -- XXX deprecate in favor of scan+    , nubInt -- XXX deprecate in favor of scan      -- * Map operations     , frequency@@ -29,12 +37,12 @@     -- 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+    -- | Use key specific folds to fold corresponding values to a key-value+    -- container.+    , demuxerToContainer+    , demuxerToContainerIO+    , demuxerToMap+    , demuxerToMapIO      -- *** Input is explicit key-value tuple     -- | Like above but inputs are in explicit key-value pair form.@@ -42,13 +50,13 @@     , 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-    , demuxIO+    -- | Use key specific folds to fold corresponding values to a key-value+    -- stream, restarts the fold again after it terminates, thus resulting in a+    -- stream of values for each key.+    , demuxScanGeneric+    , demuxScan+    , demuxScanGenericIO+    , demuxScanIO      -- TODO: These can be implemented using the above operations     -- , demuxSel -- Stop when the fold for the specified key stops@@ -75,12 +83,27 @@     , toMap     , toMapIO +    , classifyScanGeneric+    , classifyScan+    , classifyScanGenericIO+    , classifyScanIO+    -- , toContainerSel+    -- , toContainerMin++    -- * Deprecated+    , demuxGeneric+    , demux+    , demuxGenericIO+    , demuxIO+    , demuxToContainer+    , demuxToContainerIO+    , demuxToMap+    , demuxToMapIO+     , classifyGeneric     , classify     , classifyGenericIO     , classifyIO-    -- , toContainerSel-    -- , toContainerMin     ) where @@ -93,25 +116,17 @@ import Data.IntSet (IntSet) import Data.Set (Set) import Streamly.Internal.Data.IsMap (IsMap(..))+import Streamly.Internal.Data.Scanl.Type (Scanl(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..)) -import qualified Data.IntSet as IntSet import qualified Data.Set as Set import qualified Streamly.Internal.Data.IsMap as IsMap+import qualified Streamly.Internal.Data.Scanl.Container as Scanl  import Prelude hiding (Foldable(..)) import Streamly.Internal.Data.Fold.Type-import Streamly.Internal.Data.Fold.Combinators --- $setup--- >>> :m--- >>> :set -XFlexibleContexts--- >>> import qualified Data.Map as Map--- >>> import qualified Data.Set as Set--- >>> import qualified Data.IntSet as IntSet--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Fold.Container as Fold+#include "DocTestDataFold.hs"  -- | Fold the input to a set. --@@ -121,7 +136,7 @@ -- {-# INLINE toSet #-} toSet :: (Monad m, Ord a) => Fold m a (Set a)-toSet = foldl' (flip Set.insert) Set.empty+toSet = fromScanl Scanl.toSet  -- | Fold the input to an int set. For integer inputs this performs better than -- 'toSet'.@@ -132,7 +147,7 @@ -- {-# INLINE toIntSet #-} toIntSet :: Monad m => Fold m Int IntSet-toIntSet = foldl' (flip IntSet.insert) IntSet.empty+toIntSet = fromScanl Scanl.toIntSet  -- XXX Name as nubOrd? Or write a nubGeneric @@ -142,38 +157,21 @@ -- Example: -- -- >>> stream = Stream.fromList [1::Int,1,2,3,4,4,5,1,5,7]--- >>> Stream.fold Fold.toList $ Stream.scanMaybe Fold.nub stream+--+-- >> Stream.toList $ Stream.scanMaybe Fold.nub stream -- [1,2,3,4,5,7] -- -- /Pre-release/ {-# INLINE nub #-} nub :: (Monad m, Ord a) => Fold m a (Maybe a)-nub = fmap (\(Tuple' _ x) -> x) $ foldl' step initial--    where--    initial = Tuple' Set.empty Nothing--    step (Tuple' set _) x =-        if Set.member x set-        then Tuple' set Nothing-        else Tuple' (Set.insert x set) (Just x)+nub = fromScanl Scanl.nub  -- | Like 'nub' but specialized to a stream of 'Int', for better performance. -- -- /Pre-release/ {-# INLINE nubInt #-} nubInt :: Monad m => Fold m Int (Maybe Int)-nubInt = fmap (\(Tuple' _ x) -> x) $ foldl' step initial--    where--    initial = Tuple' IntSet.empty Nothing--    step (Tuple' set _) x =-        if IntSet.member x set-        then Tuple' set Nothing-        else Tuple' (IntSet.insert x set) (Just x)+nubInt = fromScanl Scanl.nubInt  -- XXX Try Hash set -- XXX Add a countDistinct window fold@@ -184,7 +182,7 @@ -- Definition: -- -- >>> countDistinct = fmap Set.size Fold.toSet--- >>> countDistinct = Fold.postscan Fold.nub $ Fold.catMaybes $ Fold.length+-- >>> countDistinct = Fold.postscanl Scanl.nub $ Fold.catMaybes $ Fold.length -- -- The memory used is proportional to the number of distinct elements in the -- stream, to guard against using too much memory use it as a scan and@@ -197,7 +195,7 @@ {-# INLINE countDistinct #-} countDistinct :: (Monad m, Ord a) => Fold m a Int -- countDistinct = postscan nub $ catMaybes length-countDistinct = fmap Set.size toSet+countDistinct = fromScanl Scanl.countDistinct {- countDistinct = fmap (\(Tuple' _ n) -> n) $ foldl' step initial @@ -220,13 +218,13 @@ -- Definition: -- -- >>> countDistinctInt = fmap IntSet.size Fold.toIntSet--- >>> countDistinctInt = Fold.postscan Fold.nubInt $ Fold.catMaybes $ Fold.length+-- >>> countDistinctInt = Fold.postscanl Scanl.nubInt $ Fold.catMaybes $ Fold.length -- -- /Pre-release/ {-# INLINE countDistinctInt #-} countDistinctInt :: Monad m => Fold m Int Int -- countDistinctInt = postscan nubInt $ catMaybes length-countDistinctInt = fmap IntSet.size toIntSet+countDistinctInt = fromScanl Scanl.countDistinctInt {- countDistinctInt = fmap (\(Tuple' _ n) -> n) $ foldl' step initial @@ -256,15 +254,19 @@ -- -- XXX If we use Refold in it, it can perhaps fuse/be more efficient. For -- example we can store just the result rather than storing the whole fold in--- the Map.+-- the Map. This would be similar to a refold based classify. -- -- Note: There are separate functions to determine Key and Fold from the input -- because key is to be determined on each input whereas fold is to be -- determined only once for a key.+--+-- XXX Should we use (k -> m (Fold m a b)) instead since the fold is key+-- specific? This should give better safety.  -- | This is the most general of all demux, classify operations. -- -- See 'demux' for documentation.+{-# DEPRECATED demuxGeneric "Use demuxScanGeneric instead" #-} {-# INLINE demuxGeneric #-} demuxGeneric :: (Monad m, IsMap f, Traversable f) =>        (a -> Key f)@@ -289,7 +291,11 @@                             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))+            Done b ->+                -- Done in "initial" is possible only for the very first time+                -- the fold is initialized, and in that case we have not yet+                -- inserted it in the Map, so we do not need to delete it.+                return $ Tuple' kv (Just (k, b))      step (Tuple' kv _) a = do         let k = getKey a@@ -319,6 +325,130 @@                 Partial s -> fin s                 _ -> error "demuxGeneric: unreachable code" +-- XXX There seem to be a significant difference in demux and classify. In+-- demux once a key is done we again restart it and give the result of the+-- last one. In classify, we do not restart once it is done. To keep it+-- simple we should use the classify behavior.++-- | This is the most general of all demux, classify operations.+--+-- See 'demux' for documentation.+{-# INLINE demuxerToContainer #-}+demuxerToContainer :: (Monad m, IsMap f, Traversable f) =>+       (a -> Key f)+    -> (Key f -> m (Maybe (Fold m a b)))+    -> Fold m a (f b)+demuxerToContainer getKey getFold =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) undefined final++    where++    initial = return $ Tuple' IsMap.mapEmpty IsMap.mapEmpty++    {-# INLINE runFold #-}+    runFold kv kv1 (Fold step1 initial1 _ final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                return+                    $ case res1 of+                        Partial _ ->+                            let fld = Fold step1 (return res1) undefined final1+                             in Tuple' (IsMap.mapInsert k fld kv) kv1+                        Done b ->+                            Tuple'+                                (IsMap.mapDelete k kv)+                                (IsMap.mapInsert k b kv1)+            Done b ->+                -- Done in "initial" is possible only for the very first time+                -- the fold is initialized, and in that case we have not yet+                -- inserted it in the Map, so we do not need to delete it.+                return $ Tuple' kv (IsMap.mapInsert k b kv1)++    step (Tuple' kv kv1) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                mfld <- getFold k+                case mfld of+                    Nothing -> pure $ Tuple' kv kv1+                    Just fld -> runFold kv kv1 fld (k, a)+            Just f -> runFold kv kv1 f (k, a)++    final (Tuple' kv kv1) = do+        r <- Prelude.mapM f kv+        return $ IsMap.mapUnion r kv1++        where++        f (Fold _ i _ fin) = do+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxerToContainer: unreachable code"++-- | Scanning variant of 'demuxerToContainer'.+{-# INLINE demuxScanGeneric #-}+demuxScanGeneric :: (Monad m, IsMap f, Traversable f) =>+       (a -> Key f)+    -> (Key f -> m (Maybe (Fold m a b)))+    -> Scanl m a (m (f b), Maybe (Key f, b))+demuxScanGeneric getKey getFold =+    Scanl (\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 final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                return+                    $ case res1 of+                        Partial _ ->+                            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 ->+                -- Done in "initial" is possible only for the very first time+                -- the fold is initialized, and in that case we have not yet+                -- inserted it in the Map, so we do not need to delete it.+                return $ Tuple' kv (Just (k, b))++    step (Tuple' kv _) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                mfld <- getFold k+                case mfld of+                    Nothing -> pure $ Tuple' kv Nothing+                    Just fld -> runFold kv fld (k, a)+            Just f -> runFold kv f (k, a)++    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f (Fold _ i e _) = do+            r <- i+            case r of+                Partial s -> e s+                _ -> error "demuxGeneric: unreachable code"++    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@@ -345,6 +475,7 @@ -- -- /Pre-release/ --+{-# DEPRECATED demux "Use demuxScan instead" #-} {-# INLINE demux #-} demux :: (Monad m, Ord k) =>        (a -> k)@@ -352,8 +483,28 @@     -> Fold m a (m (Map k b), Maybe (k, b)) demux = demuxGeneric +{-# INLINE demuxUsingMap #-}+demuxUsingMap :: (Monad m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Fold m a b)))+    -> Scanl m a (m (Map k b), Maybe (k, b))+demuxUsingMap = demuxScanGeneric++-- | Scanning variant of 'demuxerToMap'.+--+-- TODO: To drain the final in-progress folds this requires the drain step of+-- Scanl to be streaming.+--+{-# INLINE demuxScan #-}+demuxScan :: (Monad m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Fold m a b)))+    -> Scanl m a (Maybe (k, b))+demuxScan getKey = fmap snd . demuxUsingMap getKey+ -- | This is specialized version of 'demuxGeneric' that uses mutable IO cells -- as fold accumulators for better performance.+{-# DEPRECATED demuxGenericIO "Use demuxScanGenericIO instead" #-} {-# INLINE demuxGenericIO #-} demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) =>        (a -> Key f)@@ -374,6 +525,9 @@                 res1 <- step1 s a                 case res1 of                     Partial _ -> do+                        -- XXX Instead of using a Fold type here use a custom+                        -- type with an IORef (possibly unboxed) for the+                        -- accumulator. That will reduce the allocations.                         let fld = Fold step1 (return res1) extract1 final1                         ref <- liftIO $ newIORef fld                         return $ Tuple' (IsMap.mapInsert k ref kv) Nothing@@ -428,12 +582,170 @@                 Partial s -> fin s                 _ -> error "demuxGenericIO: unreachable code" +-- | This is a specialized version of 'demuxToContainer' that uses mutable IO cells+-- as fold accumulators for better performance.+{-# INLINE demuxerToContainerIO #-}+demuxerToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>+       (a -> Key f)+    -> (Key f -> m (Maybe (Fold m a b)))+    -> Fold m a (f b)+demuxerToContainerIO getKey getFold =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) undefined final++    where++    initial = return $ Tuple' IsMap.mapEmpty IsMap.mapEmpty++    {-# INLINE initFold #-}+    initFold kv kv1 (Fold step1 initial1 _ final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                case res1 of+                    Partial _ -> do+                        -- XXX Instead of using a Fold type here use a custom+                        -- type with an IORef (possibly unboxed) for the+                        -- accumulator. That will reduce the allocations.+                        let fld = Fold step1 (return res1) undefined final1+                        ref <- liftIO $ newIORef fld+                        return $ Tuple' (IsMap.mapInsert k ref kv) kv1+                    Done b -> return $ Tuple' kv (IsMap.mapInsert k b kv1)+            Done b -> return $ Tuple' kv (IsMap.mapInsert k b kv1)++    {-# INLINE runFold #-}+    runFold kv kv1 ref (Fold step1 initial1 _ 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) undefined final1+                            liftIO $ writeIORef ref fld+                            return $ Tuple' kv kv1+                        Done b ->+                            let r = IsMap.mapDelete k kv+                             in return $ Tuple' r (IsMap.mapInsert k b kv1)+            Done _ -> error "demuxGenericIO: unreachable"++    step (Tuple' kv kv1) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                res <- getFold k+                case res of+                    Nothing -> pure $ Tuple' kv kv1+                    Just f -> initFold kv kv1 f (k, a)+            Just ref -> do+                f <- liftIO $ readIORef ref+                runFold kv kv1 ref f (k, a)++    final (Tuple' kv kv1) = do+        r <- Prelude.mapM f kv+        return $ IsMap.mapUnion r kv1++        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 a 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 demuxScanGenericIO #-}+demuxScanGenericIO :: (MonadIO m, IsMap f, Traversable f) =>+       (a -> Key f)+    -> (Key f -> m (Maybe (Fold m a b)))+    -> Scanl m a (m (f b), Maybe (Key f, b))+demuxScanGenericIO getKey getFold =+    Scanl (\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 final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                case res1 of+                    Partial _ -> do+                        -- XXX Instead of using a Fold type here use a custom+                        -- type with an IORef (possibly unboxed) for the+                        -- accumulator. That will reduce the allocations.+                        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 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 final1+                            liftIO $ writeIORef ref fld+                            return $ Tuple' kv Nothing+                        Done b ->+                            let kv1 = IsMap.mapDelete k kv+                             in return $ Tuple' kv1 (Just (k, b))+            Done _ -> error "demuxGenericIO: unreachable"++    step (Tuple' kv _) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                res <- getFold k+                case res of+                    Nothing -> pure $ Tuple' kv Nothing+                    Just f -> initFold kv f (k, a)+            Just ref -> do+                f <- liftIO $ readIORef ref+                runFold kv ref f (k, a)++    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f ref = do+            Fold _ i e _ <- liftIO $ readIORef ref+            r <- i+            case r of+                Partial s -> e s+                _ -> 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. --+{-# DEPRECATED demuxIO "Use demuxScanIO instead" #-} {-# INLINE demuxIO #-} demuxIO :: (MonadIO m, Ord k) =>        (a -> k)@@ -441,6 +753,26 @@     -> Fold m a (m (Map k b), Maybe (k, b)) demuxIO = demuxGenericIO +{-# INLINE demuxUsingMapIO #-}+demuxUsingMapIO :: (MonadIO m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Fold m a b)))+    -> Scanl m a (m (Map k b), Maybe (k, b))+demuxUsingMapIO = demuxScanGenericIO++-- | This is a specialized version of 'demuxScan' that uses mutable IO cells as+-- scan accumulators for better performance.+--+-- TODO: To drain the final in-progress folds this requires the drain step of+-- Scanl to be streaming.+--+{-# INLINE demuxScanIO #-}+demuxScanIO :: (MonadIO m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Fold m a b)))+    -> Scanl m a (Maybe (k, b))+demuxScanIO getKey = fmap snd . demuxUsingMapIO getKey+ -- | 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 #-}@@ -448,6 +780,7 @@ kvToMapOverwriteGeneric =     foldl' (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty +{-# DEPRECATED demuxToContainer "Use demuxerToContainer instead" #-} {-# INLINE demuxToContainer #-} demuxToContainer :: (Monad m, IsMap f, Traversable f) =>     (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)@@ -464,11 +797,42 @@  -- | This collects all the results of 'demux' in a Map. --+{-# DEPRECATED demuxToMap "Use demuxerToMap instead" #-} {-# INLINE demuxToMap #-} demuxToMap :: (Monad m, Ord k) =>     (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b) demuxToMap = demuxToContainer +-- | @demuxerToMap 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.+--+-- 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 combinator can be used to scan a stream and collect the results from+-- the scan output.+--+-- Since the fold generator function is monadic, folds for new keys can be+-- added dynamically or folds for old keys can be deleted or modified. 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.+--+-- Note that this fold never terminates. Inputs that do not correspond to a+-- fold in the map are dropped.+--+-- Compare with 'classify', the fold in 'classify' is a static fold.+--+-- /Pre-release/+--+{-# INLINE demuxerToMap #-}+demuxerToMap :: (Monad m, Ord k) =>+    (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)+demuxerToMap = demuxerToContainer++{-# DEPRECATED demuxToContainerIO "Use demuxerToContainerIO instead" #-} {-# INLINE demuxToContainerIO #-} demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>     (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)@@ -485,28 +849,36 @@  -- | Same as 'demuxToMap' but uses 'demuxIO' for better performance. --+{-# DEPRECATED demuxToMapIO "Use demuxerToMapIO instead" #-} {-# INLINE demuxToMapIO #-} demuxToMapIO :: (MonadIO m, Ord k) =>     (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b) demuxToMapIO = demuxToContainerIO +-- | Same as 'demuxerToMap' but uses mutable cells for better performance.+--+{-# INLINE demuxerToMapIO #-}+demuxerToMapIO :: (MonadIO m, Ord k) =>+    (a -> k) -> (k -> m (Maybe (Fold m a b))) -> Fold m a (Map k b)+demuxerToMapIO = demuxerToContainerIO+ {-# INLINE demuxKvToContainer #-} demuxKvToContainer :: (Monad m, IsMap f, Traversable f) =>-    (Key f -> m (Fold m a b)) -> Fold m (Key f, a) (f b)-demuxKvToContainer f = demuxToContainer fst (\(k, _) -> fmap (lmap snd) (f k))+    (Key f -> m (Maybe (Fold m a b))) -> Fold m (Key f, a) (f b)+demuxKvToContainer f = demuxerToContainer fst (fmap (fmap (lmap snd)) . f)  -- | Fold a stream of key value pairs using a function that maps keys to folds. -- -- Definition: ----- >>> demuxKvToMap f = Fold.demuxToContainer fst (Fold.lmap snd . f)+-- >>> demuxKvToMap f = Fold.demuxerToContainer fst (Fold.lmap snd . f) -- -- Example: -- -- >>> import Data.Map (Map) -- >>> :{---  let f "SUM" = return Fold.sum---      f _ = return Fold.product+--  let f "SUM" = return (Just Fold.sum)+--      f _ = return (Just Fold.product) --      input = Stream.fromList [("SUM",1),("PRODUCT",2),("SUM",3),("PRODUCT",4)] --   in Stream.fold (Fold.demuxKvToMap f) input :: IO (Map String Int) -- :}@@ -515,7 +887,7 @@ -- /Pre-release/ {-# INLINE demuxKvToMap #-} demuxKvToMap :: (Monad m, Ord k) =>-    (k -> m (Fold m a b)) -> Fold m (k, a) (Map k b)+    (k -> m (Maybe (Fold m a b))) -> Fold m (k, a) (Map k b) demuxKvToMap = demuxKvToContainer  ------------------------------------------------------------------------------@@ -528,6 +900,10 @@ -- done then initial would set a flag in the state to ignore the input or -- return an error. +-- XXX Use a Refold m k a b so that we can make the fold key specifc.+-- XXX Is using a function (a -> k) better than using the input (k,a)?++{-# DEPRECATED classifyGeneric "Use classifyScanGeneric instead" #-} {-# INLINE classifyGeneric #-} classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>     -- Note: we need to return the Map itself to display the in-progress values@@ -581,9 +957,116 @@          f1 k s = do             if Set.member k set+            -- XXX Why are we doing this? If it is in the set then it will not+            -- be in the map and vice-versa.             then extract1 s             else final1 s +{-# INLINE toContainer #-}+toContainer :: (Monad m, IsMap f, Traversable f) =>+    (a -> Key f) -> Fold m a b -> Fold m a (f b)+toContainer f (Fold step1 initial1 _ final1) =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) undefined final++    where++    initial = return $ Tuple' IsMap.mapEmpty IsMap.mapEmpty++    {-# INLINE initFold #-}+    initFold kv kv1 k a = do+        x <- initial1+        case x of+              Partial s -> do+                r <- step1 s a+                return+                    $ case r of+                          Partial s1 ->+                            Tuple' (IsMap.mapInsert k s1 kv) kv1+                          Done b ->+                            Tuple' kv (IsMap.mapInsert k b kv1)+              Done b -> return (Tuple' kv (IsMap.mapInsert k b kv1))++    step (Tuple' kv kv1) a = do+        let k = f a+        case IsMap.mapLookup k kv of+            Nothing -> do+                case IsMap.mapLookup k kv1 of+                    Nothing -> initFold kv kv1 k a+                    Just _ -> return (Tuple' kv kv1)+            Just s -> do+                r <- step1 s a+                return+                    $ case r of+                          Partial s1 ->+                            Tuple' (IsMap.mapInsert k s1 kv) kv1+                          Done b ->+                            let res = IsMap.mapDelete k kv+                             in Tuple' res (IsMap.mapInsert k b kv1)++    final (Tuple' kv kv1) = do+        r <- Prelude.mapM final1 kv+        return $ IsMap.mapUnion r kv1++-- | Scanning variant of 'toContainer'.+--+{-# INLINE classifyScanGeneric #-}+classifyScanGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>+    -- Note: we need to return the Map itself to display the in-progress values+    -- e.g. to implement top. We could possibly create a separate abstraction+    -- 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 -> Scanl m a (m (f b), Maybe (Key f, b))+classifyScanGeneric f (Fold step1 initial1 extract1 final1) =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) extract final++    where++    initial = return $ Tuple3' IsMap.mapEmpty Set.empty Nothing++    {-# INLINE initFold #-}+    initFold kv set k a = do+        x <- initial1+        case x of+              Partial s -> do+                r <- step1 s a+                return+                    $ case r of+                          Partial s1 ->+                            Tuple3' (IsMap.mapInsert k s1 kv) set Nothing+                          Done b ->+                            Tuple3' kv set (Just (k, b))+              Done b -> return (Tuple3' kv (Set.insert k set) (Just (k, b)))++    step (Tuple3' kv set _) a = do+        let k = f a+        case IsMap.mapLookup k kv of+            Nothing -> do+                if Set.member k set+                then return (Tuple3' kv set Nothing)+                else initFold kv set k a+            Just s -> do+                r <- step1 s a+                return+                    $ case r of+                          Partial s1 ->+                            Tuple3' (IsMap.mapInsert k s1 kv) set Nothing+                          Done b ->+                            let kv1 = IsMap.mapDelete k kv+                             in Tuple3' kv1 (Set.insert k set) (Just (k, b))++    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+            -- XXX Why are we doing this? If it is in the set then it will not+            -- be in the map and vice-versa.+            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@@ -593,17 +1076,33 @@ -- -- Definition: ----- >>> classify f fld = Fold.demux f (const fld)+-- >> classify f fld = Fold.demux f (const fld) --+{-# DEPRECATED classify "Use classifyScan instead" #-} {-# INLINE classify #-} classify :: (Monad m, Ord k) =>     (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b)) classify = classifyGeneric +{-# INLINE classifyUsingMap #-}+classifyUsingMap :: (Monad m, Ord k) =>+    (a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))+classifyUsingMap = classifyScanGeneric++-- XXX Make it consistent with demux.++-- | Scanning variant of 'toMap'.+--+{-# INLINE classifyScan #-}+classifyScan :: (MonadIO m, Ord k) =>+    (a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))+classifyScan getKey = fmap snd . classifyUsingMap getKey+ -- XXX we can use a Prim IORef if we can constrain the state "s" to be Prim -- -- The code is almost the same as classifyGeneric except the IORef operations. +{-# DEPRECATED classifyGenericIO "Use classifyGenericIO from Scanl module" #-} {-# 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))@@ -663,19 +1162,153 @@             then extract1 s             else final1 s +-- XXX we can use a Prim IORef if we can constrain the state "s" to be Prim+--+-- The code is almost the same as classifyGeneric except the IORef operations.++{-# INLINE toContainerIO #-}+toContainerIO :: (MonadIO m, IsMap f, Traversable f) =>+    (a -> Key f) -> Fold m a b -> Fold m a (f b)+toContainerIO f (Fold step1 initial1 _ final1) =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) undefined final++    where++    initial = return $ Tuple' IsMap.mapEmpty IsMap.mapEmpty++    {-# INLINE initFold #-}+    initFold kv kv1 k a = do+        x <- initial1+        case x of+              Partial s -> do+                r <- step1 s a+                case r of+                      Partial s1 -> do+                        ref <- liftIO $ newIORef s1+                        return $ Tuple' (IsMap.mapInsert k ref kv) kv1+                      Done b ->+                        return $ Tuple' kv (IsMap.mapInsert k b kv1)+              Done b -> return (Tuple' kv (IsMap.mapInsert k b kv1))++    step (Tuple' kv kv1) a = do+        let k = f a+        case IsMap.mapLookup k kv of+            Nothing -> do+                case IsMap.mapLookup k kv1 of+                    Nothing -> initFold kv kv1 k a+                    Just _ -> return $ Tuple' kv kv1+            Just ref -> do+                s <- liftIO $ readIORef ref+                r <- step1 s a+                case r of+                      Partial s1 -> do+                        liftIO $ writeIORef ref s1+                        return $ Tuple' kv kv1+                      Done b ->+                        let res = IsMap.mapDelete k kv+                         in return+                                $ Tuple' res (IsMap.mapInsert k b kv1)++    final (Tuple' kv kv1) = do+        r <- Prelude.mapM g kv+        return $ IsMap.mapUnion r kv1++        where++        g ref = liftIO (readIORef ref) >>= final1++-- | Scanning variant of 'classifyGenericIO'.+--+{-# INLINE classifyScanGenericIO #-}+classifyScanGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>+    (a -> Key f) -> Fold m a b -> Scanl m a (m (f b), Maybe (Key f, b))+classifyScanGenericIO f (Fold step1 initial1 extract1 final1) =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) extract final++    where++    initial = return $ Tuple3' IsMap.mapEmpty Set.empty Nothing++    {-# INLINE initFold #-}+    initFold kv set k a = do+        x <- initial1+        case x of+              Partial s -> do+                r <- step1 s a+                case r of+                      Partial s1 -> do+                        ref <- liftIO $ newIORef s1+                        return $ Tuple3' (IsMap.mapInsert k ref kv) set Nothing+                      Done b ->+                        return $ Tuple3' kv set (Just (k, b))+              Done b -> return (Tuple3' kv (Set.insert k set) (Just (k, b)))++    step (Tuple3' kv set _) a = do+        let k = f a+        case IsMap.mapLookup k kv of+            Nothing -> do+                if Set.member k set+                then return (Tuple3' kv set Nothing)+                else initFold kv set k a+            Just ref -> do+                s <- liftIO $ readIORef ref+                r <- step1 s a+                case r of+                      Partial s1 -> do+                        liftIO $ writeIORef ref s1+                        return $ Tuple3' kv set Nothing+                      Done b ->+                        let kv1 = IsMap.mapDelete k kv+                         in return+                                $ Tuple3' kv1 (Set.insert k set) (Just (k, b))++    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. -- -- Definitions: ----- >>> classifyIO f fld = Fold.demuxIO f (const fld)+-- >> classifyIO f fld = Fold.demuxIO f (const fld) --+{-# DEPRECATED classifyIO "Use classifyScanIO instead" #-} {-# INLINE classifyIO #-} classifyIO :: (MonadIO m, Ord k) =>     (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b)) classifyIO = classifyGenericIO +{-# INLINE classifyUsingMapIO #-}+classifyUsingMapIO :: (MonadIO m, Ord k) =>+    (a -> k) -> Fold m a b -> Scanl m a (m (Map k b), Maybe (k, b))+classifyUsingMapIO = classifyScanGenericIO++-- | This is a specialized version of 'classifyScan' that uses mutable IO cells+-- as scan accumulators for better performance.+--+-- TODO: To drain the final in-progress folds this requires the drain step of+-- Scanl to be streaming.+--+{-# INLINE classifyScanIO #-}+classifyScanIO :: (MonadIO m, Ord k) =>+    (a -> k) -> Fold m a b -> Scanl m a (Maybe (k, b))+classifyScanIO getKey = fmap snd . classifyUsingMapIO getKey++{- {-# INLINE toContainer #-} toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>     (a -> Key f) -> Fold m a b -> Fold m a (f b)@@ -689,6 +1322,7 @@                 (rmapM getMap $ lmap fst latest)                 (lmap snd $ catMaybes kvToMapOverwriteGeneric)     in postscan classifier aggregator+-}  -- | Split the input stream based on a key field and fold each split using the -- given fold. Useful for map/reduce, bucketizing the input in different bins@@ -726,6 +1360,7 @@     (a -> k) -> Fold m a b -> Fold m a (Map k b) toMap = toContainer +{- {-# INLINE toContainerIO #-} toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>     (a -> Key f) -> Fold m a b -> Fold m a (f b)@@ -739,6 +1374,7 @@                 (rmapM getMap $ lmap fst latest)                 (lmap snd $ catMaybes kvToMapOverwriteGeneric)     in postscan classifier aggregator+-}  -- | Same as 'toMap' but maybe faster because it uses mutable cells as -- fold accumulators in the Map.
+ src/Streamly/Internal/Data/Fold/Exception.hs view
@@ -0,0 +1,199 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Exception+-- Copyright   : (c) 2025 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Fold.Exception+    (+    -- * Resources+      before+    , bracketIO+    , finallyIO++    -- * Exceptions+    , onException+    )+where++------------------------------------------------------------------------------+-- Imports+------------------------------------------------------------------------------++import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Control.Monad.IO.Class (MonadIO(..))+import Control.Monad.Catch (MonadCatch)+import Streamly.Internal.Data.IOFinalizer (newIOFinalizer, runIOFinalizer)++import qualified Control.Monad.Catch as MC++import Streamly.Internal.Data.Fold.Step+import Streamly.Internal.Data.Fold.Type++------------------------------------------------------------------------------+-- Exceptions+------------------------------------------------------------------------------++{-++-- | Exception handling states of a fold+data HandleExc s f1 f2 = InitDone !s | InitFailed !f1 | StepFailed !f2++-- | @handle initHandler stepHandler fold@ produces a new fold from a given+-- fold.  The new fold executes the original @fold@, if an exception occurs+-- when initializing the fold then @initHandler@ is executed and fold resulting+-- from that starts execution.  If an exception occurs while executing the+-- @step@ function of a fold then the @stephandler@ is executed and we start+-- executing the fold resulting from that.+--+-- The exception is caught and handled, not rethrown. If the exception handler+-- itself throws an exception that exception is thrown.+--+-- /Internal/+--+{-# INLINE handle #-}+handle :: (MonadCatch m, Exception e)+    => (e -> m (Fold m a b))+    -> (e -> Fold m a b -> m (Fold m a b))+    -> Fold m a b+    -> Fold m a b+handle initH stepH (Fold step1 initial1 extract1) = Fold step initial extract++    where++    initial = fmap InitDone initial1 `MC.catch` (fmap InitFailed . initH)++    step (InitDone s) a =+        let f = Fold step1 (return s) extract1+         in fmap InitDone (step1 s a)+                `MC.catch` (\e -> fmap StepFailed (stepH e f))+    step (InitFailed (Fold step2 initial2 extract2)) a = do+        s <- initial2+        s1 <- step2 s a+        return $ InitFailed $ Fold step2 (return s1) extract2+    step (StepFailed (Fold step2 initial2 extract2)) a = do+        s <- initial2+        s1 <- step2 s a+        return $ StepFailed $ Fold step2 (return s1) extract2++    extract (InitDone s) = extract1 s+    extract (InitFailed (Fold _ initial2 extract2)) = initial2 >>= extract2+    extract (StepFailed (Fold _ initial2 extract2)) = initial2 >>= extract2++-}++-- | @onException action fold@ runs @action@ whenever the fold throws an+-- exception.  The action is executed on any exception whether it is in+-- initial, step or extract action of the fold.+--+-- The exception is not caught, simply rethrown. If the @action@ itself+-- throws an exception that exception is thrown instead of the original+-- exception.+--+-- /Internal/+--+{-# INLINE onException #-}+onException :: MonadCatch m => m x -> Fold m a b -> Fold m a b+onException action (Fold step1 initial1 extract1 final1) =+    Fold step initial extract final++    where++    initial = initial1 `MC.onException` action+    step s a = step1 s a `MC.onException` action+    extract s = extract1 s `MC.onException` action+    final s = final1 s `MC.onException` action++-- | @bracketIO before after between@ runs @before@ and invokes @between@ using+-- its output, then runs the fold generated by @between@.  If the fold ends+-- normally, due to an exception or if it is garbage collected prematurely then+-- @after@ is run with the output of @before@ as argument.+--+-- If @before@ or @after@ throw an exception that exception is thrown.+--+{-# INLINE bracketIO #-}+bracketIO :: (MonadIO m, MonadCatch m)+    => IO x -> (x -> IO c) -> (x -> Fold m a b) -> Fold m a b+bracketIO bef aft bet = Fold step initial extract final++    where++    initial = do+        r <- liftIO bef+        ref <- liftIO $ newIOFinalizer (aft r)+        case bet r of+            Fold step1 initial1 extract1 final1 -> do+                res <- initial1 `MC.onException` liftIO (runIOFinalizer ref)+                case res of+                    Partial s -> do+                        let fld1 = Fold step1 (pure (Partial s)) extract1 final1+                        pure $ Partial $ Tuple' ref fld1+                    Done b -> do+                        liftIO $ runIOFinalizer ref+                        pure $ Done b++    step (Tuple' ref (Fold step1 initial1 extract1 final1)) a = do+        res <- initial1+        case res of+            Partial s -> do+                s1 <- step1 s a `MC.onException` liftIO (runIOFinalizer ref)+                let fld1 = Fold step1 (pure s1) extract1 final1+                pure $ Partial $ Tuple' ref fld1+            Done b -> do+                liftIO $ runIOFinalizer ref+                pure $ Done b++    extract (Tuple' ref (Fold _ initial1 extract1 _)) = do+        res <- initial1+        case res of+            Partial s -> extract1 s `MC.onException` liftIO (runIOFinalizer ref)+            Done b -> pure b++    final (Tuple' ref (Fold _ initial1 _ final1)) = do+        res <- initial1+        case res of+            Partial s -> do+                val <- final1 s `MC.onException` liftIO (runIOFinalizer ref)+                runIOFinalizer ref+                pure val+            Done b -> pure b++-- | Run a side effect whenever the fold stops normally, aborts due to an+-- exception or is garbage collected.+--+{-# INLINE finallyIO #-}+finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Fold m a b -> Fold m a b+finallyIO aft (Fold step1 initial1 extract1 final1) =+    Fold step initial extract final++    where++    initial = do+        ref <- liftIO $ newIOFinalizer aft+        res <- initial1 `MC.onException` liftIO (runIOFinalizer ref)+        pure $ case res of+            Done b -> Done b+            Partial s -> Partial $ Tuple' ref s++    step (Tuple' ref s) a = do+        res <- step1 s a `MC.onException` liftIO (runIOFinalizer ref)+        pure $ case res of+            Done b -> Done b+            Partial s1 -> Partial $ Tuple' ref s1++    extract (Tuple' ref s) =+        extract1 s `MC.onException` liftIO (runIOFinalizer ref)++    final (Tuple' ref s) = do+        res <- final1 s `MC.onException` liftIO (runIOFinalizer ref)+        liftIO $ runIOFinalizer ref+        pure res+++-- | Run a side effect before the initialization of the fold.+--+{-# INLINE before #-}+before :: Monad m => m x -> Fold m a b -> Fold m a b+before effect (Fold s i e f) = Fold s (effect *> i) e f
src/Streamly/Internal/Data/Fold/Step.hs view
@@ -28,6 +28,18 @@ -- terminate early whereas we use data constructors. It allows stream fusion in -- contrast to the foldr/build fusion when composing with functions. +-- XXX Change the semantics of Done such that when we return Done, the input is+-- always unused. Then we can include the takeWhile fold as well under folds.+-- This will be a breaking change, so rename "Done" to "Stop" so that users are+-- forced to look at all places where it is used.+--+-- Perhaps we do not need to return the Step type in initial. Instead of+-- returning "Done" in initial we can wait for the next input or invocation of+-- "final". This should simplify the composition of initial considerably.+--+-- Also, rename Partial to Skip, to keep it consistent with Scans/Pipes/Streams.+-- Make Partial a pattern synonym to keep backward compatibility.+ -- | Represents the result of the @step@ of a 'Fold'.  'Partial' returns an -- intermediate state of the fold, the fold step can be called again with the -- state or the driver can use @extract@ on the state to get the result out.
src/Streamly/Internal/Data/Fold/Type.hs view
@@ -210,8 +210,8 @@ -- -- This means: takeWhile, groupBy, wordBy would be implemented as parsers. ----- A proposed design is to use the same Step type with Error in Folds as well--- as Parsers. Folds won't use the Error constructor and even if they use, it+-- A proposed design is to use the same Step type with SError in Folds as well+-- as Parsers. Folds won't use the SError constructor and even if they use, it -- will be equivalent to just throwing an error. They won't have an -- alternative. --@@ -244,7 +244,7 @@ -- would succeed if the condition is satisfied and it would fail otherwise, on -- failure an alternative parser can be used on the same input. ----- We add @Error@ and @Continue@ to the @Step@ type of fold. @Continue@ is to+-- We add @SError@ and @Continue@ to the @Step@ type of fold. @Continue@ is to -- skip producing an output or to backtrack. We also add the ability to -- backtrack in @Partial@ and @Done@.: --@@ -257,7 +257,7 @@ --       Partial Int s   -- partial result and how much to backtrack --     | Done Int b      -- final result and how much to backtrack --     | Continue Int s  -- no result and how much to backtrack---     | Error String    -- error+--     | SError String    -- error -- -- data Parser a m b = --   forall s. Fold@@ -353,7 +353,7 @@     , foldl'     , foldlM'     , foldl1'-    , foldlM1'+    , foldl1M'     , foldt'     , foldtM'     , foldr'@@ -362,13 +362,18 @@     -- * Folds     , fromPure     , fromEffect+    -- XXX Do refold ops belong to Scanl or Fold?     , fromRefold+    , fromScanl     , drain     , toList+    , toListRev+    -- $toListRev     , toStreamK     , toStreamKRev-    , lengthGeneric+    , genericLength     , length+    , latest      -- * Combinators @@ -378,7 +383,14 @@     -- ** Mapping Input     , lmap     , lmapM++    -- ** Scanning input     , postscan+    , scanl+    , scanlMany+    , postscanl+    , postscanlMaybe+    -- , runScan      -- ** Filtering     , catMaybes@@ -397,6 +409,9 @@     , takeEndBy     , dropping +    -- ** Condition+    , ifThen+     -- ** Sequential application     , splitWith -- rename to "append"     , split_@@ -424,13 +439,13 @@     , longest      -- * Running A Fold-    , extractM     , reduce     , snoc     , addOne     , snocM     , snocl     , snoclM+    , finalM     , close     , isClosed @@ -441,6 +456,11 @@     -- * Deprecated     , foldr     , serialWith+    , foldlM1'+    , extractM+    , scan+    , scanMany+    , last     ) where @@ -454,13 +474,16 @@ import Data.Either (fromLeft, fromRight, isLeft, isRight) import Data.Functor.Identity (Identity(..)) import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Either.Strict (Either'(..)) import Streamly.Internal.Data.Refold.Type (Refold(..))+import Streamly.Internal.Data.Scanl.Type (Scanl(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) +-- import qualified Streamly.Internal.Data.Stream.Step as Stream import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Streamly.Internal.Data.Scanl.Type as Scanl -import Prelude hiding (Foldable(..), concatMap, filter, map, take)+import Prelude hiding (Foldable(..), concatMap, filter, map, take, scanl, last)  -- Entire module is exported, do not import selectively import Streamly.Internal.Data.Fold.Step@@ -510,16 +533,13 @@ -- 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.+-- Folds are no longer used for scanning, please see the 'Streamly.Data.Scanl'+-- module for scanning. The @extract@ operation is no longer used and will be+-- removed in future. -- -- 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.+-- can be released in @final@. -- -- When implementing fold combinators, care should be taken to cleanup any -- state of the argument folds held by the fold by calling the respective@@ -531,9 +551,36 @@ -- to create folds. -- data Fold m a b =+  -- XXX Since we have scans now, we can remove the extract function.+  -- XXX initial can be made pure, like in streams, we can add effects by using+  -- bracket like operations.   -- | @Fold@ @step@ @initial@ @extract@ @final@   forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b) (s -> m b) +-- XXX Have functions to modify initial, step, final of a fold. That way we+-- won't have to use the constructor in many cases.++{-+-- XXX Change the type to as follows. This takes care of the unfoldMany case+-- where we need to continue in produce mode. Can we keep the same Step as+-- Scanl without impacting the key-value folds?+--+-- Note: this will require a change in Parser type as well for Parser.fromFold+-- to work.+--+data Step s b =+      Consume s+    | Produce s+    | Stop b++data Fold m a b =+  forall s. Fold+    (s -> a -> m (Step s b)) -- consume step+    (m (Step s b))           -- initial+    (s -> m (Step s b))      -- produce step+    (s -> m (Step s b))      -- drain step+-}+ ------------------------------------------------------------------------------ -- Mapping on the output ------------------------------------------------------------------------------@@ -554,6 +601,11 @@ -- Left fold constructors ------------------------------------------------------------------------------ +-- | Convert a left scan to a fold.+{-# INLINE fromScanl #-}+fromScanl :: Scanl m a b -> Fold m a b+fromScanl (Scanl step initial extract final) = Fold step initial extract final+ -- | Make a fold from a left fold style pure step function and initial value of -- the accumulator. --@@ -569,12 +621,7 @@ -- {-# INLINE foldl' #-} foldl' :: Monad m => (b -> a -> b) -> b -> Fold m a b-foldl' step initial =-    Fold-        (\s a -> return $ Partial $ step s a)-        (return (Partial initial))-        return-        return+foldl' step = fromScanl . Scanl.mkScanl step  -- | Make a fold from a left fold style monadic step function and initial value -- of the accumulator.@@ -588,8 +635,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 return+foldlM' step = fromScanl . Scanl.mkScanlM step  -- | Make a strict left fold, for non-empty streams, using first element as the -- starting value. Returns Nothing if the stream is empty.@@ -597,25 +643,65 @@ -- /Pre-release/ {-# INLINE foldl1' #-} foldl1' :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)-foldl1' step = fmap toMaybe $ foldl' step1 Nothing'--    where--    step1 Nothing' a = Just' a-    step1 (Just' x) a = Just' $ step x a+foldl1' = fromScanl . Scanl.mkScanl1  -- | Like 'foldl1\'' but with a monadic step function. -- -- /Pre-release/+{-# DEPRECATED foldlM1' "Please use foldl1M' instead" #-} {-# INLINE foldlM1' #-} foldlM1' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)-foldlM1' step = fmap toMaybe $ foldlM' step1 (return Nothing')+foldlM1' = foldl1M' +-- | Like 'foldl1\'' but with a monadic step function.+--+-- /Pre-release/+{-# INLINE foldl1M' #-}+foldl1M' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+foldl1M' = fromScanl . Scanl.mkScanl1M++{-+data FromScan s b = FromScanInit !s | FromScanGo !s !b++-- XXX we can attach a scan on the last fold e.g. "runScan s last". Or run a+-- scan on a fold that supplies a default value?+--+-- If we are pushing a value to a scan and the scan stops we will lose the+-- input. Only those scans that do not use the Stop constructor can be used as+-- folds or with folds? The Stop constructor makes them suitable to be composed+-- with pull based streams, push based folds cannot work with that. Do we need+-- two types of scans then, scans for streams and scans for folds? ScanR and+-- ScanL?++-- | This does not work correctly yet. We lose the last input.+--+{-# INLINE fromScan #-}+fromScan :: Monad m => Scan m a b -> Fold m a (Maybe b)+fromScan (Scan consume initial) =+    Fold fstep (return $ Partial (FromScanInit initial)) fextract fextract+     where -    step1 Nothing' a = return $ Just' a-    step1 (Just' x) a = Just' <$> step x a+    fstep (FromScanInit ss) a = do+        r <- consume ss a+        return $ case r of+            Stream.Yield b s -> Partial (FromScanGo s b)+            Stream.Skip s -> Partial (FromScanInit s)+            -- XXX We have lost the input here.+            -- XXX Need to change folds to always return Done on the next input+            Stream.Stop -> Done Nothing+    fstep (FromScanGo ss acc) a = do+        r <- consume ss a+        return $ case r of+            Stream.Yield b s -> Partial (FromScanGo s b)+            Stream.Skip s -> Partial (FromScanGo s acc)+            -- XXX We have lost the input here.+            Stream.Stop -> Done (Just acc) +    fextract (FromScanInit _) = return Nothing+    fextract (FromScanGo _ acc) = return (Just acc)+-}+ ------------------------------------------------------------------------------ -- Right fold constructors ------------------------------------------------------------------------------@@ -637,7 +723,7 @@ -- {-# INLINE foldr' #-} foldr' :: Monad m => (a -> b -> b) -> b -> Fold m a b-foldr' f z = fmap ($ z) $ foldl' (\g x -> g . f x) id+foldr' f = fromScanl . Scanl.mkScanr f  {-# DEPRECATED foldr "Please use foldr' instead." #-} {-# INLINE foldr #-}@@ -658,8 +744,7 @@ -- /Pre-release/ {-# INLINE foldrM' #-} foldrM' :: Monad m => (a -> b -> m b) -> m b -> Fold m a b-foldrM' g z =-    rmapM (z >>=) $ foldlM' (\f x -> return $ g x >=> f) (return return)+foldrM' g = fromScanl . Scanl.mkScanrM g  ------------------------------------------------------------------------------ -- General fold constructors@@ -686,12 +771,7 @@ -- {-# 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)-        (return . extract)+foldt' step initial = fromScanl . Scanl.mkScant step initial  -- | Make a terminating fold with an effectful step function and initial state, -- and a state extraction function.@@ -711,7 +791,7 @@ ------------------------------------------------------------------------------  -- This is similar to how we run an Unfold to generate a Stream. A Fold is like--- a Stream and a Fold2 is like an Unfold.+-- a Stream and a Refold is like an Unfold. -- -- | Make a fold from a consumer. --@@ -732,8 +812,12 @@ -- {-# INLINE drain #-} drain :: Monad m => Fold m a ()-drain = foldl' (\_ _ -> ()) ()+drain = fromScanl Scanl.drain +------------------------------------------------------------------------------+-- To Containers+------------------------------------------------------------------------------+ -- | Folds the input stream to a list. -- -- /Warning!/ working on large lists accumulated as buffers in memory could be@@ -744,8 +828,27 @@ -- {-# INLINE toList #-} toList :: Monad m => Fold m a [a]-toList = foldr' (:) []+toList = fromScanl Scanl.toList +-- $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 (:)) []+ -- | Buffers the input stream to a pure stream in the reverse order of the -- input. --@@ -759,7 +862,7 @@ --  xn : ... : x2 : x1 : [] {-# INLINE toStreamKRev #-} toStreamKRev :: Monad m => Fold m a (K.StreamK n a)-toStreamKRev = foldl' (flip K.cons) K.nil+toStreamKRev = fromScanl Scanl.toStreamKRev  -- | A fold that buffers its input to a pure stream. --@@ -769,31 +872,45 @@ -- /Internal/ {-# INLINE toStreamK #-} toStreamK :: Monad m => Fold m a (K.StreamK n a)-toStreamK = foldr K.cons K.nil+toStreamK = fromScanl Scanl.toStreamK  -- | 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+-- >>> genericLength = fmap getSum $ Fold.foldMap (Sum . const  1)+-- >>> genericLength = 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+{-# INLINE genericLength #-}+genericLength :: (Monad m, Num b) => Fold m a b+genericLength = fromScanl Scanl.genericLength  -- | Determine the length of the input stream. -- -- Definition: ----- >>> length = Fold.lengthGeneric+-- >>> length = Fold.genericLength -- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1) -- {-# INLINE length #-} length :: Monad m => Fold m a Int-length = lengthGeneric+length = fromScanl Scanl.length +-- | 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 = fromScanl Scanl.latest++{-# DEPRECATED last "Please use 'latest' instead." #-}+{-# INLINE last #-}+last :: Monad m => Fold m a (Maybe a)+last = latest+ ------------------------------------------------------------------------------ -- Instances ------------------------------------------------------------------------------@@ -1230,7 +1347,9 @@     | 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+-- returned fold. This is akin to an n-ary version of 'splitWith' where the+-- next fold for splitting the input is decided dynamically using the previous+-- result. This operation can be used to express data dependencies -- between fold operations. -- -- Let's say the first element in the stream is a count of the following@@ -1321,12 +1440,17 @@     where     step' x a = f a >>= step x +------------------------------------------------------------------------------+-- Scanning+------------------------------------------------------------------------------+ -- | Postscan the input of a 'Fold' to change it in a stateful manner using -- another 'Fold'. -- -- @postscan scanner collector@ -- -- /Pre-release/+{-# DEPRECATED postscan "Please use 'postscanl' instead." #-} {-# INLINE postscan #-} postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c postscan@@ -1369,6 +1493,229 @@      final (sL, sR) = finalL sL *> finalR sR +{-+{-# INLINE runScanWith #-}+runScanWith :: Monad m => Bool -> Scan m a b -> Fold m b c -> Fold m a c+runScanWith isMany+    (Scan stepL initialL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final++    where++    step (sL, sR) x = do+        rL <- stepL sL x+        case rL of+            StreamD.Yield b sL1 -> do+                rR <- stepR sR b+                case rR of+                    Partial sR1 -> return $ Partial (sL1, sR1)+                    Done bR -> return (Done bR)+            StreamD.Skip sL1 -> return $ Partial (sL1, sR)+            -- XXX We have dropped the input.+            -- XXX Need same behavior for Stop in Fold so that the driver can+            -- consistently assume it is dropped.+            StreamD.Stop ->+                if isMany+                then return $ Partial (initialL, sR)+                else Done <$> finalR sR++    initial = do+        r <- initialR+        case r of+            Partial sR -> return $ Partial (initialL, sR)+            Done b -> return $ Done b++    extract = extractR . snd++    final = finalR . snd++-- | Scan the input of a 'Fold' to change it in a stateful manner using a+-- 'Scan'. The scan stops as soon as the fold terminates.+--+-- /Pre-release/+{-# INLINE runScan #-}+runScan :: Monad m => Scan m a b -> Fold m b c -> Fold m a c+runScan = runScanWith False+-}++-- | @postscanl scanner collector@ postscans the input of the @collector@ fold+-- to change it in a stateful manner using 'scanner'.+--+-- /Pre-release/+{-# INLINE postscanl #-}+postscanl :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+postscanl+    (Scanl stepL initialL extractL finalL)+    (Fold stepR initialR _ finalR) =+    Fold step initial undefined 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 -> 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+        rR <- initialR+        case rR of+            Partial sR -> do+                rL <- initialL+                case rL of+                    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++    final (sL, sR) = finalL sL *> finalR sR++-- | Use a 'Maybe' returning left scan for filtering the input of a fold.+--+-- >>> scanlMaybe p f = Fold.postscanl p (Fold.catMaybes f)+--+-- /Pre-release/+{-# INLINE postscanlMaybe #-}+postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Fold m b c -> Fold m a c+postscanlMaybe f1 f2 = postscanl f1 (catMaybes f2)++{-# 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+                        -- XXX recursive call. If initialL returns Done then it+                        -- will not terminate. In that case we should return+                        -- error in the beginning itself. And we should remove+                        -- this recursion, assuming it won't return Done.+                        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/+{-# DEPRECATED scan "Please use 'scanl' instead." #-}+{-# 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/+{-# DEPRECATED scanMany "Please use 'scanlMany' instead." #-}+{-# INLINE scanMany #-}+scanMany :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+scanMany = scanWith True++{-# INLINE scanlWith #-}+scanlWith :: Monad m => Bool -> Scanl m a b -> Fold m b c -> Fold m a c+scanlWith isMany+    (Scanl stepL initialL extractL finalL)+    (Fold stepR initialR _ finalR) =+    Fold step initial undefined 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+                        -- XXX recursive call. If initialL returns Done then it+                        -- will not terminate. In that case we should return+                        -- error in the beginning itself. And we should remove+                        -- this recursion, assuming it won't return Done.+                        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++    final (sL, sR) = finalL sL *> finalR sR++-- | Scan the input of a 'Fold' to change it in a stateful manner using a+-- 'Scanl'. The scan stops as soon as the fold terminates.+--+-- /Pre-release/+{-# INLINE scanl #-}+scanl :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+scanl = scanlWith 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 a+-- 'Scanl'. The scan restarts with a fresh state if it terminates.+--+-- /Pre-release/+{-# INLINE scanlMany #-}+scanlMany :: Monad m => Scanl m a b -> Fold m b c -> Fold m a c+scanlMany = scanlWith True+ ------------------------------------------------------------------------------ -- Filtering ------------------------------------------------------------------------------@@ -1392,9 +1739,10 @@  -- | Use a 'Maybe' returning fold as a filtering scan. ----- >>> scanMaybe p f = Fold.postscan p (Fold.catMaybes f)+-- >> scanMaybe p f = Fold.postscan p (Fold.catMaybes f) -- -- /Pre-release/+{-# DEPRECATED scanMaybe "Please use 'postscanlMaybe' instead." #-} {-# INLINE scanMaybe #-} scanMaybe :: Monad m => Fold m a (Maybe b) -> Fold m b c -> Fold m a c scanMaybe f1 f2 = postscan f1 (catMaybes f2)@@ -1414,7 +1762,6 @@ -- >>> Stream.fold (Fold.filter (> 5) Fold.sum) $ Stream.fromList [1..10] -- 40 ----- >>> filter p = Fold.scanMaybe (Fold.filtering p) -- >>> filter p = Fold.filterM (return . p) -- >>> filter p = Fold.mapMaybe (\x -> if p x then Just x else Nothing) --@@ -1481,36 +1828,11 @@  {-# INLINE taking #-} taking :: Monad m => Int -> Fold m a (Maybe a)-taking n = foldt' step initial extract--    where--    initial =-        if n <= 0-        then Done Nothing-        else Partial (Tuple'Fused n Nothing)--    step (Tuple'Fused i _) a =-        if i > 1-        then Partial (Tuple'Fused (i - 1) (Just a))-        else Done (Just a)--    extract (Tuple'Fused _ r) = r+taking = fromScanl . Scanl.taking  {-# INLINE dropping #-} dropping :: Monad m => Int -> Fold m a (Maybe a)-dropping n = foldt' step initial extract--    where--    initial = Partial (Tuple'Fused n Nothing)--    step (Tuple'Fused i _) a =-        if i > 0-        then Partial (Tuple'Fused (i - 1) Nothing)-        else Partial (Tuple'Fused i (Just a))--    extract (Tuple'Fused _ r) = r+dropping = fromScanl . Scanl.dropping  -- | Take at most @n@ input elements and fold them using the supplied fold. A -- negative count is treated as 0.@@ -1608,6 +1930,34 @@                 Partial s1 -> Done <$> ffinal s1                 Done b -> return $ Done b +-- Fusible if-then-else++-- | Evaluate a condition, if True then use the first fold otherwise use the+-- second fold.+{-# INLINE ifThen #-}+ifThen :: Monad m => m Bool -> Fold m a b -> Fold m a b -> Fold m a b+ifThen predicate+    (Fold step1 initial1 extract1 final1)+    (Fold step2 initial2 extract2 final2)+    = Fold step initial extract final++    where++    initial = do+        r <- predicate+        if r+        then first Left' <$> initial1+        else first Right' <$> initial2++    step (Left' s) x = first Left' <$> step1 s x+    step (Right' s) x = first Right' <$> step2 s x++    extract (Left' s) = extract1 s+    extract (Right' s) = extract2 s++    final (Left' s) = final1 s+    final (Right' s) = final2 s+ ------------------------------------------------------------------------------ -- Nesting ------------------------------------------------------------------------------@@ -1683,7 +2033,7 @@ -- Example: -- -- >>> import qualified Data.Foldable as Foldable--- >>> Fold.extractM $ Foldable.foldl Fold.snocl Fold.toList [1..3]+-- >>> Fold.finalM $ Foldable.foldl Fold.snocl Fold.toList [1..3] -- [1,2,3] -- -- /Pre-release/@@ -1760,18 +2110,34 @@ -- -- >>> extractM = Fold.drive Stream.nil ----- Example:------ >>> Fold.extractM Fold.toList--- []--- -- /Pre-release/+{-# DEPRECATED extractM "Please use finalM instead" #-} {-# INLINE extractM #-} extractM :: Monad m => Fold m a b -> m b extractM (Fold _ initial extract _) = do     res <- initial     case res of           Partial fs -> extract fs+          Done b -> return b++-- | Finalize a fold and extract the accumulated result of the fold.+--+-- Definition:+--+-- >>> finalM = Fold.drive Stream.nil+--+-- Example:+--+-- >>> Fold.finalM Fold.toList+-- []+--+-- /Pre-release/+{-# INLINE finalM #-}+finalM :: Monad m => Fold m a b -> m b+finalM (Fold _ initial _ final) = do+    res <- initial+    case res of+          Partial fs -> final fs           Done b -> return b  -- | Close a fold so that it does not accept any more input.
src/Streamly/Internal/Data/Fold/Window.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Fold.Window -- Copyright   : (c) 2020 Composewell Technologies@@ -18,10 +19,13 @@ -- For more advanced statistical measures see the @streamly-statistics@ -- package. --- XXX A window fold can be driven either using the Ring.slidingWindow+-- XXX A window fold can be driven either using the RingArray.slidingWindow -- combinator or by zipping nthLast fold and last fold. +-- XXX Deprecate all the functions in this module. These should be scans only.+ module Streamly.Internal.Data.Fold.Window+    {-# DEPRECATED "Please use Streamly.Internal.Data.Scanl instead." #-}     (     -- * Incremental Folds     -- | Folds of type @Fold m (a, Maybe a) b@ are incremental sliding window@@ -59,26 +63,23 @@  import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Bifunctor(bimap)-import Foreign.Storable (Storable, peek)+import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.RingArray (RingArray(..))+import Streamly.Internal.Data.Unbox (Unbox(..))  import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..)) 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 as Ring+import qualified Streamly.Internal.Data.MutArray.Type as MutArray+import qualified Streamly.Internal.Data.RingArray as RingArray+-- import qualified Streamly.Internal.Data.Scanl.Type as Scanl  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 Fold--- >>> import qualified Streamly.Internal.Data.Ring as Ring--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import Prelude hiding (length, sum, minimum, maximum)+#include "ArrayMacros.h"+#include "DocTestDataFold.hs"  ------------------------------------------------------------------------------- -- Utilities@@ -87,6 +88,7 @@ -- | Map a function on the incoming as well as outgoing element of a rolling -- window fold. --+-- >>> :set -fno-warn-deprecations -- >>> lmap f = Fold.lmap (bimap f (f <$>)) -- {-# INLINE windowLmap #-}@@ -138,7 +140,7 @@ -------------------------------------------------------------------------------  -- XXX Overflow.---+ -- | The sum of all the elements in a rolling window. The input elements are -- required to be intergal numbers. --@@ -166,14 +168,14 @@     extract = return  -- XXX Overflow.---+ -- | Sum of all the elements in a rolling window: -- -- \(S = \sum_{i=1}^n x_{i}\) -- -- This is the first power sum. ----- >>> sum = powerSum 1+-- >>> windowSum = Fold.windowPowerSum 1 -- -- Uses Kahan-Babuska-Neumaier style summation for numerical stability of -- floating precision arithmetic.@@ -219,7 +221,7 @@ -- -- This is the \(0\)th power sum. ----- >>> length = powerSum 0+-- >>> length = Fold.windowPowerSum 0 -- {-# INLINE windowLength #-} windowLength :: (Monad m, Num b) => Fold m (a, Maybe a) b@@ -234,7 +236,7 @@ -- -- \(S_k = \sum_{i=1}^n x_{i}^k\) ----- >>> powerSum k = lmap (^ k) sum+-- >>> windowPowerSum k = Fold.windowLmap (^ k) Fold.windowSum -- -- /Space/: \(\mathcal{O}(1)\) --@@ -246,7 +248,7 @@ -- | Like 'powerSum' but powers can be negative or fractional. This is slower -- than 'powerSum' for positive intergal powers. ----- >>> powerSumFrac p = lmap (** p) sum+-- >>> windowPowerSumFrac p = Fold.windowLmap (** p) Fold.windowSum -- {-# INLINE windowPowerSumFrac #-} windowPowerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a@@ -256,7 +258,18 @@ -- Location ------------------------------------------------------------------------------- --- XXX Remove MonadIO constraint+{-# INLINE ringRange #-}+ringRange :: (MonadIO m, Unbox a, Ord a) => RingArray a -> m (Maybe (a, a))+-- Ideally this should perform the same as the implementation below, but it is+-- 2x worse, need to investigate why.+-- ringRange = RingArray.fold (Fold.fromScanl Scanl.range)+ringRange rb@RingArray{..} = do+    if ringSize == 0+    then return Nothing+    else do+        x <- liftIO $ peekAt 0 ringContents+        let accum (mn, mx) a = return (min mn a, max mx a)+         in fmap Just $ RingArray.foldlM' accum (x, x) rb  -- | Determine the maximum and minimum in a rolling window. --@@ -268,47 +281,39 @@ -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. -- {-# INLINE windowRange #-}-windowRange :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))+windowRange :: forall m a. (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (Maybe (a, a))+-- windowRange =+    -- Fold.fromScanl . RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.range)+-- Ideally this should perform the same as the implementation below which is+-- just expanded form of this. Some inlining/exitify optimization makes this+-- perform much worse. Need to investigate and fix that.+-- windowRange = Fold.fromScanl . RingArray.scanCustomFoldRingsBy ringRange windowRange n = Fold step initial extract extract      where -    -- XXX Use Ring unfold and then fold for composing maximum and minimum to-    -- get the range.-     initial =         if n <= 0-        then error "range: window size must be > 0"-        else-            let f (a, b) = Partial $ Tuple3Fused' a b (0 :: Int)-             in fmap f $ liftIO $ Ring.new n--    step (Tuple3Fused' rb rh i) a = do-        rh1 <- liftIO $ Ring.unsafeInsert rb rh a-        return $ Partial $ Tuple3Fused' rb rh1 (i + 1)+        then error "ringsOf: window size must be > 0"+        else do+            arr :: MutArray.MutArray a <- liftIO $ MutArray.emptyOf n+            return $ Partial $ Tuple3Fused' (MutArray.arrContents arr) 0 0 -    -- XXX We need better Ring array APIs so that we can unfold the ring to a-    -- stream and fold the stream using a fold of our choice.-    ---    -- We could just scan the stream to get a stream of ring buffers and then-    -- map required folds over those, but we need to be careful that all those-    -- rings refer to the same mutable ring, therefore, downstream needs to-    -- process those strictly before it can change.-    foldFunc i-        | i < n = Ring.unsafeFoldRingM-        | otherwise = Ring.unsafeFoldRingFullM+    step (Tuple3Fused' mba rh i) a = do+        RingArray _ _ rh1 <- RingArray.replace_ (RingArray mba (n * SIZE_OF(a)) rh) a+        return $ Partial $ Tuple3Fused' mba rh1 (i + 1) -    extract (Tuple3Fused' rb rh i) =-        if i == 0-        then return Nothing-        else do-            -- 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+    -- XXX exitify optimization causes a problem here when modular folds are+    -- used. Sometimes inlining "extract" is helpful.+    -- {-# INLINE extract #-}+    extract (Tuple3Fused' mba rh i) =+    -- XXX If newest is lower than the current min than new is the min.+    -- XXX If exiting one was equal to min only then we need to find new min+    -- XXX We can supply a custom extract function to a generic window+    -- operation.+        let rs = min i n * SIZE_OF(a)+            rh1 = if i <= n then 0 else rh+         in ringRange $ RingArray mba rs rh1  -- | Find the minimum element in a rolling window. --@@ -323,8 +328,10 @@ -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. -- {-# INLINE windowMinimum #-}-windowMinimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+windowMinimum :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (Maybe a) windowMinimum n = fmap (fmap fst) $ windowRange n+-- windowMinimum =+    -- Fold.fromScanl . RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.minimum)  -- | The maximum element in a rolling window. --@@ -336,8 +343,10 @@ -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. -- {-# INLINE windowMaximum #-}-windowMaximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+windowMaximum :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (Maybe a) windowMaximum n = fmap (fmap snd) $ windowRange n+-- windowMaximum =+    -- Fold.fromScanl . RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.maximum)  -- | Arithmetic mean of elements in a sliding window: --@@ -347,7 +356,7 @@ -- sliding window and Cumulative Moving Avergae (CMA) when used on the entire -- stream. ----- >>> mean = Fold.teeWith (/) sum length+-- >>> mean = Fold.teeWith (/) Fold.windowSum Fold.windowLength -- -- /Space/: \(\mathcal{O}(1)\) --
+ src/Streamly/Internal/Data/IORef.hs view
@@ -0,0 +1,114 @@+-- |+-- Module      : Streamly.Internal.Data.IORef+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A mutable variable in a mutation capable monad (IO) holding a 'Unboxed'+-- value. This allows fast modification because of unboxed storage.+--+-- = Multithread Consistency Notes+--+-- In general, any value that straddles a machine word cannot be guaranteed to+-- be consistently read from another thread without a lock.  GHC heap objects+-- are always machine word aligned, therefore, a 'IORef' is also word aligned.+-- On a 64-bit platform, writing a 64-bit aligned type from one thread and+-- reading it from another thread should give consistent old or new value. The+-- same holds true for 32-bit values on a 32-bit platform.++module Streamly.Internal.Data.IORef+    (+      IORef++    -- Construction+    , newIORef++    -- Write+    , writeIORef+    , modifyIORef'++    -- Read+    , readIORef+    , pollGenericIORef+    , pollIORefInt+    )+where++#include "inline.hs"+#include "deprecation.h"++import Control.Monad.IO.Class (MonadIO(..))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif+import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)+import Streamly.Internal.Data.Unbox (Unbox(..), sizeOf)++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.+#if __GLASGOW_HASKELL__ >= 810+type IORef :: Type -> Type+#endif+newtype IORef a = IORef MutByteArray++-- | Create a new 'IORef'.+--+-- /Pre-release/+{-# INLINE newIORef #-}+newIORef :: forall a. Unbox a => a -> IO (IORef a)+newIORef x = do+    var <- MBA.new (sizeOf (Proxy :: Proxy a))+    pokeAt 0 var x+    return $ IORef var++-- | Write a value to an 'IORef'.+--+-- /Pre-release/+{-# INLINE writeIORef #-}+writeIORef :: Unbox a => IORef a -> a -> IO ()+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) = peekAt 0 var++-- | Modify the value of an 'IORef' using a function with strict application.+--+-- /Pre-release/+{-# INLINE modifyIORef' #-}+modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()+modifyIORef' var g = do+  x <- readIORef var+  writeIORef var (g x)++-- | Internal, do not use.+{-# INLINE_NORMAL pollGenericIORef #-}+pollGenericIORef :: (MonadIO m, Unbox a) => IORef a -> D.Stream m a+pollGenericIORef var = D.Stream step ()++    where++    {-# INLINE_LATE step #-}+    step _ () = liftIO (readIORef var) >>= \x -> return $ D.Yield x ()++-- | 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 size fits into machine register size. 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 pollIORefInt #-}+pollIORefInt :: MonadIO m => IORef Int -> D.Stream m Int+pollIORefInt = pollGenericIORef
− src/Streamly/Internal/Data/IORef/Unboxed.hs 
@@ -1,101 +0,0 @@--- |--- Module      : Streamly.Internal.Data.IORef.Unboxed--- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ A mutable variable in a mutation capable monad (IO) holding a 'Unboxed'--- value. This allows fast modification because of unboxed storage.------ = Multithread Consistency Notes------ In general, any value that straddles a machine word cannot be guaranteed to--- be consistently read from another thread without a lock.  GHC heap objects--- are always machine word aligned, therefore, a 'IORef' is also word aligned.--- On a 64-bit platform, writing a 64-bit aligned type from one thread and--- reading it from another thread should give consistent old or new value. The--- same holds true for 32-bit values on a 32-bit platform.--module Streamly.Internal.Data.IORef.Unboxed-    (-      IORef--    -- Construction-    , newIORef--    -- Write-    , writeIORef-    , modifyIORef'--    -- Read-    , readIORef-    , pollIntIORef-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Data.Proxy (Proxy(..))-import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)-import Streamly.Internal.Data.Unbox (Unbox(..), sizeOf)--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 MutByteArray---- | Create a new 'IORef'.------ /Pre-release/-{-# INLINE newIORef #-}-newIORef :: forall a. Unbox a => a -> IO (IORef a)-newIORef x = do-    var <- MBA.new (sizeOf (Proxy :: Proxy a))-    pokeAt 0 var x-    return $ IORef var---- | Write a value to an 'IORef'.------ /Pre-release/-{-# INLINE writeIORef #-}-writeIORef :: Unbox a => IORef a -> a -> IO ()-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) = peekAt 0 var---- | Modify the value of an 'IORef' using a function with strict application.------ /Pre-release/-{-# INLINE modifyIORef' #-}-modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()-modifyIORef' var g = do-  x <- readIORef var-  writeIORef var (g x)---- | 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 pollIntIORef #-}-pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> D.Stream m a-pollIntIORef var = D.Stream step ()--    where--    {-# INLINE_LATE step #-}-    step _ () = liftIO (readIORef var) >>= \x -> return $ D.Yield x ()
src/Streamly/Internal/Data/IsMap.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} -- | -- Module      : Streamly.Internal.Data.IsMap -- Copyright   : (c) 2022 Composewell Technologies
src/Streamly/Internal/Data/MutArray.hs view
@@ -5,90 +5,245 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC++-- XXX To detect array overflow issues we can have a debug mode in RTS where we+-- allocate one additional page beyond a large allocation and unmap that page+-- so that we get segfault if it is accessed. Also any unpinned large+-- allocations can be kept unmapped for a while after being freed in case those+-- are being used by someone, also we can aggressively move such pages to+-- detect problems more quickly. -- module Streamly.Internal.Data.MutArray     (     -- * MutArray.Type module       module Streamly.Internal.Data.MutArray.Type     -- * MutArray module-    , sliceIndexerFromLen+    , indexerFromLen+    , splitterFromLen+    -- , splitFromLen+    -- , splitChunksOf+    , compactMax+    , compactMax'+    , compactSepByByte_+    , compactEndByByte_+    , compactEndByLn_+    , createOfLast++    -- XXX Do not expose these yet, we should perhaps expose only the Get/Put+    -- monads instead? Decide after implementing the monads.++    -- * Serialization+    , serialize+    , deserialize+    , serializePtrN+    , deserializePtrN++    -- * Deprecated     , slicerFromLen+    , sliceIndexerFromLen+    , genSlicesFromLen+    , getSlicesFromLen     , compactLE     , pinnedCompactLE     , compactOnByte     , compactOnByteSuffix-    -- * Unboxed IORef-    , module Streamly.Internal.Data.IORef.Unboxed--    -- * Deprecated-    , genSlicesFromLen-    , getSlicesFromLen+    , IORef+    , newIORef+    , writeIORef+    , modifyIORef'+    , readIORef+    , pollIntIORef     ) where +#include "assert.hs"+#include "deprecation.h" #include "inline.hs"+#include "ArrayMacros.h"  import Control.Monad.IO.Class (MonadIO(..)) import Data.Word (Word8)+import Foreign.Ptr (Ptr) import Streamly.Internal.Data.MutByteArray.Type (PinnedState(..))+import Streamly.Internal.Data.Serialize.Type (Serialize) import Streamly.Internal.Data.Stream.Type (Stream) import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Fold.Type (Fold) -import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.IORef as IORef+import qualified Streamly.Internal.Data.RingArray as RingArray+import qualified Streamly.Internal.Data.Serialize.Type as Serialize import qualified Streamly.Internal.Data.Stream.Nesting as Stream+import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Fold.Type as Fold -- import qualified Streamly.Internal.Data.Stream.Transform as Stream import qualified Streamly.Internal.Data.Unfold as Unfold -import Prelude hiding (foldr, length, read, splitAt)+import Prelude hiding (foldr, length, read) import Streamly.Internal.Data.MutArray.Type-import Streamly.Internal.Data.IORef.Unboxed  -- | 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 sliceIndexerFromLen #-}-sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)+{-# INLINE indexerFromLen #-}+indexerFromLen, sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (MutArray a) (Int, Int)-sliceIndexerFromLen from len =+indexerFromLen 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.mapM (uncurry mkSlice) . Unfold.carry         $ Unfold.lmap fromThenTo Unfold.enumerateFromThenTo+RENAME(sliceIndexerFromLen,indexerFromLen) -{-# DEPRECATED genSlicesFromLen "Please use sliceIndexerFromLen instead." #-}+{-# DEPRECATED genSlicesFromLen "Please use indexerFromLen instead." #-} genSlicesFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (MutArray a) (Int, Int)-genSlicesFromLen = sliceIndexerFromLen+genSlicesFromLen = indexerFromLen  -- | 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 slicerFromLen #-}-slicerFromLen :: forall m a. (Monad m, Unbox a)+{-# INLINE splitterFromLen #-}+splitterFromLen, slicerFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (MutArray a) (MutArray a)-slicerFromLen from len =-    let mkSlice arr (i, n) = return $ getSliceUnsafe i n arr-     in Unfold.mapM2 mkSlice (sliceIndexerFromLen from len)+splitterFromLen from len =+    let mkSlice arr (i, n) = return $ unsafeSliceOffLen i n arr+     in Unfold.mapM (uncurry mkSlice)+        $ Unfold.carry (indexerFromLen from len)+RENAME(slicerFromLen,splitterFromLen) -{-# DEPRECATED getSlicesFromLen "Please use slicerFromLen instead." #-}+{-# DEPRECATED getSlicesFromLen "Please use splitterFromLen instead." #-} getSlicesFromLen :: forall m a. (Monad m, Unbox a)     => Int -- ^ from index     -> Int -- ^ length of the slice     -> Unfold m (MutArray a) (MutArray a)-getSlicesFromLen = slicerFromLen+getSlicesFromLen = splitterFromLen +--------------------------------------------------------------------------------+-- Serialization/Deserialization using Serialize+--------------------------------------------------------------------------------++{-# INLINE unsafeSerialize #-}+unsafeSerialize :: (MonadIO m, Serialize a) =>+    MutArray Word8 -> a -> m (MutArray Word8)+unsafeSerialize (MutArray mbarr start end bound) a = do+#ifdef DEBUG+    let len = Serialize.addSizeTo 0 a+    assertM(bound - end >= len)+#endif+    off <- liftIO $ Serialize.serializeAt end mbarr a+    pure $ MutArray mbarr start off bound++{-# NOINLINE serializeRealloc #-}+serializeRealloc :: forall m a. (MonadIO m, Serialize a) =>+       (Int -> Int)+    -> MutArray Word8+    -> a+    -> m (MutArray Word8)+serializeRealloc sizer arr x = do+    let len = Serialize.addSizeTo 0 x+    arr1 <- liftIO $ reallocBytesWith "serializeRealloc" sizer len arr+    unsafeSerialize arr1 x++{-# INLINE serializeWith #-}+serializeWith :: forall m a. (MonadIO m, Serialize a) =>+       (Int -> Int)+    -> MutArray Word8+    -> a+    -> m (MutArray Word8)+serializeWith sizer arr@(MutArray mbarr start end bound) x = do+    let len = Serialize.addSizeTo 0 x+    if (bound - end) >= len+    then do+        off <- liftIO $ Serialize.serializeAt end mbarr x+        assertM(len <= off)+        pure $ MutArray mbarr start off bound+    -- XXX this will inhibit unboxing?+    else serializeRealloc sizer arr x++-- | Serializes a (Ptr, len) pair in the same way as an array. The serialized+-- value can be de-serialized as an array or consumed as a pointer using+-- deserializePtrN.+--+-- The Ptr must be pinned or the existence of the Ptr must be ensured by the+-- user of this API.+--+-- /Unimplemented/+{-# INLINE serializePtrN #-}+serializePtrN :: -- (MonadIO m) =>+    MutArray Word8 -> Ptr a -> Int -> m (MutArray Word8)+-- assert/error out if Ptr is not pinned. unsafe prefix?+-- First serialize the length and then splice the ptr+serializePtrN _arr _ptr _len = undefined++-- | Consume a serialized array or (Ptr, length) from the MutArray using an IO+-- action that consumes the pointer directly.+--+-- WARNING! The array must be a pinned array.+--+-- /Unimplemented/+{-# INLINE deserializePtrN #-}+deserializePtrN :: -- (MonadIO m) =>+    MutArray Word8 -> (Ptr a -> Int -> m b) -> m (a, MutArray Word8)+-- assert/error out if the array is not pinned. unsafe prefix?+deserializePtrN _arr _action = undefined++-- | Serialize the supplied Haskell value at the end of the mutable array,+-- growing the array size. If there is no reserve capacity left in the array+-- the array is reallocated to double the current size.+--+-- Like 'snoc' except that the value is serialized to the byte array.+--+-- Note: If you are serializing a large number of small fields, and the types+-- are statically known, then it may be more efficient to declare a record of+-- those fields and derive an 'Serialize' instance of the entire record.+--+-- /Unstable API/+{-# INLINE serialize #-}+serialize :: forall m a. (MonadIO m, Serialize a) =>+    MutArray Word8 -> a -> m (MutArray Word8)+serialize = serializeWith f++    where++    f oldSize =+        if isPower2 oldSize+        then oldSize * 2+        else roundUpToPower2 oldSize * 2++-- | Deserialize a Haskell value from the beginning of a mutable array. The+-- deserialized value is removed from the array and the remaining array is+-- returned.+--+-- Like 'uncons' except that the value is deserialized from the byte array.+--+-- Note: If you are deserializing a large number of small fields, and the types+-- are statically known, then it may be more efficient to declare a record of+-- those fields and derive 'Serialize' instance of the entire record.+--+-- /Unstable API/+{-# INLINE deserialize #-}+deserialize :: (MonadIO m, Serialize a) =>+    MutArray Word8 -> m (a, MutArray Word8)+deserialize arr@(MutArray {..}) = do+    let lenArr = byteLength arr+    (off, val) <-+        liftIO $ Serialize.deserializeAt arrStart arrContents (arrStart + lenArr)+    assertM(off <= arrStart + lenArr)+    pure (val, MutArray arrContents off arrEnd arrBound)+ ------------------------------------------------------------------------------- -- Compacting Streams of Arrays -------------------------------------------------------------------------------@@ -102,22 +257,28 @@ -- -- Generates unpinned arrays irrespective of the pinning status of input -- arrays.-{-# INLINE compactLE #-}-compactLE :: (MonadIO m, Unbox a) =>+{-# INLINE compactMax #-}+compactMax, compactLE :: (MonadIO m, Unbox a) =>     Int -> Stream m (MutArray a) -> Stream m (MutArray a) -- XXX compactLE can be moved to MutArray/Type if we are not using the parser -- to implement it.-compactLE = compactLeAs Unpinned+compactMax = compactLeAs Unpinned -- The parser version turns out to be a little bit slower. -- compactLE n = Stream.catRights . Stream.parseManyD (pCompactLE n) --- | Pinned version of 'compactLE'.-{-# INLINE pinnedCompactLE #-}-pinnedCompactLE :: forall m a. (MonadIO m, Unbox a)+RENAME(compactLE,compactMax)++-- | Like 'compactBySizeLE' but generates pinned arrays.+{-# INLINE_NORMAL compactMax' #-}+compactMax', pinnedCompactLE :: forall m a. (MonadIO m, Unbox a)     => Int -> Stream m (MutArray a) -> Stream m (MutArray a)-pinnedCompactLE = compactLeAs Pinned--- pinnedCompactLE n = Stream.catRights . Stream.parseManyD (pPinnedCompactLE n)+compactMax' = compactLeAs Pinned+-- compactMax' n = Stream.catRights . Stream.parseManyD (pPinnedCompactLE n) +{-# DEPRECATED pinnedCompactLE "Please use compactMax' instead." #-}+{-# INLINE pinnedCompactLE #-}+pinnedCompactLE = compactMax'+ data SplitState s arr     = Initial s     | Buffering s arr@@ -128,13 +289,13 @@ -- | 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. ---{-# INLINE_NORMAL _compactOnByteCustom #-}-_compactOnByteCustom+{-# INLINE_NORMAL _compactSepByByteCustom #-}+_compactSepByByteCustom     :: MonadIO m     => Word8     -> Stream m (MutArray Word8)     -> Stream m (MutArray Word8)-_compactOnByteCustom byte (Stream.Stream step state) =+_compactSepByByteCustom byte (Stream.Stream step state) =     Stream.Stream step' (Initial state)      where@@ -144,7 +305,7 @@         r <- step gst st         case r of             Stream.Yield arr s -> do-                (arr1, marr2) <- breakOn byte arr+                (arr1, marr2) <- breakEndByWord8_ byte arr                 return $ case marr2 of                     Nothing   -> Stream.Skip (Buffering s arr1)                     Just arr2 -> Stream.Skip (Yielding arr1 (Splitting s arr2))@@ -155,7 +316,7 @@         r <- step gst st         case r of             Stream.Yield arr s -> do-                (arr1, marr2) <- breakOn byte arr+                (arr1, marr2) <- breakEndByWord8_ byte arr                 -- XXX Use spliceExp instead and then rightSize?                 buf1 <- splice buf arr1                 return $ case marr2 of@@ -168,7 +329,7 @@                 else Stream.Skip (Yielding buf Finishing)      step' _ (Splitting st buf) = do-        (arr1, marr2) <- breakOn byte buf+        (arr1, marr2) <- breakEndByWord8_ byte buf         return $ case marr2 of                 Nothing -> Stream.Skip $ Buffering st arr1                 Just arr2 -> Stream.Skip $ Yielding arr1 (Splitting st arr2)@@ -176,14 +337,15 @@     step' _ (Yielding arr next) = return $ Stream.Yield arr next     step' _ Finishing = return Stream.Stop --- XXX implement predicate based version of this--- XXX Naming of predicate based vs custom version+-- XXX implement predicate based version of this compactSepBy_, compactEndBy_+-- XXX the versions that use equality can be named compactSepByElem_ etc. The+-- byte/word etc versions of that can be specialized using rewrite rules.  -- | 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. ---{-# INLINE compactOnByte #-}-compactOnByte+{-# INLINE compactSepByByte_ #-}+compactSepByByte_, compactOnByte     :: (MonadIO m)     => Word8     -> Stream m (MutArray Word8)@@ -191,17 +353,73 @@ -- XXX compare perf of custom vs idiomatic version -- compactOnByte = _compactOnByteCustom -- XXX use spliceExp and rightSize?-compactOnByte byte = Stream.splitInnerBy (breakOn byte) splice+compactSepByByte_ byte = Stream.splitInnerBy (breakEndByWord8_ byte) splice --- | Like 'compactOnByte' considers the separator in suffix position instead of--- infix position.-{-# INLINE compactOnByteSuffix #-}-compactOnByteSuffix+RENAME(compactOnByte,compactSepByByte_)++-- | 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.+--+{-# INLINE compactEndByByte_ #-}+compactEndByByte_, compactOnByteSuffix     :: (MonadIO m)     => Word8     -> Stream m (MutArray Word8)     -> Stream m (MutArray Word8)-compactOnByteSuffix byte =+compactEndByByte_ byte =         -- XXX use spliceExp and rightSize?         Stream.splitInnerBySuffix-            (\arr -> byteLength arr == 0) (breakOn byte) splice+            (\arr -> byteLength arr == 0) (breakEndByWord8_ byte) splice++RENAME(compactOnByteSuffix,compactEndByByte_)++-- XXX On windows we should compact on "\r\n". We can just compact on '\n' and+-- drop the last byte in each array if it is '\r'.++-- | Compact byte arrays on newline character, dropping the newline char.+{-# INLINE compactEndByLn_ #-}+compactEndByLn_ :: MonadIO m+    => Stream m (MutArray Word8)+    -> Stream m (MutArray Word8)+compactEndByLn_ = compactEndByByte_ 10++-- | @createOfLast n@ folds a maximum of @n@ elements from the end of the input+-- stream to an 'MutArray'.+--+{-# INLINE createOfLast #-}+createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (MutArray a)+createOfLast n =+    Fold.ifThen+        (pure (n <= 0))+        (Fold.fromPure empty)+        (Fold.rmapM RingArray.toMutArray $ RingArray.createOfLast n)++--------------------------------------------------------------------------------+-- IoRef (Deprecated)+--------------------------------------------------------------------------------++{-# DEPRECATED IORef "Use IORef from MutByteArray module." #-}+type IORef = IORef.IORef++{-# DEPRECATED pollIntIORef "Use pollIntIORef from MutByteArray module." #-}+pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> Stream m a+pollIntIORef = IORef.pollGenericIORef++{-# DEPRECATED newIORef "Use newIORef from MutByteArray module." #-}+newIORef :: forall a. Unbox a => a -> IO (IORef a)+newIORef = IORef.newIORef+++{-# DEPRECATED writeIORef "Use writeIORef from MutByteArray module." #-}+writeIORef :: Unbox a => IORef a -> a -> IO ()+writeIORef = IORef.writeIORef+++{-# DEPRECATED modifyIORef' "Use modifyIORef' from MutByteArray module." #-}+modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()+modifyIORef' = IORef.modifyIORef'+++{-# DEPRECATED readIORef "Use readIORef from MutByteArray module." #-}+readIORef :: Unbox a => IORef a -> IO a+readIORef = IORef.readIORef
src/Streamly/Internal/Data/MutArray/Generic.hs view
@@ -18,6 +18,9 @@     -- ** Construction     , nil +    -- ** Utils+    , initializeOfFilledUpto+     -- *** Uninitialized Arrays     , emptyOf     -- , newArrayWith@@ -40,7 +43,7 @@      -- * Random writes     , putIndex-    , putIndexUnsafe+    , unsafePutIndex     , putIndices     -- , putFromThenTo     -- , putFrom -- start writing at the given position@@ -48,7 +51,7 @@     -- , putFromTo     -- , putFromRev     -- , putUptoRev-    , modifyIndexUnsafe+    , unsafeModifyIndex     , modifyIndex     -- , modifyIndices     -- , modify@@ -68,7 +71,7 @@     , snoc     -- , snocLinear     -- , snocMay-    , snocUnsafe+    , unsafeSnoc      -- ** Appending streams     -- , writeAppendNUnsafe@@ -100,8 +103,8 @@      -- ** Random reads     , getIndex-    , getIndexUnsafe-    , getIndexUnsafeWith+    , unsafeGetIndex+    , unsafeGetIndexWith     -- , getIndices     -- , getFromThenTo     -- , getIndexRev@@ -110,7 +113,7 @@     , length      -- * In-place Mutation Algorithms-    , strip+    , dropAround     -- , reverse     -- , permute     -- , partitionBy@@ -144,10 +147,10 @@      -- ** Construct from arrays     -- get chunks without copying-    , getSliceUnsafe-    , getSlice+    , unsafeSliceOffLen+    , sliceOffLen     -- , getSlicesFromLenN-    -- , splitAt -- XXX should be able to express using getSlice+    -- , splitAt -- XXX should be able to express using sliceOffLen     -- , breakOn      -- ** Appending arrays@@ -155,22 +158,32 @@     -- , spliceWith     -- , splice     -- , spliceExp-    , putSliceUnsafe+    , unsafePutSlice     -- , appendSlice     -- , appendSliceFrom      , clone      -- * Deprecated+    , getSlice+    , strip     , new     , writeNUnsafe     , writeN     , writeWith     , write+    , getIndexUnsafe+    , getIndexUnsafeWith+    , putIndexUnsafe+    , modifyIndexUnsafe+    , snocUnsafe+    , getSliceUnsafe+    , putSliceUnsafe     ) where  #include "inline.hs"+#include "deprecation.h" #include "assert.hs"  import Control.Monad (when)@@ -199,7 +212,7 @@ import qualified Streamly.Internal.Data.Stream.Lift as D import qualified Streamly.Internal.Data.StreamK.Type as K -import Prelude hiding (read, length)+import Prelude hiding (read, length, replicate)  #include "DocTestDataMutArrayGeneric.hs" @@ -215,15 +228,11 @@         , arrStart :: {-# UNPACK #-}!Int           -- ^ The starting index of this slice. -        , arrLen :: {-# UNPACK #-}!Int-          -- ^ The length of this slice.+        , arrEnd :: {-# UNPACK #-}!Int+          -- ^ The index after the last initialized index. -        , 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.+        , arrBound :: {-# UNPACK #-}!Int+          -- ^ The first invalid index.         }  {-# INLINE bottomElement #-}@@ -243,23 +252,26 @@ -- 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. +{-# INLINE initializeOfFilledUpto #-}+initializeOfFilledUpto :: MonadIO m => Int -> Int -> a -> m (MutArray a)+initializeOfFilledUpto n@(I# n#) end val =+    liftIO+        $ IO+        $ \s# ->+              case newArray# n# val s# of+                  (# s1#, arr# #) ->+                      let ma = MutArray arr# 0 end n+                       in (# s1#, ma #)+ -- | @emptyOf count@ allocates a zero length array that can be extended to hold -- up to 'count' items without reallocating. -- -- /Pre-release/ {-# INLINE emptyOf #-} emptyOf :: MonadIO m => Int -> m (MutArray a)-emptyOf n@(I# n#) =-    liftIO-        $ IO-        $ \s# ->-              case newArray# n# bottomElement s# of-                  (# s1#, arr# #) ->-                      let ma = MutArray arr# 0 0 n-                       in (# s1#, ma #)+emptyOf n = initializeOfFilledUpto n 0 bottomElement --- XXX Deprecate in major--- {-# DEPRECATED new "Please use emptyOf instead." #-}+{-# DEPRECATED new "Please use emptyOf instead." #-} {-# INLINE new #-} new :: MonadIO m => Int -> m (MutArray a) new = emptyOf@@ -269,7 +281,7 @@ -- | -- Definition: ----- >>> nil = MutArray.new 0+-- >>> nil = MutArray.emptyOf 0 {-# INLINE nil #-} nil :: MonadIO m => m (MutArray a) nil = new 0@@ -282,9 +294,9 @@ -- 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 =+{-# INLINE putIndexUnderlying #-}+putIndexUnderlying :: MonadIO m => Int -> MutableArray# RealWorld a -> a -> m ()+putIndexUnderlying n _arrContents# x =     liftIO         $ IO         $ \s# ->@@ -297,11 +309,11 @@ -- 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+{-# INLINE unsafePutIndex #-}+unsafePutIndex, putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+unsafePutIndex i arr@(MutArray {..}) x =+    assert (i >= 0 && i < length arr)+        (putIndexUnderlying (i + arrStart) arrContents# x)  invalidIndex :: String -> Int -> a invalidIndex label i =@@ -315,9 +327,9 @@ -- /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+putIndex i arr x =+    if i >= 0 && i < length arr+    then unsafePutIndex i arr x     else invalidIndex "putIndex" i  -- | Write an input stream of (index, value) pairs to an array. Throws an@@ -339,8 +351,8 @@ -- 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+unsafeModifyIndex, modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+unsafeModifyIndex i MutArray {..} f = do     liftIO         $ IO         $ \s# ->@@ -356,9 +368,9 @@ -- -- /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+modifyIndex i arr f = do+    if i >= 0 && i < length arr+    then unsafeModifyIndex i arr f     else invalidIndex "modifyIndex" i  -------------------------------------------------------------------------------@@ -373,21 +385,23 @@ realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a) realloc n arr = do     arr1 <- new n-    let !newLen@(I# newLen#) = min n (arrLen arr)+    let !newLen@(I# newLen#) = min n (length arr)         !(I# arrS#) = arrStart arr         !(I# arr1S#) = arrStart arr1         arrC# = arrContents# arr         arr1C# = arrContents# arr1+        !newEnd = arrStart arr1 + newLen+        !newBound = arrStart arr1 + n     liftIO         $ IO         $ \s# ->               let s1# = copyMutableArray# arrC# arrS# arr1C# arr1S# newLen# s#-               in (# s1#, arr1 {arrLen = newLen, arrTrueLen = n} #)+               in (# s1#, arr1 {arrEnd = newEnd, arrBound = newBound} #)  reallocWith ::        MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a) reallocWith label sizer reqSize arr = do-    let oldSize = arrLen arr+    let oldSize = length arr         newSize = sizer oldSize         safeSize = max newSize (oldSize + reqSize)     assert (newSize >= oldSize + reqSize || error badSize) (return ())@@ -413,20 +427,19 @@ -- 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+{-# INLINE unsafeSnoc #-}+snocUnsafe, unsafeSnoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+unsafeSnoc arr@(MutArray{..}) x = do+    let newEnd = arrEnd + 1+    putIndexUnderlying arrEnd arrContents# x+    return $ arr {arrEnd = newEnd}  -- 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+    unsafeSnoc arr1 x  -- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of -- the array increases by 1.@@ -441,8 +454,8 @@ {-# 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+    if arrEnd < arrBound+    then unsafeSnoc arr x     else snocWithRealloc sizer arr x  -- XXX round it to next power of 2.@@ -472,9 +485,9 @@ {-# 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+    if arrEnd + len <= arrBound+    then return $ arr {arrEnd = arrEnd + len}+    else realloc (length arr + len) arr  ------------------------------------------------------------------------------- -- Random reads@@ -484,9 +497,9 @@ -- 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 =+{-# INLINE unsafeGetIndexWith #-}+unsafeGetIndexWith, getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+unsafeGetIndexWith _arrContents# n =     liftIO         $ IO         $ \s# ->@@ -496,17 +509,17 @@ -- | 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)+{-# INLINE_NORMAL unsafeGetIndex #-}+unsafeGetIndex, getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+unsafeGetIndex n MutArray {..} = unsafeGetIndexWith 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+getIndex i arr =+    if i >= 0 && i < length arr+    then Just <$> unsafeGetIndex i arr     else return Nothing  -------------------------------------------------------------------------------@@ -522,32 +535,38 @@ -- /Unsafe/ -- -- /Pre-release/-{-# INLINE getSliceUnsafe #-}-getSliceUnsafe+{-# INLINE unsafeSliceOffLen #-}+unsafeSliceOffLen, 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}+unsafeSliceOffLen index len arr@MutArray {..} =+    assert (index >= 0 && len >= 0 && index + len <= length arr)+        $ arr {arrStart = newStart, arrEnd = newEnd}+    where+    newStart = arrStart + index+    newEnd = newStart + 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+{-# INLINE sliceOffLen #-}+sliceOffLen, 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}+sliceOffLen index len arr@MutArray{..} =+    if index >= 0 && len >= 0 && index + len <= length arr+    then arr {arrStart = newStart, arrEnd = newEnd}     else error-             $ "getSlice: invalid slice, index "+             $ "sliceOffLen: invalid slice, index "              ++ show index ++ " length " ++ show len+    where+    newStart = arrStart + index+    newEnd = newStart + len  ------------------------------------------------------------------------------- -- to Lists and streams@@ -561,7 +580,7 @@ -- /Pre-release/ {-# INLINE toList #-} toList :: MonadIO m => MutArray a -> m [a]-toList arr@MutArray{..} = mapM (`getIndexUnsafe` arr) [0 .. (arrLen - 1)]+toList arr = mapM (`unsafeGetIndex` arr) [0 .. (length arr - 1)]  -- | Generates a stream from the elements of a @MutArray@. --@@ -569,27 +588,30 @@ -- {-# INLINE_NORMAL read #-} read :: MonadIO m => MutArray a -> D.Stream m a-read arr@MutArray{..} =-    D.mapM (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)+read arr =+    D.mapM (`unsafeGetIndex` arr) $ D.enumerateFromToIntegral 0 (length arr - 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+toStreamK arr = K.unfoldrM step 0      where +    arrLen = length arr     step i         | i == arrLen = return Nothing         | otherwise = do-            x <- getIndexUnsafe i arr+            x <- unsafeGetIndex 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)+readRev arr =+    D.mapM (`unsafeGetIndex` arr)         $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0+    where+    arrLen = length arr  ------------------------------------------------------------------------------- -- Folds@@ -617,7 +639,7 @@      initial = FL.Partial <$> new (max n 0) -    step arr x = FL.Partial <$> snocUnsafe arr x+    step arr x = FL.Partial <$> unsafeSnoc arr x  {-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-} {-# INLINE writeNUnsafe #-}@@ -634,8 +656,7 @@ createOf :: MonadIO m => Int -> Fold m a (MutArray a) createOf n = FL.take n $ unsafeCreateOf n --- XXX Deprecate in major--- {-# DEPRECATED writeN "Please use createOf instead." #-}+{-# DEPRECATED writeN "Please use createOf instead." #-} {-# INLINE writeN #-} writeN :: MonadIO m => Int -> Fold m a (MutArray a) writeN = createOf@@ -667,8 +688,8 @@         let oldSize = end - start             newSize = max (oldSize * 2) 1         arr1 <- realloc newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x+        unsafeSnoc arr1 x+    step arr x = unsafeSnoc arr x      -- extract = rightSize     extract = return@@ -689,8 +710,7 @@ create :: MonadIO m => Fold m a (MutArray a) create = writeWith arrayChunkSize --- XXX Deprecate in major--- {-# DEPRECATED write "Please use create instead." #-}+{-# DEPRECATED write "Please use create instead." #-} {-# INLINE write #-} write :: MonadIO m => Fold m a (MutArray a) write = create@@ -770,7 +790,7 @@         r <- step (adaptState gst) st         case r of             D.Yield x s -> do-                putIndexUnsafeWith end contents x+                putIndexUnderlying end contents x                 let end1 = end + 1                 return $                     if end1 >= bound@@ -806,13 +826,13 @@      {-# INLINE extract #-}     extract (arr, i) =-        return $ arr {arrStart = arrStart arr + i, arrLen = arrLen arr - i}+        return $ arr {arrStart = arrStart arr + i}      {-# INLINE_LATE step #-}     step (arr, i)-        | assert (arrLen arr >= 0) (i == arrLen arr) = return D.Stop+        | i == length arr = return D.Stop     step (arr, i) = do-        x <- liftio $ getIndexUnsafe i arr+        x <- liftio $ unsafeGetIndex i arr         return $ D.Yield x (arr, i + 1)  -- | Resumable unfold of an array.@@ -833,12 +853,12 @@  -- | 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 =>+{-# INLINE unsafePutSlice #-}+unsafePutSlice, 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)+unsafePutSlice src srcStart dst dstStart len = liftIO $ do+    assertM(len <= length dst)+    assertM(len <= length src)     let !(I# srcStart#) = srcStart + arrStart src         !(I# dstStart#) = dstStart + arrStart dst         !(I# len#) = len@@ -851,9 +871,9 @@ {-# INLINE clone #-} clone :: MonadIO m => MutArray a -> m (MutArray a) clone src = do-    let len = arrLen src+    let len = length src     dst <- new len-    putSliceUnsafe src 0 dst 0 len+    unsafePutSlice src 0 dst 0 len     return dst  -------------------------------------------------------------------------------@@ -862,7 +882,7 @@  {-# INLINE length #-} length :: MutArray a -> Int-length = arrLen+length arr = arrEnd arr - arrStart arr  ------------------------------------------------------------------------------- -- Equality@@ -888,8 +908,8 @@     loop i         | i < 0 = return EQ         | otherwise = do-            v1 <- getIndexUnsafe i a1-            v2 <- getIndexUnsafe i a2+            v1 <- unsafeGetIndex i a1+            v2 <- unsafeGetIndex i a2             case compare v1 v2 of                 EQ -> loop (i - 1)                 x -> return x@@ -909,15 +929,15 @@     loop i         | i < 0 = return True         | otherwise = do-            v1 <- getIndexUnsafe i a1-            v2 <- getIndexUnsafe i a2+            v1 <- unsafeGetIndex i a1+            v2 <- unsafeGetIndex 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+{-# INLINE dropAround #-}+dropAround, strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+dropAround p arr = liftIO $ do     let lastIndex = length arr - 1     indexR <- getIndexR lastIndex -- last predicate failing index     if indexR < 0@@ -928,20 +948,34 @@         then return arr         else            let newLen = indexR - indexL + 1-            in return $ getSliceUnsafe indexL newLen arr+            in return $ unsafeSliceOffLen indexL newLen arr      where      getIndexR idx         | idx < 0 = return idx         | otherwise = do-            r <- getIndexUnsafe idx arr+            r <- unsafeGetIndex idx arr             if p r             then getIndexR (idx - 1)             else return idx      getIndexL idx = do-        r <- getIndexUnsafe idx arr+        r <- unsafeGetIndex idx arr         if p r         then getIndexL (idx + 1)         else return idx++--------------------------------------------------------------------------------+-- Renaming+--------------------------------------------------------------------------------++RENAME(strip,dropAround)+RENAME(putIndexUnsafe, unsafePutIndex)+RENAME(modifyIndexUnsafe, unsafeModifyIndex)+RENAME(getIndexUnsafe, unsafeGetIndex)+RENAME(getIndexUnsafeWith, unsafeGetIndexWith)+RENAME(getSliceUnsafe,unsafeSliceOffLen)+RENAME(putSliceUnsafe, unsafePutSlice)+RENAME(getSlice,sliceOffLen)+RENAME(snocUnsafe, unsafeSnoc)
src/Streamly/Internal/Data/MutArray/Stream.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module      : Streamly.Internal.Data.MutArray.Stream -- Copyright   : (c) 2019 Composewell Technologies
src/Streamly/Internal/Data/MutArray/Type.hs view
@@ -1,3327 +1,4221 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UnliftedFFITypes #-}--- |--- 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 (..)--    -- ** Conversion-    -- *** Pinned and Unpinned-    , pin-    , unpin-    , isPinned--    -- ** Casting-    , cast-    , castUnsafe -- XXX unsafeCast-    , asBytes-    , unsafePinnedAsPtr-    , unsafeAsPtr--    -- ** Construction-    , empty--    -- *** New-    -- | New arrays are always empty arrays with some reserve capacity to-    -- extend the length without reallocating.-    , emptyOf-    , newArrayWith -- emptyAlignedWith-    , pinnedEmptyOf-    , pinnedNewAligned -- XXX not required-    -- , new -- uninitialized array of specified length--    -- *** Cloning-    , clone-    , pinnedClone--    -- *** Slicing-    -- | Get a subarray without copying-    , getSliceUnsafe -- XXX unsafeGetSlice-    , getSlice-    , splitAt -- XXX should be able to express using getSlice-    , breakOn--    -- *** Stream Folds-    , ArrayUnsafe (..)-    , unsafeCreateOfWith-    , unsafeCreateOf-    , unsafePinnedCreateOf-    , pinnedCreateOf-    , createOfWith-    , createOf-    , revCreateOf--    , pinnedCreate-    , createWith-    , create-    -- , revCreate--    -- *** From containers-    , fromListN-    , pinnedFromListN-    , fromList-    , pinnedFromList-    , fromListRevN-    , fromListRev-    , fromStreamN-    , fromStream-    , fromPureStreamN-    , fromPureStream-    , fromByteStr#-    , fromPtrN-    , fromChunksK-    , fromChunksRealloced -- fromSmallChunks--    -- ** Random writes-    , putIndex-    , putIndexUnsafe -- XXX unsafePutIndex-    , putIndices-    -- , putFromThenTo-    -- , putFrom -- start writing at the given position-    -- , putUpto -- write from beginning up to the given position-    -- , putFromTo-    -- , putFromRev-    -- , putUptoRev-    , modifyIndexUnsafe -- XXX unsafeModifyIndex-    , modifyIndex-    , modifyIndices-    , modify-    , swapIndices-    , unsafeSwapIndices--    -- ** Reading--    -- *** Indexing-    , getIndex-    , getIndexUnsafe -- XXX unsafeGetIndex-    -- , getFromThenTo-    , getIndexRev -- getRevIndex?-    , indexReader-    , indexReaderWith--    -- *** To Streams-    , read-    , readRev-    , toStreamWith-    , toStreamRevWith-    , toStreamK-    , toStreamKWith-    , toStreamKRev-    , toStreamKRevWith--    -- *** To Containers-    , toList--    -- *** Unfolds-    -- experimental-    , producerWith-    , producer--    , reader-    , readerRevWith-    , readerRev--    -- ** Size and Capacity-    -- *** Size-    , length-    , byteLength--    -- *** Capacity-    -- , capacity-    , byteCapacity-    , bytesFree--    -- *** Capacity Management-    , blockSize-    , arrayChunkBytes-    , allocBytesToElemCount-    , realloc -- this is "resize"-    , grow-    , growExp-    , rightSize--    -- ** Folding-    , foldl'-    , foldr-    , byteCmp-    , byteEq--    -- ** In-place Mutation Algorithms-    , strip-    , reverse-    , permute-    , partitionBy-    , shuffleBy-    , divideBy-    , mergeBy-    , bubble--    -- ** 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-    -- both lower and upper bound in the array representation.--    -- *** Appending elements-    , snocWith-    , snoc-    , snocLinear-    , snocMay-    , snocUnsafe -- XXX unsafeSnoc--    -- *** Appending streams-    , unsafeAppendN-    , appendN-    , appendWith-    , append--    -- *** Appending arrays-    , spliceCopy-    , spliceWith-    , splice-    , spliceExp-    , spliceUnsafe -- XXX unsafeSplice-    -- , putSlice-    -- , appendSlice-    -- , appendSliceFrom--    -- ** Serialization using Unbox-    , pokeAppend-    , pokeAppendMay-    , pokeSkipUnsafe -- unsafePokeSkip--    -- ** Deserialization using Unbox-    , peekUncons-    , peekUnconsUnsafe -- unsafePeekUncons-    , peekSkipUnsafe -- unsafePeekSkip--    -- 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.--    -- ** Streams of Arrays-    -- *** Chunk-    -- | Group a stream into arrays.-    , chunksOf-    , pinnedChunksOf-    , buildChunks--    -- *** Split-    -- | Split an array into slices.--    -- , getSlicesFromLenN-    , splitOn-    -- , slicesOf--    -- *** Concat-    -- | Append the arrays in a stream to form a stream of elements.-    , concatWith-    , concatRevWith-    , concat-    , concatRev--    -- *** Compact-    -- | Append the arrays in a stream to form a stream of larger arrays.-    , SpliceState (..)-    , pCompactLE-    , pPinnedCompactLE-    , compactLeAs-    , fCompactGE-    , fPinnedCompactGE-    , lCompactGE-    , lPinnedCompactGE-    , compactGE-    , compactEQ--    -- ** Utilities-    , roundUpToPower2-    , memcpy-    , memcmp-    , c_memchr--    -- * Deprecated-    , asPtrUnsafe-    , writeChunks-    , flattenArrays-    , flattenArraysRev-    , fromArrayStreamK-    , fromStreamDN-    , fromStreamD-    , cmp-    , getIndices-    , getIndicesWith-    , resize-    , resizeExp-    , nil-    , new-    , pinnedNew-    , pinnedNewBytes-    , writeAppendNUnsafe-    , writeAppendN-    , writeAppendWith-    , writeAppend-    , writeNWithUnsafe-    , writeNWith-    , writeNUnsafe-    , pinnedWriteNUnsafe-    , writeN-    , pinnedWriteN-    , pinnedWriteNAligned -- XXX not required-    , writeWith-    , write-    , pinnedWrite-    , writeRevN-    )-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.Bifunctor (first)-import Data.Bits (shiftR, (.|.), (.&.))-import Data.Functor.Identity (Identity(..))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Foreign.C.Types (CSize(..))-import Foreign.Ptr (plusPtr)-import Foreign.C.Types (CInt(..))-import Streamly.Internal.Data.MutByteArray.Type-    ( MutByteArray(..)-    , PinnedState(..)-    , getMutableByteArray#-    , putSliceUnsafe-    )-import Streamly.Internal.Data.Unbox (Unbox(..))-import GHC.Base-    ( IO(..)-    , Int(..)-    , compareByteArrays#-    , copyMutableByteArray#-    )-import GHC.Base (noinline)-import GHC.Exts (unsafeCoerce#, Addr#, MutableByteArray#, RealWorld)-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.Parser.Type (Parser (..))-import Streamly.Internal.Data.StreamK.Type (StreamK)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-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.Parser.Type as Parser--- import qualified Streamly.Internal.Data.Fold.Type as Fold-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(..), concat, read, unlines, splitAt, reverse, truncate)--#include "DocTestDataMutArray.hs"------------------------------------------------------------------------------------ Foreign helpers------------------------------------------------------------------------------------ NOTE: Have to be "ccall unsafe" so that we can pass unpinned memory to these-foreign import ccall unsafe "string.h memcpy" c_memcpy_pinned_src-    :: MutableByteArray# RealWorld -> Ptr Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "memchr_index" c_memchr_index-    :: MutableByteArray# RealWorld -> CSize -> Word8 -> CSize -> IO CSize--foreign import ccall unsafe "string.h strlen" c_strlen_pinned-    :: Addr# -> IO CSize---- | 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)------------------------------------------------------------------------------------ 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.---- XXX Rename to emptyAlignedWith, alignSize should be first arg.---- | @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-        }---- For arrays "nil" sounds a bit odd. empty is better. The only problem with--- empty is that it is also used by the Alternative type class. But assuming we--- will mostly import the Array module qualified this should be fine.---- | Create an empty array.-empty ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a-empty = MutArray Unboxed.empty 0 0 0--{-# DEPRECATED nil "Please use empty instead." #-}-nil ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a-nil = empty--{-# 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 with a reserved capacity of bytes.--- The memory of the array is uninitialized and the allocation is aligned as--- per the 'Unboxed' instance of the type.------ /Pre-release/-{-# INLINE pinnedNewBytes #-}-{-# DEPRECATED pinnedNewBytes "Please use pinnedEmptyOf with appropriate calculation" #-}-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 a pinned array of zero length but growable to the specified--- capacity without reallocation.-{-# INLINE pinnedEmptyOf #-}-pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)-pinnedEmptyOf = newAs Pinned---- XXX Deprecate in major--- {-# DEPRECATED pinnedNew "Please use pinnedEmptyOf instead." #-}-{-# INLINE pinnedNew #-}-pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)-pinnedNew = pinnedEmptyOf---- | Allocates an unpinned array of zero length but growable to the specified--- capacity without reallocation.----{-# INLINE emptyOf #-}-emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)-emptyOf = newAs Unpinned---- XXX Deprecate in major--- {-# DEPRECATED new "Please use emptyOf instead." #-}-{-# INLINE new #-}-new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)-new = emptyOf------------------------------------------------------------------------------------ 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) = 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)---- 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 reallocExplicitAs #-}-reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)-reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do-    assertM(arrEnd <= arrBound)--    -- Allocate new array-    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes-    contents <--        if ps == Pinned-        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-        }---- XXX Should these be called reallocBytes etc?--- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In--- fact clone/pinnedClone can be implemented using reallocAs.---- | @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 =-    let ps =-            if isPinned arr-            then Pinned-            else Unpinned-     in liftIO $ reallocExplicitAs ps (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 =-        Prelude.concat-            [ label-            , ": new array size (in bytes) is less than required size "-            , show newSize-            , ". Please check the sizing function passed."-            ]---- | @grow 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 grow #-}-grow :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-grow nElems arr@MutArray{..} = do-    let req = SIZE_OF(a) * nElems-        cap = arrBound - arrStart-    if req < cap-    then return arr-    else realloc req arr--{-# DEPRECATED resize "Please use grow instead." #-}-{-# INLINE resize #-}-resize :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resize = grow---- | Like 'grow' but if the requested byte capacity is more than--- 'largeObjectThreshold' then it is rounded up to the closest power of 2.------ /Pre-release/-{-# INLINE growExp #-}-growExp :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-growExp nElems arr@MutArray{..} = do-    let req = roundUpLargeArray (SIZE_OF(a) * nElems)-        req1 =-            if req > largeObjectThreshold-            then roundUpToPower2 req-            else req-        cap = arrBound - arrStart-    if req1 < cap-    then return arr-    else realloc req1 arr--{-# DEPRECATED resizeExp "Please use growExp instead." #-}-{-# INLINE resizeExp #-}-resizeExp :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resizeExp = growExp---- | 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 = 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 <- 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 = 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------------------------------------------------------------------------------------ Serialization/Deserialization----------------------------------------------------------------------------------{-# INLINE pokeNewEnd #-}-pokeNewEnd :: (MonadIO m, Unbox a) =>-    Int -> MutArray Word8 -> a -> m (MutArray Word8)-pokeNewEnd newEnd arr@MutArray{..} x = liftIO $ do-    assert (newEnd <= arrBound) (return ())-    liftIO $ pokeAt arrEnd arrContents x-    return $ arr {arrEnd = newEnd}---- | Really really unsafe, unboxes a Haskell type and appends the resulting--- bytes to the byte array, may cause silent data corruption or if you are--- lucky a segfault if the array does not have enough space to append the--- element.------ /Internal/-{-# INLINE pokeAppendUnsafe #-}-pokeAppendUnsafe :: forall m a. (MonadIO m, Unbox a) =>-    MutArray Word8 -> a -> m (MutArray Word8)-pokeAppendUnsafe arr@MutArray{..} = pokeNewEnd (arrEnd + SIZE_OF(a)) arr---- | Skip the specified number of bytes in the array. The data in the skipped--- region remains uninitialzed.-{-# INLINE pokeSkipUnsafe #-}-pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8-pokeSkipUnsafe n arr@MutArray{..} =  do-    let newEnd = arrEnd + n-     in assert (newEnd <= arrBound) (arr {arrEnd = newEnd})---- | Like 'pokeAppend' but does not grow the array when pre-allocated array--- capacity becomes full.------ /Internal/-{-# INLINE pokeAppendMay #-}-pokeAppendMay :: forall m a. (MonadIO m, Unbox a) =>-    MutArray Word8 -> a -> m (Maybe (MutArray Word8))-pokeAppendMay arr@MutArray{..} x = liftIO $ do-    let newEnd = arrEnd + SIZE_OF(a)-    if newEnd <= arrBound-    then Just <$> pokeNewEnd newEnd arr x-    else return Nothing--{-# NOINLINE pokeWithRealloc #-}-pokeWithRealloc :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray Word8-    -> a-    -> m (MutArray Word8)-pokeWithRealloc sizer arr x = do-    arr1 <- liftIO $ reallocWith "pokeWithRealloc" sizer (SIZE_OF(a)) arr-    pokeAppendUnsafe arr1 x--{-# INLINE pokeAppendWith #-}-pokeAppendWith :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray Word8-    -> a-    -> m (MutArray Word8)-pokeAppendWith allocSize arr x = liftIO $ do-    let newEnd = arrEnd arr + SIZE_OF(a)-    if newEnd <= arrBound arr-    then pokeNewEnd newEnd arr x-    else pokeWithRealloc allocSize arr x---- | Unbox a Haskell type and append the resulting bytes to a mutable byte--- array. The array is grown exponentially when more space is needed.------ Definition:------ >>> pokeAppend arr x = MutArray.castUnsafe <$> MutArray.snoc (MutArray.castUnsafe arr) x----{-# INLINE pokeAppend #-}-pokeAppend :: forall m a. (MonadIO m, Unbox a) =>-    MutArray Word8 -> a -> m (MutArray Word8)-pokeAppend = pokeAppendWith f--    where--    f oldSize =-        if isPower2 oldSize-        then oldSize * 2-        else roundUpToPower2 oldSize * 2---- | Really really unsafe, create a Haskell value from an unboxed byte array,--- does not check if the array is big enough, may return garbage or if you are--- lucky may cause a segfault.------ /Internal/-{-# INLINE peekUnconsUnsafe #-}-peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) =>-    MutArray Word8 -> m (a, MutArray Word8)-peekUnconsUnsafe MutArray{..} = do-    let start1 = arrStart + SIZE_OF(a)-    assert (start1 <= arrEnd) (return ())-    liftIO $ do-        r <- peekAt arrStart arrContents-        return (r, MutArray arrContents start1 arrEnd arrBound)---- | Discard the specified number of bytes in the array.-{-# INLINE peekSkipUnsafe #-}-peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8-peekSkipUnsafe n MutArray{..} =-    let start1 = arrStart + n-     in assert (start1 <= arrEnd) (MutArray arrContents start1 arrEnd arrBound)---- | Create a Haskell value from its unboxed representation from the head of a--- byte array, return the value and the remaining array.-{-# INLINE peekUncons #-}-peekUncons :: forall m a. (MonadIO m, Unbox a) =>-    MutArray Word8 -> m (Maybe a, MutArray Word8)-peekUncons arr@MutArray{..} = do-    let start1 = arrStart + SIZE_OF(a)-    if start1 > arrEnd-    then return (Nothing, arr)-    else liftIO $ do-        r <- peekAt arrStart arrContents-        return (Just r, MutArray arrContents start1 arrEnd arrBound)------------------------------------------------------------------------------------ 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--{-# INLINE indexReaderWith #-}-indexReaderWith :: (Monad m, Unbox a) =>-    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a-indexReaderWith 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--{-# DEPRECATED getIndicesWith "Please use indexReaderWith instead." #-}-{-# INLINE getIndicesWith #-}-getIndicesWith :: (Monad m, Unbox a) =>-    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a-getIndicesWith = indexReaderWith---- | 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 indexReader #-}-indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a-indexReader = indexReaderWith liftIO---- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold-{-# DEPRECATED getIndices "Please use indexReader instead." #-}-{-# INLINE getIndices #-}-getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a-getIndices = indexReader------------------------------------------------------------------------------------ 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.createOf 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 (createOf 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 (pinnedCreateOf n)-pinnedChunksOf = chunksOfAs Pinned---- | When we are buffering a stream of unknown size into an array we do not--- know how much space to pre-allocate. So we start with the min size and emit--- the array then keep on doubling the size every time. Thus we do not need to--- guess the optimum chunk size.------ We can incorporate this in chunksOfAs if the additional size parameter does--- not impact perf.----{-# INLINE _chunksOfRange #-}-_chunksOfRange :: -- (MonadIO m, Unbox a) =>-    PinnedState -> Int -> Int -> D.Stream m a -> D.Stream m (MutArray a)-_chunksOfRange _ps _low _hi = undefined---- 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--{-# INLINE_NORMAL concatWith #-}-concatWith :: forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a-concatWith liftio (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 "reader" unfold instead.------ @concat = unfoldMany reader@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL concat #-}-concat :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-concat = concatWith liftIO--{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}-{-# INLINE flattenArrays #-}-flattenArrays :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArrays = concat--{-# INLINE_NORMAL concatRevWith #-}-concatRevWith :: forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a-concatRevWith liftio (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)---- | Use the "readerRev" unfold instead.------ @concat = unfoldMany readerRev@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL concatRev #-}-concatRev :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-concatRev = concatRevWith liftIO--{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}-{-# INLINE flattenArraysRev #-}-flattenArraysRev :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArraysRev = concatRev------------------------------------------------------------------------------------ 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 toStreamWith #-}-toStreamWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamWith 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 = toStreamWith 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 toStreamRevWith #-}-toStreamRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamRevWith 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 = toStreamRevWith 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?---- | @unsafeAppendN 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 unsafeAppendN #-}-unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>-       Int-    -> m (MutArray a)-    -> Fold m a (MutArray a)-unsafeAppendN 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 "unsafeAppendN" (+ 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))--{-# DEPRECATED writeAppendNUnsafe "Please use unsafeAppendN instead." #-}-{-# INLINE writeAppendNUnsafe #-}-writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>-       Int-    -> m (MutArray a)-    -> Fold m a (MutArray a)-writeAppendNUnsafe = unsafeAppendN---- | Append @n@ elements to an existing array. Any free space left in the array--- after appending @n@ elements is lost.------ >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)----{-# INLINE_NORMAL appendN #-}-appendN :: forall m a. (MonadIO m, Unbox a) =>-    Int -> m (MutArray a) -> Fold m a (MutArray a)-appendN n initial = FL.take n (unsafeAppendN n initial)---- XXX Deprecate in major--- {-# DEPRECATED writeAppendN "Please use appendN instead." #-}-{-# INLINE writeAppendN #-}-writeAppendN :: forall m a. (MonadIO m, Unbox a) =>-    Int -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendN = appendN---- | @appendWith 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.------ >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)------ /Pre-release/-{-# INLINE appendWith #-}-appendWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)-appendWith sizer = FL.foldlM' (snocWith sizer)--{-# DEPRECATED writeAppendWith "Please use appendWith instead." #-}-{-# INLINE writeAppendWith #-}-writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendWith = appendWith---- | @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.------ >>> append = MutArray.appendWith (* 2)----{-# INLINE append #-}-append :: forall m a. (MonadIO m, Unbox a) =>-    m (MutArray a) -> Fold m a (MutArray a)-append = appendWith (* 2)---- XXX Deprecate in major--- {-# DEPRECATED writeAppend "Please use append instead." #-}-{-# INLINE writeAppend #-}-writeAppend :: forall m a. (MonadIO m, Unbox a) =>-    m (MutArray a) -> Fold m a (MutArray a)-writeAppend = append---- 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 'unsafeCreateOf' but takes a new array allocator @alloc size@--- function as argument.------ >>> unsafeCreateOfWith alloc n = MutArray.unsafeAppendN (alloc n) n------ /Pre-release/-{-# INLINE_NORMAL unsafeCreateOfWith #-}-unsafeCreateOfWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-unsafeCreateOfWith 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))--{-# DEPRECATED writeNWithUnsafe "Please use unsafeCreateOfWith instead." #-}-{-# INLINE writeNWithUnsafe #-}-writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWithUnsafe = unsafeCreateOfWith--{-# INLINE_NORMAL writeNUnsafeAs #-}-writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> Fold m a (MutArray a)-writeNUnsafeAs ps = unsafeCreateOfWith (newAs ps)---- | Like 'createOf' 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.------ >>> unsafeCreateOf = MutArray.unsafeCreateOfWith MutArray.emptyOf----{-# INLINE_NORMAL unsafeCreateOf #-}-unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-unsafeCreateOf = writeNUnsafeAs Unpinned--{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}-{-# INLINE writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-writeNUnsafe = unsafeCreateOf---- | Like 'unsafeCreateOf' but creates a pinned array.-{-# INLINE_NORMAL unsafePinnedCreateOf #-}-unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-unsafePinnedCreateOf = writeNUnsafeAs Pinned--{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafePinnedCreateOf instead." #-}-{-# INLINE pinnedWriteNUnsafe #-}-pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-pinnedWriteNUnsafe = unsafePinnedCreateOf---- | @createOfWith alloc n@ folds a maximum of @n@ elements into an array--- allocated using the @alloc@ function.------ >>> createOfWith alloc n = Fold.take n (MutArray.unsafeCreateOfWith alloc n)--- >>> createOfWith alloc n = MutArray.appendN (alloc n) n----{-# INLINE_NORMAL createOfWith #-}-createOfWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-createOfWith alloc n = FL.take n (unsafeCreateOfWith alloc n)---- {-# DEPRECATED writeNWith "Please use createOfWith instead." #-}-{-# INLINE writeNWith #-}-writeNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWith = createOfWith--{-# INLINE_NORMAL writeNAs #-}-writeNAs ::-       forall m a. (MonadIO m, Unbox a)-    => PinnedState-    -> Int-    -> Fold m a (MutArray a)-writeNAs ps = createOfWith (newAs ps)---- | @createOf n@ folds a maximum of @n@ elements from the input stream to an--- 'MutArray'.------ >>> createOf = MutArray.createOfWith MutArray.new--- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)--- >>> createOf n = MutArray.appendN n (MutArray.emptyOf n)----{-# INLINE_NORMAL createOf #-}-createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-createOf = writeNAs Unpinned---- XXX Deprecate in major--- {-# DEPRECATED writeN "Please use createOf instead." #-}-{-# INLINE writeN #-}-writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeN = createOf---- | Like 'createOf' but creates a pinned array.-{-# INLINE_NORMAL pinnedCreateOf #-}-pinnedCreateOf ::-       forall m a. (MonadIO m, Unbox a)-    => Int-    -> Fold m a (MutArray a)-pinnedCreateOf = writeNAs Pinned--{-# DEPRECATED pinnedWriteN "Please use pinnedCreateOf instead." #-}-{-# INLINE pinnedWriteN #-}-pinnedWriteN ::-       forall m a. (MonadIO m, Unbox a)-    => Int-    -> Fold m a (MutArray a)-pinnedWriteN = pinnedCreateOf---- | Like unsafeCreateOfWith 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 createOfWith 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 'createOf' but writes the array in reverse order.------ /Pre-release/-{-# INLINE_NORMAL revCreateOf #-}-revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-revCreateOf = writeRevNWith new--{-# DEPRECATED writeRevN "Please use revCreateOf instead." #-}-{-# INLINE writeRevN #-}-writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeRevN = revCreateOf---- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the--- input stream to a 'MutArray' aligned to the given size.------ >>> pinnedWriteNAligned align = MutArray.createOfWith (MutArray.pinnedNewAligned align)--- >>> pinnedWriteNAligned align n = MutArray.appendN 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 = createOfWith (pinnedNewAligned align)---- XXX Buffer to a list instead?---- | Buffer a stream into a stream of arrays.------ >>> buildChunks n = Fold.many (MutArray.createOf 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 buildChunks #-}-buildChunks :: (MonadIO m, Unbox a) =>-    Int -> Fold m a (StreamK n (MutArray a))-buildChunks n = FL.many (createOf n) FL.toStreamK--{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}-{-# INLINE writeChunks #-}-writeChunks :: (MonadIO m, Unbox a) =>-    Int -> Fold m a (StreamK n (MutArray a))-writeChunks = buildChunks--{-# INLINE_NORMAL writeWithAs #-}-writeWithAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> Fold m a (MutArray a)--- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)-writeWithAs ps elemCount =-    FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        when (elemCount < 0) $ error "createWith: elemCount is negative"-        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 $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x--    extract = liftIO . rightSize---- XXX Compare createWith with fromStreamD which uses an array of streams--- implementation. We can write this using buildChunks above if that is faster.--- If createWith 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.---- | @createWith 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.appendWith (* 2) (MutArray.emptyOf n)--- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)--- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)------ /Pre-release/-{-# INLINE_NORMAL createWith #-}-createWith :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)--- createWith n = FL.rmapM rightSize $ appendWith (* 2) (emptyOf n)-createWith = writeWithAs Unpinned--{-# DEPRECATED writeWith "Please use createWith instead." #-}-{-# INLINE writeWith #-}-writeWith :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-writeWith = createWith---- | Fold the whole input to a single array.------ Same as 'createWith' using an initial array size of 'arrayChunkBytes' bytes--- rounded up to the element size.------ /Caution! Do not use this on infinite streams./----{-# INLINE create #-}-create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-create = createWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)---- XXX Deprecate in major--- {-# DEPRECATED write "Please use create instead." #-}-{-# INLINE write #-}-write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-write = create---- | Like 'create' but creates a pinned array.-{-# INLINE pinnedCreate #-}-pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-pinnedCreate =-    writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)--{-# DEPRECATED pinnedWrite "Please use pinnedCreate instead." #-}-{-# INLINE pinnedWrite #-}-pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-pinnedWrite = pinnedCreate------------------------------------------------------------------------------------ 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) <- 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 'createOf' fold instead.------ >>> fromStreamN n = Stream.fold (MutArray.createOf n)----{-# INLINE_NORMAL fromStreamN #-}-fromStreamN :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> m (MutArray a)--- fromStreamDN n = D.fold (createOf n)-fromStreamN = fromStreamDNAs Unpinned--{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}-{-# INLINE fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> m (MutArray a)-fromStreamDN = fromStreamN---- | 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 (revCreateOf n) $ D.fromList xs---- | Convert a pure stream in Identity monad to a mutable array.-{-# INLINABLE fromPureStreamN #-}-fromPureStreamN :: (MonadIO m, Unbox a) =>-    Int -> Stream Identity a -> m (MutArray a)-fromPureStreamN n xs =-    D.fold (createOf n) $ D.morphInner (return . runIdentity) 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 =-    D.fold create $ D.morphInner (return . runIdentity) xs--{-# INLINABLE fromPtrN #-}-fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)-fromPtrN len addr = do-    -- memcpy is better than stream copy when the size is known.-    -- XXX We can implement a stream copy in a similar way by streaming Word64-    -- first and then remaining Word8.-    (arr :: MutArray Word8) <- emptyOf len-    let mbarr = getMutableByteArray# (arrContents arr)-    _ <- liftIO $ c_memcpy_pinned_src mbarr addr (fromIntegral len)-    pure (arr { arrEnd = len })--{-# INLINABLE fromByteStr# #-}-fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)-fromByteStr# addr = do-    -- It is better to count the size first and allocate exact space.-    -- Also, memcpy is better than stream copy when the size is known.-    -- C strlen compares 4 bytes at a time, so is better than the stream-    -- version. https://github.com/bminor/glibc/blob/master/string/strlen.c-    -- XXX We can possibly use a stream of Word64 to do the same.-    -- fromByteStr# addr = fromPureStream (D.fromByteStr# addr)-    len <- liftIO $ c_strlen_pinned addr-    fromPtrN (fromIntegral len) (Ptr addr)------------------------------------------------------------------------------------ convert a stream of arrays to a single array by reallocating and copying------------------------------------------------------------------------------------ XXX Both of these implementations of splicing seem to perform equally well.--- We need to perform benchmarks over a range of sizes though.---- | Also see 'fromChunksK'.-{-# INLINE fromChunksRealloced #-}-fromChunksRealloced :: forall m a. (MonadIO m, Unbox a)-    => Stream m (MutArray a) -> m (MutArray a)-fromChunksRealloced s = do-    res <- D.uncons s-    case res of-        Just (a, strm) -> do-            arr <- D.foldlM' spliceExp (pure a) strm-            -- Reallocation is exponential so there may be 50% empty space in-            -- worst case. One more reallocation to reclaim the space.-            rightSize arr-        Nothing -> pure nil------------------------------------------------------------------------------------ convert a stream of arrays to a single array by buffering arrays first----------------------------------------------------------------------------------{-# 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 fromChunkskAs #-}-fromChunkskAs :: (Unbox a, MonadIO m) =>-    PinnedState -> StreamK m (MutArray a) -> m (MutArray a)-fromChunkskAs ps as = do-    len <- arrayStreamKLength as-    arr <- newAs ps len-    -- XXX is StreamK fold faster or StreamD fold?-    K.foldlM' spliceUnsafe (pure arr) as-    -- fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as---- XXX Need to compare this with fromChunks and fromChunkList and keep the--- fastest or simplest one if all are equally fast.---- | Convert an array stream to an array. Note that this requires peak memory--- that is double the size of the array stream.------ Also see 'fromChunksRealloced'.----{-# INLINE fromChunksK #-}-fromChunksK :: (Unbox a, MonadIO m) =>-    StreamK m (MutArray a) -> m (MutArray a)-fromChunksK = fromChunkskAs Unpinned--{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}-{-# INLINE fromArrayStreamK #-}-fromArrayStreamK :: (Unbox a, MonadIO m) =>-    StreamK m (MutArray a) -> m (MutArray a)-fromArrayStreamK = fromChunksK--{-# INLINE fromStreamDAs #-}-fromStreamDAs ::-       (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)-fromStreamDAs ps m =-    arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps---- | Create an 'Array' from a stream. This is useful when we want to create a--- single array from a stream of unknown size. 'createOf' 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 = fromStreamDAs Unpinned---- fromStream (Stream m) = P.fold create m--- 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 create".------ | 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.create----{-# INLINE fromStreamD #-}-{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}-fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)-fromStreamD = fromStream---- | 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------------------------------------------------------------------------------------ Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is--- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast--- it again. We can use SIMD read/write as well.--{-# INLINE cloneAs #-}-cloneAs ::-    ( MonadIO m-#ifdef DEVBUILD-    , Unbox a-#endif-    )-    => PinnedState -> MutArray a -> m (MutArray a)-cloneAs ps src =-    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 = do-    let start1 = arrStart arr1-        start2 = arrStart arr2-        len1 = arrEnd arr1 - start1-        len2 = arrEnd arr2 - start2-    let len = len1 + len2-    newArrContents <--        if Unboxed.isPinned (arrContents arr1)-        then liftIO $ Unboxed.pinnedNew len-        else liftIO $ Unboxed.new len-    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 =-    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 = appendWith (`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."-            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------------------------------------------------------------------------------------ | Generate a stream of array slices using a predicate. The array 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.indexOnSuffix predicate (read arr)---- | Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m-    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))-breakOn sep arr@MutArray{..} = liftIO $ do-    -- XXX We do not need memchr here, we can use a Haskell equivalent.-    -- Need efficient stream based primitives that work on Word64.-    let marr = getMutableByteArray# arrContents-        len = fromIntegral (arrEnd - arrStart)-    sepIndex <- c_memchr_index marr (fromIntegral arrStart) sep len-    let intIndex = fromIntegral sepIndex-    return $-        if sepIndex >= len-        then (arr, Nothing)-        else-            ( MutArray-                { arrContents = arrContents-                , arrStart = arrStart-                , arrEnd = arrStart + intIndex -- exclude the separator-                , arrBound = arrStart + intIndex-                }-            , Just $ MutArray-                    { arrContents = arrContents-                    , arrStart = arrStart + (intIndex + 1)-                    , arrEnd = arrEnd-                    , arrBound = arrBound-                    }-            )---- | Like 'splitAt' but does not check whether the index is valid.----{-# INLINE unsafeSplitAt #-}-unsafeSplitAt :: forall a. Unbox a =>-    Int -> MutArray a -> (MutArray a, MutArray a)-unsafeSplitAt i MutArray{..} =-    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-          }-        )---- | Create two slices of an array without copying the original array. The--- specified index @i@ is the first index of the second slice.----{-# INLINE splitAt #-}-splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)-splitAt i arr =-    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 unsafeSplitAt i arr------------------------------------------------------------------------------------ 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.---- XXX 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.------ XXX we cannot pass the length of the ptr here as in some cases it may not be--- available e.g. a null terminated C string. However, we can create another--- flavor of the API e.g. asPtrN.---- | NOTE: this is deprecated because it can lead to accidental problems if the--- user tries to use it to mutate the array because it does not return the new--- array after pinning.-{-# DEPRECATED unsafePinnedAsPtr "Pin the array and then use unsafeAsPtr." #-}-{-# INLINE unsafePinnedAsPtr #-}-unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-unsafePinnedAsPtr arr f = do-    arr1 <- liftIO $ Unboxed.pin (arrContents arr)-    Unboxed.unsafeAsPtr arr1 (\ptr -> f (ptr `plusPtr` arrStart arr))--{-# DEPRECATED asPtrUnsafe "Pin the array and then use unsafeAsPtr." #-}-{-# INLINE asPtrUnsafe #-}-asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-asPtrUnsafe = unsafePinnedAsPtr---- | @unsafeAsPtr arr f@, f is a function used as @f ptr len@ where @ptr@ is a--- pointer to the beginning of array and @len@ is the length of the array.------ /Unsafe/ WARNING:------ 1. The array must be pinned, otherwise it will lead to memory corruption.--- 2. The user must not use the pointer beyond the supplied length.------ /Pre-release/----{-# INLINE unsafeAsPtr #-}-unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-unsafeAsPtr arr f =-    Unboxed.unsafeAsPtr-        (arrContents arr) (\ptr -> f (ptr `plusPtr` arrStart arr))------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Byte compare two arrays. 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.------ /Unsafe/: Note that the 'Unbox' instance of sum types with constructors of--- different sizes may leave some memory uninitialized which can make byte--- comparison unreliable.------ /Pre-release/-{-# INLINE byteCmp #-}-byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering-byteCmp arr1 arr2 = 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--{-# INLINE cmp #-}-{-# DEPRECATED cmp "Please use byteCmp instead." #-}-cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering-cmp = byteCmp---- | Byte equality of two arrays.------ >>> byteEq arr1 arr2 = (==) EQ $ MArray.byteCmp arr1 arr2------ /Unsafe/: See 'byteCmp'.-{-# INLINE byteEq #-}-byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool-byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2------------------------------------------------------------------------------------ Compact------------------------------------------------------------------------------------ Note: LE versions avoid an extra copy compared to GE. LE parser trades--- backtracking one array in lieu of avoiding a copy. However, LE and GE both--- can leave some memory unused. They can split the last array to fit it--- exactly in the space.--{-# INLINE_NORMAL pCompactLeAs #-}-pCompactLeAs ::-       forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> Parser (MutArray a) m (MutArray a)-pCompactLeAs ps maxElems = Parser step initial extract--    where--    maxBytes = maxElems * SIZE_OF(a)--    functionName = "Streamly.Internal.Data.MutArray.pCompactLE"--    initial =-        return-            $ if maxElems <= 0-              then error-                       $ functionName-                       ++ ": the size of arrays ["-                       ++ show maxElems ++ "] must be a natural number"-              else Parser.IPartial Nothing--    step Nothing arr =-        return-            $ let len = byteLength arr-               in if len >= maxBytes-                  then Parser.Done 0 arr-                  else Parser.Partial 0 (Just arr)-    -- XXX Split the last array to use the space more compactly.-    step (Just buf) arr =-        let len = byteLength buf + byteLength arr-         in if len > maxBytes-            then return $ Parser.Done 1 buf-            else do-                buf1 <--                    if byteCapacity buf < maxBytes-                    then liftIO $ reallocExplicitAs-                            ps (SIZE_OF(a)) maxBytes buf-                    else return buf-                buf2 <- spliceUnsafe buf1 arr-                return $ Parser.Partial 0 (Just buf2)--    extract Nothing = return $ Parser.Done 0 nil-    extract (Just buf) = return $ Parser.Done 0 buf---- | Parser @pCompactLE maxElems@ coalesces adjacent arrays in the input stream--- only if the combined size would be less than or equal to @maxElems@--- elements. Note that it won't split an array if the original array is already--- larger than maxElems.------ @maxElems@ must be greater than 0.------ Generates unpinned arrays irrespective of the pinning status of input--- arrays.------ /Internal/-{-# INLINE pCompactLE #-}-pCompactLE ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> Parser (MutArray a) m (MutArray a)-pCompactLE = pCompactLeAs Unpinned---- | Pinned version of 'pCompactLE'.-{-# INLINE pPinnedCompactLE #-}-pPinnedCompactLE ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> Parser (MutArray a) m (MutArray a)-pPinnedCompactLE = pCompactLeAs Pinned--data SpliceState s arr-    = SpliceInitial s-    | SpliceBuffering s arr-    | SpliceYielding arr (SpliceState s arr)-    | SpliceFinish---- 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 additional space so a new array is allocated--- instead of mutating it.--{-# INLINE_NORMAL compactLeAs #-}-compactLeAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)-compactLeAs ps maxElems (D.Stream step state) =-    D.Stream step' (SpliceInitial state)--    where--    maxBytes = maxElems * SIZE_OF(a)--    functionName = "Streamly.Internal.Data.MutArray.rCompactLE"--    {-# INLINE_LATE step' #-}-    step' gst (SpliceInitial st) = do-        when (maxElems <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ functionName ++ ": the size of arrays [" ++ show maxElems-                ++ "] must be a natural number"-        r <- step gst st-        case r of-            D.Yield arr s -> return $-                let len = byteLength arr-                 in if len >= maxBytes-                    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--    -- XXX Split the last array to use the space more compactly.-    step' gst (SpliceBuffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                let len = byteLength buf + byteLength arr-                if len > maxBytes-                then return $-                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))-                else do-                    buf1 <- if byteCapacity buf < maxBytes-                            then liftIO $ reallocExplicitAs-                                    ps (SIZE_OF(a)) maxBytes buf-                            else return buf-                    buf2 <- spliceUnsafe buf1 arr-                    return $ D.Skip (SpliceBuffering s buf2)-            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---{-# INLINE_NORMAL fCompactGeAs #-}-fCompactGeAs ::-       forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> FL.Fold m (MutArray a) (MutArray a)-fCompactGeAs ps minElems = Fold step initial extract extract--    where--    minBytes = minElems * SIZE_OF(a)--    functionName = "Streamly.Internal.Data.MutArray.fCompactGE"--    initial =-        return-            $ if minElems < 0-              then error-                       $ functionName-                       ++ ": the size of arrays ["-                       ++ show minElems ++ "] must be a natural number"-              else FL.Partial Nothing--    step Nothing arr =-        return-            $ let len = byteLength arr-               in if len >= minBytes-                  then FL.Done arr-                  else FL.Partial (Just arr)-    -- XXX Buffer arrays as a list to avoid copy and reallocations-    step (Just buf) arr = do-        let len = byteLength buf + byteLength arr-        buf1 <--            if byteCapacity buf < len-            then liftIO $ reallocExplicitAs-                    ps (SIZE_OF(a)) (max minBytes len) buf-            else return buf-        buf2 <- spliceUnsafe buf1 arr-        if len >= minBytes-        then return $ FL.Done buf2-        else return $ FL.Partial (Just buf2)--    extract Nothing = return nil-    extract (Just buf) = return buf---- | Fold @fCompactGE minElems@ coalesces adjacent arrays in the input stream--- until the size becomes greater than or equal to @minElems@.------ Generates unpinned arrays irrespective of the pinning status of input--- arrays.-{-# INLINE fCompactGE #-}-fCompactGE ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> FL.Fold m (MutArray a) (MutArray a)-fCompactGE = fCompactGeAs Unpinned---- | Pinned version of 'fCompactGE'.-{-# INLINE fPinnedCompactGE #-}-fPinnedCompactGE ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> FL.Fold m (MutArray a) (MutArray a)-fPinnedCompactGE = fCompactGeAs Pinned--{-# INLINE_NORMAL lCompactGeAs #-}-lCompactGeAs :: forall m a. (MonadIO m, Unbox a)-    => PinnedState -> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()--- The fold version turns out to be a little bit slower.--- lCompactGeAs ps n = FL.many (fCompactGeAs ps n)-lCompactGeAs ps minElems (Fold step1 initial1 _ final1) =-    Fold step initial extract final--    where--    minBytes = minElems * SIZE_OF(a)--    functionName = "Streamly.Internal.Data.MutArray.lCompactGE"--    initial = do-        when (minElems <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ functionName ++ ": the size of arrays ["-                ++ show minElems ++ "] must be a natural number"--        r <- initial1-        return $ first (Tuple' Nothing) r--    {-# INLINE runInner #-}-    runInner len acc buf =-            if len >= minBytes-            then do-                r <- step1 acc 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) acc--    step (Tuple' Nothing r1) arr =-         runInner (byteLength arr) r1 arr--    -- XXX Buffer arrays as a list to avoid copy and reallocations-    step (Tuple' (Just buf) r1) arr = do-        let len = byteLength buf + byteLength arr-        buf1 <- if byteCapacity buf < len-                then liftIO $ reallocExplicitAs-                        ps (SIZE_OF(a)) (max minBytes len) buf-                else return buf-        buf2 <- spliceUnsafe buf1 arr-        runInner len r1 buf2--    -- 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 "lCompactGE: 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 ()---- | Like 'compactGE' but for transforming folds instead of stream.------ >>> lCompactGE n = Fold.many (MutArray.fCompactGE n)------ Generates unpinned arrays irrespective of the pinning status of input--- arrays.-{-# INLINE lCompactGE #-}-lCompactGE :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()-lCompactGE = lCompactGeAs Unpinned---- | Pinned version of 'lCompactGE'.-{-# INLINE lPinnedCompactGE #-}-lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()-lPinnedCompactGE = lCompactGeAs Pinned---- | @compactGE n stream@ coalesces adjacent arrays in the @stream@ until--- the size becomes greater than or equal to @n@.------ >>> compactGE n = Stream.foldMany (MutArray.fCompactGE n)----{-# INLINE compactGE #-}-compactGE ::-       (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compactGE n = D.foldMany (fCompactGE n)---- | 'compactEQ n' coalesces adajacent arrays in the input stream to--- arrays of exact size @n@.------ /Unimplemented/-{-# INLINE compactEQ #-}-compactEQ :: -- (MonadIO m, Unbox a) =>-    Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compactEQ _n = undefined -- D.parseManyD (pCompactEQ n)------------------------------------------------------------------------------------ In-place mutation algorithms------------------------------------------------------------------------------------ | 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------------------------------------------------------------------------------------- Deprecated Foreign APIs-----------------------------------------------------------------------------------foreign import ccall unsafe "string.h memcpy" c_memcpy-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)--{-# DEPRECATED c_memchr "c_memchr is now deprecated." #-}-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--{-# DEPRECATED memcpy "Use copyMutableByteArray# instead." #-}-memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy dst src len = void (c_memcpy dst src (fromIntegral len))--{-# DEPRECATED memcmp "Use byteCmp instead." #-}-{-# 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+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- 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 (..)+    , fromMutByteArray+    , toMutByteArray++    -- ** Conversion+    -- *** Pinned and Unpinned+    , pin+    , unpin+    , isPinned++    -- ** Casting+    , cast+    , unsafeCast+    , asBytes+    , unsafeAsPtr -- XXX asPtr+    , asCString+    , asCWString++    -- ** Construction+    , empty+ -- , singleton++    -- *** New+    -- | New arrays are always empty arrays with some reserve capacity to+    -- extend the length without reallocating.+    , emptyOf+    , emptyWithAligned -- XXX emptyAlignAtWith+    , emptyOf'++    -- *** Slicing+    -- | Get a subarray without copying++    -- Element agnostic.+    , unsafeSliceOffLen+    , sliceOffLen++    -- Counting from the beginning+    -- We use the name "break" for splitting into two parts. And the word+    -- "split" for splitting into possibly more than two.+    , unsafeBreakAt+    , breakAt -- called splitAt in lists+ -- , take+ -- , drop+ -- , uncons+ -- , tail++    -- Counting from the end+ -- , revBreakAt+ -- , takeEnd+ -- , dropEnd+ -- , unsnoc+ -- , init++    -- Element aware+    -- search from the beginning+    , breakEndByWord8_+    , breakEndBy+    , breakEndBy_+ -- , breakBeginBy -- called break in lists+ -- , breakSpan -- called span in lists+ -- , breakBeginBySeq -- called breakOn in text+ -- , breakSepBy_+    , dropWhile+ -- , takeWhile+ -- , stripPrefix++    -- search from the end+    , revBreakEndBy+    , revBreakEndBy_+ -- , revBreakBeginBy -- called breakOnEnd in text+    , revDropWhile -- dropWhileEnd+ -- , takeWhileEnd+ -- , stripSuffix++    , dropAround++    -- *** Stream Folds+    -- | Note: create is just appending to an empty array. So keep the names+    -- consistent with append operations.+    , ArrayUnsafe (..)++    -- With allocator, of capacity+    , unsafeCreateWithOf+    , createWithOf -- create alloc with++    , unsafeCreateOf+    , createOf+    , createMinOf+    , create -- XXX should we change the min to one elem or one Word?+ -- , createGrowBy++    -- Reverse variants+    , revCreateOf+ -- , revCreate++    -- Pinned variants++    , unsafeCreateOf'+    , createOf'+    , create'++    -- *** From containers+    -- | These can be implemented by appending a stream to an empty array.+    , clone -- XXX fromMutArray or copyMutArray+    , clone'+    , fromListN+    , fromListN'+    , fromList+    , fromList'+    , fromListRevN+    , fromListRev+    , fromStreamN+    , fromStream+    , fromPureStreamN+    , fromPureStream+    , fromCString#+    , fromW16CString#+    , fromPtrN+    , fromChunksK+    , fromChunksRealloced -- fromSmallChunks++    , unsafeCreateWithPtr'++    -- ** Random writes+    , putIndex+ -- , putIndexRev -- or revPutIndex+    , unsafePutIndex+    , putIndices+    -- , putFromThenTo+    -- , putFrom -- start writing at the given position+    -- , putUpto -- write from beginning up to the given position+    -- , putFromTo+    -- , putFromRev+    -- , putUptoRev+    , unsafeModifyIndex+    , modifyIndex+    , modifyIndices+    , modify+    , swapIndices+    , unsafeSwapIndices++    -- ** Reading++    -- *** Indexing+ -- , head+    , getIndex+    , unsafeGetIndex+    , unsafeGetIndexRev+    -- , getFromThenTo+ -- , last+    , getIndexRev -- getRevIndex?+    , indexReader+    , indexReaderWith++    -- -- *** Searching+    -- See the Data.Array module as well+    -- , binarySearch+    -- , findIndicesOf+    -- , getIndicesOf+    -- , indexFinder+    -- , findIndexOf+    -- , find+    -- , elem++    -- *** To Streams+    , read+    , readRev+    , toStreamWith+    , toStreamRevWith+    , toStreamK+    , toStreamKWith+    , toStreamKRev+    , toStreamKRevWith++    -- *** To Containers+    , toList++    -- *** Unfolds+    -- experimental+    , producerWith+    , producer++    , reader+    , readerRevWith+    , readerRev++    -- ** Size and Capacity+    -- *** Size+ -- , null+ -- , compareLength+    , length+    , byteLength++    -- *** Capacity Reporting+    , capacity+    , free+    , byteCapacity+    , bytesFree++    -- *** Capacity Management+    -- There are two ways of growing an array:+    --+    -- * grow: double, align to next power of 2 if large, never shrink+    -- * growBy: align to block size if large, never shrink++    , blockSize+    , arrayChunkBytes+    , allocBytesToElemCount+    , reallocBytes+    , reallocBytesWith++ -- , grow -- double the used capacity and align to power of 2+    , growTo+    , growBy+    , growExp+    , rightSize+    , vacate++    -- ** Folding+    , foldl'+    , foldr+    , fold+    , foldRev -- XXX revFold+    , byteCmp+    , byteEq++    -- ** In-place Mutation Algorithms+    , reverse+    , permute+    , partitionBy+    , shuffleBy+    , divideBy+    , mergeBy+    , bubble+    , rangeBy+ -- , filter++    -- ** Growing and Shrinking+    -- | Arrays grow only at the end, though technically it is possible to+    -- grow on both sides and therefore we can have a cons as well as snoc. But+    -- cons is not implemented yet.++    -- *** Appending elements+    -- | snoc is the fundamental operation for growing arrays. Streaming folds,+    -- appending streams can be implemented in terms of snoc.++    -- XXX snoc 128/256/512 bit data using SIMD.+    , snocWith -- XXX snocGrowWith+    , snoc+    , snocGrowBy+    , snocMay+    , unsafeSnoc++ -- , revSnoc -- cons+ -- , revSnocGrowBy  -- consGrowBy++    -- *** Folds for appending streams+    -- | Fundamentally these are a sequence of snoc operations.+    -- Folds are named "append" whereas joining two arrays is named as "splice".++    , appendWith -- XXX replace by pure appendGrowWith++    , unsafeAppendMax -- can be renamed to unsafeAppendN later+    , appendMax -- can be renamed to appendN later+ -- , appendMin -- like createMinOf, supplies a min hint to reduce allocs+ -- , appendGrowWith+    , append2   -- to be renamed to append later+    , appendGrowBy++ -- , revAppend+ -- , revAppendN+ -- , revAppendGrowBy++    -- *** Appending streams+    -- | Fundamentally these are a sequence of snoc operations. These are+    -- convenience operations implemented in terms of folds.+    , unsafeAppendPtrN+    , appendPtrN+    , appendCString+    , appendCString#+ -- , appendStreamGrowWith+    , appendStream+    , appendStreamN+ -- , appendStreamGrowBy++    -- *** Splicing arrays+    -- | TODO: We can replace memcpy with stream copy using Word64. Arrays are+    -- aligned on 64-bit boundaries on 64-bit CPUs. A fast way to copy an+    -- array is to unsafeCast it to Word64, read it as a stream, write the+    -- stream to Word64 array and unsafeCast it again. We can use SIMD+    -- read/write as well.++    , spliceCopy -- XXX freeze and splice instead?+    , splice+    , spliceWith -- XXX spliceGrowWith+    , spliceExp -- XXX spliceGrowExp+ -- , spliceN+ -- , spliceGrowBy+    , unsafeSplice+    -- , putSlice+    -- , appendSlice+    -- , appendSliceFrom++    -- XXX Do not expose these yet, we should perhaps expose only the Peek/Poke+    -- monads instead? Decide after implementing the monads.++    -- ** Serialization using Unbox+    -- | Fixed length serialization.+    -- Serialization operations are essentially a combination of serialization+    -- using Unbox/Serialize type class, followed by snoc. TODO: use SIMD for+    -- snoc.+    , poke+    , pokeMay+ -- , pokeGrowBy+    , unsafePokeSkip -- XXX unsafePoke_+ -- , revPoke++    -- ** Deserialization using Unbox+    -- Fixed length deserialization.+    , peek+    , unsafePeek+    , unsafePeekSkip -- XXX unsafePeek_+ -- , revPeek++    -- 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.++    -- ** Streams of Arrays+    -- *** Chunk+    -- | Group a stream into arrays.+    , chunksOf+    , chunksOf' -- chunksOf'+    -- , timedChunksOf -- see the Streamly.Data.Stream.Prelude module+    , buildChunks+    , chunksEndBy+    , chunksEndBy'+    , chunksEndByLn+    , chunksEndByLn'+    -- , chunksBeginBySeq -- for parsing streams with headers++    -- *** Split+    -- | Split an array into a stream of slices.++    -- Note: some splitting APIs are in MutArray.hs+    , splitEndBy_+    , splitEndBy+ -- , splitSepBy_+ -- , splitSepBySeq+ -- , splitGroupBy+ -- , splitWordsBy++    -- *** Concat+    -- | Append the arrays in a stream to form a stream of elements.+    , concat+    -- , concatSepBy+    -- , concatEndBy+    -- , concatEndByLn -- unlines - concat a byte chunk stream using newline byte separator+    -- , concatWordsBy+    , concatWith -- internal+    , concatRev+    , concatRevWith -- internal++    -- *** Compact+    -- | Coalesce arrays together in a stream of arrays to form a stream of+    -- larger arrays.+    , SpliceState (..)+    , compactLeAs -- internal++    -- Creation folds/parsers+    , createCompactMax+    , createCompactMax'+    , createCompactMin+    , createCompactMin'++    -- Stream compaction+    , compactMin+    -- , compactMin'+    , compactExact+    -- , compactExact'++    -- Scans+    , scanCompactMin+    , scanCompactMin'++    -- ** Utilities+    , isPower2+    , roundUpToPower2++    -- * Deprecated+    , getSlice+    , strip+    , breakOn+    , splitAt+    , realloc+    , createOfWith+    , peekUncons+    , peekUnconsUnsafe+    , pokeAppend+    , pokeAppendMay+    , castUnsafe+    , newArrayWith+    , getSliceUnsafe+    , putIndexUnsafe+    , modifyIndexUnsafe+    , getIndexUnsafe+    , snocUnsafe+    , spliceUnsafe+    , pokeSkipUnsafe+    , peekSkipUnsafe+    , asPtrUnsafe+    , writeChunks+    , flattenArrays+    , flattenArraysRev+    , fromArrayStreamK+    , fromStreamDN+    , fromStreamD+    , cmp+    , getIndices+    , getIndicesWith+    , resize+    , resizeExp+    , nil+    , new+    , pinnedNew+    , pinnedNewBytes+    , writeAppendNUnsafe+    , writeAppendN+    , writeAppendWith+    , writeAppend+    , writeNWithUnsafe+    , writeNWith+    , writeNUnsafe+    , pinnedWriteNUnsafe+    , writeN+    , pinnedWriteN+    , pinnedWriteNAligned -- XXX not required+    , writeWith+    , write+    , pinnedWrite+    , writeRevN+    , fromByteStr#+    , pCompactLE+    , pPinnedCompactLE+    , fCompactGE+    , fPinnedCompactGE+    , lPinnedCompactGE+    , lCompactGE+    , compactGE+    , pinnedEmptyOf+    , pinnedChunksOf+    , pinnedCreateOf+    , pinnedCreate+    , pinnedFromListN+    , pinnedFromList+    , pinnedClone+    , unsafePinnedCreateOf+    , splitOn+    , pinnedNewAligned+    , unsafePinnedAsPtr+    , grow+    , createWith+    , snocLinear+    , unsafeAppendN+    , appendN+    , append+    )+where++#include "assert.hs"+#include "deprecation.h"+#include "inline.hs"+#include "ArrayMacros.h"+#include "MachDeps.h"++import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bifunctor (first)+import Data.Bits (shiftR, (.|.), (.&.))+import Data.Char (ord)+import Data.Functor.Identity (Identity(..))+import Data.Proxy (Proxy(..))+import Data.Word (Word8, Word16)+import Foreign.C.String (CString, CWString)+import Foreign.C.Types (CSize(..), CChar, CWchar)+import Foreign.Ptr (plusPtr, castPtr)+import Streamly.Internal.Data.MutByteArray.Type+    ( MutByteArray(..)+    , PinnedState(..)+    , getMutByteArray#+    , unsafePutSlice+    , blockSize+    , largeObjectThreshold+    , unsafeByteCmp+    )+import Streamly.Internal.Data.Unbox (Unbox(..))+import GHC.Base (noinline)+import GHC.Exts (Addr#, MutableByteArray#, RealWorld)+import GHC.Ptr (Ptr(..))+import GHC.Exts (byteArrayContents#, unsafeCoerce#)++import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Producer.Type (Producer (..))+import Streamly.Internal.Data.Scanl.Type (Scanl (..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Parser.Type (Parser (..))+import Streamly.Internal.Data.StreamK.Type (StreamK)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+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.Parser.Type as Parser+-- import qualified Streamly.Internal.Data.Fold.Type as Fold+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.Stream.Generate as D+import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Prelude++import Prelude hiding+    (Foldable(..), concat, read, unlines, splitAt, reverse, truncate, dropWhile)++#include "DocTestDataMutArray.hs"++-------------------------------------------------------------------------------+-- Foreign helpers+-------------------------------------------------------------------------------++-- NOTE: Have to be "ccall unsafe" so that we can pass unpinned memory to+-- these. For passing unpinned memory safely we have to pass unlifted byte+-- array pointers in FFI so that neither the constructor nor the array can+-- become stale if a GC kicks in at any point before the call.++foreign import ccall unsafe "string.h memcpy" c_memcpy_pinned_src+    :: MutableByteArray# RealWorld -> Ptr Word8 -> CSize -> IO (Ptr Word8)++foreign import ccall unsafe "memchr_index" c_memchr_index+    :: MutableByteArray# RealWorld -> CSize -> Word8 -> CSize -> IO CSize++-- XXX Use cstringLength# from GHC.CString in ghc-prim+foreign import ccall unsafe "string.h strlen" c_strlen_pinned+    :: Addr# -> IO CSize++-- | 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)++-------------------------------------------------------------------------------+-- MutArray Data Type+-------------------------------------------------------------------------------++-- Note on using "IO" callbacks:+--+-- The Array APIs should use "IO" callbacks instead of lifted callbacks as the+-- lifted callbacks aren't optimized properly.+--+-- See:+-- https://github.com/composewell/streamly/issues/2820+-- https://github.com/composewell/streamly/issues/2589+++-- $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.+    -- XXX rename to arrCapacity to be consistent with ring.+    , arrBound :: {-# UNPACK #-} !Int  -- ^ first invalid index of arrContents.+    }++-------------------------------------------------------------------------------+-- Construction and destructuring+-------------------------------------------------------------------------------++{-# INLINE fromMutByteArray #-}+fromMutByteArray :: MonadIO m => MutByteArray -> Int -> Int -> m (MutArray a)+fromMutByteArray arr start end = do+    len <- liftIO $ Unboxed.length arr+    return $ MutArray+        { arrContents = arr+        , arrStart = start+        , arrEnd = end+        , arrBound = len+        }++{-# INLINE toMutByteArray #-}+toMutByteArray :: MutArray a -> (MutByteArray, Int, Int)+toMutByteArray MutArray{..} = (arrContents, arrStart, arrEnd)++-------------------------------------------------------------------------------+-- 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 clone' 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.++-- XXX Rename to emptyAlignedWith, alignSize should be first arg.++-- | @emptyWithAligned 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 emptyWithAligned #-}+newArrayWith, emptyWithAligned :: forall m a. (MonadIO m, Unbox a)+    => (Int -> Int -> IO MutByteArray) -> Int -> Int -> m (MutArray a)+emptyWithAligned alloc alignSize count = liftIO $ do+    let size = max (count * SIZE_OF(a)) 0+    contents <- alloc size alignSize+    return $ MutArray+        { arrContents = contents+        , arrStart = 0+        , arrEnd   = 0+        , arrBound = size+        }++-- For arrays "nil" sounds a bit odd. empty is better. The only problem with+-- empty is that it is also used by the Alternative type class. But assuming we+-- will mostly import the Array module qualified this should be fine.++-- | Create an empty array.+empty ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a+empty = MutArray Unboxed.empty 0 0 0++{-# DEPRECATED nil "Please use empty instead." #-}+nil ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a+nil = empty++{-# INLINE newBytesAs #-}+newBytesAs :: MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    PinnedState -> Int -> m (MutArray a)+newBytesAs ps bytes = do+    contents <- liftIO $ Unboxed.newAs ps bytes+    return $ MutArray+        { arrContents = contents+        , arrStart = 0+        , arrEnd   = 0+        , arrBound = bytes+        }++-- | Allocates a pinned empty array that with a reserved capacity of bytes.+-- The memory of the array is uninitialized and the allocation is aligned as+-- per the 'Unboxed' instance of the type.+--+-- > pinnedNewBytes = (unsafeCast :: Array Word8 -> a) . emptyOf'+--+-- /Pre-release/+{-# INLINE pinnedNewBytes #-}+{-# DEPRECATED pinnedNewBytes "Please use emptyOf' to create a Word8 array and cast it accordingly." #-}+pinnedNewBytes :: MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    Int -> m (MutArray a)+pinnedNewBytes = newBytesAs Pinned++-- | Like 'emptyWithAligned' but using an allocator is a pinned memory allocator and+-- the alignment is dictated by the 'Unboxed' instance of the type.+--+-- /Internal/+{-# DEPRECATED pinnedNewAligned "Please use emptyOf' to create a Word8 array and cast it accordingly." #-}+{-# INLINE pinnedNewAligned #-}+pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)+pinnedNewAligned = emptyWithAligned (\s _ -> liftIO $ Unboxed.new' s)++{-# INLINE newAs #-}+newAs :: (MonadIO m, Unbox a) => PinnedState -> Int -> m (MutArray a)+newAs ps =+    emptyWithAligned+        (\s _ -> liftIO $ Unboxed.newAs ps s)+        (error "new: alignment is not used in unpinned arrays.")++-- XXX can unaligned allocation be more efficient when alignment is not needed?++-- | Allocates a pinned array of zero length but growable to the specified+-- capacity without reallocation.+{-# INLINE emptyOf' #-}+pinnedEmptyOf, emptyOf' :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+emptyOf' = newAs Pinned+RENAME_PRIME(pinnedEmptyOf,emptyOf)++{-# DEPRECATED pinnedNew "Please use emptyOf' instead." #-}+{-# INLINE pinnedNew #-}+pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+pinnedNew = emptyOf'++-- | Allocates an unpinned array of zero length but growable to the specified+-- capacity without reallocation.+--+{-# INLINE emptyOf #-}+emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+emptyOf = newAs Unpinned++{-# DEPRECATED new "Please use emptyOf instead." #-}+{-# INLINE new #-}+new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+new = emptyOf++-------------------------------------------------------------------------------+-- 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 unsafePutIndex #-}+putIndexUnsafe, unsafePutIndex :: forall m a. (MonadIO m, Unbox a)+    => Int -> MutArray a -> a -> m ()+unsafePutIndex 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) = 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, unsafeModifyIndex :: forall m a b. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> (a -> (a, b)) -> m b+unsafeModifyIndex 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 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)++-- NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.+-- Since this is not inlined, Unboxed constraint leads to dictionary passing+-- which complicates some inspection tests.+--+{-# NOINLINE reallocExplicitAs #-}+reallocExplicitAs :: PinnedState -> Int -> Int -> MutArray a -> IO (MutArray a)+reallocExplicitAs ps elemSize newCapacityInBytes MutArray{..} = do+    assertM(arrEnd <= arrBound)++    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes+        oldSizeInBytes = arrEnd - arrStart+        -- XXX Should we round up instead?+        newCapInBytes = roundDownTo elemSize newCapMaxInBytes+        newLenInBytes = min oldSizeInBytes newCapInBytes++    assert (oldSizeInBytes `mod` elemSize == 0) (return ())+    assert (newLenInBytes >= 0) (return ())+    assert (newLenInBytes `mod` elemSize == 0) (return ())++    contents <-+        Unboxed.reallocSliceAs+            ps newCapInBytes arrContents arrStart newLenInBytes++    return $ MutArray+        { arrStart = 0+        , arrContents = contents+        , arrEnd   = newLenInBytes+        , arrBound = newCapInBytes+        }++-- XXX We may also need reallocAs to allocate as pinned/unpinned explicitly. In+-- fact clone/clone' can be implemented using reallocAs.++-- | @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 reallocBytes #-}+realloc, reallocBytes :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+reallocBytes bytes arr =+    let ps =+            if isPinned arr+            then Pinned+            else Unpinned+     in liftIO $ reallocExplicitAs ps (SIZE_OF(a)) bytes arr++-- | @reallocBytesWith 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.+reallocBytesWith :: forall m a. (MonadIO m , Unbox a) =>+       String+    -> (Int -> Int)+    -> Int+    -> MutArray a+    -> m (MutArray a)+reallocBytesWith 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 =+        Prelude.concat+            [ label+            , ": new array size (in bytes) is less than required size "+            , show newSize+            , ". Please check the sizing function passed."+            ]++-- | @growTo 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).+--+-- Nothing is done if the requested capacity is <= 0.+--+-- /Pre-release/+{-# INLINE growTo #-}+growTo, grow :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+growTo nElems arr@MutArray{..} = do+    let req = SIZE_OF(a) * nElems+        cap = arrBound - arrStart+    if req < cap+    then return arr+    else realloc req arr++RENAME(grow,growTo)++-- | Like 'growTo' but specifies the required reserve (unused) capacity rather+-- than the total capacity. Increases the reserve capacity, if required, to at+-- least the given amount.+--+-- Nothing is done if the requested capacity is <= 0.+--+{-# INLINE growBy #-}+growBy :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+growBy nElems arr@MutArray{..} = do+    let req = arrEnd - arrStart + SIZE_OF(a) * nElems+        cap = arrBound - arrStart+    if req < cap+    then return arr+    else realloc req arr++{-# DEPRECATED resize "Please use growTo instead." #-}+{-# INLINE resize #-}+resize :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+resize = grow++-- | Like 'growTo' but if the requested byte capacity is more than+-- 'largeObjectThreshold' then it is rounded up to the closest power of 2.+--+-- Nothing is done if the requested capacity is <= 0.+--+-- /Pre-release/+{-# INLINE growExp #-}+growExp :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+growExp nElems arr@MutArray{..} = do+    let req = roundUpLargeArray (SIZE_OF(a) * nElems)+        req1 =+            if req > largeObjectThreshold+            then roundUpToPower2 req+            else req+        cap = arrBound - arrStart+    if req1 < cap+    then return arr+    else realloc req1 arr++{-# DEPRECATED resizeExp "Please use growExp instead." #-}+{-# INLINE resizeExp #-}+resizeExp :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m (MutArray a)+resizeExp = growExp++-- | 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+        cap = 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 < cap && len < 3 * waste+    then realloc target arr+    else return arr++-- | Reset the array end position to start, thus truncating the array to 0+-- length, making it empty. The capacity of the array remains unchanged. The+-- array refers to the same memory as before.+{-# INLINE vacate #-}+vacate :: MutArray a -> MutArray a+vacate MutArray{..} = MutArray arrContents arrStart arrStart arrBound++-------------------------------------------------------------------------------+-- 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 unsafeSnoc #-}+snocUnsafe, unsafeSnoc :: forall m a. (MonadIO m, Unbox a) =>+    MutArray a -> a -> m (MutArray a)+unsafeSnoc 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 = do+    let newEnd = INDEX_NEXT(arrEnd,a)+    if newEnd <= arrBound+    then Just <$> snocNewEnd newEnd arr x+    else return Nothing++-- | Increments the capacity such that there is at least one unused slot even+-- if the sizer returns a size less than or equal to current size.++-- 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 <- reallocBytesWith "snocWith" sizer (SIZE_OF(a)) arr+    unsafeSnoc arr1 x++-- XXX sizer should use elements instead of bytes? That may increase the cost+-- but sizing is not a frequent operation.++-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The used 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. The sizer+-- function should return a capacity more than or equal to the current used+-- size. If the capacity returned is less than or equal to the current used+-- size, the array is still grown by one element.+--+-- If the new array size is more than 'largeObjectThreshold' then it is rounded+-- 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 sizer arr x = do+    let newEnd = INDEX_NEXT(arrEnd arr,a)+    if newEnd <= arrBound arr+    then snocNewEnd newEnd arr x+    else snocWithRealloc sizer 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/+{-# DEPRECATED snocLinear "Please use snocGrowBy instead. snocLinear ~ snocGrowBy (1024 / sizeOf (Proxy :: Proxy a) + 1)" #-}+{-# 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 grow it by adding space for the requested number of elements, the new+-- size is rounded up to 'blockSize' when the size becomes more than+-- 'largeObjectThreshold'. If the size specified is <= 0 then the array is+-- grown by one element.+--+-- 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 compared to 'snoc'.+--+-- /Pre-release/+{-# INLINE snocGrowBy #-}+snocGrowBy :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> a -> m (MutArray a)+snocGrowBy n = snocWith (+ (n * SIZE_OF(a)))++-- | 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 and aligned to a power of 2.+--+-- 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.+--+-- Performs only O(n * log n) copies to grow, but is liberal with memory+-- allocation compared to 'snocGrowBy'.+--+{-# 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++-------------------------------------------------------------------------------+-- Serialization/Deserialization using Unbox+-------------------------------------------------------------------------------++{-# INLINE pokeNewEnd #-}+pokeNewEnd :: (MonadIO m, Unbox a) =>+    Int -> MutArray Word8 -> a -> m (MutArray Word8)+pokeNewEnd newEnd arr@MutArray{..} x = liftIO $ do+    assert (newEnd <= arrBound) (return ())+    liftIO $ pokeAt arrEnd arrContents x+    return $ arr {arrEnd = newEnd}++-- | Really really unsafe, unboxes a Haskell type and appends the resulting+-- bytes to the byte array, may cause silent data corruption or if you are+-- lucky a segfault if the array does not have enough space to append the+-- element.+--+-- /Internal/+{-# INLINE unsafePoke #-}+unsafePoke :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> a -> m (MutArray Word8)+unsafePoke arr@MutArray{..} = pokeNewEnd (arrEnd + SIZE_OF(a)) arr++-- | Skip the specified number of bytes in the array. The data in the skipped+-- region remains uninitialzed.+{-# INLINE unsafePokeSkip #-}+pokeSkipUnsafe, unsafePokeSkip :: Int -> MutArray Word8 -> MutArray Word8+unsafePokeSkip n arr@MutArray{..} =  do+    let newEnd = arrEnd + n+     in assert (newEnd <= arrBound) (arr {arrEnd = newEnd})++-- | Like 'poke' but does not grow the array when pre-allocated array+-- capacity becomes full.+--+-- /Internal/+{-# INLINE pokeMay #-}+pokeAppendMay, pokeMay :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> a -> m (Maybe (MutArray Word8))+pokeMay arr@MutArray{..} x = liftIO $ do+    let newEnd = arrEnd + SIZE_OF(a)+    if newEnd <= arrBound+    then Just <$> pokeNewEnd newEnd arr x+    else return Nothing++{-# NOINLINE pokeWithRealloc #-}+pokeWithRealloc :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray Word8+    -> a+    -> m (MutArray Word8)+pokeWithRealloc sizer arr x = do+    arr1 <- liftIO $ reallocBytesWith "pokeWithRealloc" sizer (SIZE_OF(a)) arr+    unsafePoke arr1 x++{-# INLINE pokeWith #-}+pokeWith :: forall m a. (MonadIO m, Unbox a) =>+       (Int -> Int)+    -> MutArray Word8+    -> a+    -> m (MutArray Word8)+pokeWith allocSize arr x = liftIO $ do+    let newEnd = arrEnd arr + SIZE_OF(a)+    if newEnd <= arrBound arr+    then pokeNewEnd newEnd arr x+    else pokeWithRealloc allocSize arr x++-- | Unbox a Haskell type and append the resulting bytes to a mutable byte+-- array. The array is grown exponentially when more space is needed.+--+-- Like 'snoc' except that the value is unboxed to the byte array.+--+-- Note: If you are serializing a large number of small fields, and the types+-- are statically known, then it may be more efficient to declare a record of+-- those fields and derive an 'Unbox' instance of the entire record.+--+{-# INLINE poke #-}+pokeAppend, poke :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> a -> m (MutArray Word8)+poke = pokeWith f++    where++    f oldSize =+        if isPower2 oldSize+        then oldSize * 2+        else roundUpToPower2 oldSize * 2++-- | Really really unsafe, create a Haskell value from an unboxed byte array,+-- does not check if the array is big enough, may return garbage or if you are+-- lucky may cause a segfault.+--+-- /Internal/+{-# INLINE unsafePeek #-}+peekUnconsUnsafe, unsafePeek :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> m (a, MutArray Word8)+unsafePeek MutArray{..} = do+    let start1 = arrStart + SIZE_OF(a)+    assert (start1 <= arrEnd) (return ())+    liftIO $ do+        r <- peekAt arrStart arrContents+        return (r, MutArray arrContents start1 arrEnd arrBound)++-- | Discard the specified number of bytes at the beginning of the array.+{-# INLINE unsafePeekSkip #-}+peekSkipUnsafe, unsafePeekSkip :: Int -> MutArray Word8 -> MutArray Word8+unsafePeekSkip n MutArray{..} =+    let start1 = arrStart + n+     in assert (start1 <= arrEnd) (MutArray arrContents start1 arrEnd arrBound)++-- | Create a Haskell value from its unboxed representation from the head of a+-- byte array, return the value and the remaining array.+--+-- Like 'uncons' except that the value is deserialized from the byte array.+--+-- Note: If you are deserializing a large number of small fields, and the types+-- are statically known, then it may be more efficient to declare a record of+-- those fields and derive an 'Unbox' instance of the entire record.+{-# INLINE peek #-}+peekUncons, peek :: forall m a. (MonadIO m, Unbox a) =>+    MutArray Word8 -> m (Maybe a, MutArray Word8)+peek arr@MutArray{..} = do+    let start1 = arrStart + SIZE_OF(a)+    if start1 > arrEnd+    then return (Nothing, arr)+    else liftIO $ do+        r <- peekAt arrStart arrContents+        return (Just r, MutArray arrContents start1 arrEnd arrBound)++-------------------------------------------------------------------------------+-- 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 unsafeGetIndex #-}+getIndexUnsafe, unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+unsafeGetIndex 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++{-# INLINE_NORMAL unsafeGetIndexRev #-}+unsafeGetIndexRev :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> m a+unsafeGetIndexRev i MutArray{..} = do+    let index = RINDEX_OF(arrEnd,i,a)+    assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())+    liftIO $ peekAt index arrContents++-- | /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++{-# INLINE indexReaderWith #-}+indexReaderWith :: (Monad m, Unbox a) =>+    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a+indexReaderWith 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++{-# DEPRECATED getIndicesWith "Please use indexReaderWith instead." #-}+{-# INLINE getIndicesWith #-}+getIndicesWith :: (Monad m, Unbox a) =>+    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a+getIndicesWith = indexReaderWith++-- | 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 indexReader #-}+indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+indexReader = indexReaderWith liftIO++-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold+{-# DEPRECATED getIndices "Please use indexReader instead." #-}+{-# INLINE getIndices #-}+getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+getIndices = indexReader++-------------------------------------------------------------------------------+-- Subarrays+-------------------------------------------------------------------------------++-- XXX We can also get immutable slices.+-- XXX sliceFromLen for a stream of slices starting from a given index++-- | /O(1)/ Slice an array in constant time.+--+-- Unsafe: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE unsafeSliceOffLen #-}+unsafeSliceOffLen, getSliceUnsafe  :: forall a. Unbox a+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+unsafeSliceOffLen 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)/ Get a reference to a slice from a mutable array. Throws an error if+-- the slice extends out of the array bounds.+--+-- The capacity of the slice is the same as its length i.e. it does not have+-- any unused or reserved space at the end.+--+-- The slice shares the same underlying mutable array when created. However, if+-- the slice or the original array is reallocated by growing or shrinking then+-- it will be copied to new memory and they will no longer share the same+-- memory.+--+-- /Pre-release/+{-# INLINE sliceOffLen #-}+sliceOffLen, getSlice :: forall a. Unbox a =>+       Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+sliceOffLen 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+                $ "sliceOffLen: 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++-- XXX Use vector instructions in arrays to find min/max/range faster++-- XXX If we can mutate the array then we can do pairwise processing to keep+-- min in the first slot and max in the second. Then compare adjacent mins and+-- keep the min of those in the first slot, and similarly for max. Thus+-- reducing the comparisons in binary fashion.+--+-- Or we can use mergeBy as defined above.+--+-- If we cannot mutate the array then we can (1) copy it and use the above+-- algo, or (2) stream the array and use pairwise concat.++-- | Find the minimum and maximum elements in the array using the provided+-- comparison function.+rangeBy :: (a -> a -> Ordering) -> MutArray a -> IO (Maybe (a, a))+rangeBy = 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 used 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++{-# INLINE capacity #-}+capacity :: forall a. Unbox a => MutArray a -> Int+capacity arr =+    let elemSize = SIZE_OF(a)+        bcap = byteCapacity arr+     in assert (bcap `mod` elemSize == 0) (bcap `div` elemSize)++{-# INLINE free #-}+free :: forall a. Unbox a => MutArray a -> Int+free arr =+    let elemSize = SIZE_OF(a)+        bfree = bytesFree arr+     in assert (bfree `mod` elemSize == 0) (bfree `div` elemSize)++-------------------------------------------------------------------------------+-- 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.createOf 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 (createOf n)+chunksOf = chunksOfAs Unpinned++-- | Like 'chunksOf' but creates pinned arrays.+{-# INLINE_NORMAL chunksOf' #-}+pinnedChunksOf, chunksOf' :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- chunksOf' n = D.foldMany (createOf' n)+chunksOf' = chunksOfAs Pinned+RENAME_PRIME(pinnedChunksOf,chunksOf)++-- | Create arrays from the input stream using a predicate to find the end of+-- the chunk. When the predicate matches, the chunk ends, the matching element+-- is included in the chunk.+--+--  Definition:+--+-- >>> chunksEndBy p = Stream.foldMany (Fold.takeEndBy p MutArray.create)+--+{-# INLINE chunksEndBy #-}+chunksEndBy :: forall m a. (MonadIO m, Unbox a)+    => (a -> Bool) -> D.Stream m a -> D.Stream m (MutArray a)+chunksEndBy p = D.foldMany (FL.takeEndBy p create)++-- | Like 'chunksEndBy' but creates pinned arrays.+--+{-# INLINE chunksEndBy' #-}+chunksEndBy' :: forall m a. (MonadIO m, Unbox a)+    => (a -> Bool) -> D.Stream m a -> D.Stream m (MutArray a)+chunksEndBy' p = D.foldMany (FL.takeEndBy p create')++-- | Create chunks using newline as the separator, including it.+{-# INLINE chunksEndByLn #-}+chunksEndByLn :: (MonadIO m)+    => D.Stream m Word8 -> D.Stream m (MutArray Word8)+chunksEndByLn = chunksEndBy (== fromIntegral (ord '\n'))++-- | Like 'chunksEndByLn' but creates pinned arrays.+{-# INLINE chunksEndByLn' #-}+chunksEndByLn' :: (MonadIO m)+    => D.Stream m Word8 -> D.Stream m (MutArray Word8)+chunksEndByLn' = chunksEndBy' (== fromIntegral (ord '\n'))++-- | When we are buffering a stream of unknown size into an array we do not+-- know how much space to pre-allocate. So we start with the min size and emit+-- the array then keep on doubling the size every time. Thus we do not need to+-- guess the optimum chunk size.+--+-- We can incorporate this in chunksOfAs if the additional size parameter does+-- not impact perf.+--+{-# INLINE _chunksOfRange #-}+_chunksOfRange :: -- (MonadIO m, Unbox a) =>+    PinnedState -> Int -> Int -> D.Stream m a -> D.Stream m (MutArray a)+_chunksOfRange _ps _low _hi = undefined++-- 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++{-# INLINE_NORMAL concatWith #-}+concatWith :: forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a+concatWith liftio (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)++-- | Same as the following but may be more efficient due to better fusion:+--+-- >>> concat = Stream.unfoldEach MutArray.reader+--+{-# INLINE_NORMAL concat #-}+concat :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+concat = concatWith liftIO++{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}+{-# INLINE flattenArrays #-}+flattenArrays :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+flattenArrays = concat++{-# INLINE_NORMAL concatRevWith #-}+concatRevWith :: forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> D.Stream m (MutArray a) -> D.Stream m a+concatRevWith liftio (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)++-- | Use the "readerRev" unfold instead.+--+-- @concat = unfoldMany readerRev@+--+-- We can try this if there are any fusion issues in the unfold.+--+{-# INLINE_NORMAL concatRev #-}+concatRev :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+concatRev = concatRevWith liftIO++{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}+{-# INLINE flattenArraysRev #-}+flattenArraysRev :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (MutArray a) -> D.Stream m a+flattenArraysRev = concatRev++-------------------------------------------------------------------------------+-- 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 toStreamWith #-}+toStreamWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a+toStreamWith 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 = toStreamWith 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 toStreamRevWith #-}+toStreamRevWith ::+       forall m a. (Monad m, Unbox a)+    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a+toStreamRevWith 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 = toStreamRevWith 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++-- | Fold an array using a 'Fold'.+--+-- For example:+--+-- >>> findIndex eq = MutArray.fold (Fold.findIndex eq)+--+-- /Pre-release/+{-# INLINE fold #-}+fold :: (MonadIO m, Unbox a) => Fold m a b -> MutArray a -> m b+fold f arr = D.fold f (read arr)++-- | Fold an arary starting from end up to beginning.+--+-- For example:+--+-- >>> findIndexRev eq = MutArray.foldRev (Fold.findIndex eq)+--+foldRev :: (MonadIO m, Unbox a) => Fold m a b -> MutArray a -> m b+foldRev f arr = D.fold f (readRev arr)++-------------------------------------------------------------------------------+-- Folds for appending+-------------------------------------------------------------------------------++-- 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?++-- | @unsafeAppendN 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/+{-# DEPRECATED unsafeAppendN "Please use unsafeAppendMax instead." #-}+{-# INLINE_NORMAL unsafeAppendN #-}+unsafeAppendN :: forall m a. (MonadIO m, Unbox a) =>+       Int+    -> m (MutArray a)+    -> Fold m a (MutArray a)+unsafeAppendN 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 reallocBytesWith "unsafeAppendN" (+ needed) needed arr+            else return arr+        return $ toArrayUnsafe arr1++    step (ArrayUnsafe contents start end) x = do+        liftIO $ pokeAt end contents x+        -- We are using end as the bound, so no reserved space left.+        return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))++-- | @unsafeAppendMax 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.+--+-- /Internal/+{-# INLINE_NORMAL unsafeAppendMax #-}+unsafeAppendMax :: forall m a. (MonadIO m, Unbox a) =>+       Int+    -> MutArray a+    -> Fold m a (MutArray a)+unsafeAppendMax n arr@MutArray{..} =+    fmap final $ FL.foldlM' step initial++    where++    free_ = arrBound - arrEnd+    needed = n * SIZE_OF(a)+    bound = arrBound + needed - free_++    initial = do+        assert (n >= 0) (return ())+        arr1 <-+            if free_ < needed+            then noinline+                    reallocBytesWith "unsafeAppendMax" (+ 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))++    final (ArrayUnsafe contents start end) =+        MutArray contents start end bound++{-# DEPRECATED writeAppendNUnsafe "Please use unsafeAppendN instead." #-}+{-# INLINE writeAppendNUnsafe #-}+writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>+       Int+    -> m (MutArray a)+    -> Fold m a (MutArray a)+writeAppendNUnsafe = unsafeAppendN++-- | Append @n@ elements to an existing array. Any free space left in the array+-- after appending @n@ elements is lost.+--+-- >>> appendN n initial = Fold.take n (MutArray.unsafeAppendN n initial)+--+{-# DEPRECATED appendN "Please use appendMax instead." #-}+{-# INLINE_NORMAL appendN #-}+appendN :: forall m a. (MonadIO m, Unbox a) =>+    Int -> m (MutArray a) -> Fold m a (MutArray a)+appendN n initial = FL.take n (unsafeAppendN n initial)++-- | Allocates space for n additional elements. The fold terminates after+-- appending n elements. If less than n elements are supplied then the space+-- for the remaining elements is guaranteed to be reserved.+--+-- >>> appendMax n arr = Fold.take n (MutArray.unsafeAppendMax n arr)+--+{-# INLINE_NORMAL appendMax #-}+appendMax :: forall m a. (MonadIO m, Unbox a) =>+    Int -> MutArray a -> Fold m a (MutArray a)+appendMax n initial = FL.take n (unsafeAppendMax n initial)++{-# DEPRECATED writeAppendN "Please use appendN instead." #-}+{-# INLINE writeAppendN #-}+writeAppendN :: forall m a. (MonadIO m, Unbox a) =>+    Int -> m (MutArray a) -> Fold m a (MutArray a)+writeAppendN = appendN++-- | @appendWith sizer 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 @sizer oldSize@,+-- where @oldSize@ is the current size of the array in bytes. If the sizer+-- returns less than or equal to the current size then the size is incremented+-- by one element.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> appendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)+--+-- /Pre-release/+{-# INLINE appendWith #-}+appendWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+appendWith sizer = FL.foldlM' (snocWith sizer)++{-# DEPRECATED writeAppendWith "Please use appendWith instead." #-}+{-# INLINE writeAppendWith #-}+writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>+    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+writeAppendWith = appendWith++-- | @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 and aligned to power of 2.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> append = Fold.foldlM' MutArray.snoc+--+{-# DEPRECATED append "Please use append2 instead." #-}+{-# INLINE append #-}+append :: forall m a. (MonadIO m, Unbox a) =>+    m (MutArray a) -> Fold m a (MutArray a)+-- append = appendWith (* 2)+append = FL.foldlM' snoc++-- | Fold @append2 arr@ mutates the array arr to append the input stream. If+-- there is no reserved space available in the array it is reallocated to+-- double the size and aligned to power of 2.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> append2 arr = Fold.foldlM' MutArray.snoc (pure arr)+--+{-# INLINE append2 #-}+append2 :: (MonadIO m, Unbox a) => MutArray a -> Fold m a (MutArray a)+append2 arr = FL.foldlM' snoc (pure arr)++{-# DEPRECATED writeAppend "Please use append instead." #-}+{-# INLINE writeAppend #-}+writeAppend :: forall m a. (MonadIO m, Unbox a) =>+    m (MutArray a) -> Fold m a (MutArray a)+writeAppend = append++-- | @appendGrowBy arr@ mutates the array arr to append the input stream. If+-- there is no reserved space available in the array it is reallocated to add+-- space for the min number of elements supplied and align to block size if the+-- array becomes larger than 'largeObjectThreshold'.+--+-- Note that the returned array may be a mutated version of original array.+--+-- >>> appendGrowBy n arr = Fold.foldlM' (MutArray.snocGrowBy n) (pure arr)+--+{-# INLINE appendGrowBy #-}+appendGrowBy :: (MonadIO m, Unbox a) =>+    Int -> MutArray a -> Fold m a (MutArray a)+appendGrowBy n arr = FL.foldlM' (snocGrowBy n) (pure arr)++-------------------------------------------------------------------------------+-- Actions for Appending streams+-------------------------------------------------------------------------------++-- |+-- >>> appendStream arr = Stream.fold (MutArray.append (pure arr))+--+{-# INLINE appendStream #-}+appendStream :: (MonadIO m, Unbox a) =>+    MutArray a -> Stream m a -> m (MutArray a)+appendStream arr = D.fold (append (pure arr))++-- |+-- >>> appendStreamN n arr = Stream.fold (MutArray.appendMax n arr)+--+{-# INLINE appendStreamN #-}+appendStreamN :: (MonadIO m, Unbox a) =>+    Int -> MutArray a -> Stream m a -> m (MutArray a)+appendStreamN n arr = D.fold (appendMax n arr)++-- | The array is grown only by the required amount of space.+{-# INLINE appendCString# #-}+appendCString# :: MonadIO m => MutArray Word8 -> Addr# -> m (MutArray Word8)+appendCString# arr addr = do+    len <- liftIO $ c_strlen_pinned addr+    appendPtrN arr (Ptr addr) (fromIntegral len)++-- Note: in hsc code # is treated in a special way, so it is difficult to use+-- appendCString#+{-# INLINE appendCString #-}+appendCString :: MonadIO m => MutArray Word8 -> Ptr a -> m (MutArray Word8)+appendCString arr (Ptr addr) = appendCString# arr addr++-------------------------------------------------------------------------------+-- Folds for creating+-------------------------------------------------------------------------------++-- XXX Use "IO" instead of "m" in the alloc function++-- 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 'unsafeCreateOf' but takes a new array allocator @alloc size@+-- function as argument.+--+-- >>> unsafeCreateWithOf alloc n = MutArray.unsafeAppendN (alloc n) n+--+-- /Pre-release/+{-# INLINE_NORMAL unsafeCreateWithOf #-}+unsafeCreateWithOf :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+unsafeCreateWithOf 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))++{-# DEPRECATED writeNWithUnsafe "Please use unsafeCreateWithOf instead." #-}+{-# INLINE writeNWithUnsafe #-}+writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeNWithUnsafe = unsafeCreateWithOf++{-# INLINE_NORMAL writeNUnsafeAs #-}+writeNUnsafeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m a (MutArray a)+writeNUnsafeAs ps = unsafeCreateWithOf (newAs ps)++-- | Like 'createOf' 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.+--+-- >>> unsafeCreateOf = MutArray.unsafeCreateWithOf MutArray.emptyOf+--+{-# INLINE_NORMAL unsafeCreateOf #-}+unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+unsafeCreateOf = writeNUnsafeAs Unpinned++{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}+{-# INLINE writeNUnsafe #-}+writeNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+writeNUnsafe = unsafeCreateOf++-- | Like 'unsafeCreateOf' but creates a pinned array.+{-# INLINE_NORMAL unsafeCreateOf' #-}+unsafePinnedCreateOf, unsafeCreateOf' :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+unsafeCreateOf' = writeNUnsafeAs Pinned+RENAME_PRIME(unsafePinnedCreateOf,unsafeCreateOf)++{-# DEPRECATED pinnedWriteNUnsafe "Please use unsafeCreateOf' instead." #-}+{-# INLINE pinnedWriteNUnsafe #-}+pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+pinnedWriteNUnsafe = unsafeCreateOf'++-- XXX Use "IO" instead of "m" in the alloc function++-- | @createWithOf alloc n@ folds a maximum of @n@ elements into an array+-- allocated using the @alloc@ function.+--+-- The array capacity is guranteed to be at least @n@.+--+-- >>> createWithOf alloc n = Fold.take n (MutArray.unsafeCreateWithOf alloc n)+-- >>> createWithOf alloc n = MutArray.appendN (alloc n) n+--+{-# INLINE_NORMAL createWithOf #-}+createOfWith, createWithOf :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+createWithOf alloc n = FL.take n (unsafeCreateWithOf alloc n)++{-# DEPRECATED writeNWith "Please use createWithOf instead." #-}+{-# INLINE writeNWith #-}+writeNWith :: forall m a. (MonadIO m, Unbox a)+    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+writeNWith = createWithOf++{-# INLINE_NORMAL writeNAs #-}+writeNAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState+    -> Int+    -> Fold m a (MutArray a)+writeNAs ps = createWithOf (newAs ps)++-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an+-- 'MutArray'.+--+-- The array capacity is guranteed to be at least @n@.+--+-- >>> createOf = MutArray.createWithOf MutArray.emptyOf+-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)+-- >>> createOf n = MutArray.appendMax n MutArray.empty+--+{-# INLINE_NORMAL createOf #-}+createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+createOf = writeNAs Unpinned++{-# DEPRECATED writeN "Please use createOf instead." #-}+{-# INLINE writeN #-}+writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+writeN = createOf++-- | Like 'createOf' but creates a pinned array.+{-# INLINE_NORMAL createOf' #-}+pinnedCreateOf, createOf' ::+       forall m a. (MonadIO m, Unbox a)+    => Int+    -> Fold m a (MutArray a)+createOf' = writeNAs Pinned+RENAME_PRIME(pinnedCreateOf,createOf)++{-# DEPRECATED pinnedWriteN "Please use createOf' instead." #-}+{-# INLINE pinnedWriteN #-}+pinnedWriteN ::+       forall m a. (MonadIO m, Unbox a)+    => Int+    -> Fold m a (MutArray a)+pinnedWriteN = createOf'++-- | Like unsafeCreateWithOf 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 createWithOf 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 'createOf' but writes the array in reverse order.+--+-- /Pre-release/+{-# INLINE_NORMAL revCreateOf #-}+revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+revCreateOf = writeRevNWith new++{-# DEPRECATED writeRevN "Please use revCreateOf instead." #-}+{-# INLINE writeRevN #-}+writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+writeRevN = revCreateOf++-- | @pinnedWriteNAligned align n@ folds a maximum of @n@ elements from the+-- input stream to a 'MutArray' aligned to the given size.+--+-- /Pre-release/+--+{-# INLINE_NORMAL pinnedWriteNAligned #-}+pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> Fold m a (MutArray a)+pinnedWriteNAligned align = createWithOf (pinnedNewAligned align)++-- XXX Buffer to a list instead?++-- | Buffer a stream into a stream of arrays.+--+-- >>> buildChunks n = Fold.many (MutArray.createOf 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 buildChunks #-}+buildChunks :: (MonadIO m, Unbox a) =>+    Int -> Fold m a (StreamK n (MutArray a))+buildChunks n = FL.many (createOf n) FL.toStreamK++{-# DEPRECATED writeChunks "Please use buildChunks instead." #-}+{-# INLINE writeChunks #-}+writeChunks :: (MonadIO m, Unbox a) =>+    Int -> Fold m a (StreamK n (MutArray a))+writeChunks = buildChunks++-- | Grows by doubling+{-# INLINE_NORMAL writeWithAs #-}+writeWithAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m a (MutArray a)+-- writeWithAs ps n = FL.rmapM rightSize $ appendWith (* 2) (newAs ps n)+writeWithAs ps elemCount =+    FL.rmapM extract $ FL.foldlM' step initial++    where++    -- XXX create an empty Array if the count is <= 0?+    initial = do+        when (elemCount < 0) $ error "createWith: elemCount is negative"+        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 $ reallocExplicitAs ps (SIZE_OF(a)) newSize arr+        unsafeSnoc arr1 x+    step arr x = unsafeSnoc arr x++    extract = liftIO . rightSize++-- XXX Compare createWith with fromStreamD which uses an array of streams+-- implementation. We can write this using buildChunks above if that is faster.+-- If createWith 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 seems 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.++-- | @createMinOf count@ 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.+--+-- The array capacity is guaranteed to be at least count.+--+-- /Caution! Do not use this on infinite streams./+--+-- >>> f n = MutArray.appendWith (* 2) (MutArray.emptyOf n)+-- >>> createWith n = Fold.rmapM MutArray.rightSize (f n)+-- >>> createWith n = Fold.rmapM MutArray.fromChunksK (MutArray.buildChunks n)+--+-- /Pre-release/+{-# INLINE_NORMAL createMinOf #-}+createMinOf, createWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+-- createWith n = FL.rmapM rightSize $ appendWith (* 2) (emptyOf n)+createMinOf = writeWithAs Unpinned++RENAME(createWith,createMinOf)++{-# DEPRECATED writeWith "Please use createMinOf instead." #-}+{-# INLINE writeWith #-}+writeWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (MutArray a)+writeWith = createMinOf++-- | Fold the whole input to a single array.+--+-- Same as 'createMinOf using an initial array size of 'arrayChunkBytes' bytes+-- rounded up to the element size. If the array is expected to be smaller than+-- 'arrayChunkBytes' then use 'createMinOf' to avoid wasting memory.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE create #-}+create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+create = createMinOf (allocBytesToElemCount (undefined :: a) arrayChunkBytes)++{-# DEPRECATED write "Please use create instead." #-}+{-# INLINE write #-}+write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+write = create++-- | Like 'create' but creates a pinned array.+{-# INLINE create' #-}+pinnedCreate, create' :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+create' =+    writeWithAs Pinned (allocBytesToElemCount (undefined :: a) arrayChunkBytes)+RENAME_PRIME(pinnedCreate,create)++{-# DEPRECATED pinnedWrite "Please use create' instead." #-}+{-# INLINE pinnedWrite #-}+pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+pinnedWrite = create'++-------------------------------------------------------------------------------+-- 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) <- 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)++-- | Create a MutArray of given size from a stream.+--+-- >>> fromStreamN n = Stream.fold (MutArray.createOf n)+--+{-# INLINE_NORMAL fromStreamN #-}+fromStreamN :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> m (MutArray a)+-- fromStreamDN n = D.fold (createOf n)+fromStreamN = fromStreamDNAs Unpinned++{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}+{-# INLINE fromStreamDN #-}+fromStreamDN :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> m (MutArray a)+fromStreamDN = fromStreamN++-- | 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 = fromStreamN n $ D.fromList xs++-- | Like 'fromListN' but creates a pinned array.+{-# INLINABLE fromListN' #-}+pinnedFromListN, fromListN' :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+fromListN' n xs = fromStreamDNAs Pinned n $ D.fromList xs+RENAME_PRIME(pinnedFromListN,fromListN)++-- | 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 (revCreateOf n) $ D.fromList xs++-- | Convert a pure stream in Identity monad to a mutable array.+{-# INLINABLE fromPureStreamN #-}+fromPureStreamN :: (MonadIO m, Unbox a) =>+    Int -> Stream Identity a -> m (MutArray a)+fromPureStreamN n = D.fold (createOf n) . D.generalizeInner++-- | 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 = D.fold create . D.generalizeInner++-- | @fromPtrN len addr@ copies @len@ bytes from @addr@ into an array.+--+-- /Unsafe:/+--+-- The caller has to ensure that:+--+-- 1. the pointer is pinned and alive during the call.+-- 2. the pointer passed is valid up to the given length.+--+{-# INLINABLE fromPtrN #-}+fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)+fromPtrN len addr = do+    -- memcpy is better than stream copy when the size is known.+    -- XXX We can implement a stream copy in a similar way by streaming Word64+    -- first and then remaining Word8.+    (arr :: MutArray Word8) <- emptyOf len+    let mbarr = getMutByteArray# (arrContents arr)+    _ <- liftIO $ c_memcpy_pinned_src mbarr addr (fromIntegral len)+    pure (arr { arrEnd = len })++-- | @fromCString# addr@ copies a C string consisting of bytes and+-- terminated by a null byte, into a Word8 array. The null byte is not copied.+--+-- >>> MutArray.fromCString# "hello"#+--+-- /Unsafe:/+--+-- The caller has to ensure that:+--+-- 1. the @addr@ is pinned and alive during the call.+-- 2. the pointer passed is valid up to the point where null byte is found.+--+{-# INLINABLE fromCString# #-}+fromCString# :: MonadIO m => Addr# -> m (MutArray Word8)+fromCString# addr = do+    -- It is better to count the size first and allocate exact space.+    -- Also, memcpy is better than stream copy when the size is known.+    -- C strlen compares 4 bytes at a time, so is better than the stream+    -- version. https://github.com/bminor/glibc/blob/master/string/strlen.c+    -- XXX We can possibly use a stream of Word64 to do the same.+    -- fromByteStr# addr = fromPureStream (D.fromByteStr# addr)+    len <- liftIO $ c_strlen_pinned addr+    fromPtrN (fromIntegral len) (Ptr addr)++{-# DEPRECATED fromByteStr# "Please fromCString# instead." #-}+{-# INLINABLE fromByteStr# #-}+fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)+fromByteStr# = fromCString#++-- | @fromW16CString# addr@ copies a C string consisting of 16-bit wide chars+-- and terminated by a 16-bit null char, into a Word16 array. The null+-- character is not copied.+--+-- Useful for copying UTF16 strings on Windows.+--+-- /Unsafe:/+--+-- The caller has to ensure that:+--+-- 1. the @addr@ is pinned and alive during the call.+-- 2. the pointer passed is valid up to the point where null Word16 is found.+--+{-# INLINABLE fromW16CString# #-}+fromW16CString# :: MonadIO m => Addr# -> m (MutArray Word16)+fromW16CString# addr = do+    -- XXX this can be done faster if we process one Word64 at a time+    w16len <- D.fold FL.length $ D.fromW16CString# addr+    let bytes = w16len * 2+    arr <- fromPtrN bytes (Ptr addr)+    pure $ unsafeCast arr++-------------------------------------------------------------------------------+-- convert a stream of arrays to a single array by reallocating and copying+-------------------------------------------------------------------------------++-- XXX Both of these implementations of splicing seem to perform equally well.+-- We need to perform benchmarks over a range of sizes though.++-- | Also see 'fromChunksK'.+{-# INLINE fromChunksRealloced #-}+fromChunksRealloced :: forall m a. (MonadIO m, Unbox a)+    => Stream m (MutArray a) -> m (MutArray a)+fromChunksRealloced s = do+    res <- D.uncons s+    case res of+        Just (a, strm) -> do+            arr <- D.foldlM' spliceExp (pure a) strm+            -- Reallocation is exponential so there may be 50% empty space in+            -- worst case. One more reallocation to reclaim the space.+            rightSize arr+        Nothing -> pure nil++-------------------------------------------------------------------------------+-- convert a stream of arrays to a single array by buffering arrays first+-------------------------------------------------------------------------------++{-# 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 fromChunkskAs #-}+fromChunkskAs :: (Unbox a, MonadIO m) =>+    PinnedState -> StreamK m (MutArray a) -> m (MutArray a)+fromChunkskAs ps as = do+    len <- arrayStreamKLength as+    arr <- newAs ps len+    -- XXX is StreamK fold faster or StreamD fold?+    K.foldlM' unsafeSplice (pure arr) as+    -- fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as++-- XXX Need to compare this with fromChunks and fromChunkList and keep the+-- fastest or simplest one if all are equally fast.++-- | Convert an array stream to an array. Note that this requires peak memory+-- that is double the size of the array stream.+--+-- Also see 'fromChunksRealloced'.+--+{-# INLINE fromChunksK #-}+fromChunksK :: (Unbox a, MonadIO m) =>+    StreamK m (MutArray a) -> m (MutArray a)+fromChunksK = fromChunkskAs Unpinned++{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}+{-# INLINE fromArrayStreamK #-}+fromArrayStreamK :: (Unbox a, MonadIO m) =>+    StreamK m (MutArray a) -> m (MutArray a)+fromArrayStreamK = fromChunksK++{-# INLINE fromStreamDAs #-}+fromStreamDAs ::+       (MonadIO m, Unbox a) => PinnedState -> D.Stream m a -> m (MutArray a)+fromStreamDAs ps m =+    arrayStreamKFromStreamDAs Unpinned m >>= fromChunkskAs ps++-- | Create an 'Array' from a stream. This is useful when we want to create a+-- single array from a stream of unknown size. 'createOf' 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 = fromStreamDAs Unpinned++-- fromStream (Stream m) = P.fold create m+-- 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 create".+--+-- | 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.create+--+{-# INLINE fromStreamD #-}+{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}+fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)+fromStreamD = fromStream++-- | 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 fromList' #-}+pinnedFromList, fromList' :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+fromList' xs = fromStreamDAs Pinned $ D.fromList xs+RENAME_PRIME(pinnedFromList,fromList)++-- 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+-------------------------------------------------------------------------------++-- Arrays are aligned on 64-bit boundaries. The fastest way to copy an array is+-- to unsafeCast it to Word64, read it, write it to Word64 array and unsafeCast+-- it again. We can use SIMD read/write as well.++{-# INLINE cloneAs #-}+cloneAs ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => PinnedState -> MutArray a -> m (MutArray a)+cloneAs ps src =+    do+        let startSrc = arrStart src+            srcLen = arrEnd src - startSrc+        newArrContents <-+            Unboxed.unsafeCloneSliceAs ps startSrc srcLen (arrContents src)+        return $ MutArray newArrContents 0 srcLen srcLen++-- | Clone the elements of a MutArray. Does not clone the reserve capacity.+--+-- To clone a slice of "MutArray" you can create a slice with "unsafeSliceOffLen"+-- and then use "clone".+--+-- The new "MutArray" is unpinned in nature. Use "clone'" to clone the+-- MutArray in pinned memory.+{-# INLINE clone #-}+clone ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => MutArray a -> m (MutArray a)+clone = cloneAs Unpinned++-- Similar to "clone" but uses pinned memory.+{-# INLINE clone' #-}+pinnedClone, clone' ::+    ( MonadIO m+#ifdef DEVBUILD+    , Unbox a+#endif+    )+    => MutArray a -> m (MutArray a)+clone' = cloneAs Pinned+RENAME_PRIME(pinnedClone,clone)++-------------------------------------------------------------------------------+-- Combining+-------------------------------------------------------------------------------++-- | Copy two arrays into a newly allocated array. If the first array is pinned+-- the spliced array is also pinned.+--+-- Note: If you freeze and splice it will create a new array.+{-# INLINE spliceCopy #-}+spliceCopy :: forall m a. MonadIO m =>+#ifdef DEVBUILD+    Unbox a =>+#endif+    MutArray a -> MutArray a -> m (MutArray a)+spliceCopy arr1 arr2 = do+    let start1 = arrStart arr1+        start2 = arrStart arr2+        len1 = arrEnd arr1 - start1+        len2 = arrEnd arr2 - start2+    let len = len1 + len2+    newArrContents <-+        if Unboxed.isPinned (arrContents arr1)+        then liftIO $ Unboxed.new' len+        else liftIO $ Unboxed.new len+    unsafePutSlice (arrContents arr1) start1 newArrContents 0 len1+    unsafePutSlice (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 unsafeSplice #-}+spliceUnsafe, unsafeSplice :: MonadIO m =>+    MutArray a -> MutArray a -> m (MutArray a)+unsafeSplice dst src = do+     let startSrc = arrStart src+         srcLen = arrEnd src - startSrc+         endDst = arrEnd dst+     assertM(endDst + srcLen <= arrBound dst)+     unsafePutSlice+         (arrContents src) startSrc (arrContents dst) endDst srcLen+     return $ dst {arrEnd = endDst + srcLen}++-- | Append specified number of bytes from a given pointer to the MutArray.+--+-- /Unsafe:/+--+-- The caller has to ensure that:+--+-- 1. the MutArray is valid up to the given length.+-- 2. the source pointer is pinned and alive during the call.+-- 3. the pointer passed is valid up to the given length.+--+{-# INLINE unsafeAppendPtrN #-}+unsafeAppendPtrN :: MonadIO m =>+    MutArray Word8 -> Ptr Word8 -> Int -> m (MutArray Word8)+unsafeAppendPtrN arr ptr ptrLen = do+    let newEnd = arrEnd arr + ptrLen+    assertM(newEnd <= arrBound arr)+    Unboxed.unsafePutPtrN ptr (arrContents arr) (arrEnd arr) ptrLen+    return $ arr {arrEnd = newEnd}++{-# INLINE appendPtrN #-}+appendPtrN :: MonadIO m =>+    MutArray Word8 -> Ptr Word8 -> Int -> m (MutArray Word8)+appendPtrN arr ptr ptrLen = do+    arr1 <- growBy ptrLen arr+    unsafeAppendPtrN arr1 ptr ptrLen++-- | @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 = appendWith (`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."+            realloc newSizeInBytes dst+        else return dst+    unsafeSplice dst1 src++-- | The first array is extended in-place to append the second array. If there is no+-- reserved space available in the first array then a new allocation of exact+-- required size is done.+--+-- Note that the returned array may be an extended version of first array,+-- referring to the same memory as the original 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+-------------------------------------------------------------------------------++{-# INLINE splitUsing #-}+splitUsing :: (MonadIO m, Unbox a) =>+    ((a -> Bool) -> Stream m a -> Stream m (Int, Int))+    -> (a -> Bool) -> MutArray a -> Stream m (MutArray a)+splitUsing f predicate arr =+    fmap (\(i, len) -> unsafeSliceOffLen i len arr)+        $ f predicate (read arr)++-- | Generate a stream of array slices using a predicate. The array element+-- matching the predicate is dropped.+--+-- /Pre-release/+{-# INLINE splitEndBy_ #-}+splitEndBy_, splitOn :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> Stream m (MutArray a)+splitEndBy_ = splitUsing D.indexEndBy_++RENAME(splitOn,splitEndBy_)++-- | Generate a stream of array slices using a predicate. The array element+-- matching the predicate is included.+--+-- /Pre-release/+{-# INLINE splitEndBy #-}+splitEndBy :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> Stream m (MutArray a)+splitEndBy = splitUsing D.indexEndBy++-- XXX See advanceStartTill for a potential performance issue with this type of+-- code which needed to be investigated. Measure the perf of this and use+-- advanceStartTill if that turns out to be better.++{-# INLINE breakUsing #-}+breakUsing :: (MonadIO m, Unbox a) =>+    Int -> ((a -> Bool) -> Stream m a -> Stream m (Int, Int))+    -> (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+breakUsing adj indexer predicate arr = do+    -- XXX Use MutArray.fold Fold.findIndex instead.+    r <- D.head $ indexer predicate (read arr)+    case r of+        Just (i, len) ->+            -- assert (i == 0)+            -- XXX avoid using length (div operation)+            let arrLen = length arr+                i1 = len + adj+                arr1 =+                    if i1 >= arrLen+                    then empty+                    else unsafeSliceOffLen i1 (arrLen - i1) arr+             in return (unsafeSliceOffLen i len arr, arr1)+        Nothing -> return (arr, empty)++{-# INLINE revBreakUsing #-}+revBreakUsing :: (MonadIO m, Unbox a) =>+    Bool -> (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+revBreakUsing withSep predicate arr = do+    let indexer = if withSep then D.indexEndBy else D.indexEndBy_+        adj = if withSep then 0 else 1+    -- XXX Use MutArray.foldRev Fold.findIndex instead.+    r <- D.head $ indexer predicate (readRev arr)+    case r of+        Just (_, len) ->+            -- assert (i == 0)+            -- XXX avoid using length (div operation)+            let arrLen = length arr+                len1 = len + adj+                arr0 =+                    if len1 >= arrLen+                    then empty+                    else unsafeSliceOffLen 0 (arrLen - len1) arr+                arr1 = unsafeSliceOffLen (arrLen - len) len arr+             in return (arr0, arr1)+        Nothing -> return (arr, empty)++-- |+-- >>> arr <- MutArray.fromList "hello world"+-- >>> (a,b) <- MutArray.breakEndBy (== ' ') arr+-- >>> MutArray.toList a+-- "hello "+-- >>> MutArray.toList b+-- "world"+--+{-# INLINE breakEndBy #-}+breakEndBy :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+breakEndBy = breakUsing 0 D.indexEndBy++-- | Break the array into two slices when the predicate succeeds. The array+-- element matching the predicate is dropped. If the predicate never succeeds+-- the second array is empty.+--+-- >>> arr <- MutArray.fromList "hello world"+-- >>> (a,b) <- MutArray.breakEndBy_ (== ' ') arr+-- >>> MutArray.toList a+-- "hello"+-- >>> MutArray.toList b+-- "world"+--+-- /Pre-release/+{-# INLINE breakEndBy_ #-}+breakEndBy_ :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+breakEndBy_ = breakUsing 1 D.indexEndBy_++-- |+--+-- >>> arr <- MutArray.fromList "hello world"+-- >>> (a,b) <- MutArray.revBreakEndBy (== ' ') arr+-- >>> MutArray.toList a+-- "hello"+-- >>> MutArray.toList b+-- " world"+--+{-# INLINE revBreakEndBy #-}+revBreakEndBy :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+revBreakEndBy = revBreakUsing True++-- |+--+-- >>> arr <- MutArray.fromList "hello world"+-- >>> (a,b) <- MutArray.revBreakEndBy_ (== ' ') arr+-- >>> MutArray.toList a+-- "hello"+-- >>> MutArray.toList b+-- "world"+--+{-# INLINE revBreakEndBy_ #-}+revBreakEndBy_ :: (MonadIO m, Unbox a) =>+    (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+revBreakEndBy_ = revBreakUsing False++-- Note: We could return empty array instead of Nothing. But then we cannot+-- distinguish if the separator was found in the end or was not found at all.+-- XXX Do we need to distinguish that?++-- | Drops the separator byte+{-# INLINE breakEndByWord8_ #-}+breakEndByWord8_, breakOn :: MonadIO m+    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+breakEndByWord8_ sep arr@MutArray{..} = liftIO $ do+    -- XXX We do not need memchr here, we can use a Haskell equivalent.+    -- Need efficient stream based primitives that work on Word64.+    let marr = getMutByteArray# arrContents+        len = fromIntegral (arrEnd - arrStart)+    sepIndex <- c_memchr_index marr (fromIntegral arrStart) sep len+    let intIndex = fromIntegral sepIndex+    return $+        if sepIndex >= len+        then (arr, Nothing)+        else+            ( MutArray+                { arrContents = arrContents+                , arrStart = arrStart+                , arrEnd = arrStart + intIndex -- exclude the separator+                , arrBound = arrStart + intIndex+                }+            , Just $ MutArray+                    { arrContents = arrContents+                    , arrStart = arrStart + (intIndex + 1)+                    , arrEnd = arrEnd+                    , arrBound = arrBound+                    }+            )+RENAME(breakOn,breakEndByWord8_)++-- | Like 'breakAt' but does not check whether the index is valid.+--+-- >>> unsafeBreakAt i arr = (MutArray.unsafeSliceOffLen 0 i arr, MutArray.unsafeSliceOffLen i (MutArray.length arr - i) arr)+--+{-# INLINE unsafeBreakAt #-}+unsafeBreakAt :: forall a. Unbox a =>+    Int -> MutArray a -> (MutArray a, MutArray a)+unsafeBreakAt i MutArray{..} =+    -- (unsafeSliceOffLen 0 i arr, unsafeSliceOffLen i (length arr - i) arr)+    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+          }+        )++-- | Create two slices of an array without copying the original array. The+-- specified index @i@ is the first index of the second slice.+--+{-# INLINE breakAt #-}+breakAt, splitAt+    :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+breakAt i arr =+    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 unsafeBreakAt i arr+RENAME(splitAt,breakAt)++-------------------------------------------------------------------------------+-- 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, unsafeCast ::+#ifdef DEVBUILD+    Unbox b =>+#endif+    MutArray a -> MutArray b+unsafeCast (MutArray contents start end bound) =+    MutArray contents start end bound++-- | Cast an @MutArray a@ into an @MutArray Word8@.+--+asBytes :: MutArray a -> MutArray Word8+asBytes = unsafeCast++-- | 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 $ unsafeCast arr++-- XXX 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.++-- | NOTE: this is deprecated because it can lead to accidental problems if the+-- user tries to use it to mutate the array because it does not return the new+-- array after pinning.+{-# DEPRECATED unsafePinnedAsPtr "Pin the array and then use unsafeAsPtr." #-}+{-# INLINE unsafePinnedAsPtr #-}+unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> Int -> m b) -> m b+unsafePinnedAsPtr mutarr f = do+    let arr0 = arrContents mutarr+    arr <- liftIO $ Unboxed.pin arr0+    let !ptr = Ptr (byteArrayContents#+                     (unsafeCoerce# (getMutByteArray# arr)))+    r <- f (ptr `plusPtr` arrStart mutarr) (byteLength mutarr)+    liftIO $ Unboxed.touch arr+    return r++{-# DEPRECATED asPtrUnsafe "Pin the array and then use unsafeAsPtr." #-}+{-# INLINE asPtrUnsafe #-}+asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+asPtrUnsafe a f = unsafePinnedAsPtr a (\p _ -> f p)++-- | @unsafeAsPtr arr f@, f is a function used as @f ptr len@ where @ptr@ is a+-- pointer to the beginning of array and @len@ is the byte-length of the array.+--+-- /Unsafe/ WARNING:+--+-- 1. The array must be pinned, otherwise it will lead to memory corruption.+-- 2. The user must not use the pointer beyond the supplied length.+--+-- /Pre-release/+--+{-# INLINE unsafeAsPtr #-}+unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> Int -> IO b) -> m b+unsafeAsPtr arr f =+    Unboxed.unsafeAsPtr+        (arrContents arr)+        (\ptr -> f (ptr `plusPtr` arrStart arr) (byteLength arr))++-- | @unsafeCreateWithPtr' capacity populator@ creates a pinned array of+-- @capacity@ bytes and invokes the @populator@ function to populate it.+-- @populator ptr len@ gets the pointer to the array and MUST return the amount+-- of the capacity populated in bytes.+--+-- /Unsafe/ because the populator is allowed to use the pointer only up to+-- specified length. In other words, bytes populated MUST be less than or equal+-- to the total capacity.+{-# INLINE unsafeCreateWithPtr' #-}+unsafeCreateWithPtr'+    :: MonadIO m => Int -> (Ptr Word8 -> IO Int) -> m (MutArray Word8)+unsafeCreateWithPtr' cap pop = do+    (arr :: MutArray Word8) <- emptyOf' cap+    len <- Unboxed.unsafeAsPtr (arrContents arr) pop+    when (len > cap) (error (errMsg len))+    -- arrStart == 0+    pure (arr { arrEnd = len })+++    where++    errMsg len =+        "unsafeCreateWithPtr': length > capacity, "+             ++ "length = " ++ show len ++ ", "+             ++ "capacity = " ++ show cap++asCString :: MutArray a -> (CString -> IO b) -> IO b+asCString arr act = do+    let pinned = isPinned arr+        req = byteLength arr + SIZE_OF(CChar)+    arr1 <-+        if byteCapacity arr < req || not pinned+        then reallocExplicitAs Pinned 1 req arr+        else return arr+    arr2 :: MutArray CChar <- snocUnsafe (unsafeCast arr1) (0 :: CChar)+    unsafeAsPtr arr2 $ \ptr _ -> act (castPtr ptr)++asCWString :: MutArray a -> (CWString -> IO b) -> IO b+asCWString arr act = do+    let pinned = isPinned arr+        req = byteLength arr + SIZE_OF(CWchar)+    arr1 <-+        if byteCapacity arr < req || not pinned+        then reallocExplicitAs Pinned 1 req arr+        else return arr+    arr2 :: MutArray CWchar <- snocUnsafe (unsafeCast arr1) (0 :: CWchar)+    unsafeAsPtr arr2 $ \ptr _ -> act (castPtr ptr)++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Byte compare two arrays. 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.+--+-- /Unsafe/: Note that the 'Unbox' instance of sum types with constructors of+-- different sizes may leave some memory uninitialized which can make byte+-- comparison unreliable.+--+-- /Pre-release/+{-# INLINE byteCmp #-}+byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+byteCmp arr1 arr2 = do+    let !marr1 = arrContents arr1+        !marr2 = arrContents arr2+        !len1 = byteLength arr1+        !len2 = byteLength arr2+        !st1 = arrStart arr1+        !st2 = arrStart arr2+    case compare len1 len2 of+        EQ -> do+            r <- liftIO $ unsafeByteCmp marr1 st1 marr2 st2 len1+            return $ compare r 0+        x -> return x++{-# INLINE cmp #-}+{-# DEPRECATED cmp "Please use byteCmp instead." #-}+cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+cmp = byteCmp++-- | Byte equality of two arrays.+--+-- >>> byteEq arr1 arr2 = (==) EQ <$> MutArray.byteCmp arr1 arr2+--+-- /Unsafe/: See 'byteCmp'.+{-# INLINE byteEq #-}+byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool+byteEq arr1 arr2 = fmap (EQ ==) $ byteCmp arr1 arr2++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- Note: LE versions avoid an extra copy compared to GE. LE parser trades+-- backtracking one array in lieu of avoiding a copy. However, LE and GE both+-- can leave some memory unused. They may split the last array to fit it+-- exactly in the space.++{-# INLINE_NORMAL pCompactLeAs #-}+pCompactLeAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Parser (MutArray a) m (MutArray a)+pCompactLeAs ps maxElems = Parser step initial extract++    where++    maxBytes = maxElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.pCompactLE"++    initial =+        return+            $ if maxElems <= 0+              then error+                       $ functionName+                       ++ ": the size of arrays ["+                       ++ show maxElems ++ "] must be a natural number"+              else Parser.IPartial Nothing++    step Nothing arr =+        return+            $ let len = byteLength arr+               in if len >= maxBytes+                  then Parser.SDone 1 arr+                  else Parser.SPartial 1 (Just arr)+    -- XXX Split the last array to use the space more compactly.+    step (Just buf) arr =+        let len = byteLength buf + byteLength arr+         in if len > maxBytes+            then return $ Parser.SDone 0 buf+            else do+                buf1 <-+                    if byteCapacity buf < maxBytes+                    then liftIO $ reallocExplicitAs+                            ps (SIZE_OF(a)) maxBytes buf+                    else return buf+                buf2 <- unsafeSplice buf1 arr+                return $ Parser.SPartial 1 (Just buf2)++    extract Nothing = return $ Parser.FDone 0 nil+    extract (Just buf) = return $ Parser.FDone 0 buf++-- | Parser @createCompactMax maxElems@ coalesces adjacent arrays in the+-- input stream only if the combined size would be less than or equal to+-- @maxElems@ elements. Note that it won't split an array if the original array+-- is already larger than maxElems.+--+-- @maxElems@ must be greater than 0.+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+--+-- Note that a fold compacting to less than or equal to a given size is not+-- possible, as folds cannot backtrack.+--+-- /Internal/+{-# INLINE createCompactMax #-}+createCompactMax, pCompactLE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> Parser (MutArray a) m (MutArray a)+createCompactMax = pCompactLeAs Unpinned++RENAME(pCompactLE,createCompactMax)++-- | Pinned version of 'createCompactMax'.+{-# INLINE createCompactMax' #-}+createCompactMax', pPinnedCompactLE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> Parser (MutArray a) m (MutArray a)+createCompactMax' = pCompactLeAs Pinned++{-# DEPRECATED pPinnedCompactLE "Please use createCompactMax' instead." #-}+{-# INLINE pPinnedCompactLE #-}+pPinnedCompactLE = createCompactMax'++data SpliceState s arr+    = SpliceInitial s+    | SpliceBuffering s arr+    | SpliceYielding arr (SpliceState s arr)+    | SpliceFinish++-- | 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 additional space so a new array is allocated+-- instead of mutating it.+{-# INLINE_NORMAL compactLeAs #-}+compactLeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)+compactLeAs ps maxElems (D.Stream step state) =+    D.Stream step' (SpliceInitial state)++    where++    maxBytes = maxElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.rCompactLE"++    {-# INLINE_LATE step' #-}+    step' gst (SpliceInitial st) = do+        when (maxElems <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ functionName ++ ": the size of arrays [" ++ show maxElems+                ++ "] must be a natural number"+        r <- step gst st+        case r of+            D.Yield arr s -> return $+                let len = byteLength arr+                 in if len >= maxBytes+                    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++    -- XXX Split the last array to use the space more compactly.+    step' gst (SpliceBuffering st buf) = do+        r <- step gst st+        case r of+            D.Yield arr s -> do+                let len = byteLength buf + byteLength arr+                if len > maxBytes+                then return $+                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))+                else do+                    buf1 <- if byteCapacity buf < maxBytes+                            then liftIO $ reallocExplicitAs+                                    ps (SIZE_OF(a)) maxBytes buf+                            else return buf+                    buf2 <- unsafeSplice buf1 arr+                    return $ D.Skip (SpliceBuffering s buf2)+            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+++{-# INLINE_NORMAL fCompactGeAs #-}+fCompactGeAs ::+       forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> FL.Fold m (MutArray a) (MutArray a)+fCompactGeAs ps minElems = Fold step initial extract extract++    where++    minBytes = minElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.fCompactGE"++    initial =+        return+            $ if minElems < 0+              then error+                       $ functionName+                       ++ ": the size of arrays ["+                       ++ show minElems ++ "] must be a natural number"+              else FL.Partial Nothing++    step Nothing arr =+        return+            $ let len = byteLength arr+               in if len >= minBytes+                  then FL.Done arr+                  else FL.Partial (Just arr)+    -- XXX Buffer arrays as a list to avoid copy and reallocations+    step (Just buf) arr = do+        let len = byteLength buf + byteLength arr+        buf1 <-+            if byteCapacity buf < len+            then liftIO $ reallocExplicitAs+                    ps (SIZE_OF(a)) (max minBytes len) buf+            else return buf+        buf2 <- unsafeSplice buf1 arr+        if len >= minBytes+        then return $ FL.Done buf2+        else return $ FL.Partial (Just buf2)++    extract Nothing = return nil+    extract (Just buf) = return buf++-- | Fold @createCompactMin minElems@ coalesces adjacent arrays in the+-- input stream until the size becomes greater than or equal to @minElems@.+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE createCompactMin #-}+createCompactMin, fCompactGE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> FL.Fold m (MutArray a) (MutArray a)+createCompactMin = fCompactGeAs Unpinned++RENAME(fCompactGE,createCompactMin)++-- | Pinned version of 'createCompactMin'.+{-# INLINE createCompactMin' #-}+createCompactMin', fPinnedCompactGE ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> FL.Fold m (MutArray a) (MutArray a)+createCompactMin' = fCompactGeAs Pinned++{-# DEPRECATED fPinnedCompactGE "Please use createCompactMin' instead." #-}+{-# INLINE fPinnedCompactGE #-}+fPinnedCompactGE = createCompactMin'++{-# INLINE_NORMAL lCompactGeAs #-}+lCompactGeAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+-- The fold version turns out to be a little bit slower.+-- lCompactGeAs ps n = FL.many (fCompactGeAs ps n)+lCompactGeAs ps minElems (Fold step1 initial1 _ final1) =+    Fold step initial extract final++    where++    minBytes = minElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.lCompactGE"++    initial = do+        when (minElems <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ functionName ++ ": the size of arrays ["+                ++ show minElems ++ "] must be a natural number"++        r <- initial1+        return $ first (Tuple' Nothing) r++    {-# INLINE runInner #-}+    runInner len acc buf =+            if len >= minBytes+            then do+                r <- step1 acc 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) acc++    step (Tuple' Nothing r1) arr =+         runInner (byteLength arr) r1 arr++    -- XXX Buffer arrays as a list to avoid copy and reallocations+    step (Tuple' (Just buf) r1) arr = do+        let len = byteLength buf + byteLength arr+        buf1 <- if byteCapacity buf < len+                then liftIO $ reallocExplicitAs+                        ps (SIZE_OF(a)) (max minBytes len) buf+                else return buf+        buf2 <- unsafeSplice buf1 arr+        runInner len r1 buf2++    -- 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 "lCompactGE: 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 ()++-- | Like 'compactGE' but for transforming folds instead of stream.+--+-- >> lCompactGE n = Fold.many (MutArray.fCompactGE n)+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# DEPRECATED lCompactGE "Please use scanCompactMin instead." #-}+{-# INLINE lCompactGE #-}+lCompactGE :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+lCompactGE = lCompactGeAs Unpinned++-- | Pinned version of 'lCompactGE'.+{-# DEPRECATED lPinnedCompactGE "Please use scanCompactMin' instead." #-}+{-# INLINE lPinnedCompactGE #-}+lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+lPinnedCompactGE = lCompactGeAs Pinned++data CompactMinState arr =+    CompactMinInit | CompactMinIncomplete arr | CompactMinComplete arr++{-# INLINE_NORMAL scanCompactMinAs #-}+scanCompactMinAs :: forall m a. (MonadIO m, Unbox a)+    => PinnedState -> Int -> Scanl m (MutArray a) (Maybe (MutArray a))+scanCompactMinAs ps minElems =+    Scanl step initial extract final++    where++    minBytes = minElems * SIZE_OF(a)++    functionName = "Streamly.Internal.Data.MutArray.scanCompactMin"++    initial = do+        when (minElems <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ functionName ++ ": the size of arrays ["+                ++ show minElems ++ "] must be a natural number"++        return $ FL.Partial CompactMinInit++    {-# INLINE runInner #-}+    runInner len buf =+            if len >= minBytes+            then do+                return $ FL.Partial $ CompactMinComplete buf+            else return $ FL.Partial $ CompactMinIncomplete buf++    step CompactMinInit arr =+         runInner (byteLength arr) arr++    step (CompactMinComplete _) arr =+         runInner (byteLength arr) arr++    -- XXX Buffer arrays as a list to avoid copy and reallocations+    step (CompactMinIncomplete buf) arr = do+        let len = byteLength buf + byteLength arr+        buf1 <- if byteCapacity buf < len+                then liftIO $ reallocExplicitAs+                        ps (SIZE_OF(a)) (max minBytes len) buf+                else return buf+        buf2 <- unsafeSplice buf1 arr+        runInner len buf2++    extract CompactMinInit = return Nothing+    extract (CompactMinComplete arr) = return (Just arr)+    extract (CompactMinIncomplete _) = return Nothing++    final CompactMinInit = return Nothing+    final (CompactMinComplete arr) = return (Just arr)+    final (CompactMinIncomplete arr) = return (Just arr)++-- | Like 'compactMin' but a scan.+{-# INLINE scanCompactMin #-}+scanCompactMin :: forall m a. (MonadIO m, Unbox a)+    => Int -> Scanl m (MutArray a) (Maybe (MutArray a))+scanCompactMin = scanCompactMinAs Unpinned++-- | Like 'compactMin'' but a scan.+{-# INLINE scanCompactMin' #-}+scanCompactMin' :: forall m a. (MonadIO m, Unbox a)+    => Int -> Scanl m (MutArray a) (Maybe (MutArray a))+scanCompactMin' = scanCompactMinAs Pinned++-- | @compactMin n stream@ coalesces adjacent arrays in the @stream@ until+-- the compacted array size becomes greater than or equal to @n@.+--+-- >>> compactMin n = Stream.foldMany (MutArray.createCompactMin n)+--+{-# INLINE compactMin #-}+compactMin, compactGE ::+       (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactMin n = D.foldMany (createCompactMin n)++RENAME(compactGE,compactMin)++-- | 'compactExact n' coalesces adajacent arrays in the input stream to+-- arrays of exact size @n@.+--+-- /Unimplemented/+{-# INLINE compactExact #-}+compactExact :: -- (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactExact _n = undefined -- D.parseManyD (pCompactEQ n)++-------------------------------------------------------------------------------+-- In-place mutation algorithms+-------------------------------------------------------------------------------++-- XXX Can use SIMD+-- XXX findIndex can be implemented using this if fold perf is not good enough.++{-# INLINE advanceStartTill #-}+advanceStartTill :: forall a. (Unbox a) => (a -> Bool) -> MutArray a -> IO Int+advanceStartTill eq MutArray{..} = go arrStart++    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)+    -}++    go cur =+        if cur < arrEnd+        then do+            r <- peekAt cur arrContents+            if eq r+            then go (INDEX_NEXT(cur,a))+            else return cur+        else return cur++{-# INLINE retractEndTill #-}+retractEndTill :: forall a. (Unbox a) => (a -> Bool) -> MutArray a -> IO Int+retractEndTill eq MutArray{..} = go arrEnd++    where++    go cur = do+        if cur > arrStart+        then do+            let prev = INDEX_PREV(cur,a)+            r <- peekAt prev arrContents+            if eq r+            then go prev+            else return cur+        else return cur++-- | Strip elements which match the predicate, from the start of the array.+--+-- >>> arr <- MutArray.fromList "    hello world"+-- >>> a <- MutArray.dropWhile (== ' ') arr+-- >>> MutArray.toList a+-- "hello world"+--+-- /Pre-release/+{-# INLINE dropWhile #-}+dropWhile :: forall a m. (Unbox a, MonadIO m) =>+    (a -> Bool) -> MutArray a -> m (MutArray a)+dropWhile eq arr@MutArray{..} = liftIO $ do+    st <- advanceStartTill eq arr+    -- return arr{arrStart = st}+    return $+        if st >= arrEnd+        then empty+        else arr{arrStart = st}++-- | Strip elements which match the predicate, from the end of the array.+--+-- >>> arr <- MutArray.fromList "hello world    "+-- >>> a <- MutArray.revDropWhile (== ' ') arr+-- >>> MutArray.toList a+-- "hello world"+--+-- /Pre-release/+{-# INLINE revDropWhile #-}+revDropWhile :: forall a m. (Unbox a, MonadIO m) =>+    (a -> Bool) -> MutArray a -> m (MutArray a)+revDropWhile eq arr@MutArray{..} = liftIO $ do+    end <- retractEndTill eq arr+    -- return arr {arrEnd = end}+    return $+        if end <= arrStart+        then empty+        else arr{arrEnd = end}++-- | Strip elements which match the predicate, from both ends.+--+-- >>> arr <- MutArray.fromList "   hello world    "+-- >>> a <- MutArray.dropAround (== ' ') arr+-- >>> MutArray.toList a+-- "hello world"+--+-- /Pre-release/+{-# INLINE dropAround #-}+dropAround, strip :: forall a m. (Unbox a, MonadIO m) =>+    (a -> Bool) -> MutArray a -> m (MutArray a)+dropAround eq arr = liftIO $ dropWhile eq arr >>= revDropWhile eq+RENAME(strip,dropAround)++-- | 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 <- unsafeGetIndex (l - 1) arr+        go x (l - 2)++        where++        l = length arr++        go x i =+            if i >= 0+            then do+                x1 <- unsafeGetIndex i arr+                case x `cmp0` x1 of+                    LT -> do+                        unsafePutIndex (i + 1) arr x1+                        go x (i - 1)+                    _ -> unsafePutIndex (i + 1) arr x+            else unsafePutIndex (i + 1) arr x++--------------------------------------------------------------------------------+-- Renaming+--------------------------------------------------------------------------------++RENAME(realloc,reallocBytes)+RENAME(castUnsafe,unsafeCast)+RENAME(newArrayWith,emptyWithAligned)+RENAME(getSliceUnsafe,unsafeSliceOffLen)+RENAME(getSlice,sliceOffLen)+RENAME(putIndexUnsafe,unsafePutIndex)+RENAME(modifyIndexUnsafe,unsafeModifyIndex)+RENAME(getIndexUnsafe,unsafeGetIndex)+RENAME(snocUnsafe,unsafeSnoc)+RENAME(spliceUnsafe,unsafeSplice)+RENAME(pokeSkipUnsafe,unsafePokeSkip)+RENAME(peekSkipUnsafe,unsafePeekSkip)+RENAME(peekUncons,peek)+RENAME(peekUnconsUnsafe,unsafePeek)+RENAME(pokeAppend,poke)+RENAME(pokeAppendMay,pokeMay)++-- This renaming can be done directly without deprecations. But I'm keeping this+-- intentionally. Packdiff should be able to point out such APIs that we can+-- just remove.+RENAME(createOfWith,createWithOf)
src/Streamly/Internal/Data/MutByteArray.hs view
@@ -1,5 +1,3 @@-{-# LANGUAGE TemplateHaskell #-}- -- This is required as all the instances in this module are orphan instances. {-# OPTIONS_GHC -fno-warn-orphans #-} @@ -91,28 +89,25 @@     {-# INLINE addSizeTo #-}     addSizeTo acc x =         case x of-            Nothing -> (acc + 1)-            Just field0 -> (addSizeTo (acc + 1)) field0+            Nothing -> acc + 1+            Just field0 -> addSizeTo (acc + 1) field0      {-# INLINE deserializeAt #-}     deserializeAt initialOffset arr endOffset = do-        (i0, tag) <- ((deserializeAt initialOffset) arr) endOffset+        (i0, tag) <- deserializeAt initialOffset arr endOffset         case tag :: Word8 of             0 -> pure (i0, Nothing)-            1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+            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+            Nothing -> serializeAt initialOffset arr (0 :: Word8)             Just field0 -> do-                i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)-                i1 <- ((serializeAt i0) arr) field0-                pure i1+                i0 <- serializeAt initialOffset arr (1 :: Word8)+                serializeAt i0 arr field0  -- $(Serialize.deriveSerialize ''Either) instance (Serialize a, Serialize b) => Serialize (Either a b) where@@ -120,16 +115,16 @@     {-# INLINE addSizeTo #-}     addSizeTo acc x =         case x of-            Left field0 -> (addSizeTo (acc + 1)) field0-            Right field0 -> (addSizeTo (acc + 1)) field0+            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+        (i0, tag) <- deserializeAt initialOffset arr endOffset         case tag :: Word8 of-            0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+            0 -> do (i1, a0) <- deserializeAt i0 arr endOffset                     pure (i1, Left a0)-            1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+            1 -> do (i1, a0) <- deserializeAt i0 arr endOffset                     pure (i1, Right a0)             _ -> error "Found invalid tag while peeking (Either a b)" @@ -137,21 +132,19 @@     serializeAt initialOffset arr val =         case val of             Left field0 -> do-                i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)-                i1 <- ((serializeAt i0) arr) field0-                pure i1+                i0 <- serializeAt initialOffset arr (0 :: Word8)+                serializeAt i0 arr field0             Right field0 -> do-                i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)-                i1 <- ((serializeAt i0) arr) field0-                pure i1+                i0 <- serializeAt initialOffset arr (1 :: Word8)+                serializeAt i0 arr field0  instance Serialize (Proxy a) where      {-# INLINE addSizeTo #-}-    addSizeTo acc _ = (acc + 1)+    addSizeTo acc _ = acc + 1      {-# INLINE deserializeAt #-}-    deserializeAt initialOffset _ _ = pure ((initialOffset + 1), Proxy)+    deserializeAt initialOffset _ _ = pure (initialOffset + 1, Proxy)      {-# INLINE serializeAt #-}     serializeAt initialOffset _ _ = pure (initialOffset + 1)@@ -171,19 +164,19 @@     {-# 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+            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+        (i0, tag) <- deserializeAt initialOffset arr endOffset         case tag :: Word8 of-            0 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+            0 -> do (i1, a0) <- deserializeAt i0 arr endOffset                     pure (i1, LIS a0)-            1 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+            1 -> do (i1, a0) <- deserializeAt i0 arr endOffset                     pure (i1, LIP a0)-            2 -> do (i1, a0) <- ((deserializeAt i0) arr) endOffset+            2 -> do (i1, a0) <- deserializeAt i0 arr endOffset                     pure (i1, LIN a0)             _ -> error "Found invalid tag while peeking (LiftedInteger)" @@ -191,17 +184,14 @@     serializeAt initialOffset arr val =         case val of             LIS field0 -> do-                i0 <- ((serializeAt initialOffset) arr) (0 :: Word8)-                i1 <- ((serializeAt i0) arr) field0-                pure i1+                i0 <- serializeAt initialOffset arr (0 :: Word8)+                serializeAt i0 arr field0             LIP field0 -> do-                i0 <- ((serializeAt initialOffset) arr) (1 :: Word8)-                i1 <- ((serializeAt i0) arr) field0-                pure i1+                i0 <- serializeAt initialOffset arr (1 :: Word8)+                serializeAt i0 arr field0             LIN field0 -> do-                i0 <- ((serializeAt initialOffset) arr) (2 :: Word8)-                i1 <- ((serializeAt i0) arr) field0-                pure i1+                i0 <- serializeAt initialOffset arr (2 :: Word8)+                serializeAt i0 arr field0  #if __GLASGOW_HASKELL__ >= 900
src/Streamly/Internal/Data/MutByteArray/Type.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}  -- | -- Module      : Streamly.Internal.Data.MutByteArray.Type@@ -12,8 +13,11 @@     (     -- ** MutByteArray       MutByteArray(..)-    , getMutableByteArray# -- XXX getMutByteArray#+    , getMutByteArray# +    -- ** Helpers+    , touch+     -- ** Pinning     , PinnedState(..)     , isPinned@@ -22,35 +26,61 @@      -- ** Allocation     , empty-    , newBytesAs -- XXX should be removed+    , newAs     , new-    , pinnedNew-    , pinnedNewAlignedBytes -- XXX should be removed+    , new'+    , reallocSliceAs      -- ** Access-    , sizeOfMutableByteArray -- XXX length-    , putSliceUnsafe-    , cloneSliceUnsafeAs-    , cloneSliceUnsafe-    , pinnedCloneSliceUnsafe-    , unsafePinnedAsPtr+    , length     , unsafeAsPtr +    -- ** Modify+    , unsafePutSlice+    , unsafePutPtrN++    -- ** Copy+    , unsafeCloneSliceAs+    , unsafeCloneSlice+    , unsafePinnedCloneSlice -- XXX unsafeCloneSlice'++    -- ** Compare+    , unsafeByteCmp++    -- ** Capacity Management+    , blockSize+    , largeObjectThreshold+     -- ** Deprecated     , MutableByteArray+    , getMutableByteArray#+    , newBytesAs+    , sizeOfMutableByteArray+    , putSliceUnsafe+    , cloneSliceUnsafeAs+    , cloneSliceUnsafe+    , pinnedCloneSliceUnsafe+    , pinnedNewAlignedBytes     , asPtrUnsafe+    , unsafePinnedAsPtr     , nil+    , pinnedNew     ) where +#include "deprecation.h"+ import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad (when)+import Data.Word (Word8) #ifdef DEBUG import Debug.Trace (trace) #endif+import Foreign.C.Types (CSize(..)) import GHC.Base (IO(..)) import System.IO.Unsafe (unsafePerformIO)  import GHC.Exts+import Prelude hiding (length)  -------------------------------------------------------------------------------- -- The ArrayContents type@@ -70,14 +100,14 @@ {-# DEPRECATED MutableByteArray "Please use MutByteArray instead" #-} type MutableByteArray = MutByteArray -{-# INLINE getMutableByteArray# #-}-getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld-getMutableByteArray# (MutByteArray mbarr) = mbarr+{-# INLINE getMutByteArray# #-}+getMutableByteArray#, getMutByteArray# :: MutByteArray -> MutableByteArray# RealWorld+getMutByteArray# (MutByteArray mbarr) = mbarr  -- | Return the size of the array in bytes.-{-# INLINE sizeOfMutableByteArray #-}-sizeOfMutableByteArray :: MutByteArray -> IO Int-sizeOfMutableByteArray (MutByteArray arr) =+{-# INLINE length #-}+sizeOfMutableByteArray, length :: MutByteArray -> IO Int+length (MutByteArray arr) =     IO $ \s ->         case getSizeofMutableByteArray# arr s of             (# s1, i #) -> (# s1, I# i #)@@ -90,45 +120,50 @@ -- XXX Some functions in this module are "IO" and others are "m", we need to -- make it consistent. --- 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.- -- | NOTE: this is deprecated because it can lead to accidental problems if the -- user tries to use it to mutate the array because it does not return the new -- array after pinning. {-# DEPRECATED unsafePinnedAsPtr "Pin the array and then use unsafeAsPtr." #-} {-# INLINE unsafePinnedAsPtr #-} unsafePinnedAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b-unsafePinnedAsPtr arr f = do-    arr1 <- liftIO $ pin arr-    unsafeAsPtr arr1 f+unsafePinnedAsPtr arr0 f = do+    arr <- liftIO $ pin arr0+    let !ptr = Ptr (byteArrayContents#+                     (unsafeCoerce# (getMutByteArray# arr)))+    r <- f ptr+    liftIO $ touch arr+    return r -{-# DEPRECATED asPtrUnsafe "Please use unsafePinnedAsPtr instead." #-}+{-# DEPRECATED asPtrUnsafe "Pin the array and then use unsafeAsPtr." #-} {-# INLINE asPtrUnsafe #-} asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b asPtrUnsafe = unsafePinnedAsPtr --- | For use with unsafe FFI functions. Does not force pin the array memory.+-- | 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.+--+-- /Unsafe/ WARNING:+--+-- 1. Will lead to memory corruption if the array is not pinned. Use+-- only if the array is known to be pinned already or pin it explicitly.+--+-- 2. Ensure that the pointer is accessed within the legal bounds of the array.+-- The size of the MutByteArray must be taken into account.+--+-- /Pre-release/+-- {-# INLINE unsafeAsPtr #-}-unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b-unsafeAsPtr arr f = do+unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> IO b) -> m b+unsafeAsPtr arr f = liftIO $ do     when (not (isPinned arr))         $ error "unsafeAsPtr requires the array to be pinned"+     let !ptr = Ptr (byteArrayContents#-                     (unsafeCoerce# (getMutableByteArray# arr)))+                     (unsafeCoerce# (getMutByteArray# arr)))     r <- f ptr     -- While f is using the bare pointer, the MutByteArray may be garbage     -- collected by the GC, tell the GC that we are still using it.-    liftIO $ touch arr+    touch arr     return r  --------------------------------------------------------------------------------@@ -143,10 +178,42 @@ nil :: MutByteArray nil = empty --- XXX add "newRounded" to round up the large size to the next page boundary+-- 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++{-# INLINE pinnedNewRaw #-}+pinnedNewRaw :: Int -> IO MutByteArray+pinnedNewRaw (I# nbytes) = IO $ \s ->+    case newPinnedByteArray# nbytes s of+        (# s', mbarr# #) ->+           let c = MutByteArray mbarr#+            in (# s', c #)++{-# INLINE new' #-}+new', pinnedNew :: Int -> IO MutByteArray+new' nbytes | nbytes < 0 =+  errorWithoutStackTrace "new': size must be >= 0"+new' nbytes = pinnedNewRaw nbytes+RENAME_PRIME(pinnedNew,new)++-- XXX add "newRoundedUp" to round up the large size to the next page boundary -- and return the allocated size.+-- Uses the pinned version of allocated if the size required is >+-- largeObjectThreshold {-# INLINE new #-} new :: Int -> IO MutByteArray+new nbytes | nbytes > largeObjectThreshold = pinnedNewRaw nbytes new nbytes | nbytes < 0 =   errorWithoutStackTrace "newByteArray: size must be >= 0" new (I# nbytes) = IO $ \s ->@@ -155,16 +222,7 @@            let c = MutByteArray mbarr#             in (# s', c #) -{-# INLINE pinnedNew #-}-pinnedNew :: Int -> IO MutByteArray-pinnedNew nbytes | nbytes < 0 =-  errorWithoutStackTrace "pinnedNew: size must be >= 0"-pinnedNew (I# nbytes) = IO $ \s ->-    case newPinnedByteArray# nbytes s of-        (# s', mbarr# #) ->-           let c = MutByteArray mbarr#-            in (# s', c #)-+{-# DEPRECATED pinnedNewAlignedBytes "Please use pinnedNew instead" #-} {-# INLINE pinnedNewAlignedBytes #-} pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray pinnedNewAlignedBytes nbytes _align | nbytes < 0 =@@ -175,20 +233,44 @@            let c = MutByteArray mbarr#             in (# s', c #) -{-# INLINE newBytesAs #-}-newBytesAs :: PinnedState -> Int -> IO MutByteArray-newBytesAs Unpinned = new-newBytesAs Pinned = pinnedNew+{-# INLINE newAs #-}+newBytesAs, newAs :: PinnedState -> Int -> IO MutByteArray+newAs Unpinned = new+newAs Pinned = pinnedNew +-- | @reallocSliceAs pinType newLen array offset len@ reallocates a slice+-- from @array@ starting at @offset@ and having length @len@ to a new array of+-- length @newLen@ copying the old data to the new. Note that if the @newLen@+-- is smaller than @len@ it will truncate the old data.+{-# INLINE reallocSliceAs #-}+reallocSliceAs ::+    PinnedState -> Int -> MutByteArray -> Int -> Int -> IO MutByteArray+reallocSliceAs ps newLen (MutByteArray src#) srcStart srcLen = do+    MutByteArray dst# <- newBytesAs ps newLen++    -- Copy old data+    let !(I# srcStart#) = srcStart+        !(I# newLen#) = min srcLen newLen+    IO $ \s# -> (# copyMutableByteArray# src# srcStart#+                        dst# 0# newLen# s#, MutByteArray dst# #)+ ------------------------------------------------------------------------------- -- 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 ::+-- Note: Array copy is more efficient than streaming copy.+-- CopyMutableByteArray# translates to genMemcpy in GHC/CmmToAsm/X86/CodeGen.hs+-- glibc memcpy copies bytes/words/pages - unrolls the loops:+-- https://github.com/bminor/glibc/blob/4290aed05135ae4c0272006442d147f2155e70d7/string/memcpy.c+-- https://github.com/bminor/glibc/blob/4290aed05135ae4c0272006442d147f2155e70d7/string/wordcopy.c++-- | @unsafePutSlice src srcOffset dst dstOffset len@ copies @len@ bytes from+-- @src@ at @srcOffset@ to dst at @dstOffset@.+--+-- This is unsafe as it does not check the bounds of @src@ or @dst@.+--+{-# INLINE unsafePutSlice #-}+putSliceUnsafe, unsafePutSlice ::        MonadIO m     => MutByteArray     -> Int@@ -196,49 +278,99 @@     -> Int     -> Int     -> m ()-putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do+unsafePutSlice src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do #ifdef DEBUG-    srcLen <- sizeOfMutableByteArray src-    dstLen <- sizeOfMutableByteArray dst+    srcLen <- length src+    dstLen <- length dst     when (srcLen - srcStartBytes < lenBytes)-        $ error $ "putSliceUnsafe: src overflow: start" ++ show srcStartBytes+        $ error $ "unsafePutSlice: src overflow: start" ++ show srcStartBytes             ++ " end " ++ show srcLen ++ " len " ++ show lenBytes     when (dstLen - dstStartBytes < lenBytes)-        $ error $ "putSliceUnsafe: dst overflow: start" ++ show dstStartBytes+        $ error $ "unsafePutSlice: 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+    let arrS# = getMutByteArray# src+        arrD# = getMutByteArray# dst     IO $ \s# -> (# copyMutableByteArray#                     arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#                 , () #) +foreign import ccall unsafe "string.h memcpy" c_memcpy_pinned+    :: Addr# -> Addr# -> CSize -> IO (Ptr Word8)++-- | @unsafePutPtrN srcPtr dst dstOffset len@ copies @len@ bytes from @srcPtr@+-- to dst at @dstOffset@.+--+-- /Unsafe/:+--+-- The caller has to ensure that:+--+-- * the MutByteArray @dst@ is valid up to @dstOffset + len@.+-- * the @srcPtr@ is alive and pinned during the call.+-- * the @srcPtr@ is valid up to length @len@.+--+{-# INLINE unsafePutPtrN #-}+unsafePutPtrN ::+       MonadIO m+    => Ptr Word8+    -> MutByteArray+    -> Int+    -> Int+    -> m ()+unsafePutPtrN (Ptr srcAddr) dst dstOffset len = liftIO $ do+#ifdef DEBUG+    dstLen <- length dst+    when (dstLen - dstOffset < len)+        $ error $ "unsafePutPtrN: dst overflow: start" ++ show dstOffset+            ++ " end " ++ show dstLen ++ " len " ++ show len+#endif+    let !dstAddr# = byteArrayContents# (unsafeCoerce# (getMutByteArray# dst))+        !(I# dstOff#) = dstOffset+        !dstAddr1# = plusAddr# dstAddr# dstOff#+    _ <- c_memcpy_pinned dstAddr1# srcAddr (fromIntegral len)+    pure ()+ -- | Unsafe as it does not check whether the start offset and length supplied -- are valid inside the array.-{-# INLINE cloneSliceUnsafeAs #-}-cloneSliceUnsafeAs :: MonadIO m =>+{-# INLINE unsafeCloneSliceAs #-}+cloneSliceUnsafeAs, unsafeCloneSliceAs :: MonadIO m =>     PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray-cloneSliceUnsafeAs ps srcOff srcLen src =+unsafeCloneSliceAs ps srcOff srcLen src =     liftIO $ do-        mba <- newBytesAs ps srcLen-        putSliceUnsafe src srcOff mba 0 srcLen+        mba <- newAs ps srcLen+        unsafePutSlice src srcOff mba 0 srcLen         return mba --- | @cloneSliceUnsafe offset len arr@ clones a slice of the supplied array+-- | @unsafeCloneSlice 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+{-# INLINE unsafeCloneSlice #-}+cloneSliceUnsafe, unsafeCloneSlice :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+unsafeCloneSlice = unsafeCloneSliceAs Unpinned --- | @pinnedCloneSliceUnsafe offset len arr@-{-# INLINE pinnedCloneSliceUnsafe #-}-pinnedCloneSliceUnsafe :: MonadIO m =>+-- | @unsafePinnedCloneSlice offset len arr@+{-# INLINE unsafePinnedCloneSlice #-}+pinnedCloneSliceUnsafe, unsafePinnedCloneSlice :: MonadIO m =>     Int -> Int -> MutByteArray -> m MutByteArray-pinnedCloneSliceUnsafe = cloneSliceUnsafeAs Pinned+unsafePinnedCloneSlice = unsafeCloneSliceAs Pinned +unsafeByteCmp+    :: MutByteArray -> Int -> MutByteArray -> Int -> Int -> IO Int+unsafeByteCmp+    (MutByteArray marr1) (I# st1#) (MutByteArray marr2) (I# st2#) (I# len#) =+    IO $ \s# ->+        let res =+                I#+                    (compareByteArrays#+                         (unsafeCoerce# marr1)+                         st1#+                         (unsafeCoerce# marr2)+                         st2#+                         len#)+         in (# s#, res #)+ ------------------------------------------------------------------------------- -- Pinning & Unpinning -------------------------------------------------------------------------------@@ -301,3 +433,15 @@              $ \s# ->                    case cloneMutableArrayWith# newByteArray# marr# s# of                        (# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)++--------------------------------------------------------------------------------+-- Renaming+--------------------------------------------------------------------------------++RENAME(getMutableByteArray#, getMutByteArray#)+RENAME(newBytesAs, newAs)+RENAME(sizeOfMutableByteArray, length)+RENAME(putSliceUnsafe, unsafePutSlice)+RENAME(cloneSliceUnsafeAs, unsafeCloneSliceAs)+RENAME(cloneSliceUnsafe, unsafeCloneSlice)+RENAME(pinnedCloneSliceUnsafe, unsafePinnedCloneSlice)
src/Streamly/Internal/Data/Parser.hs view
@@ -1,3574 +1,3592 @@ {-# 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+{-# LANGUAGE NoMonoLocalBinds #-}+-- |+-- 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++    -- * 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 ('takeBeginBy'), 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_+    , takeBeginBy+    , takeBeginBy_+    , 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 takeBeginBy, 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+    , takeStartBy+    , takeStartBy_+    )+where++#include "inline.hs"+#include "deprecation.h"+#include "assert.hs"++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 SPartial: " ++ show n+    cerror n = error $ "toFold: parser backtracks in SContinue: " ++ show n+    derror n = error $ "toFold: parser backtracks in SDone: " ++ show n+    eerror err = error $ "toFold: parser throws error: " ++ err++    step st a = do+        r <- pstep st a+        case r of+            SPartial 1 s -> return $ FL.Partial s+            SContinue 1 s -> return $ FL.Partial s+            SDone 1 b -> return $ FL.Done b+            SPartial n _ -> perror n+            SContinue n _ -> cerror n+            SDone n _ -> derror n+            SError err -> eerror err++    extract = error "toFold: parser cannot be used for scanning"++    final st = do+        r <- pextract st+        case r of+            FDone 0 b -> return b+            FContinue n _ -> cerror n+            FDone n _ -> derror n+            FError 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 -> SPartial 1 s1+                  FL.Done b -> SDone 1 b++    extract = fmap (FDone 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 -> SPartial 1 s1+                  FL.Done b ->+                        case b of+                            Just x -> SDone 1 x+                            Nothing -> SError errMsg++    extract s = do+        res <- ffinal s+        case res of+            Just x -> return $ FDone 0 x+            Nothing -> return $ FError 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 $ SDone 0 a++    extract () = return $ FError "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 $ SError "eof: not at end of input"++    extract () = return $ FDone 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 $ SDone 1 (Just a)++  extract () = pure $ FDone 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 -> SDone 1 b+            Left err -> SError err++    extract () = return $ FError "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 -> SDone 1 b+            Nothing -> SError "maybe: predicate failed"++    extract () = return $ FError "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 SDone 1 a+        else SError "satisfy: predicate failed"++    extract () = return $ FError "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.parsePos 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 (ParseErrorPos 1 "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)++    -- In the case of Identity monad+    -- @+    -- when True (error invalidRange)+    -- @+    -- does not evaluate the @error invalidRange@ due to which no error occurs.+    initial =+        if low >= 0 && high >= 0 && low > high+        then error invalidRange+        else 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 $ SContinue 1 s1+                else if i1 < high+                then return $ SPartial 1 s1+                else fmap (SDone 1) (ffinal s)+            FL.Done b ->+                return+                    $ if i1 >= low+                      then SDone 1 b+                      else SError (foldErr i1)++    step (Tuple'Fused i s) a = fstep s a >>= snext i++    extract f (Tuple'Fused i s)+        | i >= low && i <= high = fmap (FDone 0) (ffinal s)+        | otherwise = return $ FError (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.parsePos (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]+-- Right [1,0]+--+-- >>> Stream.parsePos (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]+-- Left (ParseErrorPos 3 "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 -> SContinue 1 $ Tuple'Fused (i1 + 1) s+                    FL.Done _ ->+                        SError+                            $ "takeEQ: Expecting exactly " ++ show n+                                ++ " elements, fold terminated on " ++ show i1+        else+            -- assert (n == i1)+            SDone 1+                <$> 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+            $ FError+            $ "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.parsePos (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]+-- Left (ParseErrorPos 3 "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 -> SContinue 1 $ TakeGELT (i1 + 1) s+                      FL.Done _ ->+                        SError+                            $ "takeGE: Expecting at least " ++ show n+                                ++ " elements, fold terminated on " ++ show i1+        else+            -- assert (n <= i1)+            return+                $ case res of+                      FL.Partial s -> SPartial 1 $ TakeGEGE s+                      FL.Done b -> SDone 1 b+    step (TakeGEGE r) a = do+        res <- fstep r a+        return+            $ case res of+                  FL.Partial s -> SPartial 1 $ TakeGEGE s+                  FL.Done b -> SDone 1 b++    extract (TakeGELT i _) =+        return+            $ FError+            $ "takeGE: Expecting at least " ++ show n+                ++ " elements, input terminated on " ++ show (i - 1)+    extract (TakeGEGE r) = fmap (FDone 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+            -- In this case when converting Final to Step we don't add 1 as we+            -- don't consume the current element.+            r <- pextract s+            case r of+                FError err -> return $ SError err+                FDone n s1 -> return $ SDone n s1+                FContinue n s1 -> return $ SContinue n 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 -> SPartial 1 s1+                      FL.Done b -> SDone 1 b+        else SDone 0 <$> ffinal s++    extract s = fmap (FDone 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 -> SPartial 1 (Right' s1)+                  FL.Done b -> SDone 1 b++    step (Left' s) a =+        if predicate a+        then process s a+        else return $ SError "takeWhile1: predicate failed on first element"+    step (Right' s) a =+        if predicate a+        then process s a+        else do+            b <- ffinal s+            return $ SDone 0 b++    extract (Left' _) = return $ FError "takeWhile1: end of input"+    extract (Right' s) = fmap (FDone 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 -> SContinue 1 (FrameEscGo s1 n)+                FL.Done b -> SDone 1 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 SDone 1 <$> 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 SDone 1 <$> ffinal s+                        else process s a n+            Nothing -> -- takeBeginBy case+                case begin of+                    Just isBegin ->+                        if isBegin a+                        then SDone 1 <$> 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 $ SPartial 1 $ 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 $ SPartial 1 (FrameEscGo s 0)+                else return $ SError "takeFramedByGeneric: missing frame start"+            Nothing ->+                case end of+                    Just isEnd ->+                        if isEnd a+                        then SDone 1 <$> 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 . FError++    extract (FrameEscInit _) =+        err "takeFramedByGeneric: empty token"+    extract (FrameEscGo s _) =+        case begin of+            Just _ ->+                case end of+                    Nothing -> fmap (FDone 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 -> SContinue 1 (nextState s1)+                FL.Done b -> SDone 1 b++    step (BlockInit s) a =+        return+            $ if a == bopen+              then SContinue 1 $ BlockUnquoted 1 s+              else SError "blockWithQuotes: missing block start"+    step (BlockUnquoted level s) a+        | a == bopen = process s a (BlockUnquoted (level + 1))+        | a == bclose =+            if level == 1+            then fmap (SDone 1) (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 . FError++    extract (BlockInit s) = fmap (FDone 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++{-# INLINE takeEndByDone #-}+takeEndByDone :: Monad f => (s -> f (Final s b)) -> Step s b -> f (Step s b)+takeEndByDone pextract res =+    -- If the parser is backtracking we let it backtrack even if the+    -- predicate is true.+    case res of+        SPartial 1 s1 -> do+            res1 <- pextract s1+            pure $ case res1 of+                FDone n b -> SDone (1 + n) b+                FContinue n s -> SPartial (1 + n) s+                FError err -> SError err+        SContinue 1 s1 -> do+            res1 <- pextract s1+            pure $ case res1 of+                FDone n b -> SDone (1 + n) b+                FContinue n s -> SContinue (1 + n) s+                FError err -> SError err+        SPartial _ _ -> return res+        SContinue _ _ -> return res+        SDone n b -> return $ SDone n b+        SError n -> return $ SError n++-- | @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 takeEndByDone 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 $ SPartial 1 $ Right' s+        else do+            res <- pstep s a+            if not (isSep a)+            then return $ first Left' res+            else fmap (first Left') $ takeEndByDone 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 $ FError "takeEndByEsc: trailing escape"++-- | Like 'takeEndBy' but the separator is dropped.+--+-- See also "Streamly.Data.Fold.takeEndBy_".+--+-- /Pre-release/+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => (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 do+            res <- pextract s+            pure $ case res of+                FDone n b -> SDone (n + 1) b+                FContinue n s1 -> SPartial (n + 1) s1+                FError err -> SError err+        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.takeBeginBy p f)+--+-- Examples: -+--+-- >>> p = Parser.takeBeginBy (== ',') Fold.toList+-- >>> leadingComma = Stream.parsePos p . Stream.fromList+-- >>> leadingComma "a,b"+-- Left (ParseErrorPos 1 "takeBeginBy: missing frame start")+-- ...+-- >>> leadingComma ",,"+-- Right ","+-- >>> leadingComma ",a,b"+-- Right ",a"+-- >>> leadingComma ""+-- Right ""+--+-- /Pre-release/+--+{-# INLINE takeBeginBy #-}+takeBeginBy, takeStartBy :: Monad m =>+    (a -> Bool) -> Fold m a b -> Parser a m b+takeBeginBy 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 "takeBeginBy: fold done without input"++    {-# INLINE process #-}+    process s a = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> SPartial 1 (Right' s1)+                FL.Done b -> SDone 1 b++    step (Left' s) a =+        if cond a+        then process s a+        else return $ SError "takeBeginBy: missing frame start"+    step (Right' s) a =+        if not (cond a)+        then process s a+        else SDone 0 <$> ffinal s++    extract (Left' s) = fmap (FDone 0) $ ffinal s+    extract (Right' s) = fmap (FDone 0) $ ffinal s++RENAME(takeStartBy,takeBeginBy)++-- | Like 'takeBeginBy' but drops the separator.+--+-- >>> takeBeginBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing+--+{-# INLINE takeBeginBy_ #-}+takeBeginBy_, takeStartBy_ :: Monad m =>+    (a -> Bool) -> Fold m a b -> Parser a m b+takeBeginBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing++RENAME(takeStartBy_,takeBeginBy_)++-- | @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.parsePos p $ Stream.fromList "{hello {world}"+-- Left (ParseErrorPos 14 "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 -> SContinue 1 (FrameEscGo s1 n)+                FL.Done b -> SDone 1 b++    step (FrameEscInit s) a =+        if isBegin a+        then return $ SPartial 1 (FrameEscGo s 0)+        else return $ SError "takeFramedByEsc_: missing frame start"+    step (FrameEscGo s n) a =+        if isEsc a+        then return $ SPartial 1 $ 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 SDone 1 <$> ffinal s+                else process s a (n - 1)+    step (FrameEscEsc s n) a = process s a n++    err = return . FError++    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 -> SContinue 1 (FrameGo s1 n)+                FL.Done b -> SDone 1 b++    step (FrameInit s) a =+        if isBegin a+        then return $ SContinue 1 (FrameGo s 0)+        else return $ SError "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 = SDone 1 <$> ffinal s+        | otherwise = process s a (n - 1)++    err = return . FError++    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 -> SPartial 1 $ WBWord s1+                  FL.Done b -> SDone 1 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 $ SPartial 1 $ WBLeft s+    step (WBWord s) a =+        if not (predicate a)+        then worder s a+        else do+            b <- ffinal s+            return $ SPartial 1 $ WBRight b+    step (WBRight b) a =+        return+            $ if not (predicate a)+              then SDone 0 b+              else SPartial 1 $ WBRight b++    extract (WBLeft s) = fmap (FDone 0) $ ffinal s+    extract (WBWord s) = fmap (FDone 0) $ ffinal s+    extract (WBRight b) = return (FDone 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 -> SContinue 1 (WordFramedWord s1 n)+                FL.Done b -> SDone 1 b++    step (WordFramedSkipPre s) a+        | isEsc a = return $ SContinue 1 $ WordFramedEsc s 0+        | isSep a = return $ SPartial 1 $ WordFramedSkipPre s+        | isBegin a = return $ SContinue 1 $ WordFramedWord s 1+        | isEnd a =+            return $ SError "wordFramedBy: missing frame start"+        | otherwise = process s a 0+    step (WordFramedWord s n) a+        | isEsc a = return $ SContinue 1 $ WordFramedEsc s n+        | n == 0 && isSep a = do+            b <- ffinal s+            return $ SPartial 1 $ 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 $ SContinue 1 $ WordFramedWord s 1+               else if isEnd a+                    then return $ SError "wordFramedBy: missing frame start"+                    else process s a n+            else+               -- Need to check isEnd first+                if isEnd a+                then+                   if n == 1+                   then return $ SContinue 1 $ 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 SDone 0 b+              else SPartial 1 $ WordFramedSkipPost b++    err = return . FError++    extract (WordFramedSkipPre s) = fmap (FDone 0) $ ffinal s+    extract (WordFramedWord s n) =+        if n == 0+        then fmap (FDone 0) $ ffinal s+        else err "wordFramedBy: missing frame end"+    extract (WordFramedEsc _ _) =+        err "wordFramedBy: trailing escape"+    extract (WordFramedSkipPost b) = return (FDone 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 -> SContinue 1 (WordQuotedWord s1 n ql qr)+                FL.Done b -> SDone 1 b++    {-# INLINE processUnquoted #-}+    processUnquoted s a = do+        res <- fstep s a+        return+            $ case res of+                FL.Partial s1 -> SContinue 1 (WordUnquotedWord s1)+                FL.Done b -> SDone 1 b++    {-# INLINE checkRightQuoteAndProcess #-}+    checkRightQuoteAndProcess s a n ql qr+        | a == qr =+           if n == 1+           then if keepQuotes+                then processUnquoted s a+                else return $ SContinue 1 $ WordUnquotedWord s+           else processQuoted s a (n - 1) ql qr+        | a == ql = processQuoted s a (n + 1) ql qr+        | otherwise = processQuoted s a n ql qr++    step (WordQuotedSkipPre s) a+        | isEsc a = return $ SContinue 1 $ WordUnquotedEsc s+        | isSep a = return $ SPartial 1 $ WordQuotedSkipPre s+        | otherwise =+            case toRight a of+                Just qr ->+                  if keepQuotes+                  then processQuoted s a 1 a qr+                  else return $ SContinue 1 $ WordQuotedWord s 1 a qr+                Nothing+                    | isInvalid a ->+                        return $ SError "wordKeepQuotes: invalid unquoted char"+                    | otherwise -> processUnquoted s a+    step (WordUnquotedWord s) a+        | isEsc a = return $ SContinue 1 $ WordUnquotedEsc s+        | isSep a = do+            b <- ffinal s+            return $ SPartial 1 $ WordQuotedSkipPost b+        | otherwise = do+            case toRight a of+                Just qr ->+                    if keepQuotes+                    then processQuoted s a 1 a qr+                    else return $ SContinue 1 $ WordQuotedWord s 1 a qr+                Nothing ->+                    if isInvalid a+                    then return $ SError "wordKeepQuotes: invalid unquoted char"+                    else processUnquoted s a+    step (WordQuotedWord s n ql qr) a+        | isEsc a = return $ SContinue 1 $ WordQuotedEsc s n ql qr+        {-+        -- XXX Will this ever occur? Will n ever be 0?+        | n == 0 && isSep a = do+            b <- fextract s+            return $ SPartial 1 $ WordQuotedSkipPost b+        -}+        | otherwise = checkRightQuoteAndProcess 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 -> checkRightQuoteAndProcess s1 a n ql qr+                    FL.Done b -> return $ SDone 1 b+            Just x -> processQuoted s x n ql qr+    step (WordQuotedSkipPost b) a =+        return+            $ if not (isSep a)+              then SDone 0 b+              else SPartial 1 $ WordQuotedSkipPost b++    err = return . FError++    extract (WordQuotedSkipPre s) = fmap (FDone 0) $ ffinal s+    extract (WordUnquotedWord s) = fmap (FDone 0) $ ffinal s+    extract (WordQuotedWord s n _ _) =+        if n == 0+        then fmap (FDone 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 (FDone 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 -> SDone 1 b+                  FL.Partial s1 -> SPartial 1 (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 SDone 0 <$> ffinal s++    extract (GroupByInit s) = fmap (FDone 0) $ ffinal s+    extract (GroupByGrouping _ s) = fmap (FDone 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 -> SDone 1 b+                  FL.Partial s1 -> SPartial 1 (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 SDone 0 <$> ffinal s++    extract (GroupByInit s) = fmap (FDone 0) $ ffinal s+    extract (GroupByGrouping _ s) = fmap (FDone 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 $ SContinue 1 (GroupByGroupingPair a s1 s2)++    {-# INLINE grouperL2 #-}+    grouperL2 s1 s2 a = do+        res <- fstep1 s1 a+        return+            $ case res of+                FL.Done b -> SDone 1 (Left b)+                FL.Partial s11 -> SPartial 1 (GroupByGroupingPairL a s11 s2)++    {-# INLINE grouperL #-}+    grouperL s1 s2 a0 a = do+        res <- fstep1 s1 a0+        case res of+            FL.Done b -> return $ SDone 1 (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 -> SDone 1 (Right b)+                FL.Partial s21 -> SPartial 1 (GroupByGroupingPairR a s1 s21)++    {-# INLINE grouperR #-}+    grouperR s1 s2 a0 a = do+        res <- fstep2 s2 a0+        case res of+            FL.Done b -> return $ SDone 1 (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 SDone 0 . Left <$> ffinal1 s1++    step (GroupByGroupingPairR a0 s1 s2) a =+        if eq a0 a+        then grouperR2 s1 s2 a+        else SDone 0 . Right <$> ffinal2 s2++    extract (GroupByInitPair s1 _) = FDone 0 . Left <$> ffinal1 s1+    extract (GroupByGroupingPairL _ s1 _) = FDone 0 . Left <$> ffinal1 s1+    extract (GroupByGroupingPairR _ _ s2) = FDone 0 . Right <$> ffinal2 s2+    extract (GroupByGroupingPair a s1 _) = do+                res <- fstep1 s1 a+                case res of+                    FL.Done b -> return $ FDone 0 (Left b)+                    FL.Partial s11 -> FDone 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.parsePos (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"+-- Left (ParseErrorPos 2 "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 $ SDone 1 str+    step [x] a =+        return+            $ if x `cmp` a+              then SDone 1 str+              else SError "listEqBy: failed, yet to match the last element"+    step (x:xs) a =+        return+            $ if x `cmp` a+              then SContinue 1 xs+              else SError+                       $ "listEqBy: failed, yet to match "+                       ++ show (length xs + 1) ++ " elements"++    extract xs =+        return+            $ SError+            $ "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 -> SContinue 1 (Just' x1, s)+                    D.Stop -> SDone 1 ()+                    D.Skip s -> SContinue 0 (Nothing', s)+          else return $ SError "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 SContinue 1 (Nothing', s)+                    else SError "streamEqBy: mismatch occurred"+                D.Stop -> SDone 0 ()+                D.Skip s -> SContinue 0 (Nothing', s)++    extract _ = return $ FError "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 $ SContinue 1 (Just' x1, s, fs1)+                    D.Stop -> do+                        x <- ffinal fs1+                        return $ SDone 1 x+                    D.Skip s -> return $ SContinue 0 (Nothing', s, fs1)+            FL.Done x -> return $ SDone 1 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 $ SContinue 1 (Nothing', s, fs1)+                        FL.Done x -> return $ SDone 1 x+                D.Stop -> do+                    x <- ffinal fs+                    return $ SDone 0 x+                D.Skip s -> return $ SContinue 0 (Nothing', s, fs)++    extract _ = return $ FError "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.parsePos (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]+-- Left (ParseErrorPos 4 "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+        case res of+            SPartial 1 s -> do+                let cnt1 = cnt + 1+                assertM(cnt1 >= 0)+                if cnt1 < lim+                then return $ SPartial 1 $ Tuple' cnt1 s+                else do+                    r1 <- pextract s+                    return $ case r1 of+                        FDone n b -> SDone (n + 1) b+                        FContinue n s1 -> SContinue (n + 1) (Tuple' (cnt1 + n) s1)+                        FError err -> SError err++            SContinue 1 s -> do+                let cnt1 = cnt + 1+                assertM(cnt1 >= 0)+                if cnt1 < lim+                then return $ SContinue 1 $ Tuple' cnt1 s+                else do+                    r1 <- pextract s+                    return $ case r1 of+                        FDone n b -> SDone (n + 1) b+                        FContinue n s1 -> SContinue (n + 1) (Tuple' (cnt1 + n) s1)+                        FError err -> SError err+            SPartial n s -> do+                let taken = cnt + n+                assertM(taken >= 0)+                return $ SPartial n $ Tuple' taken s+            SContinue n s -> do+                let taken = cnt + n+                assertM(taken >= 0)+                return $ SContinue n $ Tuple' taken s+            SDone n b -> return $ SDone n b+            SError str -> return $ SError str++    extract (Tuple' cnt r) = do+        r1 <- pextract r+        return $ case r1 of+            FDone n b -> FDone n b+            FContinue n s1 -> FContinue n (Tuple' (cnt + n) s1)+            FError err -> FError err++    -- XXX Need to make the Initial type Step to remove this+    iextract s = do+        r <- pextract s+        return $ case r of+            FDone _ b -> IDone b+            FError 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+        return+            $ case r of+                  SPartial n s -> SContinue n (Tuple'Fused (cnt + n) s)+                  SContinue n s -> SContinue n (Tuple'Fused (cnt + n) s)+                  SDone _ b -> SDone (- cnt) b+                  SError err -> SError 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+            $ FError+            $ "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.parsePos p $ Stream.fromList "1+"+-- Left (ParseErrorPos 2 "takeWhile1: end of input")+-- >>> Stream.parse p $ Stream.fromList "1+2+3"+-- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]+--+-- See also 'Streamly.Internal.Data.ParserK.chainl1'.+--+{-# 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 $ SPartial n (nextState fs1)+            FL.Done c -> return $ SDone n c++    {-# INLINE runStepL #-}+    runStepL fs sL a = do+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SPartial n (DeintercalateAllL fs s)+            SContinue n s -> return $ SContinue n (DeintercalateAllL fs s)+            SDone n b ->+                processL (fstep fs (Left b)) n DeintercalateAllInitR+            SError err -> return $ SError err++    {-# INLINE processR #-}+    processR foldAction n = do+        fres <- foldAction+        case fres of+            FL.Partial fs1 -> do+                res <- initialL+                case res of+                    IPartial ps -> return $ SPartial n (DeintercalateAllL fs1 ps)+                    IDone _ -> errMsg "left" "succeed"+                    IError _ -> errMsg "left" "fail"+            FL.Done c -> return $ SDone n c++    {-# INLINE runStepR #-}+    runStepR fs sR a = do+        r <- stepR sR a+        case r of+            SPartial n s -> return $ SPartial n (DeintercalateAllR fs s)+            SContinue n s -> return $ SContinue n (DeintercalateAllR fs s)+            SDone n b -> processR (fstep fs (Right b)) n+            SError err -> return $ SError 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 (FDone n) $ ffinal fs1+            FL.Done c -> return (FDone n c)+    extract (DeintercalateAllInitL fs) = fmap (FDone 0) $ ffinal fs+    extract (DeintercalateAllL fs sL) = do+        r <- extractL sL+        case r of+            FDone n b -> extractResult n fs (Left b)+            FError err -> return $ FError err+            FContinue n s -> return $ FContinue n (DeintercalateAllL fs s)+    extract (DeintercalateAllInitR fs) = fmap (FDone 0) $ ffinal fs+    extract (DeintercalateAllR _ _) =+        return $ FError "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"]+--+-- See also 'Streamly.Internal.Data.ParserK.chainl1'.+--+{-# 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 $ SPartial n (nextState fs1)+            FL.Done c -> return $ SDone n c++    {-# INLINE runStepL #-}+    runStepL cnt fs sL a = do+        r <- stepL sL a+        case r of+            -- XXX If we subtract instead of adding we do not need to negate+            -- when returning cnt.+            SPartial n s -> return $ SContinue n (DeintercalateL (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (DeintercalateL (cnt + n) fs s)+            SDone n b ->+                processL (fstep fs (Left b)) n DeintercalateInitR+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (-cnt) xs++    {-# INLINE processR #-}+    processR cnt b fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ SContinue n (DeintercalateRL cnt b fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        r <- stepR sR a+        case r of+            SPartial n s -> return $ SContinue n (DeintercalateR (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (DeintercalateR (cnt + n) fs s)+            SDone n b -> processR (cnt + n) b fs n+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) 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+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SContinue n (DeintercalateRL (cnt + n) bR fs s)+            SContinue n s -> return $ SContinue n (DeintercalateRL (cnt + n) bR fs s)+            SDone 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 $ SPartial n (DeintercalateInitR fs2)+                            FL.Done c -> return $ SDone n c+                    -- XXX We could have the fold accept pairs of (bR, bL)+                    FL.Done _ -> error "Fold terminated consuming partial input"+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) xs++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (FDone n) $ ffinal fs1+            FL.Done c -> return (FDone n c)++    extract (DeintercalateInitL fs) = fmap (FDone 0) $ ffinal fs+    extract (DeintercalateL cnt fs sL) = do+        r <- extractL sL+        case r of+            FDone n b -> extractResult n fs (Left b)+            FContinue n s -> return $ FContinue n (DeintercalateL (cnt + n) fs s)+            FError _ -> do+                xs <- ffinal fs+                return $ FDone (- cnt) xs+    extract (DeintercalateInitR fs) = fmap (FDone 0) $ ffinal fs+    extract (DeintercalateR cnt fs _) = fmap (FDone (- cnt)) $ ffinal fs+    extract (DeintercalateRL cnt bR fs sL) = do+        r <- extractL sL+        case r of+            FDone 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"+            FContinue n s -> return $ FContinue n (DeintercalateRL (cnt + n) bR fs s)+            FError _ -> do+                xs <- ffinal fs+                return $ FDone (- 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.parsePos p $ Stream.fromList ""+-- Left (ParseErrorPos 0 "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 $ SPartial n (nextState fs1)+            FL.Done c -> return $ SDone n c++    {-# INLINE runStepInitL #-}+    runStepInitL cnt fs sL a = do+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SContinue n (Deintercalate1InitL (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (Deintercalate1InitL (cnt + n) fs s)+            SDone n b ->+                processL (fstep fs (Left b)) n Deintercalate1InitR+            SError err -> return $ SError err++    {-# INLINE processR #-}+    processR cnt b fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ SContinue n (Deintercalate1RL cnt b fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        r <- stepR sR a+        case r of+            SPartial n s -> return $ SContinue n (Deintercalate1R (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (Deintercalate1R (cnt + n) fs s)+            SDone n b -> processR (cnt + n) b fs n+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) 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+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SContinue n (Deintercalate1RL (cnt + n) bR fs s)+            SContinue n s -> return $ SContinue n (Deintercalate1RL (cnt + n) bR fs s)+            SDone 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 $ SPartial n (Deintercalate1InitR fs2)+                            FL.Done c -> return $ SDone n c+                    -- XXX We could have the fold accept pairs of (bR, bL)+                    FL.Done _ -> error "Fold terminated consuming partial input"+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) xs++    {-# INLINE extractResult #-}+    extractResult n fs r = do+        res <- fstep fs r+        case res of+            FL.Partial fs1 -> fmap (FDone n) $ ffinal fs1+            FL.Done c -> return (FDone n c)++    extract (Deintercalate1InitL cnt fs sL) = do+        r <- extractL sL+        case r of+            FDone n b -> extractResult n fs (Left b)+            FContinue n s -> return $ FContinue n (Deintercalate1InitL (cnt + n) fs s)+            FError err -> return $ FError err+    extract (Deintercalate1InitR fs) = fmap (FDone 0) $ ffinal fs+    extract (Deintercalate1R cnt fs _) = fmap (FDone (- cnt)) $ ffinal fs+    extract (Deintercalate1RL cnt bR fs sL) = do+        r <- extractL sL+        case r of+            FDone 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"+            FContinue n s -> return $ FContinue n (Deintercalate1RL (cnt + n) bR fs s)+            FError _ -> do+                xs <- ffinal fs+                return $ FDone (- 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.finalM 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 $ SPartial n (nextState fs1)+            FL.Done c -> return $ SDone n c++    {-# INLINE runStepL #-}+    runStepL cnt fs sL a = do+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SContinue n (SepByL (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (SepByL (cnt + n) fs s)+            SDone n b ->+                processL (fstep fs b) n SepByInitR+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) xs++    {-# INLINE processR #-}+    processR cnt fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ SContinue n (SepByL cnt fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        r <- stepR sR a+        case r of+            SPartial n s -> return $ SContinue n (SepByR (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (SepByR (cnt + n) fs s)+            SDone n _ -> processR (cnt + n) fs n+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) 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 (FDone n) $ ffinal fs1+            FL.Done c -> return (FDone n c)++    extract (SepByInitL fs) = fmap (FDone 0) $ ffinal fs+    extract (SepByL cnt fs sL) = do+        r <- extractL sL+        case r of+            FDone n b -> extractResult n fs b+            FContinue n s -> return $ FContinue n (SepByL (cnt + n) fs s)+            FError _ -> do+                xs <- ffinal fs+                return $ FDone (- cnt) xs+    extract (SepByInitR fs) = fmap (FDone 0) $ ffinal fs+    extract (SepByR cnt fs _) = fmap (FDone (- 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.parsePos p $ Stream.fromList ""+-- Left (ParseErrorPos 0 "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 $ SPartial n (nextState fs1)+            FL.Done c -> return $ SDone n c++    {-# INLINE runStepInitL #-}+    runStepInitL cnt fs sL a = do+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SContinue n (SepBy1InitL (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (SepBy1InitL (cnt + n) fs s)+            SDone n b ->+                processL (fstep fs b) n SepBy1InitR+            SError err -> return $ SError err++    {-# INLINE runStepL #-}+    runStepL cnt fs sL a = do+        r <- stepL sL a+        case r of+            SPartial n s -> return $ SContinue n (SepBy1L (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (SepBy1L (cnt + n) fs s)+            SDone n b ->+                processL (fstep fs b) n SepBy1InitR+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (- cnt) xs++    {-# INLINE processR #-}+    processR cnt fs n = do+        res <- initialL+        case res of+            IPartial ps -> return $ SContinue n (SepBy1L cnt fs ps)+            IDone _ -> errMsg "left" "succeed"+            IError _ -> errMsg "left" "fail"++    {-# INLINE runStepR #-}+    runStepR cnt fs sR a = do+        r <- stepR sR a+        case r of+            SPartial n s -> return $ SContinue n (SepBy1R (cnt + n) fs s)+            SContinue n s -> return $ SContinue n (SepBy1R (cnt + n) fs s)+            -- XXX review, need tests for sepBy1+            SDone n _ -> processR (cnt + n) fs n+            SError _ -> do+                xs <- ffinal fs+                return $ SDone (-cnt) 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 (FDone n) $ ffinal fs1+            FL.Done c -> return (FDone n c)++    extract (SepBy1InitL cnt fs sL) = do+        r <- extractL sL+        case r of+            FDone n b -> extractResult n fs b+            FContinue n s -> return $ FContinue n (SepBy1InitL (cnt + n) fs s)+            FError err -> return $ FError err+    extract (SepBy1L cnt fs sL) = do+        r <- extractL sL+        case r of+            FDone n b -> extractResult n fs b+            FContinue n s -> return $ FContinue n (SepBy1L (cnt + n) fs s)+            FError _ -> do+                xs <- ffinal fs+                return $ FDone (- cnt) xs+    extract (SepBy1InitR fs) = fmap (FDone 0) $ ffinal fs+    extract (SepBy1R cnt fs _) = fmap (FDone (- 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 $ SContinue 0 (Just' p, ss1, fs)+            D.Stop -> do+                c <- ffinal fs+                return $ SDone 0 c+            D.Skip ss1 -> return $ SContinue 0 (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+                    SPartial n ps2 ->+                        let newP =+                              Just' $ Parser pstep (return $ IPartial ps2) pextr+                        in return $ SPartial n (newP, ss, fs)+                    SContinue n ps2 ->+                        let newP =+                              Just' $ Parser pstep (return $ IPartial ps2) pextr+                        in return $ SContinue n (newP, ss, fs)+                    SDone n b -> do+                        fres <- fstep fs b+                        case fres of+                            FL.Partial fs1 ->+                                return $ SPartial n (Nothing', ss, fs1)+                            FL.Done c -> return $ SDone n c+                    SError msg -> return $ SError msg+            IDone b -> do+                fres <- fstep fs b+                case fres of+                    FL.Partial fs1 ->+                        return $ SPartial 0 (Nothing', ss, fs1)+                    FL.Done c -> return $ SDone 0 c+            IError err -> return $ SError err++    extract (Nothing', _, fs) = fmap (FDone 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+                    FDone n b -> do+                        res <- fstep fs b+                        case res of+                            FL.Partial fs1 -> fmap (FDone n) $ ffinal fs1+                            FL.Done c -> return (FDone n c)+                    FError err -> return $ FError err+                    FContinue n s -> return $ FContinue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)+            IDone b -> do+                fres <- fstep fs b+                case fres of+                    FL.Partial fs1 -> fmap (FDone 0) $ ffinal fs1+                    FL.Done c -> return (FDone 0 c)+            IError err -> return $ FError 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 p test f@ tries the parser @test@ on the input, if @test@+-- fails it backtracks and tries @p@, after @p@ succeeds @test@ is+-- tried again and so on. The parser stops when @test@ succeeds.  The output of+-- @test@ is discarded and the output of @p@ is accumulated by the+-- supplied fold. The parser fails if @p@ 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+            SPartial n s -> return $ SPartial n (ManyTillR 0 fs s)+            SContinue n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (ManyTillR (cnt + n) fs s)+            SDone n _ -> do+                b <- ffinal fs+                return $ SDone n b+            SError _ -> do+                resL <- initialL+                case resL of+                    IPartial sl ->+                        return $ SContinue (negate cnt) (ManyTillL fs sl)+                    IDone bl -> do+                        fr <- fstep fs bl+                        -- XXX review, need tests for manyTill+                        case fr of+                            FL.Partial fs1 ->+                                scrutR+                                    fs1+                                    (SPartial (-cnt))+                                    (SContinue (-cnt))+                                    (SDone (-cnt))+                                    SError+                            FL.Done fb -> return $ SDone (-cnt) fb+                    IError err -> return $ SError err+    step (ManyTillL fs st) a = do+        r <- stepL st a+        case r of+            SPartial n s -> return $ SPartial n (ManyTillL fs s)+            SContinue n s -> return $ SContinue n (ManyTillL fs s)+            SDone n b -> do+                fs1 <- fstep fs b+                case fs1 of+                    FL.Partial s ->+                        scrutR s (SPartial n) (SContinue n) (SDone n) SError+                    FL.Done b1 -> return $ SDone n b1+            SError err -> return $ SError err++    extract (ManyTillL fs sR) = do+        res <- extractL sR+        case res of+            FDone n b -> do+                r <- fstep fs b+                case r of+                    FL.Partial fs1 -> fmap (FDone n) $ ffinal fs1+                    FL.Done c -> return (FDone n c)+            FError err -> return $ FError err+            FContinue n s -> return $ FContinue n (ManyTillL fs s)+    extract (ManyTillR _ fs _) = fmap (FDone 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,
src/Streamly/Internal/Data/Parser/Tee.hs view
@@ -168,7 +168,7 @@                     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)+            SError err -> return (undefined, Err err)      {-# INLINE_LATE step #-}     step (TeePair (bufL, StepState sL, inpL1, inpL2)@@ -186,8 +186,8 @@                 let (_, StepResult rL, _, _) = l                     (_, StepResult rR, _, _) = r                  in Done (min n1 n2) (zf rL rR)-            (Err err, _) -> Error err-            (_, Err err) -> Error err+            (Err err, _) -> SError err+            (_, Err err) -> SError err             _ -> Continue 0 next      step (TeePair (bufL, StepState sL, inpL1, inpL2)@@ -204,7 +204,7 @@                 let (_, StepResult rL, _, _) = l                  in Done n (zf rL rR)             Skp -> Continue 0 next-            Err err -> Error err+            Err err -> SError err      step (TeePair l@(_, StepResult rL, _, _)                     (bufR, StepState sR, inpR1, inpR2)) x = do@@ -220,7 +220,7 @@                 let (_, StepResult rR, _, _) = r                  in Done n (zf rL rR)             Skp -> Continue 0 next-            Err err -> Error err+            Err err -> SError err      step _ _ = undefined @@ -301,7 +301,7 @@                     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)+            SError err -> return (undefined, Err err)      {-# INLINE_LATE step #-}     step (TeePair (bufL, StepState sL, inpL1, inpL2)@@ -314,7 +314,7 @@             -- 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?+            -- SError 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.@@ -329,8 +329,8 @@                     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+            (Err err, _) -> return $ SError err+            (_, Err err) -> return $ SError err             _ -> return $ Continue 0 next      step (TeePair (bufL, StepState sL, inpL1, inpL2)@@ -347,7 +347,7 @@                 let (_, StepResult rL, _, _) = l                  in Done n (zf rL rR)             Skp -> Continue 0 next-            Err err -> Error err+            Err err -> SError err      step _ _ = undefined @@ -435,7 +435,7 @@                     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)+            SError 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@@ -454,8 +454,8 @@                 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+            (Err err, _) -> SError err+            (_, Err err) -> SError err             _ -> Continue 0 next      step _ _ = undefined@@ -536,7 +536,7 @@                     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)+            SError err -> return (undefined, Err err)      {-# INLINE_LATE step #-}     step (TeePair (bufL, StepState sL, inpL1, inpL2)@@ -552,8 +552,8 @@                 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+            (Err err, _) -> SError err+            (_, Err err) -> SError err             _ -> Continue 0 next      -- XXX the parser that finishes last may not be the longest because it may@@ -574,7 +574,7 @@                 let (_, StepResult rL, _, _) = l                  in Done n rL             Skp -> Continue 0 next-            Err err -> Error err+            Err err -> SError err      step (TeePair l@(_, StepResult _, _, _)                     (bufR, StepState sR, inpR1, inpR2)) x = do@@ -586,7 +586,7 @@                 let (_, StepResult rR, _, _) = r                  in Done n rR             Skp -> Continue 0 next-            Err err -> Error err+            Err err -> SError err      step _ _ = undefined
src/Streamly/Internal/Data/Parser/Type.hs view
@@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE NoMonoLocalBinds #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-} -- | -- Module      : Streamly.Internal.Data.Parser.ParserD.Type -- Copyright   : (c) 2020 Composewell Technologies@@ -40,7 +43,7 @@ -- 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+-- 4. 'SError': indicates that the parser has failed without a result -- -- = How a Parser Works? --@@ -55,7 +58,7 @@ -- 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@.+-- return @SError 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@@ -63,7 +66,7 @@ -- 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+-- cannot use @SError@. 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@@ -74,10 +77,10 @@ -- multi-yield parser.  However, this implementation is amenable to stream -- fusion and can therefore be much faster. ----- = Error Handling+-- = SError 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+-- 'Done' or an 'SError' 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@@ -90,7 +93,7 @@ -- 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+-- function because of performance reasons. 'SError' constructor in that case -- allows loop fusion and better performance. -- -- = Optimizing backtracking@@ -123,7 +126,7 @@ -- 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+-- translate the "SError" of parser to an exception.  This gives us best of both -- worlds, the applicative as well as alternative would have optimal -- backtracking buffer. --@@ -177,11 +180,15 @@     (     -- * Types       Initial (..)-    , Step (..)-    , extractStep+    -- (..) does not seem to export patterns yet the compiler complains it does.+    , Step(Partial, Continue, Done, Error, SPartial, SContinue, SDone, SError)+    , Final(..)+    , mapCount     , bimapOverrideCount+    , bimapMorphOverrideCount     , Parser (..)     , ParseError (..)+    , ParseErrorPos (..)     , rmapM      -- * Constructors@@ -207,6 +214,8 @@     , noErrorUnsafeSplitWith     , noErrorUnsafeSplit_     , noErrorUnsafeConcatMap++    , localReaderT     ) where @@ -221,6 +230,7 @@ -- import Control.Monad (MonadPlus(..), (>=>)) import Control.Monad ((>=>)) import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (ReaderT, local) import Data.Bifunctor (Bifunctor(..)) import Fusion.Plugin.Types (Fuse(..)) import Streamly.Internal.Data.Fold.Type (Fold(..), toList)@@ -245,6 +255,10 @@ -- where the processing in intiial is just a sepcial case of step, see -- takeBetween for example. +-- XXX IPartial indicates that the parser has a default result and cannot fail.+-- Such parsers should rather be written as Parslets? We should use IContinue+-- in initial.+ -- | The type of a 'Parser''s initial action. -- -- /Internal/@@ -280,7 +294,7 @@ -- 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+-- In this case SError 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.@@ -289,108 +303,181 @@  -- | 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.+-- /Result types/: The parser driver feeds the input stream to the parser one+-- element at a time, representing a parse 'Step'. If the step result+-- 'SPartial' indicates that a parse result is available and the parser can+-- accept more input, we can extract the result using the parser's extract+-- function and feed more input to the parser. If the result is 'SContinue', we+-- must feed more input in order to get a result. If the parser returns 'SDone'+-- then a result is available and 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.+-- /Stream position/: The @n@ in @SPartial n@, @Scontinue n@ and @SDone n@ is a+-- count by which we adjust the current stream position after this step. If the+-- count is positive we move forward in the stream, if it is 0 then we stay+-- where we are, if it is negative then we move backward in the stream.+-- Essentially, if the input stream position was @pos@ before processing the+-- current element then the new stream position after processing the element+-- would be @pos + n@. ----- 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.+-- We can also think of this count as the number of items consumed by the+-- parser. If the current input item is consumed then n is 1, if the current+-- input item should be presented to the next parser step then n is 0. If @n@+-- is less than 0 then the parser backtracks by n elements before the current+-- element before the next parsing step is invoked. @n@ is not allowed to be+-- greater than 1 in the regular stream parsers, but it can be more than 1 in+-- an array parser because it can consume more than one elements from the+-- array. ----- 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.+-- /Backtracking/: If the parser result is 'SContinue', the parser driver+-- retains the input in a backtracking buffer, in case of failure the parser+-- can backtrack maximum up to the length of the backtracking buffer. Whenever+-- the result is `SPartial` the current backtracking buffer is discarded; this+-- means that we cannot backtrack beyond the currrent position in the stream.+-- The parser must ensure that the backtrack position is always within the+-- bounds of the backtracking buffer, otherwise a runtime error will occur. --+-- /Failure/: If the parser is not yet done, we can use the @extract@ operation+-- on the @state@ of the parser to extract a result. If the parser never+-- yielded a result in the past, @extract@ fails with a 'ParseError' exception.+-- If the parser yielded a 'Partial' result in the past then extract returns+-- the latest partial result. Therefore, if a parser yields a partial result+-- once then it cannot fail later on.+-- -- /Pre-release/ -- {-# ANN type Step Fuse #-} data Step s b =-        Partial !Int !s-    -- ^ @Partial count state@. The following hold on Partial result:+        SPartial !Int !s+    -- ^ @SPartial count state@. The following statements hold on an SPartial+    -- 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.+    -- 2. Input stream position is updated to @current position + count@.+    -- 3. All buffered input before the new position is dropped. The parser can+    -- never backtrack before this position. -    | Continue !Int !s-    -- ^ @Continue count state@. The following hold on a Continue result:+    | SContinue !Int !s+    -- ^ @SContinue count state@. The following statements hold on an SContinue+    -- 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.+    -- 1. If 'SPartial' result was returned in the past, @extract@ on @state@+    -- would give that result otherwise it will return 'SError' or 'SContinue'.+    -- 2. Input stream position is updated to @current position + count@.+    -- 3. the previous input is retained in a backtrack buffer. -    | Done !Int !b+    | SDone !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@.+    -- @SDone count result@ means the parser has finished, it will not accept+    -- any more input, the final stream position must be set to @current+    -- position + count@ and the result of the parser is in @result@. -    | Error !String+    | SError !String     -- ^ Parser failed without generating any output.     --     -- The parsing operation may backtrack to the beginning and try another     -- alternative.+    deriving (Show) +{-# ANN type Final Fuse #-}+data Final s b+    = FDone !Int !b      -- ^ Return a result right away without an input.+    | FContinue !Int !s+    | FError !String -- ^ Return an error right away without an input.++--------------------------------------------------------------------------------+-- Custom Patterns+--------------------------------------------------------------------------------++negateDirection :: Step s b -> Step s b+negateDirection (SPartial i s) = SPartial (1 - i) s+negateDirection (SContinue i s) = SContinue (1 - i) s+negateDirection (SDone i b) = SDone (1 - i) b+negateDirection (SError s) = SError s++{-# DEPRECATED Error "Use @SError@ instead of @Error@" #-}+pattern Error :: String -> Step s b+pattern Error s = SError s++{-# DEPRECATED Partial "Use @SPartial (1 - n)@ instead of @Partial n@" #-}+pattern Partial :: Int -> s -> Step s b+pattern Partial i s <- (negateDirection -> SPartial i s)+    where Partial i s = SPartial (1 - i) s++{-# DEPRECATED Continue "Replace @Continue n@ with @SContinue (1 - n)@ in parser step and with @FContinue (-n)@ in parser extract" #-}+pattern Continue :: Int -> s -> Step s b+pattern Continue i s <- (negateDirection -> SContinue i s)+    where Continue i s = SContinue (1 - i) s++{-# DEPRECATED Done "Replace @Done n@ with @SDone (1 - n)@ in parser step and with @FDone (-n)@ in parser extract" #-}+pattern Done :: Int -> b -> Step s b+pattern Done i b <- (negateDirection -> SDone i b)+    where Done i b = SDone (1 - i) b++--------------------------------------------------------------------------------+-- Code+--------------------------------------------------------------------------------+ -- | 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+            SPartial n s -> SPartial n (f s)+            SContinue n s -> SContinue n (f s)+            SDone n b -> SDone n (g b)+            SError err -> SError err +instance Bifunctor Final where+    {-# INLINE bimap #-}+    bimap f g step =+        case step of+            FContinue n s -> FContinue n (f s)+            FDone n b -> FDone n (g b)+            FError err -> FError 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+        SPartial _ s -> SPartial n (f s)+        SContinue _ s -> SContinue n (f s)+        SDone _ b -> SDone n (g b)+        SError err -> SError err +bimapMorphOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Final s b -> Step s1 b1+bimapMorphOverrideCount n f g step =+    case step of+        FDone _ b -> SDone n (g b)+        FContinue _ s -> SContinue n (f s)+        FError err -> SError err++bimapFinalOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Final s b -> Final s1 b1+bimapFinalOverrideCount n f g step =+    case step of+        FContinue _ s -> FContinue n (f s)+        FDone _ b -> FDone n (g b)+        FError err -> FError 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+instance Functor (Final s) where+    {-# INLINE fmap #-}+    fmap = second --- | Map an extract function over the state of Step+-- | Map a function over the count. ---{-# INLINE extractStep #-}-extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)-extractStep f res =+{-# INLINE mapCount #-}+mapCount :: (Int -> Int) -> Step s b -> Step s b+mapCount 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+        SPartial n s -> SPartial (f n) s+        SDone n b -> SDone (f n) b+        SContinue n s -> SContinue (f n) s+        SError err -> SError err  -- | Map a monadic function over the result @b@ in @Step s b@. --@@ -399,11 +486,19 @@ 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+        SPartial n s -> pure $ SPartial n s+        SDone n b -> SDone n <$> f b+        SContinue n s -> pure $ SContinue n s+        SError err -> pure $ SError err +{-# INLINE mapMFinal #-}+mapMFinal :: Applicative m => (a -> m b) -> Final s a -> m (Final s b)+mapMFinal f res =+    case res of+        FDone n b -> FDone n <$> f b+        FContinue n s -> pure $ FContinue n s+        FError err -> pure $ FError 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@@@ -419,25 +514,28 @@ 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))+        (s -> m (Final 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+    deriving (Eq, Show)  instance Exception ParseError where     displayException (ParseError err) = err +-- | Like 'ParseError' but reports the stream position where the error ocurred.+-- The @Int@ is the position in the stream where the error ocurred. This+-- exception is used by position reporting parser drivers.+data ParseErrorPos = ParseErrorPos Int String+    deriving (Eq, Show)++instance Exception ParseErrorPos where+    displayException (ParseErrorPos pos err) =+        concat ["At ", show pos, ":", 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 #-}@@ -449,7 +547,7 @@         initial = fmap2 f initial1         step s b = fmap2 f (step1 s b)         fmap2 g = fmap (fmap g)-        fmap3 g = fmap2 (fmap g)+        fmap3 g = fmap (fmap (fmap g))  ------------------------------------------------------------------------------ -- Mapping on the output@@ -461,7 +559,7 @@ {-# 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)+    Parser step1 initial1 (extract >=> mapMFinal f)      where @@ -571,17 +669,17 @@             -- 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+            SPartial n s -> return $ SContinue n (SeqParseL s)+            SContinue n s -> return $ SContinue n (SeqParseL s)+            SDone 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+                   IPartial sr -> SContinue n $ SeqParseR (func b) sr+                   IDone br -> SDone n (func b br)+                   IError err -> SError err+            SError err -> return $ SError err      step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a) @@ -590,7 +688,7 @@         -- XXX Use bimap here         rL <- extractL sL         case rL of-            Done n bL -> do+            FDone n bL -> do                 -- XXX Use bimap here if we use Step type in Initial                 iR <- initialR                 case iR of@@ -598,11 +696,10 @@                         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)+                    IDone bR -> return $ FDone n $ func bL bR+                    IError err -> return $ FError err+            FError err -> return $ FError err+            FContinue n s -> return $ FContinue n (SeqParseL s)  ------------------------------------------------------------------------------- -- Sequential applicative for backtracking folds@@ -644,22 +741,22 @@             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.+    -- a terminating parser returning a SDone 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+            SPartial n s -> return $ SPartial n (SeqParseL s)+            SContinue n s -> return $ SContinue n (SeqParseL s)+            SDone n b -> do                 res <- initialR                 return                     $ case res of-                          IPartial sr -> Partial n $ SeqParseR (func b) sr-                          IDone br -> Done n (func b br)+                          IPartial sr -> SPartial n $ SeqParseR (func b) sr+                          IDone br -> SDone n (func b br)                           IError err -> errMsg err-            Error err -> errMsg err+            SError err -> errMsg err      step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a) @@ -668,19 +765,18 @@     extract (SeqParseL sL) = do         rL <- extractL sL         case rL of-            Done n bL -> do+            FDone n bL -> do                 iR <- initialR                 case iR of                     IPartial sR -> do                         rR <- extractR sR                         return-                            $ bimapOverrideCount+                            $ bimapFinalOverrideCount                                 n (SeqParseR (func bL)) (func bL) rR-                    IDone bR -> return $ Done n $ func bL bR+                    IDone bR -> return $ FDone n $ func bL bR                     IError err -> errMsg err-            Error err -> errMsg err-            Partial _ _ -> errMsg "Partial"-            Continue n s -> return $ Continue n (SeqParseL s)+            FError err -> errMsg err+            FContinue n s -> return $ FContinue n (SeqParseL s)  {-# ANN type SeqAState Fuse #-} data SeqAState sl sr = SeqAL !sl | SeqAR !sr@@ -721,7 +817,7 @@             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.+    -- a terminating parser returning a SDone 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.@@ -729,15 +825,15 @@         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+            SPartial n s -> return $ SContinue n (SeqAL s)+            SContinue n s -> return $ SContinue n (SeqAL s)+            SDone 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+                    IPartial s -> SContinue n (SeqAR s)+                    IDone b -> SDone n b+                    IError err -> SError err+            SError err -> return $ SError err      step (SeqAR st) a = first SeqAR <$> stepR st a @@ -745,17 +841,16 @@     extract (SeqAL sL) = do         rL <- extractL sL         case rL of-            Done n _ -> do+            FDone 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)+                        fmap (bimapFinalOverrideCount n SeqAR id) (extractR sR)+                    IDone bR -> return $ FDone n bR+                    IError err -> return $ FError err+            FError err -> return $ FError err+            FContinue n s -> return $ FContinue n (SeqAL s)  -- | Better performance 'split_' for non-failing parsers. --@@ -783,22 +878,22 @@             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.+    -- a terminating parser returning a SDone 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+            SPartial n s -> return $ SPartial n (SeqAL s)+            SContinue n s -> return $ SContinue n (SeqAL s)+            SDone n _ -> do                 initR <- initialR                 return $ case initR of-                    IPartial s -> Partial n (SeqAR s)-                    IDone b -> Done n b+                    IPartial s -> SPartial n (SeqAR s)+                    IDone b -> SDone n b                     IError err -> errMsg err-            Error err -> errMsg err+            SError err -> errMsg err      step (SeqAR st) a = first SeqAR <$> stepR st a @@ -806,16 +901,15 @@     extract (SeqAL sL) = do         rL <- extractL sL         case rL of-            Done n _ -> do+            FDone n _ -> do                 iR <- initialR                 case iR of                     IPartial sR -> do-                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)-                    IDone bR -> return $ Done n bR+                        fmap (bimapFinalOverrideCount n SeqAR id) (extractR sR)+                    IDone bR -> return $ FDone n bR                     IError err -> errMsg err-            Error err -> errMsg err-            Partial _ _ -> error "split_: Partial"-            Continue n s -> return $ Continue n (SeqAL s)+            FError err -> errMsg err+            FContinue n s -> return $ FContinue n (SeqAL s)  -- | READ THE CAVEATS in 'splitWith' before using this instance. --@@ -860,8 +954,8 @@ -- 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]+-- >> 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@@ -899,44 +993,43 @@     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+            SPartial n s -> return $ SPartial n (AltParseL 0 s)+            SContinue n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (AltParseL (cnt + n) s)+            SDone n b -> return $ SDone n b+            SError _ -> do                 res <- initialR                 return                     $ case res of-                          IPartial rR -> Continue (cnt + 1) (AltParseR rR)-                          IDone b -> Done (cnt + 1) b-                          IError err -> Error err+                          IPartial rR -> SContinue (negate cnt) (AltParseR rR)+                          IDone b -> SDone (negate cnt) b+                          IError err -> SError 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+            SPartial n s -> SPartial n (AltParseR s)+            SContinue n s -> SContinue n (AltParseR s)+            SDone n b -> SDone n b+            SError err -> SError 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+            FDone n b -> return $ FDone n b+            FError _ -> 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)+                          IPartial rR -> FContinue (- cnt) (AltParseR rR)+                          IDone b -> FDone (- cnt) b+                          IError err -> FError err+            FContinue n s -> do+                assertM(n == (- cnt))+                return $ FContinue n (AltParseL 0 s)  {-# ANN type Fused3 Fuse #-} data Fused3 a b c = Fused3 !a !b !c@@ -975,36 +1068,35 @@     {-# 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+            SPartial n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) fs)+            SContinue n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) fs)+            SDone n b -> do+                assertM(cnt + n >= 0)+                fstep fs b >>= handleCollect (SPartial n) (SDone n)+            SError _ -> do                 xs <- ffinal fs-                return $ Done cnt xs+                -- XXX review, need a test for this+                return $ SDone (- cnt) xs -    extract (Fused3 _ 0 fs) = fmap (Done 0) (ffinal fs)+    extract (Fused3 _ 0 fs) = fmap (FDone 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)+            FError _ -> fmap (FDone (- cnt)) (ffinal fs)+            FDone 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))+                    FL.Partial s1 -> fmap (FDone n) (ffinal s1)+                    FL.Done b1 -> return (FDone n b1)+            FContinue n s1 -> do+                assertM((- n) == cnt)+                return (FContinue n (Fused3 s1 0 fs))  -- | Like splitMany, but inner fold emits an output at the end even if no input -- is received.@@ -1039,35 +1131,33 @@     {-# 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+            SPartial n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) fs)+            SContinue n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) fs)+            SDone n b -> do+                assertM(cnt + n >= 0)+                fstep fs b >>= handleCollect (SPartial n) (SDone n)+            SError _ -> do                 xs <- ffinal fs-                return $ Done cnt1 xs+                return $ SDone (- cnt) 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)+            FError _ -> fmap (FDone (- cnt)) (ffinal fs)+            FDone 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))+                    FL.Partial s1 -> fmap (FDone n) (ffinal s1)+                    FL.Done b1 -> return (FDone n b1)+            FContinue n s1 -> do+                assertM((- n) == cnt)+                return (FContinue n (Fused3 s1 0 fs))  -- | See documentation of 'Streamly.Internal.Data.Parser.some'. --@@ -1116,61 +1206,57 @@     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+            SPartial n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) (Left fs))+            SContinue n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) (Left fs))+            SDone n b -> do+                assertM(cnt + n >= 0)+                fstep fs b >>= handleCollect (SPartial n) (SDone n)+            SError err -> return $ SError 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+            SPartial n s -> do+                assertM(cnt + n >= 0)+                return $ SPartial n (Fused3 s (cnt + n) (Right fs))+            SContinue n s -> do+                assertM(cnt + n >= 0)+                return $ SContinue n (Fused3 s (cnt + n) (Right fs))+            SDone n b -> do+                assertM(cnt + n >= 0)+                fstep fs b >>= handleCollect (SPartial n) (SDone n)+            SError _ -> SDone (- cnt) <$> 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)+            FError err -> return (FError err)+            FDone 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)))+                    FL.Partial s1 -> fmap (FDone n) (ffinal s1)+                    FL.Done b1 -> return (FDone n b1)+            FContinue n s1 -> do+                assertM((- n) == cnt)+                return (FContinue 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)+            FError _ -> fmap (FDone (- cnt)) (ffinal fs)+            FDone 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)))+                    FL.Partial s1 -> fmap (FDone n) (ffinal s1)+                    FL.Done b1 -> return (FDone n b1)+            FContinue n s1 -> do+                assertM((- n) == cnt)+                return (FContinue n (Fused3 s1 0 (Right fs)))  -- | A parser that always fails with an error message without consuming -- any input.@@ -1218,7 +1304,7 @@ {-# 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))+    | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Final s b))  -- XXX Does it fuse completely? Check and update, it cannot fuse the -- dynamically generated parser.@@ -1255,25 +1341,25 @@     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+            IPartial sr -> SContinue n $ ConcatParseR stepR sr extractR+            IDone br -> SDone n br+            IError err -> SError 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+            SPartial n s -> return $ SContinue n (ConcatParseL s)+            SContinue n s -> return $ SContinue n (ConcatParseL s)+            SDone n b -> initializeRL n (func b)+            SError err -> return $ SError 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+            SPartial n s -> SPartial n $ ConcatParseR stepR s extractR+            SContinue n s -> SContinue n $ ConcatParseR stepR s extractR+            SDone n b -> SDone n b+            SError err -> SError err      {-# INLINE extractP #-}     extractP n (Parser stepR initialR extractR) = do@@ -1283,18 +1369,17 @@                 fmap                     (first (\s1 -> ConcatParseR stepR s1 extractR))                     (extractR s)-            IDone b -> return (Done n b)-            IError err -> return $ Error err+            IDone b -> return (FDone n b)+            IError err -> return $ FError 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)+            FError err -> return $ FError err+            FDone n b -> extractP n $ func b+            FContinue n s -> return $ FContinue n (ConcatParseL s)  -- | Better performance 'concatMap' for non-failing parsers. --@@ -1329,25 +1414,25 @@     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+            IPartial sr -> SPartial n $ ConcatParseR stepR sr extractR+            IDone br -> SDone n br+            IError err -> SError 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+            SPartial n s -> return $ SPartial n (ConcatParseL s)+            SContinue n s -> return $ SContinue n (ConcatParseL s)+            SDone n b -> initializeRL n (func b)+            SError err -> return $ SError 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+            SPartial n s -> SPartial n $ ConcatParseR stepR s extractR+            SContinue n s -> SContinue n $ ConcatParseR stepR s extractR+            SDone n b -> SDone n b+            SError err -> SError err      {-# INLINE extractP #-}     extractP n (Parser stepR initialR extractR) = do@@ -1357,18 +1442,17 @@                 fmap                     (first (\s1 -> ConcatParseR stepR s1 extractR))                     (extractR s)-            IDone b -> return (Done n b)-            IError err -> return $ Error err+            IDone b -> return (FDone n b)+            IError err -> return $ FError 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)+            FError err -> return $ FError err+            FDone n b -> extractP n $ func b+            FContinue n s -> return $ FContinue 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@@ -1449,4 +1533,16 @@      where -    step1 x a = if f a then step x a else return $ Partial 0 x+    step1 x a = if f a then step x a else return $ SPartial 1 x++-- XXX move this to ParserD.Transformer++-- | Modify the environment of the underlying ReaderT monad.+{-# INLINE localReaderT #-}+localReaderT ::+    (r -> r) -> Parser a (ReaderT r m) b -> Parser a (ReaderT r m) b+localReaderT f (Parser step initial extract) =+    Parser+        ((local f .) . step)+        (local f initial)+        (local f . extract)
+ src/Streamly/Internal/Data/ParserDrivers.h view
@@ -0,0 +1,1100 @@+#ifndef PARSER_WITH_POS+#define PARSE_BREAK parseBreak+#define PARSE_BREAK_STREAMK parseBreakStreamK+#define PARSE_BREAK_CHUNKS parseBreakChunks+#define PARSE_BREAK_CHUNKS_GENERIC parseBreakChunksGeneric+#define PARSE_MANY parseMany+#define PARSE_ITERATE parseIterate+#define OPTIONAL(x)+#define PARSE_ERROR(x) ParseError+#define PARSE_ERROR_TYPE ParseError+#else+#undef PARSE_BREAK+#define PARSE_BREAK parseBreakPos+#undef PARSE_BREAK_STREAMK+#define PARSE_BREAK_STREAMK parseBreakStreamKPos+#undef PARSE_BREAK_CHUNKS+#define PARSE_BREAK_CHUNKS parseBreakChunksPos+#undef PARSE_BREAK_CHUNKS_GENERIC+#define PARSE_BREAK_CHUNKS_GENERIC parseBreakChunksGenericPos++#define ParseChunksState ParseChunksStatePos+#define ParseChunksInit ParseChunksInitPos+#define ParseChunksInitBuf ParseChunksInitBufPos+#define ParseChunksInitLeftOver ParseChunksInitLeftOverPos+#define ParseChunksStream ParseChunksStreamPos+#define ParseChunksStop ParseChunksStopPos+#define ParseChunksBuf ParseChunksBufPos+#define ParseChunksExtract ParseChunksExtractPos+#define ParseChunksYield ParseChunksYieldPos++#undef PARSE_MANY+#define PARSE_MANY parseManyPos++#define ConcatParseState ConcatParseStatePos+#define ConcatParseInit ConcatParseInitPos+#define ConcatParseInitBuf ConcatParseInitBufPos+#define ConcatParseInitLeftOver ConcatParseInitLeftOverPos+#define ConcatParseStop ConcatParseStopPos+#define ConcatParseStream ConcatParseStreamPos+#define ConcatParseBuf ConcatParseBufPos+#define ConcatParseExtract ConcatParseExtractPos+#define ConcatParseYield ConcatParseYieldPos++#undef PARSE_ITERATE+#define PARSE_ITERATE parseIteratePos+#undef OPTIONAL+#define OPTIONAL(x) (x)+#undef PARSE_ERROR+#define PARSE_ERROR(x) ParseErrorPos (x)+#undef PARSE_ERROR_TYPE+#define PARSE_ERROR_TYPE ParseErrorPos+#endif++{- HLINT ignore -}++{-# ANN type ParseChunksState Fuse #-}+data ParseChunksState x inpBuf st pst =+      ParseChunksInit OPTIONAL(Int) inpBuf st+    | ParseChunksInitBuf OPTIONAL(Int) inpBuf+    | ParseChunksInitLeftOver OPTIONAL(Int) inpBuf+    | ParseChunksStream OPTIONAL(Int) st inpBuf !pst+    | ParseChunksStop OPTIONAL(Int) inpBuf !pst+    | ParseChunksBuf OPTIONAL(Int) inpBuf st inpBuf !pst+    | ParseChunksExtract OPTIONAL(Int) inpBuf inpBuf !pst+    | ParseChunksYield x (ParseChunksState x inpBuf st pst)++-- XXX return the remaining stream as part of the error.+{-# INLINE_NORMAL PARSE_MANY #-}+PARSE_MANY+    :: Monad m+    => PRD.Parser a m b+    -> Stream m a+    -> Stream m (Either PARSE_ERROR_TYPE b)+PARSE_MANY (PRD.Parser pstep initial extract) (Stream step state) =+    Stream stepOuter (ParseChunksInit OPTIONAL(0) [] state)++    where++    {-# INLINE splitAt #-}+    splitAt = Stream.splitAt "Data.StreamK.parseMany"++    {-# 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 OPTIONAL(i) [] 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 OPTIONAL(i) [x] s [] ps+                    PRD.IDone pb ->+                        let next = ParseChunksInit OPTIONAL(i) [x] s+                         in return $ Skip $ ParseChunksYield (Right pb) next+                    PRD.IError err ->+                        return+                            $ Skip+                            $ ParseChunksYield+                                (Left (PARSE_ERROR(i) err))+                                (ParseChunksInitLeftOver OPTIONAL(i) [])+            Skip s -> return $ Skip $ ParseChunksInit OPTIONAL(i) [] s+            Stop   -> return Stop++    -- Buffer is not empty, go to buffered processing loop+    stepOuter _ (ParseChunksInit OPTIONAL(i) src st) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ParseChunksBuf OPTIONAL(i) src st [] ps+            PRD.IDone pb ->+                let next = ParseChunksInit OPTIONAL(i) src st+                 in return $ Skip $ ParseChunksYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (PARSE_ERROR(i) err))+                        (ParseChunksInitLeftOver OPTIONAL(i) [])++    -- This is simplified ParseChunksInit+    stepOuter _ (ParseChunksInitBuf OPTIONAL(i) src) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ParseChunksExtract OPTIONAL(i) src [] ps+            PRD.IDone pb ->+                let next = ParseChunksInitBuf OPTIONAL(i) src+                 in return $ Skip $ ParseChunksYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (PARSE_ERROR(i) err))+                        (ParseChunksInitLeftOver OPTIONAL(i) [])++    -- XXX we just discard any leftover input at the end+    stepOuter _ (ParseChunksInitLeftOver OPTIONAL(_) _) = return Stop++    -- Buffer is empty, process elements from the stream+    stepOuter gst (ParseChunksStream OPTIONAL(i) st buf pst) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.SPartial 1 pst1 ->+                        return $ Skip $ ParseChunksStream OPTIONAL(i + 1) s [] pst1+                    PR.SPartial m pst1 -> do+                        let n = 1 - m+                        assert (n <= length (x:buf)) (return ())+                        let src0 = Prelude.take n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s [] pst1+                    PR.SContinue 1 pst1 ->+                        return $ Skip $ ParseChunksStream OPTIONAL(i + 1) s (x:buf) pst1+                    PR.SContinue m pst1 -> do+                        let n = 1 - m+                        assert (n <= length (x:buf)) (return ())+                        let (src0, buf1) = splitAt n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s buf1 pst1+                    PR.SDone 1 b -> do+                        return $ Skip $+                            ParseChunksYield+                                (Right b) (ParseChunksInit OPTIONAL(i + 1) [] s)+                    PR.SDone m b -> do+                        let n = 1 - m+                        assert (n <= length (x:buf)) (return ())+                        let src = Prelude.reverse (Prelude.take n (x:buf))+                        return $ Skip $+                            ParseChunksYield+                                (Right b) (ParseChunksInit OPTIONAL(i + m) src s)+                    PR.SError err ->+                        return+                            $ Skip+                            $ ParseChunksYield+                                (Left (PARSE_ERROR(i + 1) err))+                                (ParseChunksInitLeftOver OPTIONAL(i + 1) [])+            Skip s -> return $ Skip $ ParseChunksStream OPTIONAL(i) s buf pst+            Stop -> return $ Skip $ ParseChunksStop OPTIONAL(i) buf pst++    -- go back to stream processing mode+    stepOuter _ (ParseChunksBuf OPTIONAL(i) [] s buf pst) =+        return $ Skip $ ParseChunksStream OPTIONAL(i) s buf pst++    -- buffered processing loop+    stepOuter _ (ParseChunksBuf OPTIONAL(i) (x:xs) s buf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                return $ Skip $ ParseChunksBuf OPTIONAL(i + 1) xs s [] pst1+            PR.SPartial m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s [] pst1+            PR.SContinue 1 pst1 ->+                return $ Skip $ ParseChunksBuf OPTIONAL(i + 1) xs s (x:buf) pst1+            PR.SContinue m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksBuf OPTIONAL(i + m) src s buf1 pst1+            PR.SDone 1 b ->+                return+                    $ Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit OPTIONAL(i + 1) xs s)+            PR.SDone m b -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return $ Skip+                    $ ParseChunksYield+                        (Right b) (ParseChunksInit OPTIONAL(i + m) src s)+            PR.SError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (PARSE_ERROR(i + 1) err))+                        (ParseChunksInitLeftOver OPTIONAL(i + 1) [])++    -- This is simplified ParseChunksBuf+    stepOuter _ (ParseChunksExtract OPTIONAL(i) [] buf pst) =+        return $ Skip $ ParseChunksStop OPTIONAL(i) buf pst++    stepOuter _ (ParseChunksExtract OPTIONAL(i) (x:xs) buf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                return $ Skip $ ParseChunksExtract OPTIONAL(i + 1) xs [] pst1+            PR.SPartial m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksExtract OPTIONAL(i + m) src [] pst1+            PR.SContinue 1 pst1 ->+                return $ Skip $ ParseChunksExtract OPTIONAL(i + 1) xs (x:buf) pst1+            PR.SContinue m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip $ ParseChunksExtract OPTIONAL(i + m) src buf1 pst1+            PR.SDone 1 b ->+                return+                    $ Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf OPTIONAL(i + 1) xs)+            PR.SDone m b -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return+                    $ Skip+                    $ ParseChunksYield+                        (Right b) (ParseChunksInitBuf OPTIONAL(i + m) src)+            PR.SError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (PARSE_ERROR(i + 1) err))+                        (ParseChunksInitLeftOver OPTIONAL(i + 1) [])++    -- This is simplified ParseChunksExtract+    stepOuter _ (ParseChunksStop OPTIONAL(i) buf pst) = do+        pRes <- extract pst+        case pRes of+            PR.FContinue 0 pst1 ->+                return $ Skip $ ParseChunksStop OPTIONAL(i) buf pst1+            PR.FContinue m pst1 -> do+                let n = (- m)+                assert (n <= length buf) (return ())+                let (src0, buf1) = splitAt n buf+                    src  = Prelude.reverse src0+                return $ Skip $ ParseChunksExtract OPTIONAL(i + m) src buf1 pst1+            PR.FDone 0 b -> do+                return $ Skip $+                    ParseChunksYield (Right b) (ParseChunksInitLeftOver OPTIONAL(i) [])+            PR.FDone m b -> do+                let n = (- m)+                assert (n <= length buf) (return ())+                let src = Prelude.reverse (Prelude.take n buf)+                return $ Skip $+                    ParseChunksYield (Right b) (ParseChunksInitBuf OPTIONAL(i + m) src)+            PR.FError err ->+                return+                    $ Skip+                    $ ParseChunksYield+                        (Left (PARSE_ERROR(i) err))+                        (ParseChunksInitLeftOver OPTIONAL(i) [])++    stepOuter _ (ParseChunksYield a next) = return $ Yield a next++{-# ANN type ConcatParseState Fuse #-}+data ConcatParseState c b inpBuf st p m a =+      ConcatParseInit OPTIONAL(Int) inpBuf st p+    | ConcatParseInitBuf OPTIONAL(Int) inpBuf p+    | ConcatParseInitLeftOver OPTIONAL(Int) inpBuf+    | forall s. ConcatParseStop OPTIONAL(Int)+        inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Final s b))+    | forall s. ConcatParseStream OPTIONAL(Int)+        st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Final s b))+    | forall s. ConcatParseBuf OPTIONAL(Int)+        inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Final s b))+    | forall s. ConcatParseExtract OPTIONAL(Int)+        inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Final s b))+    | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)++{-# INLINE_NORMAL PARSE_ITERATE #-}+PARSE_ITERATE+    :: Monad m+    => (b -> PRD.Parser a m b)+    -> b+    -> Stream m a+    -> Stream m (Either PARSE_ERROR_TYPE b)+PARSE_ITERATE func seed (Stream step state) =+    Stream stepOuter (ConcatParseInit OPTIONAL(0) [] state (func seed))++    where++    {-# INLINE splitAt #-}+    splitAt = Stream.splitAt "Data.StreamK.parseIterate"++    {-# INLINE_LATE stepOuter #-}+    -- Buffer is empty, go to stream processing loop+    stepOuter _ (ConcatParseInit OPTIONAL(i) [] st (PRD.Parser pstep initial extract)) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ConcatParseStream OPTIONAL(i) st [] pstep ps extract+            PRD.IDone pb ->+                let next = ConcatParseInit OPTIONAL(i) [] st (func pb)+                 in return $ Skip $ ConcatParseYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (PARSE_ERROR(i) err))+                        (ConcatParseInitLeftOver OPTIONAL(i) [])++    -- Buffer is not empty, go to buffered processing loop+    stepOuter _ (ConcatParseInit OPTIONAL(i) src st+                    (PRD.Parser pstep initial extract)) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ConcatParseBuf OPTIONAL(i) src st [] pstep ps extract+            PRD.IDone pb ->+                let next = ConcatParseInit OPTIONAL(i) src st (func pb)+                 in return $ Skip $ ConcatParseYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (PARSE_ERROR(i) err))+                        (ConcatParseInitLeftOver OPTIONAL(i) [])++    -- This is simplified ConcatParseInit+    stepOuter _ (ConcatParseInitBuf OPTIONAL(i) src+                    (PRD.Parser pstep initial extract)) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ Skip $ ConcatParseExtract OPTIONAL(i) src [] pstep ps extract+            PRD.IDone pb ->+                let next = ConcatParseInitBuf OPTIONAL(i) src (func pb)+                 in return $ Skip $ ConcatParseYield (Right pb) next+            PRD.IError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (PARSE_ERROR(i) err))+                        (ConcatParseInitLeftOver OPTIONAL(i) [])++    -- XXX we just discard any leftover input at the end+    stepOuter _ (ConcatParseInitLeftOver OPTIONAL(_) _) = return Stop++    -- Buffer is empty process elements from the stream+    stepOuter gst (ConcatParseStream OPTIONAL(i) 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.SPartial 1 pst1 ->+                        return $ Skip+                            $ ConcatParseStream OPTIONAL(i + 1) s [] pstep pst1 extract+                    PR.SPartial m pst1 -> do+                        let n = 1 - m+                        assert (n <= length (x:buf)) (return ())+                        let src0 = Prelude.take n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip+                            $ ConcatParseBuf+                                OPTIONAL(i + m) src s [] pstep pst1 extract+                    -- PR.SContinue 1 pst1 ->+                    --     return $ Skip $ ConcatParseStream s (x:buf) pst1+                    PR.SContinue m pst1 -> do+                        let n = 1 - m+                        assert (n <= length (x:buf)) (return ())+                        let (src0, buf1) = splitAt n (x:buf)+                            src  = Prelude.reverse src0+                        return $ Skip+                            $ ConcatParseBuf+                                OPTIONAL(i + m) src s buf1 pstep pst1 extract+                    -- XXX Specialize for Stop 0 common case?+                    PR.SDone m b -> do+                        let n = 1 - m+                        assert (n <= length (x:buf)) (return ())+                        let src = Prelude.reverse (Prelude.take n (x:buf))+                        return $ Skip+                            $ ConcatParseYield+                                (Right b)+                                (ConcatParseInit OPTIONAL(i + m) src s (func b))+                    PR.SError err ->+                        return+                            $ Skip+                            $ ConcatParseYield+                                (Left (PARSE_ERROR(i + 1) err))+                                (ConcatParseInitLeftOver OPTIONAL(i + 1) [])+            Skip s ->+                return $ Skip $ ConcatParseStream OPTIONAL(i) s buf pstep pst extract+            Stop -> return $ Skip $ ConcatParseStop OPTIONAL(i) buf pstep pst extract++    -- go back to stream processing mode+    stepOuter _ (ConcatParseBuf OPTIONAL(i) [] s buf pstep ps extract) =+        return $ Skip $ ConcatParseStream OPTIONAL(i) s buf pstep ps extract++    -- buffered processing loop+    stepOuter _ (ConcatParseBuf OPTIONAL(i) (x:xs) s buf pstep pst extract) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                return $ Skip+                    $ ConcatParseBuf OPTIONAL(i + 1) xs s [] pstep pst1 extract+            PR.SPartial m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip+                    $ ConcatParseBuf OPTIONAL(i + m) src s [] pstep pst1 extract+         -- PR.SContinue 1 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1+            PR.SContinue m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip+                    $ ConcatParseBuf OPTIONAL(i + m) src s buf1 pstep pst1 extract+            -- XXX Specialize for Stop 0 common case?+            PR.SDone m b -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return $ Skip+                    $ ConcatParseYield+                        (Right b) (ConcatParseInit OPTIONAL(i + m) src s (func b))+            PR.SError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (PARSE_ERROR(i + 1) err))+                        (ConcatParseInitLeftOver OPTIONAL(i + 1) [])++    -- This is simplified ConcatParseBuf+    stepOuter _ (ConcatParseExtract OPTIONAL(i) [] buf pstep pst extract) =+        return $ Skip $ ConcatParseStop OPTIONAL(i) buf pstep pst extract++    stepOuter _ (ConcatParseExtract OPTIONAL(i) (x:xs) buf pstep pst extract) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                return $ Skip+                    $ ConcatParseExtract OPTIONAL(i + 1) xs [] pstep pst1 extract+            PR.SPartial m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src0 = Prelude.take n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip+                    $ ConcatParseExtract OPTIONAL(i + m) src [] pstep pst1 extract+            PR.SContinue 1 pst1 ->+                return $ Skip+                    $ ConcatParseExtract OPTIONAL(i + 1) xs (x:buf) pstep pst1 extract+            PR.SContinue m pst1 -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let (src0, buf1) = splitAt n (x:buf)+                    src  = Prelude.reverse src0 ++ xs+                return $ Skip+                    $ ConcatParseExtract OPTIONAL(i + m) src buf1 pstep pst1 extract+            PR.SDone 1 b ->+                 return $ Skip+                    $ ConcatParseYield+                        (Right b) (ConcatParseInitBuf OPTIONAL(i + 1) xs (func b))+            PR.SDone m b -> do+                let n = 1 - m+                assert (n <= length (x:buf)) (return ())+                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs+                return $ Skip+                    $ ConcatParseYield+                        (Right b) (ConcatParseInitBuf OPTIONAL(i + m) src (func b))+            PR.SError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (PARSE_ERROR(i + 1) err))+                        (ConcatParseInitLeftOver OPTIONAL(i + 1) [])++    -- This is simplified ConcatParseExtract+    stepOuter _ (ConcatParseStop OPTIONAL(i) buf pstep pst extract) = do+        pRes <- extract pst+        case pRes of+            PR.FContinue 0 pst1 ->+                return $ Skip $ ConcatParseStop OPTIONAL(i) buf pstep pst1 extract+            PR.FContinue m pst1 -> do+                let n = (- m)+                assert (n <= length buf) (return ())+                let (src0, buf1) = splitAt n buf+                    src  = Prelude.reverse src0+                return $ Skip+                    $ ConcatParseExtract OPTIONAL(i + m) src buf1 pstep pst1 extract+            PR.FDone 0 b -> do+                return $ Skip $+                    ConcatParseYield (Right b) (ConcatParseInitLeftOver OPTIONAL(i) [])+            PR.FDone m b -> do+                let n = (- m)+                assert (n <= length buf) (return ())+                let src = Prelude.reverse (Prelude.take n buf)+                return $ Skip $+                    ConcatParseYield+                        (Right b) (ConcatParseInitBuf OPTIONAL(i + m) src (func b))+            PR.FError err ->+                return+                    $ Skip+                    $ ConcatParseYield+                        (Left (PARSE_ERROR(i) err))+                        (ConcatParseInitLeftOver OPTIONAL(i) [])++    stepOuter _ (ConcatParseYield a next) = return $ Yield a next++{-# INLINE PARSE_BREAK #-}+PARSE_BREAK :: Monad m =>+    PR.Parser a m b -> Stream m a -> m (Either PARSE_ERROR_TYPE b, Stream m a)+PARSE_BREAK (PRD.Parser pstep initial extract) stream@(Stream step state) = do+    res <- initial+    case res of+        PRD.IPartial s ->+            go SPEC state (List []) s OPTIONAL(0)+            -- Using go0 does improve alt and manyTill benchmarks dramatically+            -- but also degrades the split/monad benchmarks equally. Needs more+            -- investigation.+            -- go0 SPEC state s COUNT(0)+        PRD.IDone b -> return (Right b, stream)+        PRD.IError err -> return (Left (PARSE_ERROR(0) err), stream)++    where++    {-# INLINE splitAt #-}+    splitAt = Stream.splitAt "Data.Stream.parseBreak"++    -- "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 OPTIONAL(i) = do+        r <- step defState st+        case r of+            Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.SPartial 1 pst1 -> go SPEC s (List []) pst1 OPTIONAL(i+1)+                        -- go0 SPEC s pst1 (i + 1)+                    PR.SPartial 0 pst1 -> go1 SPEC s x pst1 OPTIONAL(i)+                    PR.SPartial m pst1 -> do+                        let n = 1 - m+                        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 OPTIONAL(i+m)+                    PR.SContinue 1 pst1 ->+                        go SPEC s (List (x:getList buf)) pst1 OPTIONAL(i+1)+                    PR.SContinue 0 pst1 -> gobuf SPEC s buf (List [x]) pst1 OPTIONAL(i)+                    PR.SContinue m pst1 -> do+                        let n = 1 - m+                        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 OPTIONAL(i+m)+                    PR.SDone 1 b -> return (Right b, Stream step s)+                    PR.SDone m b -> do+                        let n = 1 - m+                        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.SError err -> do+                        let src = Prelude.reverse $ x:getList buf+                        return+                            ( Left (PARSE_ERROR(i+1) err)+                            , Nesting.append (fromList src) (Stream step s)+                            )++            Skip s -> go SPEC s buf pst OPTIONAL(i)+            Stop -> goStop SPEC buf pst OPTIONAL(i)++    {-+    go0 !_ st !pst i = do+        r <- step defState st+        case r of+            Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.SPartial 1 pst1 -> go0 SPEC s pst1 (i + 1)+                    PR.SPartial 0 pst1 -> go1 SPEC s x pst1 i+                    PR.SPartial _ _ -> error "Unreachable"+                    PR.SContinue 1 pst1 -> go SPEC s (List [x]) pst1 (i + 1)+                    PR.SContinue 0 pst1 -> go1 SPEC s x pst1 i+                    PR.SContinue _ _ -> error "Unreachable"+                    PR.SDone 1 b -> return (Right b, Stream step s)+                    PR.SDone 0 b ->+                        return ( Right b, StreamD.cons x (Stream step s))+                    PR.SDone _ _ -> error "Unreachable"+                    PR.SError err -> do+                        return+                            ( Left (PARSE_ERROR(i + 1) err)+                            , StreamD.cons x (Stream step s)+                            )++            Skip s -> go0 SPEC s pst i+            Stop -> goStop SPEC (List []) pst i+    -}++    go1 !_ s x !pst OPTIONAL(i) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                -- go0 SPEC s pst1 OPTIONAL(i + 1)+                go SPEC s (List []) pst1 OPTIONAL(i + 1)+            PR.SPartial 0 pst1 -> do+                go1 SPEC s x pst1 OPTIONAL(i)+            PR.SPartial m _ ->+                error $ "parseBreak: parser bug, go1: Partial m = " ++ show m+            PR.SContinue 1 pst1 ->+                go SPEC s (List [x]) pst1 OPTIONAL(i + 1)+            PR.SContinue 0 pst1 ->+                go1 SPEC s x pst1 OPTIONAL(i)+            PR.SContinue m _ -> do+                error $ "parseBreak: parser bug, go1: Continue m = " ++ show m+            PR.SDone 1 b -> do+                return (Right b, Stream step s)+            PR.SDone 0 b -> do+                return (Right b, StreamD.cons x (Stream step s))+            PR.SDone m _ -> do+                error $ "parseBreak: parser bug, go1: SDone m = " ++ show m+            PR.SError err ->+                return+                    ( Left (PARSE_ERROR(i + 1) err)+                    , Nesting.append (fromPure x) (Stream step s)+                    )++    -- gobuf !_ s (List []) (List []) !pst i = go0 SPEC s pst i+    gobuf !_ s buf (List []) !pst OPTIONAL(i) = go SPEC s buf pst OPTIONAL(i)+    gobuf !_ s buf (List (x:xs)) !pst OPTIONAL(i) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                gobuf SPEC s (List []) (List xs) pst1 OPTIONAL(i + 1)+            PR.SPartial m pst1 -> do+                let n = 1 - m+                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 OPTIONAL(i + m)+            PR.SContinue 1 pst1 ->+                gobuf SPEC s (List (x:getList buf)) (List xs) pst1 OPTIONAL(i + 1)+            PR.SContinue 0 pst1 ->+                gobuf SPEC s buf (List (x:xs)) pst1 OPTIONAL(i)+            PR.SContinue m pst1 -> do+                let n = 1 - m+                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 OPTIONAL(i + m)+            PR.SDone m b -> do+                let n = 1 - m+                assert (n <= length (x:getList buf)) (return ())+                let src0 = Prelude.take n (x:getList buf)+                    src  = Prelude.reverse src0 ++ xs+                return (Right b, Nesting.append (fromList src) (Stream step s))+            PR.SError err -> do+                let src = Prelude.reverse (getList buf) ++ x:xs+                return+                    ( Left (PARSE_ERROR(i + 1) err)+                    , Nesting.append (fromList src) (Stream step s)+                    )++    -- This is simplified gobuf+    goExtract !_ buf (List []) !pst OPTIONAL(i) = goStop SPEC buf pst OPTIONAL(i)+    goExtract !_ buf (List (x:xs)) !pst OPTIONAL(i) = do+        pRes <- pstep pst x+        case pRes of+            PR.SPartial 1 pst1 ->+                goExtract SPEC (List []) (List xs) pst1 OPTIONAL(i + 1)+            PR.SPartial m pst1 -> do+                let n = 1 - m+                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 OPTIONAL(i + m)+            PR.SContinue 1 pst1 ->+                goExtract SPEC (List (x:getList buf)) (List xs) pst1 OPTIONAL(i + 1)+            PR.SContinue 0 pst1 ->+                goExtract SPEC buf (List (x:xs)) pst1 OPTIONAL(i)+            PR.SContinue m pst1 -> do+                let n = 1 - m+                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 OPTIONAL(i + m)+            PR.SDone m b -> do+                let n = 1 - m+                assert (n <= length (x:getList buf)) (return ())+                let src0 = Prelude.take n (x:getList buf)+                    src  = Prelude.reverse src0 ++ xs+                return (Right b, fromList src)+            PR.SError err -> do+                let src = Prelude.reverse (getList buf) ++ x:xs+                return (Left (PARSE_ERROR(i + 1) err), fromList src)++    -- This is simplified goExtract+    {-# INLINE goStop #-}+    goStop _ buf pst OPTIONAL(i) = do+        pRes <- extract pst+        case pRes of+            PR.FContinue 0 pst1 -> goStop SPEC buf pst1 OPTIONAL(i)+            PR.FContinue m pst1 -> do+                let n = (- m)+                assert (n <= length (getList buf)) (return ())+                let (src0, buf1) = splitAt n (getList buf)+                    src = Prelude.reverse src0+                goExtract SPEC (List buf1) (List src) pst1 OPTIONAL(i + m)+            PR.FDone 0 b -> return (Right b, StreamD.nil)+            PR.FDone m b -> do+                let n = (- m)+                assert (n <= length (getList buf)) (return ())+                let src0 = Prelude.take n (getList buf)+                    src  = Prelude.reverse src0+                return (Right b, fromList src)+            PR.FError err -> do+                let src  = Prelude.reverse $ getList buf+                return (Left (PARSE_ERROR(i) err), fromList src)++{-# INLINE_NORMAL PARSE_BREAK_STREAMK #-}+PARSE_BREAK_STREAMK+    :: forall m a b. Monad m+    => ParserK.ParserK a m b+    -> StreamK m a+    -> m (Either PARSE_ERROR_TYPE b, StreamK m a)+PARSE_BREAK_STREAMK parser input = do+    let parserk = ParserK.runParser parser ParserK.parserDone 0 0+     in go OPTIONAL(0) [] parserk input++    where++    {-# INLINE backtrck #-}+    -- backtrck :: Int -> [a] -> StreamK m a -> (StreamK m a, [a])+    backtrck n xs stream =+        let (pre, post) = Stream.splitAt "Data.StreamK.parseBreak" n xs+         in (StreamK.append (StreamK.fromList (Prelude.reverse pre)) stream, post)++    {-# INLINE goStop #-}+    {-+    goStop+        :: OPTIONAL(Int ->)+           [a]+        -> (ParserK.Input a -> m (ParserK.Step a m b))+        -> m (Either PARSE_ERROR_TYPE b, StreamK m a)+    -}+    goStop OPTIONAL(pos) 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 OPTIONAL(pos) [] cont1 StreamK.nil+            ParserK.Partial n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= length backBuf)+                let (s1, backBuf1) = backtrck n1 backBuf StreamK.nil+                 in go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Continue 0 cont1 ->+                go OPTIONAL(pos) backBuf cont1 StreamK.nil+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= length backBuf)+                let (s1, backBuf1) = backtrck n1 backBuf StreamK.nil+                 in go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Done 0 b ->+                return (Right b, StreamK.nil)+            ParserK.Done n b -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= length backBuf)+                let (s1, _) = backtrck n1 backBuf StreamK.nil+                 in return (Right b, s1)+            ParserK.Error _n err ->+                let strm = StreamK.fromList (Prelude.reverse backBuf)+                 in return (Left (PARSE_ERROR(pos + _n) err), strm)++    {-+    yieldk+        :: OPTIONAL(Int ->)+           [a]+        -> (ParserK.Input a -> m (ParserK.Step a m b))+        -> a+        -> StreamK m a+        -> m (Either PPARSE_ERROR_TYPE b, StreamK m a)+    -}+    yieldk OPTIONAL(pos) backBuf parserk element stream = do+        pRes <- parserk (ParserK.Chunk element)+        -- NOTE: factoring out "StreamK.cons element stream" in a let statement here+        -- cause big alloc regression.+        case pRes of+            ParserK.Partial 1 cont1 -> go OPTIONAL(pos + 1) [] cont1 stream+            ParserK.Partial 0 cont1 -> go OPTIONAL(pos) [] cont1 (StreamK.cons element stream)+            ParserK.Partial n cont1 -> do -- n < 0 case+                let n1 = negate n+                    bufLen = length backBuf+                    s = StreamK.cons element stream+                assertM(n1 >= 0 && n1 <= bufLen)+                let (s1, _) = backtrck n1 backBuf s+                go OPTIONAL(pos + n) [] cont1 s1+            ParserK.Continue 1 cont1 -> go OPTIONAL(pos + 1) (element:backBuf) cont1 stream+            ParserK.Continue 0 cont1 ->+                go OPTIONAL(pos) backBuf cont1 (StreamK.cons element stream)+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                    bufLen = length backBuf+                    s = StreamK.cons element stream+                assertM(n1 >= 0 && n1 <= bufLen)+                let (s1, backBuf1) = backtrck n1 backBuf s+                go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Done 1 b -> pure (Right b, stream)+            ParserK.Done 0 b -> pure (Right b, StreamK.cons element stream)+            ParserK.Done n b -> do+                let n1 = negate n+                    bufLen = length backBuf+                    s = StreamK.cons element stream+                assertM(n1 >= 0 && n1 <= bufLen)+                let (s1, _) = backtrck n1 backBuf s+                pure (Right b, s1)+            ParserK.Error _n err ->+                let strm =+                        StreamK.append+                            (StreamK.fromList (Prelude.reverse backBuf))+                            (StreamK.cons element stream)+                 -- XXX Need to test if the +1 is correct.+                 in return (Left (PARSE_ERROR(pos + _n + 1) err), strm)++    {-+    go+        :: OPTIONAL(Int ->)+           [a]+        -> (ParserK.Input a -> m (ParserK.Step a m b))+        -> StreamK m a+        -> m (Either PARSE_ERROR_TYPE b, StreamK m a)+    -}+    go OPTIONAL(pos) backBuf parserk stream = do+        let stop = goStop OPTIONAL(pos) backBuf parserk+            single a = yieldk OPTIONAL(pos) backBuf parserk a StreamK.nil+         in StreamK.foldStream+                defState (yieldk OPTIONAL(pos) backBuf parserk) single stop stream++{-# INLINE_NORMAL PARSE_BREAK_CHUNKS #-}+PARSE_BREAK_CHUNKS+    :: (Monad m, Unbox a)+    => ParserK (Array a) m b+    -> StreamK m (Array a)+    -> m (Either PARSE_ERROR_TYPE b, StreamK m (Array a))+PARSE_BREAK_CHUNKS parser input = do+    let parserk = ParserK.runParser parser ParserK.parserDone 0 0+     in go OPTIONAL(0) [] parserk input++    where++    {-# INLINE goStop #-}+    goStop OPTIONAL(pos) 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 OPTIONAL(pos) [] cont1 StreamK.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 StreamK.nil+                 in go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Continue 0 cont1 ->+                go OPTIONAL(pos) backBuf cont1 StreamK.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 StreamK.nil+                 in go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Done 0 b ->+                return (Right b, StreamK.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 StreamK.nil+                 in return (Right b, s1)+            ParserK.Error _n err -> do+                let s1 = Prelude.foldl (flip StreamK.cons) StreamK.nil backBuf+                return (Left (PARSE_ERROR(pos + _n) err), s1)++    seekErr n len =+        error $ "parseBreak: Partial: forward seek not implemented n = "+            ++ show n ++ " len = " ++ show len++    yieldk OPTIONAL(pos) 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 OPTIONAL(pos + n) [] cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk OPTIONAL(pos + n) [] cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map Array.length backBuf)+                                s = StreamK.cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, _) = backtrack n1 backBuf s+                            go OPTIONAL(pos + n) [] cont1 s1+                    GT -> seekErr n len+            ParserK.Continue n cont1 ->+                case compare n len of+                    EQ -> go OPTIONAL(pos + n) (arr:backBuf) cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk OPTIONAL(pos + n) backBuf cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map Array.length backBuf)+                                s = StreamK.cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, backBuf1) = backtrack n1 backBuf s+                            go OPTIONAL(pos + n) 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 _n err -> do+                let s1 = Prelude.foldl (flip StreamK.cons) stream (arr:backBuf)+                return (Left (PARSE_ERROR(pos + _n + 1) err), s1)++    go OPTIONAL(pos) backBuf parserk stream = do+        let stop = goStop OPTIONAL(pos) backBuf parserk+            single a = yieldk OPTIONAL(pos) backBuf parserk a StreamK.nil+         in StreamK.foldStream+                defState (yieldk OPTIONAL(pos) backBuf parserk) single stop stream++{-# INLINE_NORMAL PARSE_BREAK_CHUNKS_GENERIC #-}+PARSE_BREAK_CHUNKS_GENERIC+    :: forall m a b. Monad m+    => ParserK.ParserK (GArray.Array a) m b+    -> StreamK m (GArray.Array a)+    -> m (Either PARSE_ERROR_TYPE b, StreamK m (GArray.Array a))+PARSE_BREAK_CHUNKS_GENERIC parser input = do+    let parserk = ParserK.runParser parser ParserK.parserDone 0 0+     in go OPTIONAL(0) [] parserk input++    where++    {-# INLINE goStop #-}+    {-+    goStop+        :: OPTIONAL(Int ->)+           [GArray.Array a]+        -> (ParserK.Input (GArray.Array a)+                -> m (ParserK.Step (GArray.Array a) m b))+        -> m (Either PARSE_ERROR_TYPE b, StreamK m (GArray.Array a))+    -}+    goStop OPTIONAL(pos) 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 OPTIONAL(pos) [] cont1 StreamK.nil+            ParserK.Partial n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map GArray.length backBuf))+                let (s1, backBuf1) = backtrackGeneric n1 backBuf StreamK.nil+                 in go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Continue 0 cont1 ->+                go OPTIONAL(pos) backBuf cont1 StreamK.nil+            ParserK.Continue n cont1 -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map GArray.length backBuf))+                let (s1, backBuf1) = backtrackGeneric n1 backBuf StreamK.nil+                 in go OPTIONAL(pos + n) backBuf1 cont1 s1+            ParserK.Done 0 b ->+                return (Right b, StreamK.nil)+            ParserK.Done n b -> do+                let n1 = negate n+                assertM(n1 >= 0 && n1 <= sum (Prelude.map GArray.length backBuf))+                let (s1, _) = backtrackGeneric n1 backBuf StreamK.nil+                 in return (Right b, s1)+            ParserK.Error _n err ->+                let strm = Prelude.foldl (flip StreamK.cons) StreamK.nil backBuf+                 in return (Left (PARSE_ERROR(pos + _n) err), strm)++    seekErr n len =+        error $ "parseBreak: Partial: forward seek not implemented n = "+            ++ show n ++ " len = " ++ show len++    {-+    yieldk+        :: OPTIONAL(Int ->)+           [GArray.Array a]+        -> (ParserK.Input (GArray.Array a)+                -> m (ParserK.Step (GArray.Array a) m b))+        -> Array a+        -> StreamK m (GArray.Array a)+        -> m (Either PARSE_ERROR_TYPE b, StreamK m (GArray.Array a))+    -}+    yieldk OPTIONAL(pos) backBuf parserk arr stream = do+        pRes <- parserk (ParserK.Chunk arr)+        let len = GArray.length arr+        case pRes of+            ParserK.Partial n cont1 ->+                case compare n len of+                    EQ -> go OPTIONAL(pos + n) [] cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk OPTIONAL(pos + n) [] cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map GArray.length backBuf)+                                s = StreamK.cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, _) = backtrackGeneric n1 backBuf s+                            go OPTIONAL(pos + n) [] cont1 s1+                    GT -> seekErr n len+            ParserK.Continue n cont1 ->+                case compare n len of+                    EQ -> go OPTIONAL(pos + n) (arr:backBuf) cont1 stream+                    LT -> do+                        if n >= 0+                        then yieldk OPTIONAL(pos + n) backBuf cont1 arr stream+                        else do+                            let n1 = negate n+                                bufLen = sum (Prelude.map GArray.length backBuf)+                                s = StreamK.cons arr stream+                            assertM(n1 >= 0 && n1 <= bufLen)+                            let (s1, backBuf1) = backtrackGeneric n1 backBuf s+                            go OPTIONAL(pos + n) backBuf1 cont1 s1+                    GT -> seekErr n len+            ParserK.Done n b -> do+                let n1 = len - n+                assertM(n1 <= sum (Prelude.map GArray.length (arr:backBuf)))+                let (s1, _) = backtrackGeneric n1 (arr:backBuf) stream+                 in return (Right b, s1)+            ParserK.Error _n err ->+                let strm = Prelude.foldl (flip StreamK.cons) stream (arr:backBuf)+                 in return (Left (PARSE_ERROR(pos + _n + 1) err), strm)++    {-+    go+        :: OPTIONAL(Int ->)+           [GArray.Array a]+        -> (ParserK.Input (GArray.Array a)+                -> m (ParserK.Step (GArray.Array a) m b))+        -> StreamK m (GArray.Array a)+        -> m (Either PARSE_ERROR_TYPE b, StreamK m (GArray.Array a))+    -}+    go OPTIONAL(pos) backBuf parserk stream = do+        let stop = goStop OPTIONAL(pos) backBuf parserk+            single a = yieldk OPTIONAL(pos) backBuf parserk a StreamK.nil+         in StreamK.foldStream+                defState (yieldk OPTIONAL(pos) backBuf parserk) single stop stream
+ src/Streamly/Internal/Data/ParserDrivers.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.ParserDrivers+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.ParserDrivers+    (+    -- * Running a Parser+      parseBreak+    , parseBreakPos+    , parseBreakStreamK+    , parseBreakStreamKPos+    , parseBreakChunks+    , parseBreakChunksPos+    , parseBreakChunksGeneric+    , parseBreakChunksGenericPos+    , parseMany+    , parseManyPos+    , parseIterate+    , parseIteratePos+    )+    where++#include "assert.hs"+#include "inline.hs"+#include "ArrayMacros.h"++import Data.Proxy (Proxy(..))+import Fusion.Plugin.Types (Fuse(..))+import GHC.Exts (SpecConstrAnnotation(..))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))+import Streamly.Internal.Data.ParserK.Type (ParserK)+import Streamly.Internal.Data.StreamK.Type (StreamK)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Unbox (Unbox(..))++import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Array.Generic.Type as GArray+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.Parser as PRD+import qualified Streamly.Internal.Data.ParserK.Type as ParserK+import qualified Streamly.Internal.Data.Stream.Type as Nesting+import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Stream.Generate as StreamD+import qualified Streamly.Internal.Data.StreamK.Type as StreamK++import Streamly.Internal.Data.Stream.Type hiding (splitAt)+import Prelude hiding (splitAt)++-- 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]}++-- 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 count buf inp+  | count < 0 = seekOver count+  -- XXX this is handled at the call site, so we can assert that here.+  | count == 0 = (inp, buf)+  | otherwise = go count buf inp++    where++    go n [] _ = seekUnder count n+    go n (x:xs) stream =+        let len = Array.length x+        in if n > len+           then go (n - len) xs (StreamK.cons x stream)+           else if n == len+           then (StreamK.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 (StreamK.cons arr1 stream, arr2:xs)++    seekOver x =+        error $ "Array.parseBreak: bug in parser, seeking ["+            ++ show (negate x)+            ++ "] elements in future"++    seekUnder x y =+        error $ "Array.parseBreak: bug in parser, backtracking ["+            ++ show x+            ++ "] elements. Goes ["+            ++ show y+            ++ "] elements beyond backtrack buffer"++{-# INLINE backtrackGeneric #-}+backtrackGeneric ::+       Int+    -> [GArray.Array a]+    -> StreamK m (GArray.Array a)+    -> (StreamK m (GArray.Array a), [GArray.Array a])+backtrackGeneric count buf inp+  | count < 0 = seekOver count+  | count == 0 = (inp, buf)+  | otherwise = go count buf inp++    where++    go n [] _ = seekUnder count n+    go n (x:xs) stream =+        let len = GArray.length x+        in if n > len+           then go (n - len) xs (StreamK.cons x stream)+           else if n == len+           then (StreamK.cons x stream, xs)+           else let arr1 = GArray.unsafeSliceOffLen (len - n) n x+                    arr2 = GArray.unsafeSliceOffLen 0 (len - n) x+                 in (StreamK.cons arr1 stream, arr2:xs)++    seekOver x =+        error $ "Array.Generic.parseBreak: bug in parser, seeking ["+            ++ show (negate x)+            ++ "] elements in future"++    seekUnder x y =+        error $ "Array.Generic.parseBreak: bug in parser, backtracking ["+            ++ show x+            ++ "] elements. Goes ["+            ++ show y+            ++ "] elements beyond backtrack buffer"++#include "ParserDrivers.h"+#define PARSER_WITH_POS+#include "ParserDrivers.h"
src/Streamly/Internal/Data/ParserK.hs view
@@ -10,7 +10,30 @@ module Streamly.Internal.Data.ParserK     (       module Streamly.Internal.Data.ParserK.Type++    -- * Deprecated+    , adaptC+    , adaptCG     ) where +import Streamly.Internal.Data.Parser (Parser)+import Streamly.Internal.Data.Array (Array)+import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.ParserK.Type++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Array.Generic as GenArray++#include "inline.hs"++{-# DEPRECATED adaptC "Use Streamly.Data.Array.toParserK" #-}+{-# INLINE_LATE adaptC #-}+adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+adaptC = Array.toParserK++{-# DEPRECATED adaptCG "Use Streamly.Data.Array.Generic.toParserK" #-}+{-# INLINE_LATE adaptCG #-}+adaptCG ::+       Monad m => Parser a m b -> ParserK (GenArray.Array a) m b+adaptCG = GenArray.toParserK
src/Streamly/Internal/Data/ParserK/Type.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Parser.ParserK.Type -- Copyright   : (c) 2020 Composewell Technologies@@ -16,29 +17,44 @@ -- 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     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Types       Step (..)     , Input (..)     , ParseResult (..)     , ParserK (..)-    , adaptC-    , adapt-    , adaptCG-    -- , toParser++    -- * Adapting from Parser+    , parserDone+    , toParserK -- XXX move to StreamK module+    , toParser -- XXX unParserK, unK, unPK++    -- * Basic Parsers     , fromPure     , fromEffect     , die++    -- * Expression Parsers+    , chainl+    , chainl1+    , chainr+    , chainr1++    -- * Deprecated+    , adapt     ) where  #include "ArrayMacros.h" #include "assert.hs"+#include "deprecation.h" #include "inline.hs"  #if !MIN_VERSION_base(4,18,0)@@ -48,20 +64,46 @@ 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 +#include "DocTestDataParserK.hs"++-------------------------------------------------------------------------------+-- Developer Notes+-------------------------------------------------------------------------------++-- MonadReader cannot be implemented using continuations for ParserK+--+-- "local" (and hence "MonadReader") cannot be implemented for ParserK because+-- there is no way to override all continuations.+--+-- We can implement `MonadReader` for ParserK via ParserD:+--+-- @+-- instance (Show r, MonadReader r m) => MonadReader r (Parser a m) where+--     {-# INLINE ask #-}+--     ask = Parser.fromEffect ask+--     {-# INLINE local #-}+--     local f (Parser step initial extract) =+--         Parser+--             ((local f .) . step)+--             (local f initial)+--             (local f . extract)+--+-- instance (Show r, MonadReader r m) => MonadReader r (ParserK a m) where+--     {-# INLINE ask #-}+--     ask = ParserK.fromEffect ask+--     {-# INLINE local #-}+--     local f parser = ParserK.adapt $ local f $ ParserK.toParser parser+-- @++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------+ -- 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.@@ -73,24 +115,46 @@ -- -- data Input a = None | Chunk {-# UNPACK #-} !(Array a) --+-- XXX Rename Chunk to Some. data Input a = None | Chunk a +-- Note: Step should ideally be called StepResult and StepParser should be just+-- Step, but then it will not be consistent with Parser/Stream.++-- 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.++-- | A parsing function that parses a single input object.+type StepParser a m r = Input a -> m (Step a m r)+ -- | 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.+-- (1) stop with a final result ('Done') with no more inputs to be accepted,+-- (2) generate an intermediate result ('Partial') and accept more inputs, (3)+-- generate no result but wait for more input ('Continue'), (4) or fail with an+-- error ('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.+-- The Int is a count by which the current stream position should be adjusted+-- before calling the next parsing step. --+-- See the documentation of 'Streamly.Data.Parser.Step' for more details, this+-- has the same semantics.+-- -- /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))+    | Partial !Int (StepParser a m r)+    | Continue !Int (StepParser a m r)+    -- The Error constructor in ParserK Step carries a count, but the 'Parser'+    -- Step does not carry a count - this is because in ParserK we can have+    -- chunked drivers which can consume multiple inputs before returning a+    -- result or error. In such cases, if an error occurs the parser has to+    -- tell us the offset where the error occurred. In case of 'Parser' type we+    -- do not have chunked drivers, we always drive it one element at a time,+    -- therefore, the offset is not required on Error, the driver already knows+    -- where we are. However, if we ever build a chunked driver for 'Parser' we+    -- will need this argument in Parser Step as well.     | Error !Int String  instance Functor m => Functor (Step a m) where@@ -104,8 +168,11 @@  -- | 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.+-- Int is the position index in the stream relative to the position on entry+-- i.e. when the parser started running. When the parser enters the position+-- index is zero. If the parser consumed n elements then the new position index+-- would be n. If the parser is backtracking then the position index would be+-- negative. -- -- /Pre-release/ --@@ -125,42 +192,46 @@ -- -- 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.+-- | A continuation passing style parser representation.++-- A parser is 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. --+-- The first argument of runParser is a continuation to be invoked after the+-- parser is done, it is of the following shape:+--+-- >>> type Cont = ParseResult b -> Int -> StepParser a m r+--+-- First argument of the continuation is the 'ParseResult'. The current stream+-- position is carried as part of the 'Success' or 'Failure' constructors of+-- 'ParseResult'. The second argument of the continuation is a count of the+-- elements used in the current alterantive in an alternative composition, if+-- the alternative fails we need to backtrack by this amount before invoking+-- the next alternative.+--+-- The second argument of runParser is the incoming stream position adjustment.+-- The parser driver needs to adjust the current position of the stream by this+-- amount before consuming further input. A positive value means move forward+-- by that much in the stream and a negative value means backward. See the+-- 'Step' and 'Streamly.Data.Parser.Step' documentation for more details.+--+-- The third argument is the incoming cumulative used element count for the+-- current alternative, same as described for the continuation above.+-- 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".+           -- Continuation to be invoked after the parser is done+           (ParseResult b -> Int -> StepParser a m r)+           -- stream position adjustment before the parser starts.         -> Int-           -- used elem count, a count of elements consumed by the parser. If-           -- an Alternative fails we need to backtrack by this amount.+           -- initial used count for the current alternative.         -> 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)+            -- final parse result, when the last continuation is done.+        -> StepParser a m r     }  -------------------------------------------------------------------------------@@ -172,9 +243,9 @@ -- | 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 ->+    fmap f parser = MkParser $ \k pos used inp ->         let k1 res = k (fmap f res)-         in runParser parser k1 n st arr+         in runParser parser k1 pos used inp  ------------------------------------------------------------------------------- -- Sequential applicative@@ -188,7 +259,7 @@ -- {-# INLINE fromPure #-} fromPure :: b -> ParserK a m b-fromPure b = MkParser $ \k n st arr -> k (Success n b) st arr+fromPure b = MkParser $ \k pos used inp -> k (Success pos b) used inp  -- | See 'Streamly.Internal.Data.Parser.fromEffect'. --@@ -197,7 +268,7 @@ {-# 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+    MkParser $ \k pos used inp -> eff >>= \b -> k (Success pos b) used inp  -- | @f \<$> p1 \<*> p2@ applies parsers p1 and p2 sequentially to an input -- stream. The first parser runs and processes the input, the remaining input@@ -213,19 +284,19 @@     (<*>) = 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+    p1 *> p2 = MkParser $ \k pos used input ->+        let k1 (Success pos1 _) u inp = runParser p2 k pos1 u inp+            k1 (Failure pos1 e) u inp = k (Failure pos1 e) u inp+        in runParser p1 k1 pos used input      {-# 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+    p1 <* p2 = MkParser $ \k pos used input ->+        let k1 (Success pos1 b) u1 inp =+                let k2 (Success pos2 _) u2 inp2 = k (Success pos2 b) u2 inp2+                    k2 (Failure pos2 e) u2 inp2 = k (Failure pos2 e) u2 inp2+                in runParser p2 k2 pos1 u1 inp+            k1 (Failure pos1 e) u1 inp = k (Failure pos1 e) u1 inp+        in runParser p1 k1 pos used input      {-# INLINE liftA2 #-}     liftA2 f p = (<*>) (fmap f p)@@ -243,7 +314,7 @@ -- {-# INLINE die #-} die :: String -> ParserK a m b-die err = MkParser (\k n st arr -> k (Failure n err) st arr)+die err = MkParser (\k pos used inp -> k (Failure pos err) used inp)  -- | Monad composition can be used for lookbehind parsers, we can dynamically -- compose new parsers based on the results of the previously parsed values.@@ -252,10 +323,10 @@     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+    p >>= f = MkParser $ \k pos used input ->+        let k1 (Success pos1 b) u1 inp = runParser (f b) k pos1 u1 inp+            k1 (Failure pos1 e) u1 inp = k (Failure pos1 e) u1 inp+         in runParser p k1 pos used input      {-# INLINE (>>) #-}     (>>) = (*>)@@ -288,11 +359,11 @@     empty = die "empty"      {-# INLINE (<|>) #-}-    p1 <|> p2 = MkParser $ \k n _ arr ->+    p1 <|> p2 = MkParser $ \k pos _ input ->         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+            k1 (Failure pos1 _) used inp = runParser p2 k (pos1 - used) 0 inp+            k1 success _ inp = k success 0 inp+        in runParser p1 k1 pos 0 input      -- some and many are implemented here instead of using default definitions     -- so that we can use INLINE on them. It gives 50% performance improvement.@@ -329,150 +400,8 @@     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+-- Make a ParserK from Parser --------------------------------------------------------------------------------  {-# INLINE adaptWith #-}@@ -480,7 +409,7 @@     :: 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))+    -> (s -> m (ParserD.Final s b))     -> (ParseResult b -> Int -> Input a -> m (Step a m r))     -> Int     -> Int@@ -490,21 +419,22 @@     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+                    -- In element parser case chunk is just one element+                    Chunk element -> parseContChunk usedCount pst element                     None -> parseContNothing usedCount pst             -- XXX Previous code was using Continue in this case-            else pure $ Partial relPos (parseCont usedCount pst)+            else+                -- We consumed previous input, need to fetch the next+                -- input from the driver.+                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@@ -512,212 +442,94 @@         where          go !_ !pst = do-            pRes <- pstep pst x-            case pRes of-                ParserD.Done 0 b ->+            r <- pstep pst x+            case r of+                -- Done, call the next continuation+                ParserD.SDone 1 b ->                     cont (Success 1 b) (count + 1) (Chunk x)-                ParserD.Done 1 b ->+                ParserD.SDone 0 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 ->+                ParserD.SDone m b -> -- n > 1+                    let n = 1 - m+                     in cont (Success (1 - n) b) (count + 1 - n) (Chunk x)++                -- Not done yet, return the parseCont continuation+                ParserD.SPartial 1 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?+                ParserD.SPartial 0 pst1 ->+                    -- XXX if we recurse we are not dropping backtrack buffer+                    -- on partial.+                    -- XXX recurse or call the driver?                     go SPEC pst1-                ParserD.Partial n pst1 ->-                    pure $ Partial (1 - n) (parseCont (count + 1 - n) pst1)-                ParserD.Continue 0 pst1 ->+                ParserD.SPartial m pst1 -> -- n > 0+                    let n = 1 - m+                     in pure $ Partial (1 - n) (parseCont (count + 1 - n) pst1)+                ParserD.SContinue 1 pst1 ->                     pure $ Continue 1 (parseCont (count + 1) pst1)-                ParserD.Continue 1 pst1 ->+                ParserD.SContinue 0 pst1 ->+                    -- XXX recurse or call the driver?                     go SPEC pst1-                ParserD.Continue n pst1 ->-                    pure $ Continue (1 - n) (parseCont (count + 1 - n) pst1)-                ParserD.Error err ->-                    -- XXX fix undefined+                ParserD.SContinue m pst1 -> -- n > 0+                    let n = 1 - m+                     in pure $ Continue (1 - n) (parseCont (count + 1 - n) pst1)++                -- SError case+                ParserD.SError err ->                     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?+            ParserD.FDone n b ->+                assert (n <= 0)+                    (cont (Success n b) (count + n) None)+            ParserD.FContinue n pst1 ->+                assert (n <= 0)+                    (return $ Continue n (parseCont (count + n) pst1))+            ParserD.FError err ->+                -- XXX It is called only when there is no input chunk. 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 (Chunk element) = parseContChunk cnt pst element     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) =+{-# INLINE_LATE toParserK #-}+toParserK, adapt :: Monad m => ParserD.Parser a m b -> ParserK a m b+toParserK (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+RENAME(adapt,toParserK) -{- ------------------------------------------------------------------------------- -- 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"+parserDone :: Applicative m =>+    ParseResult b -> Int -> Input a -> m (Step a m b)+parserDone (Success n b) _ _ =+    -- trace ("parserDone Success n: " ++ show n) $+        assert(n <= 1) `seq` pure (Done n b)+parserDone (Failure n e) _ _ =+    -- trace ("parserDone Failure n: " ++ show n) $+        assert(n <= 1) `seq` pure (Error n e) --- | Convert a CPS style 'ParserK' to a direct style 'ParserD.Parser'.+-- XXX Note that this works only for single element parsers and not for Array+-- input parsers. The asserts will fail for array parsers.+-- XXX We should move this to StreamK module along with toParserK++-- | Convert a CPS style 'ParserK' to a direct style 'Parser'. -- -- /Pre-release/ --@@ -727,26 +539,91 @@      where -    initial = pure (ParserD.IPartial (\x -> runParser parser 0 0 x parserDone))+    initial = pure (ParserD.IPartial (runParser parser parserDone 0 0))      step cont a = do-        r <- cont (Single a)+        r <- cont (Chunk 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+            Done n b -> assert (n <= 1) (ParserD.SDone n b)+            Error _ e -> ParserD.SError e+            Partial n cont1 -> assert (n <= 1) (ParserD.SPartial n cont1)+            Continue n cont1 -> assert (n <= 1) (ParserD.SContinue 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+            Done n b ->  assert (n <= 0) (return $ ParserD.FDone n b)+            Error _ e -> return $ ParserD.FError e             Partial _ cont1 -> extract cont1-            Continue n cont1 -> return $ ParserD.Continue n cont1+            Continue n cont1 ->+                assert (n <= 0) (return $ ParserD.FContinue n cont1) -{-# RULES "fromParser/toParser fusion" [2]-    forall s. toParser (fromParser s) = s #-}-{-# RULES "toParser/fromParser fusion" [2]-    forall s. fromParser (toParser s) = s #-}--}+{-# RULES "toParserK/toParser fusion" [2]+    forall s. toParser (toParserK s) = s #-}+{-# RULES "toParser/toParserK fusion" [2]+    forall s. toParserK (toParser s) = s #-}++-- | @chainl1 p op x@ parses /one/ or more occurrences of @p@, separated by+-- @op@. Returns a value obtained by a /left/ associative application of all+-- functions returned by @op@ to the values returned by @p@.+--+-- >>> num = Parser.decimal+-- >>> plus = Parser.char '+' *> pure (+)+-- >>> expr = ParserK.chainl1 (StreamK.toParserK num) (StreamK.toParserK plus)+-- >>> StreamK.parse expr $ StreamK.fromStream $ Stream.fromList "1+2+3"+-- Right 6+--+-- If you're building full expression parsers with operator precedence and+-- associativity, consider using @makeExprParser@ from the @parser-combinators@+-- package.+--+-- See also 'Streamly.Internal.Data.Parser.deintercalate'.+--+{-# INLINE chainl1 #-}+chainl1 :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a+chainl1 p op = p >>= go++    where++    go l = step l <|> pure l++    step l = do+        f <- op+        r <- p+        go (f l r)++-- | @chainl p op x@ is like 'chainl1' but allows /zero/ or more occurrences of+-- @p@, separated by @op@. If there are zero occurrences of @p@, the value @x@+-- is returned.+{-# INLINE chainl #-}+chainl :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a+chainl p op x = chainl1 p op <|> pure x++-- | Like chainl1 but parses right associative application of the operator+-- instead of left associative.+--+-- >>> num = Parser.decimal+-- >>> pow = Parser.char '^' *> pure (^)+-- >>> expr = ParserK.chainr1 (StreamK.toParserK num) (StreamK.toParserK pow)+-- >>> StreamK.parse expr $ StreamK.fromStream $ Stream.fromList "2^3^2"+-- Right 512+--+{-# INLINE chainr1 #-}+chainr1 :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> ParserK b IO a+chainr1 p op = p >>= go++    where++    go l = step l <|> pure l++    step l = do+        f <- op+        r <- chainr1 p op+        return (f l r)++-- | @chainr p op x@ is like 'chainr1' but allows /zero/ or more occurrences of+-- @p@, separated by @op@. If there are zero occurrences of @p@, the value @x@+-- is returned.+{-# INLINE chainr #-}+chainr :: ParserK b IO a -> ParserK b IO (a -> a -> a) -> a -> ParserK b IO a+chainr p op x = chainr1 p op <|> pure x
+ src/Streamly/Internal/Data/Path.hs view
@@ -0,0 +1,58 @@+-- |+-- Module      : Streamly.Internal.Data.Path+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+module Streamly.Internal.Data.Path+    (+    -- * Exceptions+      PathException (..)++    -- * Conversions+    , IsPath (..)+    )+where++import Control.Exception (Exception)+import Control.Monad.Catch (MonadThrow(..))++------------------------------------------------------------------------------+-- Exceptions+------------------------------------------------------------------------------++-- | Exceptions thrown by path operations.+newtype PathException =+    InvalidPath String+    deriving (Show, Eq)++instance Exception PathException++------------------------------------------------------------------------------+-- Conversions+------------------------------------------------------------------------------++-- XXX Swap the order of IsPath arguments?+-- XXX rename to fromBase, fromBasePath, fromOsPath?++-- | If the type @a b@ is a member of 'IsPath' it means we know how to convert+-- the type @b@ to and from the base type @a@.+--+class IsPath a b where+    -- | Like 'fromPath' but does not check the properties of 'Path'. The user+    -- is responsible to maintain the invariants enforced by the type @b@+    -- otherwise surprising behavior may result.+    --+    -- This operation provides performance and simplicity when we know that the+    -- properties of the path are already verified, for example, when we get+    -- the path from the file system or from the OS APIs.+    unsafeFromPath :: a -> b++    -- | Convert a base path type to other forms of well-typed paths. It may+    -- fail if the path does not satisfy the properties of the target type.+    --+    fromPath :: MonadThrow m => a -> m b++    -- | Convert a well-typed path to the base path type. Never fails.+    toPath :: b -> a
src/Streamly/Internal/Data/Pipe.hs view
@@ -6,268 +6,34 @@ -- Stability   : experimental -- Portability : GHC ----- There are three fundamental types in streamly. They are streams--- ("Streamly.Data.Stream"), pipes ("Streamly.Internal.Data.Pipe") and folds ("Streamly.Data.Fold").+-- There are three fundamental types that make up a stream pipeline:+--+-- * Stream: sources+-- * Scan: transformations+-- * Fold: sinks+-- -- Streams are sources or producers of values, multiple sources can be merged -- into a single source but a source cannot be split into multiple stream -- sources.  Folds are sinks or consumers, a stream can be split and -- distributed to multiple folds but the results cannot be merged back into a--- stream source again. Pipes are transformations, a stream source can be split--- and distributed to multiple pipes each pipe can apply its own transform on--- the stream and the results can be merged back into a single pipe. Pipes can--- be attached to a source to produce a source or they can be attached to a--- fold to produce a fold, or multiple pipes can be merged or zipped into a--- single pipe.+-- stream source again. Scans are simple one-to-one transformations with+-- filtering. One element cannot be transformed to multiple elements. --+-- The Pipe type is a super type of all the above, it is the most complex type.+-- All of these can be represented by a pipe. A pipe can act as a source or a+-- sink or a transformation, dynamically. A stream source can be split and+-- distributed to multiple pipes each pipe can apply its own transform on the+-- stream and the results can be merged back into a single pipe. Pipes can be+-- attached to a source to produce a source or they can be attached to a fold+-- to produce a fold, or multiple pipes can be merged or zipped into a single+-- pipe.+-- -- > import qualified Streamly.Internal.Data.Pipe as Pipe  module Streamly.Internal.Data.Pipe     (-    -- * Pipe Type       module Streamly.Internal.Data.Pipe.Type--    -- * Pipes-    -- ** Mapping-    , mapM--    {--    -- ** Filtering-    , lfilter-    , lfilterM-    -- , ldeleteBy-    -- , luniq--    {--    -- ** Mapping Filters-    , lmapMaybe-    , lmapMaybeM--    -- ** Scanning Filters-    , lfindIndices-    , lelemIndices--    -- ** Insertion-    -- | Insertion adds more elements to the stream.--    , linsertBy-    , lintersperseM--    -- ** Reordering-    , lreverse-    -}--    -- * Parsing-    -- ** Trimming-    , ltake-    -- , lrunFor -- time-    , ltakeWhile-    {--    , ltakeWhileM-    , ldrop-    , ldropWhile-    , ldropWhileM-    -}--    -- ** Splitting-    -- | Streams can be split into segments in space or in time. We use the-    -- term @chunk@ to refer to a spatial length of the stream (spatial window)-    -- and the term @session@ to refer to a length in time (time window).--    -- In imperative terms, grouped folding can be considered as a nested loop-    -- where we loop over the stream to group elements and then loop over-    -- individual groups to fold them to a single value that is yielded in the-    -- output stream.--    -- *** By Chunks-    , chunksOf-    , sessionsOf--    -- *** By Elements-    , splitBy-    , splitSuffixBy-    , splitSuffixBy'-    -- , splitPrefixBy-    , wordsBy--    -- *** By Sequences-    , splitOn-    , splitSuffixOn-    -- , splitPrefixOn-    -- , wordsOn--    -- Keeping the delimiters-    , splitOn'-    , splitSuffixOn'-    -- , splitPrefixOn'--    -- Splitting by multiple sequences-    -- , splitOnAny-    -- , splitSuffixOnAny-    -- , splitPrefixOnAny--    -- ** Grouping-    , groups-    , groupsBy-    , groupsRollingBy-    -}-----    {--    -- * Distributing-    -- |-    -- The 'Applicative' instance of a distributing 'Fold' distributes one copy-    -- of the stream to each fold and combines the results using a function.-    ---    -- @-    ---    --                 |-------Fold m a b--------|-    -- ---stream m a---|                         |---m (b,c,...)-    --                 |-------Fold m a c--------|-    --                 |                         |-    --                            ...-    -- @-    ---    -- To compute the average of numbers in a stream without going through the-    -- stream twice:-    ---    -- >>> let avg = (/) <$> FL.sum <*> fmap fromIntegral FL.length-    -- >>> FL.foldl' avg (S.enumerateFromTo 1.0 100.0)-    -- 50.5-    ---    -- The 'Semigroup' and 'Monoid' instances of a distributing fold distribute-    -- the input to both the folds and combines the outputs using Monoid or-    -- Semigroup instances of the output types:-    ---    -- >>> import Data.Monoid (Sum)-    -- >>> FL.foldl' (FL.head <> FL.last) (fmap Sum $ S.enumerateFromTo 1.0 100.0)-    -- Just (Sum {getSum = 101.0})-    ---    -- The 'Num', 'Floating', and 'Fractional' instances work in the same way.--    , tee-    , distribute--    -- * Partitioning-    -- |-    -- Direct items in the input stream to different folds using a function to-    -- select the fold. This is useful to demultiplex the input stream.-    -- , partitionByM-    -- , partitionBy-    , partition--    -- * Demultiplexing-    , demux-    -- , demuxWith-    , demux_-    -- , demuxWith_--    -- * Classifying-    , classify-    -- , classifyWith--    -- * Unzipping-    , unzip-    -- These can be expressed using lmap/lmapM and unzip-    -- , unzipWith-    -- , unzipWithM--    -- * Nested Folds-    -- , concatMap-    -- , chunksOf-    , duplicate  -- experimental--    -- * Windowed Classification-    -- | Split the stream into windows or chunks in space or time. Each window-    -- can be associated with a key, all events associated with a particular-    -- key in the window can be folded to a single result. The stream is split-    -- into windows of specified size, the window can be terminated early if-    -- the closing flag is specified in the input stream.-    ---    -- The term "chunk" is used for a space window and the term "session" is-    -- used for a time window.--    -- ** Tumbling Windows-    -- | A new window starts after the previous window is finished.-    -- , classifyChunksOf-    , classifySessionsOf--    -- ** Keep Alive Windows-    -- | The window size is extended if an event arrives within the specified-    -- window size. This can represent sessions with idle or inactive timeout.-    -- , classifyKeepAliveChunks-    , classifyKeepAliveSessions--    {--    -- ** Sliding Windows-    -- | A new window starts after the specified slide from the previous-    -- window. Therefore windows can overlap.-    , classifySlidingChunks-    , classifySlidingSessions-    -}-    -- ** Sliding Window Buffers-    -- , slidingChunkBuffer-    -- , slidingSessionBuffer--}     ) where --- import Control.Concurrent (threadDelay, forkIO, killThread)--- import Control.Concurrent.MVar (MVar, newMVar, takeMVar, putMVar)--- import Control.Exception (SomeException(..), catch, mask)--- import Control.Monad (void)--- import Control.Monad.Catch (throwM)--- import Control.Monad.IO.Class (MonadIO(..))--- import Control.Monad.Trans (lift)--- import Control.Monad.Trans.Control (control)--- import Data.Functor.Identity (Identity)--- import Data.Heap (Entry(..))--- import Data.Map.Strict (Map)--- import Data.Maybe (fromJust, isJust, isNothing)---- import Foreign.Storable (Storable(..))-import Prelude-       hiding (id, 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,-               span, splitAt, break, mapM)---- import qualified Data.Heap as H--- import qualified Data.Map.Strict as Map--- import qualified Prelude---- import Streamly.Data.Fold.Types (Fold(..)) import Streamly.Internal.Data.Pipe.Type---- import Streamly.Internal.Data.Array.Type (Array)--- import Streamly.Internal.Data.Ring (Ring)--- import Streamly.Internal.Data.Stream (Stream)--- import Streamly.Internal.Data.Time.Units--- (AbsTime, MilliSecond64(..), addToAbsTime, diffAbsTime, toRelTime,--- toAbsTime)---- import Streamly.Internal.Data.Strict---- import qualified Streamly.Internal.Data.Array.Type as A--- import qualified Streamly.Data.Stream as S--- 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----------------------------------------------------------------------------------- Pipes----------------------------------------------------------------------------------- | Lift a monadic function to a 'Pipe'.------ @since 0.7.0-{-# INLINE mapM #-}-mapM :: Monad m => (a -> m b) -> Pipe m a b-mapM f = Pipe consume undefined ()-    where-    consume _ a = do-        r <- f a-        return $ Yield r (Consume ())
src/Streamly/Internal/Data/Pipe/Type.hs view
@@ -1,5 +1,3 @@-#include "inline.hs"- -- | -- Module      : Streamly.Internal.Data.Pipe.Type -- Copyright   : (c) 2019 Composewell Technologies@@ -9,99 +7,413 @@ -- Portability : GHC  module Streamly.Internal.Data.Pipe.Type-    ( Step (..)+    (+    -- * Type+      Step (..)     , Pipe (..)-    , PipeState (..)-    , zipWith-    , tee-    , map++    -- * From folds+    , fromStream+    , fromScanr+    , fromFold+    , scanFold++    -- * Primitive Pipes+    , identity+    , map -- function?+    , mapM -- functionM?+    , filter+    , filterM++    -- * Combinators     , compose+    , teeMerge+    -- , zipWith -- teeZip     ) where -import Control.Arrow (Arrow(..))+#include "inline.hs"+-- import Control.Arrow (Arrow(..)) import Control.Category (Category(..))-import Data.Maybe (isJust)-import Prelude hiding (zipWith, map, id, unzip, null)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))+import Data.Functor ((<&>))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Scanr (Scanr(..))+import Streamly.Internal.Data.Stream.Type (Stream(..))+-- import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))+import Streamly.Internal.Data.SVar.Type (defState)  import qualified Prelude+import qualified Streamly.Internal.Data.Fold.Type as Fold+import qualified Streamly.Internal.Data.Stream.Type as Stream +import Prelude hiding (filter, zipWith, map, mapM, id, unzip, null)++-- $setup+-- >>> :m+-- >>> :set -XFlexibleContexts+-- >>> import Control.Category+--+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Pipe as Pipe+-- >>> import qualified Streamly.Internal.Data.Stream as Stream+ ------------------------------------------------------------------------------ -- Pipes ------------------------------------------------------------------------------ --- A scan is a much simpler version of pipes. A scan always produces an output--- on an input whereas a pipe does not necessarily produce an output on an--- input, it might consume multiple inputs before producing an output. That way--- it can implement filtering. Similarly, it can produce more than one output--- on an single input.+-- XXX If we do not want to change Streams, we should use "Yield b s" instead+-- of "Yield s b". Though "Yield s b" is sometimes better when using curried+-- "Yield s". "Yield b" sounds better because the verb applies to "b". ----- Therefore when two pipes are composed in parallel formation, one may run--- slower or faster than the other. If all of them are being fed from the same--- source, we may have to buffer the input to match the speeds. In case of--- scans we do not have that problem.+-- Note: We could reduce the number of constructors by using Consume | Produce+-- wrapper around the state. But when fusion does not occur, it may be better+-- to use a flat structure rather than nested to avoid more allocations. In a+-- flat structure the pointer tag from the Step constructor itself can identiy+-- any of the 5 constructors. ----- We may also need a "Stop" constructor to indicate that we are not generating--- any more values and we can have a "Done" constructor to indicate that we are--- not consuming any more values. Similarly we can have a stop with error or--- exception and a done with error or leftover values.+{-# ANN type Step Fuse #-}+data Step cs ps b =+      YieldC cs b -- ^ Yield and consume+    | SkipC cs -- ^ Skip and consume+    | Stop -- ^ when consuming, Stop means input remains unused+    -- Therefore, Stop should not be used when we are processing an input,+    -- instead use YieldP and then Stop.+    | YieldP ps b -- ^ Yield and produce+    | SkipP ps -- ^ Skip and produce++instance Functor (Step cs ps) where+    {-# INLINE fmap #-}+    fmap f (YieldC s b) = YieldC s (f b)+    fmap f (YieldP s b) = YieldP s (f b)+    fmap _ (SkipC s) = SkipC s+    fmap _ (SkipP s) = SkipP s+    fmap _ Stop = Stop++-- A pipe uses a consume function and a produce function. It can dynamically+-- switch from consume/fold mode to a produce/source mode. ----- In generator mode, Continue means no output/continue. In fold mode Continue means--- need more input to produce result. we can perhaps call it Continue instead.+-- We can upgrade a stream, fold or scan into a pipe. However, the simpler+-- types should be preferred because they can be more efficient and fuse+-- better. ---data Step s a =-      Yield a s-    | Continue s+-- The design of the Pipe type is such that the pipe decides whether it wants+-- to consume or produce, not the driver. The driver has to do what the pipe+-- dictates, if it can. The starting state of the pipe could either be+-- consuming or producing. Current implementation starts with a consuming+-- state. If the default state of the pipe is consumption state and there is no+-- input, the driver can call finalC :: cs -> m (Step cs ps b) to switch the+-- pipe to production state. The pipe can use SkipP to switch to production+-- state. If the default state of the pipe is producing state, the pipe can use+-- SkipC to switch to the consumer state. The driver can use finalP to switch+-- to consuming state.  -- | Represents a stateful transformation over an input stream of values of -- type @a@ to outputs of type @b@ in 'Monad' @m@.+--+-- The constructor is @Pipe consume produce initial@.+data Pipe m a b =+    forall cs ps. Pipe+        (cs -> a -> m (Step cs ps b))+        (ps -> m (Step cs ps b))+     -- (cs -> m (Step cs ps b)) -- finalC+     -- (ps -> m (Step cs ps b)) -- finalP+        cs                       -- Either cs ps --- A pipe uses a consume function and a produce function. It can switch from--- consume/fold mode to a produce/source mode. The first step function is a--- fold function while the seocnd one is a stream generator function.+------------------------------------------------------------------------------+-- Functor: Mapping on the output+------------------------------------------------------------------------------++-- | 'fmap' maps a pure function on a scan output. ----- We can upgrade a stream or a fold into a pipe. However, streams are more--- efficient in generation and folds are more efficient in consumption.+-- >>> Stream.toList $ Stream.pipe (fmap (+1) Pipe.identity) $ Stream.fromList [1..5::Int]+-- [2,3,4,5,6] ----- For pure transformation we can have a 'Scan' type. A Scan would be more--- efficient in zipping whereas pipes are useful for merging and zipping where--- we know buffering can occur. A Scan type can be upgraded to a pipe.+instance Functor m => Functor (Pipe m a) where+    {-# INLINE_NORMAL fmap #-}+    fmap f (Pipe consume produce cinitial) =+        Pipe consume1 produce1 cinitial++        where++        {-# INLINE_LATE consume1 #-}+        consume1 s b = fmap (fmap f) (consume s b)+        {-# INLINE_LATE produce1 #-}+        produce1 s = fmap (fmap f) (produce s)++-------------------------------------------------------------------------------+-- Category+-------------------------------------------------------------------------------++{-# ANN type ComposeConsume Fuse #-}+#if __GLASGOW_HASKELL__ >= 810+type ComposeConsume :: Type -> Type -> Type -> Type+#endif+data ComposeConsume csL psL csR =+      ComposeConsume csL csR++{-# ANN type ComposeProduce Fuse #-}+data ComposeProduce csL psL csR psR =+      ComposeProduceR csL psR+    | ComposeProduceL psL csR+    | ComposeProduceLR psL psR++-- | Series composition. Compose two pipes such that the output of the second+-- pipe is attached to the input of the first pipe. ----- XXX In general the starting state could either be for generation or for--- consumption. Currently we are only starting with a consumption state.+-- >>> Stream.toList $ Stream.pipe (Pipe.map (+1) >>> Pipe.map (+1)) $ Stream.fromList [1..5::Int]+-- [3,4,5,6,7] ----- An explicit either type for better readability of the code-data PipeState s1 s2 = Consume s1 | Produce s2+{-# INLINE_NORMAL compose #-}+compose :: Monad m => Pipe m b c -> Pipe m a b -> Pipe m a c+compose+    (Pipe consumeR produceR initialR)+    (Pipe consumeL produceL initialL) =+        Pipe consume produce (ComposeConsume initialL initialR) -isProduce :: PipeState s1 s2 -> Bool-isProduce s =-    case s of-        Produce _ -> True-        Consume _ -> False+    where -data Pipe m a b =-  forall s1 s2. Pipe (s1 -> a -> m (Step (PipeState s1 s2) b))-                     (s2 -> m (Step (PipeState s1 s2) b)) s1+    {-# INLINE consumeLFeedR #-}+    consumeLFeedR csL csR bL = do+        rR <- consumeR csR bL+        return+            $ case rR of+                YieldC csR1 br -> YieldC (ComposeConsume csL csR1) br+                SkipC csR1 -> SkipC (ComposeConsume csL csR1)+                Stop -> Stop+                YieldP psR br -> YieldP (ComposeProduceR csL psR) br+                SkipP psR -> SkipP (ComposeProduceR csL psR) -instance Monad m => Functor (Pipe m a) where-    {-# INLINE_NORMAL fmap #-}-    fmap f (Pipe consume produce initial) = Pipe consume' produce' initial-        where-        {-# INLINE_LATE consume' #-}-        consume' st a = do-            r <- consume st a-            return $ case r of-                Yield x s -> Yield (f x) s-                Continue s -> Continue s+    {-# INLINE produceLFeedR #-}+    produceLFeedR psL csR bL = do+        rR <- consumeR csR bL+        return+            $ case rR of+                YieldC csR1 br -> YieldP (ComposeProduceL psL csR1) br+                SkipC csR1 -> SkipP (ComposeProduceL psL csR1)+                Stop -> Stop+                YieldP psR br -> YieldP (ComposeProduceLR psL psR) br+                SkipP psR -> SkipP (ComposeProduceLR psL psR) -        {-# INLINE_LATE produce' #-}-        produce' st = do-            r <- produce st-            return $ case r of-                Yield x s -> Yield (f x) s-                Continue s -> Continue s+    consume (ComposeConsume csL csR) x = do+        rL <- consumeL csL x+        case rL of+            YieldC csL1 bL ->+                -- XXX Use SkipC instead? Flat may be better for fusion.+                consumeLFeedR csL1 csR bL+            SkipC csL1 -> return $ SkipC (ComposeConsume csL1 csR)+            Stop -> return Stop+            YieldP psL bL ->+                -- XXX Use SkipC instead?+                produceLFeedR psL csR bL+            SkipP psL -> return $ SkipP (ComposeProduceL psL csR) +    produce (ComposeProduceL psL csR) = do+        rL <- produceL psL+        case rL of+            YieldC csL bL ->+                -- XXX Use SkipC instead?+                consumeLFeedR csL csR bL+            SkipC csL -> return $ SkipC (ComposeConsume csL csR)+            Stop -> return Stop+            YieldP psL1 bL ->+                -- XXX Use SkipC instead?+                produceLFeedR psL1 csR bL+            SkipP psL1 -> return $ SkipP (ComposeProduceL psL1 csR)++    produce (ComposeProduceR csL psR) = do+        rR <- produceR psR+        return+            $ case rR of+                YieldC csR1 br -> YieldC (ComposeConsume csL csR1) br+                SkipC csR1 -> SkipC (ComposeConsume csL csR1)+                Stop -> Stop+                YieldP psR1 br -> YieldP (ComposeProduceR csL psR1) br+                SkipP psR1 -> SkipP (ComposeProduceR csL psR1)++    produce (ComposeProduceLR psL psR) = do+        rR <- produceR psR+        return+            $ case rR of+                YieldC csR1 br -> YieldP (ComposeProduceL psL csR1) br+                SkipC csR1 -> SkipP (ComposeProduceL psL csR1)+                Stop -> Stop+                YieldP psR1 br -> YieldP (ComposeProduceLR psL psR1) br+                SkipP psR1 -> SkipP (ComposeProduceLR psL psR1)++-- | A pipe representing mapping of a monadic action.+--+-- >>> Stream.toList $ Stream.pipe (Pipe.mapM print) $ Stream.fromList [1..5::Int]+-- 1+-- 2+-- 3+-- 4+-- 5+-- [(),(),(),(),()]+--+{-# INLINE mapM #-}+mapM :: Monad m => (a -> m b) -> Pipe m a b+mapM f = Pipe (\() a -> f a <&> YieldC ()) undefined ()++-- | A pipe representing mapping of a pure function.+--+-- >>> Stream.toList $ Stream.pipe (Pipe.map (+1)) $ Stream.fromList [1..5::Int]+-- [2,3,4,5,6]+--+{-# INLINE map #-}+map :: Monad m => (a -> b) -> Pipe m a b+map f = mapM (return Prelude.. f)++{- HLINT ignore "Redundant map" -}++-- | An identity pipe producing the same output as input.+--+-- >>> identity = Pipe.map Prelude.id+--+-- >>> Stream.toList $ Stream.pipe (Pipe.identity) $ Stream.fromList [1..5::Int]+-- [1,2,3,4,5]+--+{-# INLINE identity #-}+identity :: Monad m => Pipe m a a+identity = map Prelude.id++-- | "." composes the pipes in series.+instance Monad m => Category (Pipe m) where+    {-# INLINE id #-}+    id = identity++    {-# INLINE (.) #-}+    (.) = compose++{-# ANN type TeeMergeConsume Fuse #-}+data TeeMergeConsume csL csR+    = TeeMergeConsume !csL !csR+    | TeeMergeConsumeOnlyL !csL+    | TeeMergeConsumeOnlyR !csR++{-# ANN type TeeMergeProduce Fuse #-}+data TeeMergeProduce csL csR psL psR x+    = TeeMergeProduce !csL !csR !x+    | TeeMergeProduceL !psL !csR !x+    | TeeMergeProduceR !csL !psR+    | TeeMergeProduceOnlyL !psL+    | TeeMergeProduceOnlyR !psR++-- | Parallel composition. Distribute the input across two pipes and merge+-- their outputs.+--+-- >>> Stream.toList $ Stream.pipe (Pipe.teeMerge Pipe.identity (Pipe.map (\x -> x * x))) $ Stream.fromList [1..5::Int]+-- [1,1,2,4,3,9,4,16,5,25]+--+{-# INLINE_NORMAL teeMerge #-}+teeMerge :: Monad m => Pipe m a b -> Pipe m a b -> Pipe m a b+teeMerge (Pipe consumeL produceL initialL) (Pipe consumeR produceR initialR) =+    Pipe consume produce (TeeMergeConsume initialL initialR)++    where++    {-# INLINE feedRightOnly #-}+    feedRightOnly csR a = do+        resR <- consumeR csR a+        return+            $ case resR of+                  YieldC cs b -> YieldC (TeeMergeConsumeOnlyR cs) b+                  SkipC cs -> SkipC (TeeMergeConsumeOnlyR cs)+                  Stop -> Stop+                  YieldP ps b -> YieldP (TeeMergeProduceOnlyR ps) b+                  SkipP ps -> SkipP (TeeMergeProduceOnlyR ps)++    {-# INLINE_LATE consume #-}+    consume (TeeMergeConsume csL csR) a = do+        resL <- consumeL csL a+        case resL of+              YieldC cs b -> return $ YieldP (TeeMergeProduce cs csR a) b+              SkipC cs -> return $ SkipP (TeeMergeProduce cs csR a)+              Stop ->+                -- XXX Skip to a state instead?+                feedRightOnly csR a+              YieldP ps b -> return $ YieldP (TeeMergeProduceL ps csR a) b+              SkipP ps -> return $ SkipP (TeeMergeProduceL ps csR a)++    -- XXX Adding additional consume states causes 4x regression in+    -- All.Data.Stream/o-1-space.pipesX4.tee benchmark (mapM 4 times).+    -- Commenting these two states makes it 4x faster. Need to investigate why.+    consume (TeeMergeConsumeOnlyL csL) a = do+        resL <- consumeL csL a+        return+            $ case resL of+                  YieldC cs b -> YieldC (TeeMergeConsumeOnlyL cs) b+                  SkipC cs -> SkipC (TeeMergeConsumeOnlyL cs)+                  Stop -> Stop+                  YieldP ps b -> YieldP (TeeMergeProduceOnlyL ps) b+                  SkipP ps -> SkipP (TeeMergeProduceOnlyL ps)+    consume (TeeMergeConsumeOnlyR csR) a = feedRightOnly csR a++    {-# INLINE_LATE produce #-}+    produce (TeeMergeProduce csL csR a) = do+        res <- consumeR csR a+        return+            $ case res of+                  YieldC cs b -> YieldC (TeeMergeConsume csL cs) b+                  SkipC cs -> SkipC (TeeMergeConsume csL cs)+                  Stop -> SkipC (TeeMergeConsumeOnlyL csL)+                  YieldP ps b -> YieldP (TeeMergeProduceR csL ps) b+                  SkipP ps -> SkipP (TeeMergeProduceR csL ps)++    produce (TeeMergeProduceL psL csR a) = do+        res <- produceL psL+        case res of+              YieldC cs b -> return $ YieldP (TeeMergeProduce cs csR a) b+              SkipC cs -> return $ SkipP (TeeMergeProduce cs csR a)+              Stop -> feedRightOnly csR a+              YieldP ps b -> return $ YieldP (TeeMergeProduceL ps csR a) b+              SkipP ps -> return $ SkipP (TeeMergeProduceL ps csR a)++    produce (TeeMergeProduceR csL psR) = do+        res <- produceR psR+        return $ case res of+              YieldC cs b -> YieldC (TeeMergeConsume csL cs) b+              SkipC cs -> SkipC (TeeMergeConsume csL cs)+              Stop -> SkipC (TeeMergeConsumeOnlyL csL)+              YieldP ps b -> YieldP (TeeMergeProduceR csL ps) b+              SkipP ps -> SkipP (TeeMergeProduceR csL ps)++    produce (TeeMergeProduceOnlyL psL) = do+        resL <- produceL psL+        return+            $ case resL of+                  YieldC cs b -> YieldC (TeeMergeConsumeOnlyL cs) b+                  SkipC cs -> SkipC (TeeMergeConsumeOnlyL cs)+                  Stop -> Stop+                  YieldP ps b -> YieldP (TeeMergeProduceOnlyL ps) b+                  SkipP ps -> SkipP (TeeMergeProduceOnlyL ps)++    produce (TeeMergeProduceOnlyR psR) = do+        resL <- produceR psR+        return+            $ case resL of+                  YieldC cs b -> YieldC (TeeMergeConsumeOnlyR cs) b+                  SkipC cs -> SkipC (TeeMergeConsumeOnlyR cs)+                  Stop -> Stop+                  YieldP ps b -> YieldP (TeeMergeProduceOnlyR ps) b+                  SkipP ps -> SkipP (TeeMergeProduceOnlyR ps)++-- | '<>' composes the pipes in parallel.+instance Monad m => Semigroup (Pipe m a b) where+    {-# INLINE (<>) #-}+    (<>) = teeMerge++-------------------------------------------------------------------------------+-- Arrow+-------------------------------------------------------------------------------++{-+unzip :: Pipe m a x -> Pipe m b y -> Pipe m (a, b) (x, y)+unzip = undefined+ -- XXX move this to a separate module data Deque a = Deque [a] [a] @@ -124,6 +436,8 @@         h : t -> Just (h, Deque [] t)         _ -> Nothing +-- XXX This is old code retained for reference until rewritten.+ -- | The composed pipe distributes the input to both the constituent pipes and -- zips the output of the two using a supplied zipping function. --@@ -251,193 +565,164 @@      (<*>) = zipWith id --- | The composed pipe distributes the input to both the constituent pipes and--- merges the outputs of the two.------ @since 0.7.0-{-# INLINE_NORMAL tee #-}-tee :: Monad m => Pipe m a b -> Pipe m a b -> Pipe m a b-tee (Pipe consumeL produceL stateL) (Pipe consumeR produceR stateR) =-        Pipe consume produce state+instance Monad m => Arrow (Pipe m) where+    {-# INLINE arr #-}+    arr = map++    {-# INLINE (***) #-}+    (***) = unzip++    {-# INLINE (&&&) #-}+    -- (&&&) = zipWith (,)+    (&&&) = undefined+-}++-------------------------------------------------------------------------------+-- Primitive pipes+-------------------------------------------------------------------------------++-- | A filtering pipe using a monadic predicate.+{-# INLINE filterM #-}+filterM :: Monad m => (a -> m Bool) -> Pipe m a a+filterM f = Pipe (\() a -> f a >>= g a) undefined ()+     where -    state = Tuple' (Consume stateL) (Consume stateR)+    {-# INLINE g #-}+    g a b =+        return+            $ if b+              then YieldC () a+              else SkipC () -    consume (Tuple' sL sR) a =-        case sL of-            Consume st -> do-                r <- consumeL st a-                return $ case r of-                    Yield x s -> Yield x (Produce (Tuple3' (Just a) s sR))-                    Continue s -> Continue (Produce (Tuple3' (Just a) s sR))-            -- XXX we should never come here unless the initial state of the-            -- first pipe is set to "Right".-            Produce _st -> undefined -- do-            {--                r <- produceL st-                return $ case r of-                    Yield x s -> Yield x (Right (Tuple3' (Just a) s sR))-                    Continue s -> Continue (Right (Tuple3' (Just a) s sR))-                -}+-- | A filtering pipe using a pure predicate.+--+-- >>> Stream.toList $ Stream.pipe (Pipe.filter odd) $ Stream.fromList [1..5::Int]+-- [1,3,5]+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Pipe m a a+filter f = filterM (return Prelude.. f) -    produce (Tuple3' (Just a) sL sR) =-        case sL of-            Consume _ ->-                case sR of-                    Consume st -> do-                        r <- consumeR st a-                        let nextL s = Consume (Tuple' sL s)-                        let nextR s = Produce (Tuple3' Nothing sL s)-                        return $ case r of-                            Yield x s@(Consume _) -> Yield x (nextL s)-                            Yield x s@(Produce _) -> Yield x (nextR s)-                            Continue s@(Consume _) -> Continue (nextL s)-                            Continue s@(Produce _) -> Continue (nextR s)-                    -- We will never come here unless the initial state of-                    -- second pipe is set to "Right".-                    Produce _ -> undefined-            Produce st -> do-                r <- produceL st-                let next s = Produce (Tuple3' (Just a) s sR)-                return $ case r of-                    Yield x s -> Yield x (next s)-                    Continue s -> Continue (next s)+-------------------------------------------------------------------------------+-- Convert folds to pipes+------------------------------------------------------------------------------- -    produce (Tuple3' Nothing sL sR) =-        case sR of-            Consume _ -> undefined -- should never occur-            Produce st -> do-                r <- produceR st-                return $ case r of-                    Yield x s@(Consume _) ->-                        Yield x (Consume (Tuple' sL s))-                    Yield x s@(Produce _) ->-                        Yield x (Produce (Tuple3' Nothing sL s))-                    Continue s@(Consume _) ->-                        Continue (Consume (Tuple' sL s))-                    Continue s@(Produce _) ->-                        Continue (Produce (Tuple3' Nothing sL s))+-- Note when we have a separate Scan type then we can remove extract from+-- Folds. Then folds can only be used for foldMany or many and not for+-- scanning. This combinator has to be removed then. -instance Monad m => Semigroup (Pipe m a b) where-    {-# INLINE (<>) #-}-    (<>) = tee+-- XXX The way filter is implemented in Folds is that it discards the input and+-- on "extract" it will return the previous accumulator value only. Thus the+-- accumulator may repeat in the output stream when filter is used. Ideally the+-- output stream should not have a value corresponding to the filtered value.+-- With "Continue s" and "Partial s b" instead of using "extract" we can do+-- that. --- | Lift a pure function to a 'Pipe'.+{-# ANN type FromFoldConsume Fuse #-}+#if __GLASGOW_HASKELL__ >= 810+type FromFoldConsume :: Type -> Type -> Type+#endif+data FromFoldConsume s x = FoldConsumeInit | FoldConsumeGo s++{-# ANN type FromFoldProduce Fuse #-}+data FromFoldProduce s x = FoldProduceInit s x | FoldProduceStop++-- XXX This should be removed once we remove "extract" from folds.++-- | Pipes do not support finalization yet. This does not finalize the fold+-- when the stream stops before the fold terminates. So cannot be used on folds+-- that require finalization. ----- @since 0.7.0-{-# INLINE map #-}-map :: Monad m => (a -> b) -> Pipe m a b-map f = Pipe consume undefined ()+-- >>> Stream.toList $ Stream.pipe (Pipe.scanFold Fold.sum) $ Stream.fromList [1..5::Int]+-- [1,3,6,10,15]+--+{-# INLINE scanFold #-}+scanFold :: Monad m => Fold m a b -> Pipe m a b+scanFold (Fold fstep finitial fextract _) =+    Pipe consume produce FoldConsumeInit+     where-    consume _ a = return $ Yield (f a) (Consume ()) -{---- | A hollow or identity 'Pipe' passes through everything that comes in.------ @since 0.7.0-{-# INLINE id #-}-id :: Monad m => Pipe m a a-id = map Prelude.id--}+    -- XXX make the initial state Either type and start in produce mode+    consume FoldConsumeInit x = do+        r <- finitial+        return $ case r of+            Fold.Partial s -> SkipP (FoldProduceInit s x)+            Fold.Done b -> YieldP FoldProduceStop b --- | Compose two pipes such that the output of the second pipe is attached to--- the input of the first pipe.+    consume (FoldConsumeGo st) a = do+        r <- fstep st a+        case r of+            Fold.Partial s -> do+                b <- fextract s+                return $ YieldC (FoldConsumeGo s) b+            Fold.Done b -> return $ YieldP FoldProduceStop b++    produce (FoldProduceInit st x) = consume (FoldConsumeGo st) x+    produce FoldProduceStop = return Stop++-- XXX The doctest for Pipe.fromFold fails with "[]" as the result.++-- | Create a singleton pipe from a fold. ----- @since 0.7.0-{-# INLINE_NORMAL compose #-}-compose :: Monad m => Pipe m b c -> Pipe m a b -> Pipe m a c-compose (Pipe consumeL produceL stateL) (Pipe consumeR produceR stateR) =-    Pipe consume produce state+-- Pipes do not support finalization yet. This does not finalize the fold+-- when the stream stops before the fold terminates. So cannot be used on folds+-- that require such finalization.+--+-- >> Stream.toList $ Stream.pipe (Pipe.fromFold Fold.sum) $ Stream.fromList [1..5::Int]+-- [15]+--+{-# INLINE fromFold #-}+fromFold :: Monad m => Fold m a b -> Pipe m a b+fromFold (Fold fstep finitial _ _) =+    Pipe consume produce FoldConsumeInit      where -    state = Tuple' (Consume stateL) (Consume stateR)+    -- XXX make the initial state Either type and start in produce mode+    consume FoldConsumeInit x = do+        r <- finitial+        return $ case r of+            Fold.Partial s -> SkipP (FoldProduceInit s x)+            Fold.Done b -> YieldP FoldProduceStop b -    consume (Tuple' sL sR) a =-        case sL of-            Consume stt ->-                case sR of-                    Consume st -> do-                        rres <- consumeR st a-                        case rres of-                            Yield x sR' -> do-                                let next s =-                                        if isProduce sR'-                                        then Produce s-                                        else Consume s-                                lres <- consumeL stt x-                                return $ case lres of-                                    Yield y s1@(Consume _) ->-                                        Yield y (next $ Tuple' s1 sR')-                                    Yield y s1@(Produce _) ->-                                        Yield y (Produce $ Tuple' s1 sR')-                                    Continue s1@(Consume _) ->-                                        Continue (next $ Tuple' s1 sR')-                                    Continue s1@(Produce _) ->-                                        Continue (Produce $ Tuple' s1 sR')-                            Continue s1@(Consume _) ->-                                return $ Continue (Consume $ Tuple' sL s1)-                            Continue s1@(Produce _) ->-                                return $ Continue (Produce $ Tuple' sL s1)-                    Produce _ -> undefined-            -- XXX we should never come here unless the initial state of the-            -- first pipe is set to "Right".-            Produce _ -> undefined+    consume (FoldConsumeGo st) a = do+        r <- fstep st a+        return $ case r of+            Fold.Partial s -> SkipC (FoldConsumeGo s)+            Fold.Done b -> YieldP FoldProduceStop b -    -- XXX we need to write the code in mor optimized fashion. Use Continue-    -- more and less yield points.-    produce (Tuple' sL sR) =-        case sL of-            Produce st -> do-                r <- produceL st-                let next s = if isProduce sR then Produce s else Consume s-                return $ case r of-                    Yield x s@(Consume _) -> Yield x (next $ Tuple' s sR)-                    Yield x s@(Produce _) -> Yield x (Produce $ Tuple' s sR)-                    Continue s@(Consume _) -> Continue (next $ Tuple' s sR)-                    Continue s@(Produce _) -> Continue (Produce $ Tuple' s sR)-            Consume stt ->-                case sR of-                    Produce st -> do-                        rR <- produceR st-                        case rR of-                            Yield x sR' -> do-                                let next s =-                                        if isProduce sR'-                                        then Produce s-                                        else Consume s-                                rL <- consumeL stt x-                                return $ case rL of-                                    Yield y s1@(Consume _) ->-                                        Yield y (next $ Tuple' s1 sR')-                                    Yield y s1@(Produce _) ->-                                        Yield y (Produce $ Tuple' s1 sR')-                                    Continue s1@(Consume _) ->-                                        Continue (next $ Tuple' s1 sR')-                                    Continue s1@(Produce _) ->-                                        Continue (Produce $ Tuple' s1 sR')-                            Continue s1@(Consume _) ->-                                return $ Continue (Consume $ Tuple' sL s1)-                            Continue s1@(Produce _) ->-                                return $ Continue (Produce $ Tuple' sL s1)-                    Consume _ -> return $ Continue (Consume $ Tuple' sL sR)+    produce (FoldProduceInit st x) = consume (FoldConsumeGo st) x+    produce FoldProduceStop = return Stop -instance Monad m => Category (Pipe m) where-    {-# INLINE id #-}-    id = map Prelude.id+-- | Produces the stream on consuming ().+--+{-# INLINE fromStream #-}+fromStream :: Monad m => Stream m a -> Pipe m () a+fromStream (Stream step state) = Pipe consume produce () -    {-# INLINE (.) #-}-    (.) = compose+    where -unzip :: Pipe m a x -> Pipe m b y -> Pipe m (a, b) (x, y)-unzip = undefined+    -- XXX make the initial state Either type and start in produce mode+    consume () () = return $ SkipP state -instance Monad m => Arrow (Pipe m) where-    {-# INLINE arr #-}-    arr = map+    produce st = do+        r <- step defState st+        return $ case r of+            Stream.Yield b s -> YieldP s b+            Stream.Skip s -> SkipP s+            Stream.Stop -> Stop -    {-# INLINE (***) #-}-    (***) = unzip+{-# INLINE fromScanr #-}+fromScanr :: Monad m => Scanr m a b -> Pipe m a b+fromScanr (Scanr step initial) = Pipe consume undefined initial -    {-# INLINE (&&&) #-}-    (&&&) = zipWith (,)+    where++    consume st a = do+        r <- step st a+        return $ case r of+            Stream.Yield b s -> YieldC s b+            Stream.Skip s -> SkipC s+            Stream.Stop -> Stop
src/Streamly/Internal/Data/Producer/Source.hs view
@@ -36,7 +36,8 @@ import Control.Exception (assert) import GHC.Exts (SpecConstrAnnotation(..)) import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Parser (ParseError(..), Step(..))+import Streamly.Internal.Data.Parser+    (ParseError(..), ParseErrorPos(..), Step(..), Final(..)) import Streamly.Internal.Data.Producer.Type (Producer(..)) import Streamly.Internal.Data.Stream.Step (Step(..)) @@ -115,7 +116,7 @@     ParserD.Parser a m b     -> Producer m (Source s a) a     -> Source s a-    -> m (Either ParseError b, Source s a)+    -> m (Either ParseErrorPos b, Source s a) parse     (ParserD.Parser pstep initial extract)     (Producer ustep uinject uextract)@@ -125,134 +126,144 @@     case res of         ParserD.IPartial s -> do             state <- uinject seed-            go SPEC state (List []) s+            go SPEC state (List []) s 0         ParserD.IDone b -> return (Right b, seed)-        ParserD.IError err -> return (Left (ParseError err), seed)+        ParserD.IError err -> return (Left (ParseErrorPos 0 err), seed)      where      -- 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+    go !_ st buf !pst i = do         r <- ustep st         case r of             Yield x s -> do                 pRes <- pstep pst x                 case pRes of-                    Partial 0 pst1 -> go SPEC s (List []) pst1-                    Partial n pst1 -> do+                    SPartial 1 pst1 -> go SPEC s (List []) pst1 i+                    SPartial m pst1 -> do+                        let n = 1 - m                         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-                    Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1-                    Continue n pst1 -> do+                        gobuf SPEC s (List []) (List src) pst1 (i + 1 - n)+                    SContinue 1 pst1 -> go SPEC s (List (x:getList buf)) pst1 (i + 1)+                    SContinue m pst1 -> do+                        let n = 1 - m                         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-                    Done n b -> do+                        gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n)+                    SDone m b -> do+                        let n = 1 - m                         assert (n <= length (x:getList buf)) (return ())                         let src0 = Prelude.take n (x:getList buf)                             src  = Prelude.reverse src0                         s1 <- uextract s                         return (Right b, unread src s1)-                    Error err -> do+                    SError err -> do                         s1 <- uextract s                         let src  = Prelude.reverse (getList buf)                         return-                            ( Left (ParseError err)+                            ( Left (ParseErrorPos (i + 1) err)                             , unread (src ++ [x]) s1                             )-            Skip s -> go SPEC s buf pst-            Stop -> goStop buf pst+            Skip s -> go SPEC s buf pst i+            Stop -> goStop buf pst i -    gobuf !_ s buf (List []) !pst = go SPEC s buf pst-    gobuf !_ s buf (List (x:xs)) !pst = do+    gobuf !_ s buf (List []) !pst i = go SPEC s buf pst i+    gobuf !_ s buf (List (x:xs)) !pst i = do         pRes <- pstep pst x         case pRes of-            Partial 0 pst1 ->-                gobuf SPEC s (List []) (List xs) pst1-            Partial n pst1 -> do+            SPartial 1 pst1 ->+                gobuf SPEC s (List []) (List xs) pst1 (i + 1)+            SPartial m pst1 -> do+                let n = 1 - m                 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-            Continue 0 pst1 ->-                gobuf SPEC s (List (x:getList buf)) (List xs) pst1-            Continue n pst1 -> do+                gobuf SPEC s (List []) (List src) pst1 (i + 1 - n)+            SContinue 1 pst1 ->+                gobuf SPEC s (List (x:getList buf)) (List xs) pst1 (i + 1)+            SContinue m pst1 -> do+                let n = 1 - m                 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-            Done n b -> do+                gobuf SPEC s (List buf1) (List src) pst1 (i + 1 - n)+            SDone m b -> do+                let n = 1 - m                 assert (n <= length (x:getList buf)) (return ())                 let src0 = Prelude.take n (x:getList buf)                     src  = Prelude.reverse src0                 s1 <- uextract s                 return (Right b, unread src s1)-            Error err -> do+            SError err -> do                     s1 <- uextract s                     let src  = Prelude.reverse (getList buf)                     return-                        ( Left (ParseError err)+                        ( Left (ParseErrorPos (i + 1) err)                         , unread (src ++ (x:xs)) s1                         )      -- This is a simplified gobuf-    goExtract !_ buf (List []) !pst = goStop buf pst-    goExtract !_ buf (List (x:xs)) !pst = do+    goExtract !_ buf (List []) !pst i = goStop buf pst i+    goExtract !_ buf (List (x:xs)) !pst i = do         pRes <- pstep pst x         case pRes of-            Partial 0 pst1 ->-                goExtract SPEC (List []) (List xs) pst1-            Partial n pst1 -> do+            SPartial 1 pst1 ->+                goExtract SPEC (List []) (List xs) pst1 (i + 1)+            SPartial m pst1 -> do+                let n = 1 - m                 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-            Continue 0 pst1 ->-                goExtract SPEC (List (x:getList buf)) (List xs) pst1-            Continue n pst1 -> do+                goExtract SPEC (List []) (List src) pst1 (i + 1 - n)+            SContinue 1 pst1 ->+                goExtract SPEC (List (x:getList buf)) (List xs) pst1 (i + 1)+            SContinue m pst1 -> do+                let n = 1 - m                 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-            Done n b -> do+                goExtract SPEC (List buf1) (List src) pst1 (i + 1 - n)+            SDone m b -> do+                let n = 1 - m                 assert (n <= length (x:getList buf)) (return ())                 let src0 = Prelude.take n (x:getList buf)                     src  = Prelude.reverse src0                 return (Right b, unread src (source Nothing))-            Error err -> do+            SError err -> do                     let src  = Prelude.reverse (getList buf)                     return-                        ( Left (ParseError err)+                        ( Left (ParseErrorPos (i + 1) err)                         , unread (src ++ (x:xs)) (source Nothing)                         )      -- This is a simplified goExtract     {-# INLINE goStop #-}-    goStop buf pst = do+    goStop buf pst i = do         pRes <- extract pst         case pRes of-            Partial _ _ -> error "Bug: parseD: Partial in extract"-            Continue 0 pst1 ->-                goStop buf pst1-            Continue n pst1 -> do+            FContinue 0 pst1 ->+                goStop buf pst1 i+            FContinue m pst1 -> do+                let n = (- m)                 assert (n <= length (getList buf)) (return ())                 let (src0, buf1) = splitAt n (getList buf)                     src = Prelude.reverse src0-                goExtract SPEC (List buf1) (List src) pst1-            Done 0 b -> return (Right b, source Nothing)-            Done n b -> do+                goExtract SPEC (List buf1) (List src) pst1 (i - n)+            FDone 0 b -> return (Right b, source Nothing)+            FDone m b -> do+                let n = (- m)                 assert (n <= length (getList buf)) (return ())                 let src0 = Prelude.take n (getList buf)                     src  = Prelude.reverse src0                 return (Right b, unread src (source Nothing))-            Error err -> do+            FError err -> do                 let src  = Prelude.reverse (getList buf)-                return (Left (ParseError err), unread src (source Nothing))+                return (Left (ParseErrorPos i 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
@@ -40,6 +40,10 @@ -- Type ------------------------------------------------------------------------------ +-- Note that this type cannot be made a Functor on the seed/result type because+-- that requires bi-directional mapping between the two types, see translate+-- and lmap below.+ -- | A @Producer m a b@ is a generator of a stream of values of type @b@ from a -- seed of type 'a' in 'Monad' @m@. --
− src/Streamly/Internal/Data/Ring.hs 
@@ -1,619 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Ring--- 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(..)--    -- * 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.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)--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-    { 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 <- 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 
@@ -1,185 +0,0 @@--- |--- 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/RingArray.hs view
@@ -0,0 +1,963 @@+-- |+-- Module      : Streamly.Internal.Data.RingArray+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Unboxed, mutable ring arrays of fixed size. In case you need to expand the+-- size of a ring, copy it to a MutArray, expand the array and cast it back to+-- ring.++-- XXX Write benchmarks++module Streamly.Internal.Data.RingArray+    ( RingArray (..)+    , Ring++    -- * Debugging+    , showRing++    -- * Construction+    , createOfLast+    , castMutArray+    , castMutArrayWith+    , unsafeCastMutArray+    , unsafeCastMutArrayWith++    -- * Moving the Head+    , moveForward+    , moveReverse+    , moveBy++    -- * In-place Mutation+    , insert+    , replace+    , replace_+    , putIndex+    , modifyIndex++    -- * Random Access+    , getIndex+    , unsafeGetIndex+    , unsafeGetHead++    -- * Conversion+    , toList+    , toMutArray++    -- * Streams+    , read+    , readRev++    -- * Unfolds+    , reader+    , readerRev++    -- * Size+    , length+    , byteLength++    -- * Casting+    , cast+    , unsafeCast+    , asBytes+    , asMutArray+    , asMutArray_++    -- * Folds+    , foldlM'+    , fold++    -- * Stream of Rings+    , ringsOf+    , scanRingsOf+    , scanCustomFoldRingsBy+    , scanFoldRingsBy++    -- * Fast Byte Comparisons+    , eqArray+    , eqArrayN++    -- * Deprecated+    , unsafeFoldRing+    , unsafeFoldRingM+    , unsafeFoldRingNM+    , unsafeFoldRingFullM+    , slidingWindow+    , slidingWindowWith+    ) where++#include "ArrayMacros.h"+#include "inline.hs"++import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Proxy (Proxy(..))+import Data.Word (Word8)+import Fusion.Plugin.Types (Fuse(..))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Array.Type (Array)+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)+import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)+import Streamly.Internal.Data.Scanl.Type (Scanl(..))+import Streamly.Internal.Data.Stream.Step (Step(..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..))+import Streamly.Internal.Data.Unbox (Unbox(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Fold.Type as Fold+import qualified Streamly.Internal.Data.MutArray.Type as MutArray+import qualified Streamly.Internal.Data.MutByteArray.Type as MutByteArray+import qualified Streamly.Internal.Data.Scanl.Type as Scanl+import qualified Streamly.Internal.Data.Stream.Transform as Stream+import qualified Streamly.Internal.Data.Stream.Type as Stream+-- import qualified Streamly.Internal.Data.Unfold as Unfold+-- XXX check split benchmarks++import Prelude hiding (length, concat, read)++-- $setup+-- >>> :m+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.MutArray as MutArray+-- >>> import qualified Streamly.Internal.Data.RingArray as RingArray+-- >>> import qualified Streamly.Internal.Data.Stream as Stream++-- XXX Need a feature in GHC to disable positional constructors for record+-- types, so that we can safely reorder the fields.+--+-- Empty (zero-sized) rings are not allowed in construction routines though the+-- code supports it. We can allow it if there is a compelling use case.+--+-- We could represent a ring as a tuple of array and ring head (MutArray a,+-- Int). The array never changes, only the head does so the array can be passed+-- as a constant in a loop.+--+-- Performance notes: Replacing the oldest item with the newest is a very+-- common operation, during this operation the only thing that changes is the+-- ring head. Updating the RingArray constructor because of that could be expensive,+-- therefore, either the RingArray constructor should be eliminated via fusion or we+-- should unbox it manually where needed to allow for only the head to change.++-- | A ring buffer is a circular buffer. A new element is inserted at a+-- position called the ring head which points to the oldest element in the+-- ring, an insert overwrites the oldest element. After inserting, the head is+-- moved to point to the next element which is now the oldest element.+--+-- Elements in the ring are indexed relative to the head. RingArray head is+-- designated as the index 0 of the ring buffer, it points to the oldest or the+-- first element in the buffer. Higher positive indices point to the newer+-- elements in the buffer. Index @-1@ points to the newest or the last element+-- in the buffer. Higher negative indices point to older elements.+--+-- The ring is of fixed size and cannot be expanded or reduced after creation.+-- Creation of zero sized rings is not allowed.+--+-- This module provides an unboxed implementation of ring buffers for best+-- performance.+--+data RingArray a = RingArray+    { ringContents :: {-# UNPACK #-} !MutByteArray+    , ringSize :: {-# UNPACK #-} !Int -- size of array in bytes+    , ringHead :: {-# UNPACK #-} !Int -- byte index in the array+    }++{-# DEPRECATED Ring "Please use RingArray instead." #-}+type Ring = RingArray++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- | Given byte offset relative to the ring head, compute the linear byte+-- offset in the array. Offset can be positive or negative. Invariants:+--+-- * RingArray size cannot be zero, this won't work correctly if so.+-- * Absolute value of offset must be less than or equal to the ring size.+-- * Offset must be integer multiple of element size.+{-# INLINE unsafeChangeHeadByOffset #-}+unsafeChangeHeadByOffset :: Int -> Int -> Int -> Int+unsafeChangeHeadByOffset rh rs i =+    let i1 = rh + i+     in if i1 >= rs+        then i1 - rs+        else if i1 < 0+             then i1 + rs+             else i1++-- | Convert a byte offset relative to the ring head to a byte offset in the+-- underlying mutable array. Offset can be positive or negative.+--+-- Throws an error if the offset is greater than or equal to the ring size.+{-# INLINE changeHeadByOffset #-}+changeHeadByOffset :: Int -> Int -> Int -> Int+changeHeadByOffset rh rs i =+    if i < rs && i > -rs+    then unsafeChangeHeadByOffset rh rs i+    else error $ "changeHeadByOffset: absolute value of offset must be less "+            ++ "than the ring size"++-- | Move the ring head forward or backward by n slots. Moves forward if the+-- argument is positive and backward if it is negative.+--+-- Throws an error if the absolute value of count is more than or euqal to the+-- ring size.+{-# INLINE moveBy #-}+moveBy :: forall a. Unbox a => Int -> RingArray a -> RingArray a+moveBy n rb =+    let i = changeHeadByOffset (ringHead rb) (ringSize rb) (n * SIZE_OF(a))+     in rb {ringHead = i}++-- | the offset must be exactly the element size in bytes.+{-# INLINE incrHeadByOffset #-}+incrHeadByOffset :: Int -> Int -> Int -> Int+incrHeadByOffset rh rs n =+    -- Note: This works even if the ring size is 0.+    let rh1 = rh + n+     -- greater than is needed when rs = 0+     in if rh1 >= rs+        then 0+        else rh1++-- | Advance the ring head forward by 1 slot, the ring head will now point to+-- the next (newer) item, and the old ring head position will become the latest+-- or the newest item position.+--+-- >>> moveForward = RingArray.moveBy 1+--+{-# INLINE moveForward #-}+moveForward :: forall a. Unbox a => RingArray a -> RingArray a+moveForward rb@RingArray{..} =+    rb { ringHead = incrHeadByOffset ringHead ringSize (SIZE_OF(a)) }++-- | the offset must be exactly the element size in bytes.+{-# INLINE decrHeadByOffset #-}+decrHeadByOffset :: Int -> Int -> Int -> Int+decrHeadByOffset rh rs n =+    -- Note: This works even if the ring size is 0.+    -- Though the head should never be accessed when ring size is 0, so it+    -- should not matter what it is.+    if rs /= 0+    then (if rh == 0 then rs else rh) - n+    else 0++-- | Move the ring head backward by 1 slot, the ring head will now point to+-- the prev (older) item, when the ring head is at the oldest item it will move+-- to the newest item.+--+-- >>> moveForward = RingArray.moveBy (-1)+--+{-# INLINE moveReverse #-}+moveReverse :: forall a. Unbox a => RingArray a -> RingArray a+moveReverse rb@RingArray{..} =+    rb { ringHead = decrHeadByOffset ringHead ringSize (SIZE_OF(a)) }++-------------------------------------------------------------------------------+-- Conversions+-------------------------------------------------------------------------------++-- | The array must not be a slice, and the index must be within the bounds of+-- the array otherwise unpredictable behavior will occur.+{-# INLINE unsafeCastMutArrayWith #-}+unsafeCastMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> RingArray a+unsafeCastMutArrayWith i arr =+    RingArray+        { ringContents = arrContents arr+        , ringSize = arrEnd arr+        , ringHead = i * SIZE_OF(a)+        }++-- | Cast a MutArray to a ring sharing the same memory without copying. The+-- ring head is at index 0 of the array. The array must not be a slice.+--+-- >>> unsafeCastMutArray = RingArray.unsafeCastMutArrayWith 0+--+{-# INLINE unsafeCastMutArray #-}+unsafeCastMutArray :: forall a. Unbox a => MutArray a -> RingArray a+unsafeCastMutArray = unsafeCastMutArrayWith 0++-- XXX To avoid the failure we can either copy the array or have a ringStart+-- field in the ring. For copying we can have another API though.++-- XXX castMutArray is called unsafeFreeze in the Array module. Make the naming+-- consistent?++-- | @castMutArrayWith index arr@ casts a mutable array to a ring array, and+-- positions the ring head at the given @index@ in the array.+--+-- A MutArray can be a slice which means its memory starts from some offset in+-- the underlying MutableByteArray, and not from 0 offset. RingArray always+-- uses the memory from offset zero in the MutableByteArray, therefore, it+-- refuses to cast if it finds the array does not start from offset zero i.e.+-- if the array was created from some slicing operation over another array. In+-- such cases it returns 'Nothing'.+--+-- To create a RingArray from a sliced MutArray use 'createOfLast', or clone+-- the MutArray and then cast it.+--+-- This operation throws an error if the index is not within the array bounds.+--+{-# INLINE castMutArrayWith #-}+castMutArrayWith :: forall a. Unbox a => Int -> MutArray a -> Maybe (RingArray a)+castMutArrayWith i arr+    | i < 0 || i >= MutArray.length arr+        = error "castMutArray: index must not be negative or >= array size"+    | arrStart arr == 0+        = Just $ unsafeCastMutArrayWith i arr+    | otherwise = Nothing++-- | Cast a MutArray to a ring sharing the same memory without copying. The+-- ring head is positioned at index 0 of the array. The size of the ring is+-- equal to the MutArray length.+--+-- See 'castMutArrayWith' for failure scenarios.+--+-- >>> castMutArray = RingArray.castMutArrayWith 0+--+{-# INLINE castMutArray #-}+castMutArray :: forall a. Unbox a => MutArray a -> Maybe (RingArray a)+castMutArray = castMutArrayWith 0++-------------------------------------------------------------------------------+-- Conversion to/from array+-------------------------------------------------------------------------------++-- | Modify a given index of a ring array using a modifier function.+--+-- /Unimplemented/+modifyIndex :: -- forall m a b. (MonadIO m, Unbox a) =>+    Int -> RingArray a -> (a -> (a, b)) -> m b+modifyIndex = undefined++-- | /O(1)/ Write the given element at the given index relative to the current+-- position of the ring head. Index starts at 0, could be positive or negative.+--+-- Throws an error if the index is more than or equal to the size of the ring.+--+-- Performs in-place mutation of the array.+--+{-# INLINE putIndex #-}+putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> a -> m ()+-- putIndex ix ring val = modifyIndex ix ring (const (val, ()))+putIndex i ring x =+    -- Note: ring must be of non-zero size.+    let j = changeHeadByOffset (ringHead ring) (ringSize ring) (i * SIZE_OF(a))+     in liftIO $ pokeAt j (ringContents ring) x++-- XXX Expand the ring by inserting the newest element before the head. If the+-- number of elements before the head are lesser than the ones after it then+-- shift them all by one place to the left, moving the first element at the end+-- of the ring. Otherwise, shift the elements after the head by one place to+-- the right. Note this requires adding a capacity field to the ring. Also,+-- like mutarray we can reallocate the ring to expand the capacity.++-- | Insert a new element without replacing an old one. Expands the size of the+-- ring. This is similar to the snoc operation for MutArray.+--+-- /Unimplemented/+{-# INLINE insert #-}+insert :: -- (MonadIO m, Unbox a) =>+    RingArray a -> a -> m (RingArray a)+insert = undefined++-- | Like 'replace' but does not return the old value of overwritten element.+--+-- Same as:+--+-- >>> replace_ rb x = RingArray.putIndex 0 rb x >> pure (RingArray.moveForward rb)+--+{-# INLINE replace_ #-}+replace_ :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a)+replace_ rb newVal = do+    -- Note poke will corrupt memory if the ring size is 0.+    when (ringSize rb /= 0)+        $ liftIO $ pokeAt (ringHead rb) (ringContents rb) newVal+    pure $ moveForward rb++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the ring array.+{-# INLINE unsafeGetRawIndex #-}+unsafeGetRawIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a+unsafeGetRawIndex i ring = liftIO $ peekAt i (ringContents ring)++-- | Replace the oldest item in the ring (the item at the ring head) with a new+-- item and move the ring head to the remaining oldest item.+--+-- Throws an error if the ring is empty.+--+{-# INLINE replace #-}+replace :: forall m a. (MonadIO m, Unbox a) => RingArray a -> a -> m (RingArray a, a)+replace rb newVal = do+    -- Note: ring size cannot be zero.+    when (ringSize rb == 0) $+        error "insert: cannot insert in 0 sized ring"+    old <- unsafeGetRawIndex (ringHead rb) rb+    liftIO $ pokeAt (ringHead rb) (ringContents rb) newVal+    pure (moveForward rb, old)++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- | Like 'getIndex' but does not check the bounds. Unpredictable behavior+-- occurs if the index is more than or equal to the ring size.+{-# INLINE unsafeGetIndex #-}+unsafeGetIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m a+unsafeGetIndex i ring =+    let rs = ringSize ring+        j = unsafeChangeHeadByOffset (ringHead ring) rs (i * SIZE_OF(a))+     in unsafeGetRawIndex j ring++-- | /O(1)/ Lookup the element at the given index relative to the ring head.+-- Index starts from 0, could be positive or negative. Returns Nothing if the+-- index is more than or equal to the size of the ring.+--+{-# INLINE getIndex #-}+getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> RingArray a -> m (Maybe a)+getIndex i ring =+    let rs = ringSize ring+     in if i < rs && i > -rs+        then Just <$> unsafeGetIndex i ring+        else return Nothing++-- | /O(1)/ Lookup the element at the head position.+--+-- Prefer this over @unsafeGetIndex 0@ as it does not have have to perform an+-- index rollover check.+--+{-# INLINE unsafeGetHead #-}+unsafeGetHead :: (MonadIO m, Unbox a) => RingArray a -> m a+unsafeGetHead ring = unsafeGetRawIndex (ringHead ring) ring++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++-- | /O(1)/ Get the byte length of the ring.+--+{-# INLINE byteLength #-}+byteLength :: RingArray a -> Int+byteLength = ringSize++-- | /O(1)/ Get the length of the ring. i.e. the number of elements in the+-- ring.+--+{-# INLINE length #-}+length :: forall a. Unbox a => RingArray a -> Int+length rb = ringSize rb `div` SIZE_OF(a)++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- | Read the entire ring, starting at the ring head i.e. from oldest to+-- newest.+--+{-# INLINE_NORMAL reader #-}+reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a+reader = Unfold step inject++    where++    inject rb = return (rb, ringSize rb)++    step (rb, n) = do+        if n <= 0+        then return Stop+        else do+            x <- unsafeGetHead rb+            return $ Yield x (moveForward rb, n - SIZE_OF(a))++-- | Read the entire ring in reverse order, starting at the item before the+-- ring head i.e. from newest to oldest+--+{-# INLINE_NORMAL readerRev #-}+readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (RingArray a) a+readerRev = Unfold step inject++    where++    inject rb = return (moveReverse rb, ringSize rb)++    step (rb, n) = do+        if n <= 0+        then return Stop+        else do+            x <- unsafeGetHead rb+            return $ Yield x (moveReverse rb, n - SIZE_OF(a))++-- | Read the entire ring as a stream, starting at the ring head i.e. from+-- oldest to newest.+--+{-# INLINE_NORMAL read #-}+read :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a+read = Stream.unfold reader++-- | Read the entire ring as a stream, starting from newest to oldest elements.+--+{-# INLINE_NORMAL readRev #-}+readRev :: forall m a. (MonadIO m, Unbox a) => RingArray a -> Stream m a+readRev = Stream.unfold readerRev++-------------------------------------------------------------------------------+-- Stream of arrays+-------------------------------------------------------------------------------++-- | @scanRingsOf n@ groups the input stream into a stream of ring arrays of+-- size up to @n@. The first ring would be of size 1, then 2, and so on up to+-- size n, when size n is reached the ring starts sliding out the oldest+-- elements and keeps the newest n elements.+--+-- Note that the ring emitted is a mutable reference, therefore, should not be+-- retained without copying otherwise the contents will change in the next+-- iteration of the stream.+--+{-# INLINE scanRingsOf #-}+scanRingsOf :: forall m a. (MonadIO m, Unbox a) => Int -> Scanl m a (RingArray a)+scanRingsOf n = Scanl step initial extract extract++    where++    rSize = n * SIZE_OF(a)++    initial =+        if n <= 0+        then error "scanRingsOf: window size must be > 0"+        else do+            mba <- liftIO $ MutByteArray.new rSize+            return $ Partial $ Tuple3Fused' mba 0 0++    step (Tuple3Fused' mba rh offset) a = do+        RingArray _ _ rh1 <- replace_ (RingArray mba rSize rh) a+        let offset1 = offset + SIZE_OF(a)+        return $ Partial $ Tuple3Fused' mba rh1 offset1++    -- XXX exitify optimization causes a problem here when modular folds are+    -- used. Sometimes inlining "extract" is helpful.+    {-# INLINE extract #-}+    extract (Tuple3Fused' mba rh offset) =+        let rs = min offset rSize+            rh1 = if offset <= rSize then 0 else rh+         in pure $ RingArray mba rs rh1++-- | @ringsOf n stream@ groups the input stream into a stream of ring arrays of+-- size up to n. See 'scanRingsOf' for more details.+--+{-# INLINE_NORMAL ringsOf #-}+ringsOf :: forall m a. (MonadIO m, Unbox a) =>+    Int -> Stream m a -> Stream m (RingArray a)+ringsOf n = Stream.postscanl (scanRingsOf n)++-- XXX to keep the order intact use RingArray.read. If order is not important for+-- the fold then we can use asMutArray which could be slightly faster.+-- f1 rb = Stream.fold f $ MutArray.read $ fst $ RingArray.asMutArray rb++-- XXX the size and the array pointer are constant in the stream, only the head+-- changes on each tick. So we can just emit the head in the loop and keep the+-- size and pointer global.++{-# INLINE_NORMAL scanCustomFoldRingsBy #-}+scanCustomFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) =>+    (RingArray a -> m b) -> Int -> Scanl m a b+-- Custom RingArray.fold performs better than the idiomatic implementations below,+-- perhaps because of some GHC optimization effect.+scanCustomFoldRingsBy f = Scanl.rmapM f . scanRingsOf++-- | Apply the given fold on sliding windows of the given size. Note that this+-- could be expensive because each operation goes through the entire window.+-- This should be used only if there is no efficient alternative way possible.+--+-- Examples:+--+-- >>> windowRange = RingArray.scanFoldRingsBy Fold.range+-- >>> windowMinimum = RingArray.scanFoldRingsBy Fold.minimum+-- >>> windowMaximum = RingArray.scanFoldRingsBy Fold.maximum+--+{-# INLINE scanFoldRingsBy #-}+scanFoldRingsBy :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> Int -> Scanl m a b+-- Custom RingArray.fold performs better than the idiomatic implementations below,+-- perhaps because of some GHC optimization effect.+scanFoldRingsBy f = scanCustomFoldRingsBy (fold f)+-- scanFoldRingsBy f = Scanl.rmapM (fold f) . scanRingsOf+-- scanFoldRingsBy f = Scanl.rmapM (Unfold.fold f reader) . scanRingsOf+-- scanFoldRingsBy f = Scanl.rmapM (Stream.fold f . read) . scanRingsOf+++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- | @createOfLast n@ returns the last n elements of the stream in a ring+-- array. @n@ must be non-zero.+--+{-# INLINE createOfLast #-}+createOfLast :: (Unbox a, MonadIO m) => Int -> Fold m a (RingArray a)+createOfLast n = Fold.fromScanl $ scanRingsOf n++-------------------------------------------------------------------------------+-- Casting+-------------------------------------------------------------------------------++-- | Cast a ring having elements of type @a@ into a ring having elements of+-- type @b@. The ring size must be a multiple of the size of type @b@.+--+{-# INLINE unsafeCast #-}+unsafeCast :: RingArray a -> RingArray b+unsafeCast RingArray{..} =+    RingArray+        { ringContents = ringContents+        , ringHead = ringHead+        , ringSize = ringSize+        }++-- | Cast a @RingArray a@ into a @RingArray Word8@.+--+asBytes :: RingArray a -> RingArray Word8+asBytes = unsafeCast++-- | Cast a ring having elements of type @a@ into a ring having elements of+-- type @b@. The length of the ring should be a multiple of the size of the+-- target element otherwise 'Nothing' is returned.+--+{-# INLINE cast #-}+cast :: forall a b. (Unbox b) => RingArray a -> Maybe (RingArray b)+cast ring =+    let len = byteLength ring+        r = len `mod` SIZE_OF(b)+     in if r /= 0+        then Nothing+        else Just $ unsafeCast ring++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Like 'eqArray' but compares only N bytes instead of entire length of the+-- ring buffer. If N is bigger than the ring or array size, it is treated as an+-- error.+--+{-# INLINE eqArrayN #-}+eqArrayN :: RingArray a -> Array a -> Int -> IO Bool+eqArrayN RingArray{..} Array.Array{..} nBytes+    | nBytes < 0 = error "eqArrayN: n should be >= 0"+    | arrEnd - arrStart < nBytes = error "eqArrayN: array is shorter than n"+    | ringSize < nBytes = error "eqArrayN: ring is shorter than n"+    | nBytes == 0 = return True+    | nBytes <= p1Len = do+          part1 <-+              MutByteArray.unsafeByteCmp+                  arrContents 0 ringContents ringHead nBytes+          pure $ part1 == 0+    | otherwise = do+          part1 <-+              MutByteArray.unsafeByteCmp+                  arrContents 0 ringContents ringHead p1Len+          part2 <-+              MutByteArray.unsafeByteCmp arrContents p1Len ringContents 0 p2Len+          pure $ part1 == 0 && part2 == 0+    where+    p1Len = ringSize - ringHead+    p2Len = nBytes - p1Len++-- | Byte compare the entire length of ringBuffer with the given array,+-- starting at the supplied ring head index.  Returns true if the Array and+-- the ring have identical contents. If the array is bigger checks only+-- up to the ring length. If array is shorter than then ring, it is treated as+-- an error.+--+{-# INLINE eqArray #-}+eqArray :: RingArray a -> Array a -> IO Bool+eqArray RingArray{..} Array.Array{..}+    | arrEnd - arrStart < ringSize =+        error "eqArrayN: array is shorter than ring"+    | otherwise = do+          part1 <-+              MutByteArray.unsafeByteCmp+                  arrContents 0 ringContents ringHead p1Len+          part2 <-+              MutByteArray.unsafeByteCmp+                  arrContents p1Len ringContents 0 p2Len+          pure $ part1 == 0 && part2 == 0+    where+    p1Len = ringSize - ringHead+    p2Len = ringHead++-------------------------------------------------------------------------------+-- Folding+-------------------------------------------------------------------------------++-- Note: INLINE_NORMAL is important for use in scanFoldRingsBy++-- | Fold the entire length of a ring buffer starting at the current ring head.+--+{-# INLINE_NORMAL fold #-}+fold :: forall m a b. (MonadIO m, Unbox a)+    => Fold m a b -> RingArray a -> m b+-- These are slower when used in a scan extract. One of the issues is the+-- exitify optimization, there could be others.+-- fold f rb = Unfold.fold f reader rb+-- fold f rb = Stream.fold f $ read rb+fold (Fold step initial _ final) rb = do+    res <- initial+    case res of+        Fold.Partial fs -> go SPEC rh fs+        Fold.Done b -> return b++    where++    rh = ringHead rb++    -- Note: Passing the SPEC arg seems to give better results in windowRange+    -- benchmarks for larger windows, while worse results for smaller windows.+    {-# INLINE go #-}+    go !_ index !fs = do+        x <- unsafeGetRawIndex index rb+        r <- step fs x+        case r of+            Fold.Done b -> return b+            Fold.Partial s -> do+                let next = incrHeadByOffset index (ringSize rb) (SIZE_OF(a))+                if next == rh+                then final s+                else go SPEC next s++-- XXX This was for folding when the ring is not full, now we do not support+-- that so this should not be needed.++-- | Fold the buffer starting from ringStart up to the given index using a pure+-- step function. This is useful to fold the items in the ring when the ring is+-- not full. The supplied index is usually the end of the ring.+--+-- Unsafe because the supplied index is not checked to be in range.+{-# DEPRECATED unsafeFoldRing "This function will be removed in future." #-}+{-# INLINE unsafeFoldRing #-}+unsafeFoldRing :: forall a b. Unbox a+    => Int -> (b -> a -> b) -> b -> RingArray a -> IO b+unsafeFoldRing !len f z rb = go z 0++    where++    go !acc !index+        | index == len = return acc+        | otherwise = do+            x <- unsafeGetRawIndex index rb+            go (f acc x) (index + SIZE_OF(a))++-- | Like unsafeFoldRing but with a monadic step function.+{-# DEPRECATED unsafeFoldRingM "This function will be removed in future." #-}+{-# INLINE unsafeFoldRingM #-}+unsafeFoldRingM :: forall m a b. (MonadIO m, Unbox a)+    => Int -> (b -> a -> m b) -> b -> RingArray a -> m b+unsafeFoldRingM !len f z rb = go z 0++    where++    go !acc !index+        | index == len = return acc+        | otherwise = do+            x <- unsafeGetRawIndex index rb+            acc1 <- f acc x+            go acc1 (index + SIZE_OF(a))++-- | Fold the entire length of a ring buffer starting at the current ring head.+--+-- Note, this will crash on ring of 0 size.+--+{-# INLINE foldlM' #-}+foldlM' :: forall m a b. (MonadIO m, Unbox a)+    => (b -> a -> m b) -> b -> RingArray a -> m b+foldlM' f z = fold (Fold.foldlM' f (pure z))++-- These are slower when used in a scan extract. One of the issues is the+-- exitify optimization, there could be others.+-- foldlM' f z rb = Unfold.fold (Fold.foldlM' f (pure z)) reader rb+-- foldlM' f z rb = Stream.fold (Fold.foldlM' f (pure z)) $ read rb++{-+foldlM' f z rb = go z rh++    where++    rh = ringHead rb++    go !acc !index = do+        x <- unsafeGetRawIndex index rb+        acc' <- f acc x+        let next = incrHeadByOffset index (ringSize rb) (SIZE_OF(a))+        if next == rh+        then return acc'+        else go acc' next+-}++{-# DEPRECATED unsafeFoldRingFullM "This function will be removed in future." #-}+{-# INLINE unsafeFoldRingFullM #-}+unsafeFoldRingFullM :: forall m a b. (MonadIO m, Unbox a)+    => (b -> a -> m b) -> b -> RingArray a -> m b+unsafeFoldRingFullM = foldlM'++-- | Fold @n@ items in the ring starting at the ring head. Won't fold more+-- than the length of the ring even if @n@ is larger.+--+-- Note, this will crash on ring of 0 size.+--+{-# DEPRECATED unsafeFoldRingNM "This function will be removed in future." #-}+{-# INLINE unsafeFoldRingNM #-}+unsafeFoldRingNM :: forall m a b. (MonadIO m, Unbox a)+    => Int -> (b -> a -> m b) -> b -> RingArray a -> m b+unsafeFoldRingNM count f z rb = go count z rh++    where++    rh = ringHead rb++    go 0 acc _ = return acc+    go !n !acc !index = do+        x <- unsafeGetRawIndex index rb+        acc' <- f acc x+        let next = unsafeChangeHeadByOffset index (ringSize rb) (SIZE_OF(a))+        if next == rh || n == 0+            then return acc'+            else go (n - 1) acc' next++-- | Cast the ring to a mutable array. Return the mutable array as well as the+-- current position of the ring head. Note that the array does not start with+-- the current ring head. The array refers to the same memory as the ring.+{-# INLINE asMutArray #-}+asMutArray :: RingArray a -> (MutArray a, Int)+asMutArray rb =+    ( MutArray+        { arrContents = ringContents rb+        , arrStart = 0+        , arrEnd = ringSize rb+        , arrBound = ringSize rb+        }+    , ringHead rb+    )++-- | Like 'asMutArray' but does not return the ring head.+--+-- >>> asMutArray_ = fst . RingArray.asMutArray+--+{-# INLINE asMutArray_ #-}+asMutArray_ :: RingArray a -> MutArray a+asMutArray_ rb =+    MutArray+        { arrContents = ringContents rb+        , arrStart = 0+        , arrEnd = ringSize rb+        , arrBound = ringSize rb+        }++-- XXX We can use bulk copy using memcpy or at least a Word64 at a time.++-- | Copy the ring to a MutArray, the first element of the MutArray is the+-- oldest element of the ring (i.e. ring head) and the last is the newest.+--+-- >>> toMutArray rb = Stream.fold (MutArray.createOf (RingArray.length rb)) $ RingArray.read rb+--+{-# INLINE toMutArray #-}+toMutArray :: (MonadIO m, Unbox a) => RingArray a -> m (MutArray a)+toMutArray rb = MutArray.fromStreamN (length rb) $ read rb+{-+toMutArray rb = do+    -- Using unpinned array here instead of pinned+    arr <- liftIO $ MutArray.emptyOf (length rb)+    let snoc' b a = liftIO $ MutArray.unsafeSnoc b a+    foldlM' snoc' arr rb+-}++-- | Copy the ring to a list, the first element of the list is the oldest+-- element of the ring (i.e. ring head) and the last is the newest.+--+-- >>> toList = Stream.toList . RingArray.read+--+{-# INLINE toList #-}+toList :: (MonadIO m, Unbox a) => RingArray a -> m [a]+toList = Stream.toList . read++-- | Show the contents of a RingArray as a list.+--+-- >>> showRing rb = RingArray.toList rb >>= return . show+--+showRing :: (Unbox a, Show a) => RingArray a -> IO String+showRing rb = show <$> toList rb++{-# ANN type SlidingWindow Fuse #-}+data SlidingWindow a s = SWArray !a !Int !s !Int | SWRing !a !Int !s++-- | 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.+{-# DEPRECATED slidingWindowWith "Please use Scanl.incrScanWith instead." #-}+{-# INLINE slidingWindowWith #-}+slidingWindowWith :: forall m a b. (MonadIO m, 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+            arr :: MutArray.MutArray a <- liftIO $ MutArray.emptyOf n+            return $+                case r of+                    Partial s -> Partial+                        $ SWArray (MutArray.arrContents arr) 0 s (n - 1)+                    Done b -> Done b++    step (SWArray mba rh st i) a = do+        RingArray _ _ rh1 <- replace_ (RingArray mba (n * SIZE_OF(a)) rh) a+        let size = (n - i) * SIZE_OF(a)+        r <- step1 st ((a, Nothing), pure (MutArray mba 0 size size))+        return $+            case r of+                Partial s ->+                    if i > 0+                    then Partial $ SWArray mba rh1 s (i - 1)+                    else Partial $ SWRing mba rh1 s+                Done b -> Done b++    step (SWRing mba rh st) a = do+        (rb1@(RingArray _ _ rh1), old) <-+            replace (RingArray mba (n * SIZE_OF(a)) rh) a+        r <- step1 st ((a, Just old), toMutArray rb1)+        return $+            case r of+                Partial s -> Partial $ SWRing mba rh1 s+                Done b -> Done b++    extract (SWArray _ _ st _) = extract1 st+    extract (SWRing _ _ st) = extract1 st++    final (SWArray _ _ st _) = final1 st+    final (SWRing _ _ 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.+--+{-# DEPRECATED slidingWindow "Please use Scanl.incrScan instead." #-}+{-# INLINE slidingWindow #-}+slidingWindow :: forall m a b. (MonadIO m, 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/RingArray/Generic.hs view
@@ -0,0 +1,189 @@+-- |+-- Module      : Streamly.Internal.Data.RingArray.Generic+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.Data.RingArray.Generic+    ( RingArray(..)+    , Ring++    -- * Generation+    , emptyOf+    , createOf++    -- * 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 RingArray a = RingArray+    { 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+    }++{-# DEPRECATED Ring "Please use RingArray instead." #-}+type Ring = RingArray++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++-- XXX If we align the ringMax to nearest power of two then computation of the+-- index to write could be cheaper.+{-# INLINE emptyOf #-}+emptyOf :: MonadIO m => Int -> m (RingArray a)+emptyOf count = liftIO $ do+    arr <- MutArray.emptyOf count+    arr1 <- MutArray.uninit arr count+    return (RingArray+        { ringArr = arr1+        , ringHead = 0+        , ringMax = count+        })+++-- | Note that it is not safe to return a reference to the mutable RingArray using a+-- scan as the RingArray is continuously getting mutated. You could however copy out+-- the RingArray.+{-# INLINE createOf #-}+createOf :: MonadIO m => Int -> Fold m a (RingArray a)+createOf n = Fold step initial extract extract++    where++    initial = do+        if n <= 0+        then Fold.Done <$> emptyOf 0+        else do+            rb <- emptyOf 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@RingArray{..} cnt) =+        return $+            if cnt < ringMax+            then RingArray ringArr 0 ringHead+            else rb++-------------------------------------------------------------------------------+-- Modification+-------------------------------------------------------------------------------++-- XXX This is safe+-- Take the ring head and return the new ring head.+{-# INLINE unsafeInsertRingWith #-}+unsafeInsertRingWith :: RingArray a -> a -> IO Int+unsafeInsertRingWith RingArray{..} x = do+    assertM(ringMax >= 1)+    assertM(ringHead < ringMax)+    MutArray.unsafePutIndex 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 -> RingArray a -> m (RingArray a)+seek adj rng@RingArray{..}+    | ringMax > 0 = liftIO $ do+        -- XXX try avoiding mod when in bounds+        let idx1 = ringHead + adj+            next = mod idx1 ringMax+        return $ RingArray 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 RingArray, 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 -> RingArray a -> m (MutArray a)+toMutArray adj n RingArray{..} =+    -- XXX for empty RingArray 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, arrEnd = end }+        else do+            -- XXX Just swap the elements in the existing ring and return the+            -- same array without reallocation.+            arr <- liftIO $ MutArray.emptyOf len+            arr1 <- MutArray.uninit arr len+            MutArray.unsafePutSlice ringArr idx arr1 0 (ringMax - idx)+            MutArray.unsafePutSlice 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 -> RingArray a -> m (MutArray a)+copyToMutArray adj n RingArray{..} = 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.emptyOf len+        arr1 <- MutArray.uninit arr len+        MutArray.unsafePutSlice ringArr idx arr1 0 (ringMax - idx)+        MutArray.unsafePutSlice 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 -> RingArray a -> Stream m a+toStreamWith = undefined+{-+toStreamWith n RingArray{..}+    | 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/Scanl.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl+-- Copyright   : (c) 2024 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Left scans.+--+-- == Scanl vs Fold+--+-- Folds and scans both are consumers of streams. A left scan is a+-- generalization of a fold. While the output of a fold is a singleton value,+-- the output of a scan is a stream. A fold is equivalent to a left scan which+-- produces only the final value in the output stream.+--+-- Like folds, a scan has an internal state. Unlike a fold, a scan produces an+-- output on each input, the output is a function of the scan state and the+-- input.+--+-- A @Scanl m a b@ can represent a @Fold m a b@ by discarding the intermediate+-- outputs and keeping only the final output of the scan.+--+-- Since folds do not care about intermediate values, we do not need the+-- extract function for folds. Because folds do not have a requirement for+-- intermediate values, they can be used for implementing combinators like+-- splitWith where intermediate values are not meaningful and are expensive to+-- compute. Folds provide an applicative and monad behavior to consume the+-- stream in parts and compose the folded results. Scans provide Category like+-- composition and stream zip applicative behavior. The finalization function+-- of a fold would return a single value whereas for scan it may be a stream+-- draining the scan buffer. For these reasons, scans and folds are required as+-- independent abstractions.+--+-- == Scanl vs Pipe+--+-- A scan is a simpler version of the consumer side of pipes. A left scan+-- always produces an output whereas a pipe has an additional ability to skip+-- output. Scans are simpler abstractions to think about compared to pipes and+-- easier for the compiler to optimize and fuse.+--+-- == Compositions+--+-- Scans can be chained in the same way as function composition (Category) and+-- can distribute input (tee Applicative). Folds provide an applicative and+-- monad behavior to consume the stream in parts and compose the folded+-- results. Folds are also a special case of parsers.++-- TBD: A scan can produce more than one output on an input, in other words,+-- it can produce output on its own.+--+module Streamly.Internal.Data.Scanl+    (+    -- * Imports+    -- $setup++      module Streamly.Internal.Data.Scanl.Type+    , module Streamly.Internal.Data.Scanl.Window+    , module Streamly.Internal.Data.Scanl.Combinators+    , module Streamly.Internal.Data.Scanl.Container+    )+where++import Streamly.Internal.Data.Scanl.Window+import Streamly.Internal.Data.Scanl.Combinators+import Streamly.Internal.Data.Scanl.Container+import Streamly.Internal.Data.Scanl.Type++#include "DocTestDataFold.hs"
+ src/Streamly/Internal/Data/Scanl/Combinators.hs view
@@ -0,0 +1,2393 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl.Combinators+-- Copyright   : (c) 2024 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.Data.Scanl.Combinators+    (+    -- * Scans++    -- ** Accumulators+    -- *** Semigroups and Monoids+      sconcat+    , mconcat+    , foldMap+    , foldMapM++    -- *** Reducers+    , drainMapM+    , the+    , mean+    , rollingHash+    , defaultSalt+    , rollingHashWithSalt+    , rollingHashFirstN+    -- , rollingHashLastN++    -- *** Saturating Reducers+    -- | 'product' terminates if it becomes 0. Other scans can theoretically+    -- saturate on bounded types, and therefore terminate, however, they will+    -- run forever on unbounded types like Integer/Double.+    , sum+    , product++    -- *** Collectors+    -- | Avoid using these scans 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 'postscanlMaybe' combinator. For scanners the result of the scan is+    -- usually a transformation of the current element rather than an+    -- aggregation of all elements till now.+ -- , nthLast -- using RingArray array+    , indexingWith+    , indexing+    , indexingRev+    , rollingMap+    , rollingMapM++    -- *** Filters+    -- | Useful in combination with the 'postscanlMaybe' combinator.+    , deleteBy+    , uniqBy+    , uniq+    , repeated+    , findIndices+    , elemIndices++    {-+    -- *** Singleton scans+    -- | Scans that terminate after consuming exactly one input element. All+    -- these can be implemented in terms of the 'maybe' scan.+    , one+    , null -- XXX not very useful and could be problematic, remove it?+    , satisfy+    , maybe+    -}++    -- *** Multi scans+    -- | Terminate after consuming one or more elements.+    , drainN+    {-+    -- , lastN+    -- , (!!)+    , genericIndex+    , index+    , findM+    , find+    , lookup+    , findIndex+    , elemIndex+    , elem+    , notElem+    , all+    , any+    , and+    , or+    -}++    -- ** Trimmers+    -- | Useful in combination with the 'postscanlMaybe' combinator.+    , takingEndByM+    , takingEndBy+    , takingEndByM_+    , takingEndBy_+    , droppingWhileM+    , droppingWhile+    , prune++    -- -- * Running A Scanl+    -- , drive+    -- , breakStream++    -- -- * Building Incrementally+    -- , addStream++    -- * Combinators+    -- ** Utilities+    , with++    -- -- ** Sliding Window+    -- , slide2++    -- ** Scanning Input+    , scanl+    , scanlMany+    -- , runScan+    , pipe+    , 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+    -- , 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+    -- , unzipWithMaxM++    -- ** Partitioning+    , partitionByM+    -- , partitionByFstM+    -- , partitionByMinM+    , partitionBy+    , partition++    -- -- ** Splitting+    -- , chunksBetween+    -- , intersperseWithQuotes++    -- ** Nesting+    , unfoldMany+    -- , concatSequence+    )+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 Streamly.Internal.Data.Unbox (Unbox(..))+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Pipe.Type (Pipe (..))+-- import Streamly.Internal.Data.Scan (Scan (..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++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.Scanl.Window as Scanl+import qualified Streamly.Internal.Data.Pipe.Type as Pipe+-- import qualified Streamly.Internal.Data.RingArray as RingArray+import qualified Streamly.Internal.Data.Stream.Type as StreamD++import Streamly.Internal.Data.Scanl.Type+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, const)++#include "DocTestDataScanl.hs"++------------------------------------------------------------------------------+-- Running+------------------------------------------------------------------------------++{-+-- | Drive a fold using the supplied 'Stream', reducing the resulting+-- expression strictly at each step.+--+-- Definition:+--+-- >>> drive = flip Stream.toList $ Stream.scanl+--+-- 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.toList $ Stream.scanlBreak+--+-- /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 -> Scanl m a b -> m (Scanl m a b)+addStream stream = drive stream . duplicate+-}++------------------------------------------------------------------------------+-- Transformations on fold inputs+------------------------------------------------------------------------------++-- |+-- >>> mapMaybeM f = Scanl.lmapM f . Scanl.catMaybes+--+{-# INLINE mapMaybeM #-}+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Scanl m b r -> Scanl m a r+mapMaybeM f = lmapM f . catMaybes++-- | @mapMaybe f scan@ maps a 'Maybe' returning function @f@ on the input of+-- the scan, filters out 'Nothing' elements, and return the values extracted+-- from 'Just'.+--+-- >>> mapMaybe f = Scanl.lmap f . Scanl.catMaybes+-- >>> mapMaybe f = Scanl.mapMaybeM (return . f)+--+-- >>> f x = if even x then Just x else Nothing+-- >>> scn = Scanl.mapMaybe f Scanl.toList+-- >>> Stream.toList $ Stream.scanl scn (Stream.enumerateFromTo 1 10)+-- [[],[],[2],[2],[2,4],[2,4],[2,4,6],[2,4,6],[2,4,6,8],[2,4,6,8],[2,4,6,8,10]]+--+{-# INLINE mapMaybe #-}+mapMaybe :: Monad m => (a -> Maybe b) -> Scanl m b r -> Scanl m a r+mapMaybe f = lmap f . catMaybes++------------------------------------------------------------------------------+-- Transformations on scan inputs+------------------------------------------------------------------------------++-- XXX rather scanl the input of a pipe? And scanr the output?+-- pipe :: Monad m => Scanl m a b -> Pipe m b c -> Scanl m a c+-- Can we do this too (in the pipe module):+-- pipe :: Monad m => Scanl m a b -> Pipe m b c -> Pipe m a c++-- | Attach a 'Pipe' on the input of a 'Scanl'.+--+-- /Pre-release/+{-# INLINE pipe #-}+pipe :: Monad m => Pipe m a b -> Scanl m b c -> Scanl m a c+pipe (Pipe consume produce pinitial) (Scanl fstep finitial fextract ffinal) =+    Scanl step initial extract final++    where++    initial = first (Tuple' pinitial) <$> finitial++    step (Tuple' cs fs) x = do+        r <- consume cs x+        go fs r++        where++        -- XXX use SPEC?+        go acc (Pipe.YieldC cs1 b) = do+            acc1 <- fstep acc b+            return+                $ case acc1 of+                      Partial s -> Partial $ Tuple' cs1 s+                      Done b1 -> Done b1+        -- XXX this case is recursive may cause fusion issues.+        -- To remove recursion we will need a produce mode in scans which makes+        -- scans similar to pipes except that they do not yield intermediate+        -- values.+        go acc (Pipe.YieldP ps1 b) = do+            acc1 <- fstep acc b+            r <- produce ps1+            case acc1 of+                Partial s -> go s r+                Done b1 -> return $ Done b1+        go acc (Pipe.SkipC cs1) =+            return $ Partial $ Tuple' cs1 acc+        -- XXX this case is recursive may cause fusion issues.+        go acc (Pipe.SkipP ps1) = do+            r <- produce ps1+            go acc r+        -- XXX a Stop in consumer means we dropped the input.+        -- XXX Need to use a "Done b" in pipes as well to represent the same+        -- behavior as scans.+        go acc Pipe.Stop = Done <$> ffinal acc++    extract (Tuple' _ fs) = fextract fs++    final (Tuple' _ fs) = ffinal fs++{-+{-# INLINE runScanWith #-}+runScanWith :: Monad m => Bool -> Scan m a b -> Fold m b c -> Scanl m a c+runScanWith isMany+    (Scan stepL initialL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final++    where++    step (sL, sR) x = do+        rL <- stepL sL x+        case rL of+            StreamD.Yield b sL1 -> do+                rR <- stepR sR b+                case rR of+                    Partial sR1 -> return $ Partial (sL1, sR1)+                    Done bR -> return (Done bR)+            StreamD.Skip sL1 -> return $ Partial (sL1, sR)+            -- XXX We have dropped the input.+            -- XXX Need same behavior for Stop in Fold so that the driver can+            -- consistently assume it is dropped.+            StreamD.Stop ->+                if isMany+                then return $ Partial (initialL, sR)+                else Done <$> finalR sR++    initial = do+        r <- initialR+        case r of+            Partial sR -> return $ Partial (initialL, sR)+            Done b -> return $ Done b++    extract = extractR . snd++    final = finalR . snd++-- | Scan the input of a 'Fold' to change it in a stateful manner using a+-- 'Scan'. The scan stops as soon as the fold terminates.+--+-- /Pre-release/+{-# INLINE runScan #-}+runScan :: Monad m => Scan m a b -> Fold m b c -> Scanl m a c+runScan = runScanWith False+-}++{-# INLINE scanWith #-}+scanWith :: Monad m => Bool -> Scanl m a b -> Scanl m b c -> Scanl m a c+scanWith isMany+    (Scanl stepL initialL extractL finalL)+    (Scanl stepR initialR extractR finalR) =+    Scanl 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+                        -- XXX recursive call. If initialL returns Done then it+                        -- will not terminate. In that case we should return+                        -- error in the beginning itself. And we should remove+                        -- this recursion, assuming it won't return Done.+                        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 'Scanl' to change it in a stateful manner using+-- another 'Scanl'. The scan stops as soon as any of the scans terminates.+--+-- This is basically an append operation.+--+-- /Pre-release/+{-# INLINE scanl #-}+scanl :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+scanl = scanWith False++-- XXX This does not fuse beacuse of the recursive step. Need to investigate.++-- | Scan the input of a 'Scanl' to change it in a stateful manner using+-- another 'Scanl'. The scan restarts with a fresh state if it terminates.+--+-- /Pre-release/+{-# INLINE scanlMany #-}+scanlMany :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+scanlMany = 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.toList $ Stream.postscanlMaybe (Scanl.deleteBy (==) 3) input+-- [1,3,5]+--+{-# INLINE_NORMAL deleteBy #-}+deleteBy :: Monad m => (a -> a -> Bool) -> a -> Scanl m a (Maybe a)+deleteBy eq x0 = fmap extract $ mkScanl 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.Scanl.Window".+--+{-# INLINE slide2 #-}+slide2 :: Monad m => Fold m (a, Maybe a) b -> Scanl 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+-}++-- XXX Compare this with the implementation in Scanl.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) -> Scanl m a b+rollingMapM f = Scanl 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 = Scanl.rollingMapM (\x y -> return $ f x y)+--+{-# INLINE rollingMap #-}+rollingMap :: Monad m => (Maybe a -> a -> b) -> Scanl m a b+rollingMap f = rollingMapM (\x y -> return $ f x y)++-- | 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.toList $ Stream.postscanlMaybe (Scanl.uniqBy f) input+-- "/a/b"+--+-- Space: @O(1)@+--+-- /Pre-release/+--+{-# INLINE uniqBy #-}+uniqBy :: Monad m => (a -> a -> Bool) -> Scanl 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 = Scanl.uniqBy (==)+--+{-# INLINE uniq #-}+uniq :: (Monad m, Eq a) => Scanl 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) -> Scanl m a (Maybe a)+prune = error "Not implemented yet!"++-- | Emit only repeated elements, once.+--+-- /Unimplemented/+repeated :: -- (Monad m, Eq a) =>+    Scanl m a (Maybe a)+repeated = error "Not implemented yet!"++------------------------------------------------------------------------------+-- Left scans+------------------------------------------------------------------------------++------------------------------------------------------------------------------+-- Run Effects+------------------------------------------------------------------------------++-- |+-- Definitions:+--+-- >>> drainMapM f = Scanl.lmapM f Scanl.drain+-- >>> drainMapM f = Scanl.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) -> Scanl m a ()+drainMapM f = lmapM f drain++-- | 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) => Scanl m a (Maybe a)+the = mkScant 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+------------------------------------------------------------------------------++-- | 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 = Scanl.cumulativeScan Scanl.incrSum+--+-- Same as following but numerically stable:+--+-- >>> sum = Scanl.mkScanl (+) 0+-- >>> sum = fmap Data.Monoid.getSum $ Scanl.foldMap Data.Monoid.Sum+--+{-# INLINE sum #-}+sum :: (Monad m, Num a) => Scanl m a a+sum = Scanl.cumulativeScan Scanl.incrSum++-- | Determine the product of all elements of a stream of numbers. Returns+-- multiplicative identity (@1@) when the stream is empty. The scan terminates+-- when it encounters (@0@) in its input.+--+-- Same as the following but terminates on multiplication by @0@:+--+-- >>> product = fmap Data.Monoid.getProduct $ Scanl.foldMap Data.Monoid.Product+--+{-# INLINE product #-}+product :: (Monad m, Num a, Eq a) => Scanl m a a+product =  mkScant step (Partial 1) id++    where++    step x a =+        if a == 0+        then Done 0+        else Partial $ x * a++------------------------------------------------------------------------------+-- To Summary (Statistical)+------------------------------------------------------------------------------++-- | Compute a numerically stable arithmetic mean of all elements in the input+-- stream.+--+{-# INLINE mean #-}+mean :: (Monad m, Fractional a) => Scanl m a a+mean = fmap done $ mkScanl 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 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 -> Scanl m a Int64+rollingHashWithSalt = mkScanl 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 = Scanl.rollingHashWithSalt Scanl.defaultSalt+--+{-# INLINE rollingHash #-}+rollingHash :: (Monad m, Enum a) => Scanl m a Int64+rollingHash = rollingHashWithSalt defaultSalt++-- | Compute an 'Int' sized polynomial rolling hash of the first n elements of+-- a stream.+--+-- >>> rollingHashFirstN n = Scanl.take n Scanl.rollingHash+--+-- /Pre-release/+{-# INLINE rollingHashFirstN #-}+rollingHashFirstN :: (Monad m, Enum a) => Int -> Scanl m a Int64+rollingHashFirstN n = take n rollingHash++------------------------------------------------------------------------------+-- Monoidal left scans+------------------------------------------------------------------------------++-- | Semigroup concat. Append the elements of an input stream to a provided+-- starting value.+--+-- Definition:+--+-- >>> sconcat = Scanl.mkScanl (<>)+--+-- >>> semigroups = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 3+-- >>> Stream.toList $ Stream.scanl (Scanl.sconcat 3) semigroups+-- [Sum {getSum = 3},Sum {getSum = 4},Sum {getSum = 6},Sum {getSum = 9}]+--+{-# INLINE sconcat #-}+sconcat :: (Monad m, Semigroup a) => a -> Scanl m a a+sconcat = mkScanl (<>)++-- | Monoid concat. Scan an input stream consisting of monoidal elements using+-- 'mappend' and 'mempty'.+--+-- Definition:+--+-- >>> mconcat = Scanl.sconcat mempty+--+-- >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 3+-- >>> Stream.toList $ Stream.scanl Scanl.mconcat monoids+-- [Sum {getSum = 0},Sum {getSum = 1},Sum {getSum = 3},Sum {getSum = 6}]+--+{-# INLINE mconcat #-}+mconcat ::+    ( Monad m+    , Monoid a) => Scanl m a a+mconcat = sconcat mempty++-- |+-- Definition:+--+-- >>> foldMap f = Scanl.lmap f Scanl.mconcat+--+-- Make a scan from a pure function that scans the output of the function+-- using 'mappend' and 'mempty'.+--+-- >>> sum = Scanl.foldMap Data.Monoid.Sum+-- >>> Stream.toList $ Stream.scanl sum $ Stream.enumerateFromTo 1 3+-- [Sum {getSum = 0},Sum {getSum = 1},Sum {getSum = 3},Sum {getSum = 6}]+--+{-# INLINE foldMap #-}+foldMap :: (Monad m, Monoid b) => (a -> b) -> Scanl m a b+foldMap f = lmap f mconcat++-- |+-- Definition:+--+-- >>> foldMapM f = Scanl.lmapM f Scanl.mconcat+--+-- Make a scan from a monadic function that scans the output of the function+-- using 'mappend' and 'mempty'.+--+-- >>> sum = Scanl.foldMapM (return . Data.Monoid.Sum)+-- >>> Stream.toList $ Stream.scanl sum $ Stream.enumerateFromTo 1 3+-- [Sum {getSum = 0},Sum {getSum = 1},Sum {getSum = 3},Sum {getSum = 6}]+--+{-# INLINE foldMapM #-}+foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Scanl m a b+foldMapM act = mkScanlM 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.Scanl.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 = Scanl.mkScanl (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 => Scanl m a [a]+toListRev = mkScanl (flip (:)) []++------------------------------------------------------------------------------+-- Partial Scans+------------------------------------------------------------------------------++-- | A scan that drains the first n elements of its input, running the effects+-- and discarding the results.+--+-- Definition:+--+-- >>> drainN n = Scanl.take n Scanl.drain+--+-- /Pre-release/+{-# INLINE drainN #-}+drainN :: Monad m => Int -> Scanl m a ()+drainN n = take n drain++{-+------------------------------------------------------------------------------+-- To Elements+------------------------------------------------------------------------------++-- | Like 'index', except with a more general 'Integral' argument+--+-- /Pre-release/+{-# INLINE genericIndex #-}+genericIndex :: (Integral i, Monad m) => i -> Scanl m a (Maybe a)+genericIndex i = mkScant 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 = Scanl.genericIndex+--+{-# INLINE index #-}+index :: Monad m => Int -> Scanl m a (Maybe a)+index = genericIndex++-- | Consume a single input and transform it using the supplied 'Maybe'+-- returning function.+--+-- /Pre-release/+--+{-# INLINE maybe #-}+maybe :: Monad m => (a -> Maybe b) -> Scanl m a (Maybe b)+maybe f = mkScant (const (Done . f)) (Partial Nothing) id++-- | Consume a single element and return it if it passes the predicate else+-- return 'Nothing'.+--+-- Definition:+--+-- >>> satisfy f = Scanl.maybe (\a -> if f a then Just a else Nothing)+--+-- /Pre-release/+{-# INLINE satisfy #-}+satisfy :: Monad m => (a -> Bool) -> Scanl 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 = Scanl.maybe Just+--+-- This is similar to the stream 'Stream.uncons' operation.+--+{-# INLINE one #-}+one :: Monad m => Scanl m a (Maybe a)+one = maybe Just++-- | Returns the first element that satisfies the given predicate.+--+-- /Pre-release/+{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+findM predicate =+    Scanl 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) -> Scanl 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 <$> Scanl.find ((== x) . fst)+--+{-# INLINE lookup #-}+lookup :: (Eq a, Monad m) => a -> Scanl m (a,b) (Maybe b)+lookup a0 = mkScant 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) -> Scanl m a (Maybe Int)+findIndex predicate = mkScant 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) -> Scanl m a (Maybe Int)+findIndices predicate =+    -- XXX implement by combining indexing and filtering scans+    fmap (either (Prelude.const Nothing) Just) $ mkScanl 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 = Scanl.findIndices (== a)+--+{-# INLINE elemIndices #-}+elemIndices :: (Monad m, Eq a) => a -> Scanl m a (Maybe Int)+elemIndices a = findIndices (== a)++{-+-- | Returns the first index where a given value is found in the stream.+--+-- Definition:+--+-- >>> elemIndex a = Scanl.findIndex (== a)+--+{-# INLINE elemIndex #-}+elemIndex :: (Eq a, Monad m) => a -> Scanl 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 Scanl.one+--+{-# INLINE null #-}+null :: Monad m => Scanl m a Bool+null = mkScant (\() _ -> Done False) (Partial ()) (const True)++-- | Returns 'True' if any element of the input satisfies the predicate.+--+-- Definition:+--+-- >>> any p = Scanl.lmap p Scanl.or+--+-- Example:+--+-- >>> Stream.toList $ Stream.scanl (Scanl.any (== 0)) $ Stream.fromList [1,0,1]+-- True+--+{-# INLINE any #-}+any :: Monad m => (a -> Bool) -> Scanl m a Bool+any predicate = mkScant 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 = Scanl.any (== a)+--+{-# INLINE elem #-}+elem :: (Eq a, Monad m) => a -> Scanl m a Bool+elem a = any (== a)++-- | Returns 'True' if all elements of the input satisfy the predicate.+--+-- Definition:+--+-- >>> all p = Scanl.lmap p Scanl.and+--+-- Example:+--+-- >>> Stream.toList $ Stream.scanl (Scanl.all (== 0)) $ Stream.fromList [1,0,1]+-- False+--+{-# INLINE all #-}+all :: Monad m => (a -> Bool) -> Scanl m a Bool+all predicate = mkScant 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 = Scanl.all (/= a)+--+{-# INLINE notElem #-}+notElem :: (Eq a, Monad m) => a -> Scanl m a Bool+notElem a = all (/= a)++-- | Returns 'True' if all elements are 'True', 'False' otherwise+--+-- Definition:+--+-- >>> and = Scanl.all (== True)+--+{-# INLINE and #-}+and :: Monad m => Scanl m Bool Bool+and = all id++-- | Returns 'True' if any element is 'True', 'False' otherwise+--+-- Definition:+--+-- >>> or = Scanl.any (== True)+--+{-# INLINE or #-}+or :: Monad m => Scanl m Bool Bool+or = any id+-}++------------------------------------------------------------------------------+-- 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.toList $ Stream.scanl (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+    -> Scanl m a b+    -> Scanl m a c+    -> Scanl m a (b, c)+splitAt n fld = splitWith (,) (take n fld)+-}++------------------------------------------------------------------------------+-- Element Aware APIs+------------------------------------------------------------------------------+--+------------------------------------------------------------------------------+-- Binary APIs+------------------------------------------------------------------------------++{-# INLINE takingEndByM #-}+takingEndByM :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+takingEndByM p = Scanl 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 = Scanl.takingEndByM (return . p)+--+{-# INLINE takingEndBy #-}+takingEndBy :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+takingEndBy p = takingEndByM (return . p)++{-# INLINE takingEndByM_ #-}+takingEndByM_ :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+takingEndByM_ p = Scanl 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 = Scanl.takingEndByM_ (return . p)+--+{-# INLINE takingEndBy_ #-}+takingEndBy_ :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+takingEndBy_ p = takingEndByM_ (return . p)++{-# INLINE droppingWhileM #-}+droppingWhileM :: Monad m => (a -> m Bool) -> Scanl m a (Maybe a)+droppingWhileM p = Scanl 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 = Scanl.droppingWhileM (return . p)+--+{-# INLINE droppingWhile #-}+droppingWhile :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+droppingWhile p = droppingWhileM (return . p)++------------------------------------------------------------------------------+-- 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.toList $ Stream.scanl f s+-- "hello there"+--+-- >>> Stream.toList $ Stream.scanl Fold.toList $ Stream.toList $ Stream.scanlMany f s+-- ["hello there",". How are"," you?"]+--+-- /Pre-release/+{-# INLINE takeEndBySeq #-}+takeEndBySeq :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>+       Array.Array a+    -> Scanl m a b+    -> Scanl 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.unsafeGetIndexIO 0 patArr+                    return $ Partial $ SplitOnSeqSingle acc pat+                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->+                    return $ Partial $ SplitOnSeqWord acc 0 0+                | otherwise -> do+                    rb <- liftIO $ RingArray.emptyOf patLen+                    return $ Partial $ SplitOnSeqKR acc 0 rb 0+            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.scanl' 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.scanl' 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 $ RingArray.unsafeInsert rb rh x+                if idx == maxIndex+                then do+                    let fld = RingArray.unsafeFoldRing (RingArray.ringCapacity rb)+                    let !ringHash = fld addCksum 0 rb+                    if ringHash == patHash && RingArray.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 :: a) <- RingArray.unsafeGetIndex rh rb+                rh1 <- liftIO $ RingArray.unsafeInsert rb rh x+                let ringHash = deltaCksum cksum old x+                if ringHash == patHash && RingArray.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 = extractFunc fextract++    final = extractFunc ffinal++-- | Like 'takeEndBySeq' but discards the matched sequence.+--+-- /Pre-release/+--+{-# INLINE takeEndBySeq_ #-}+takeEndBySeq_ :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a) =>+       Array.Array a+    -> Scanl m a b+    -> Scanl 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.unsafeGetIndexIO 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 <- liftIO $ RingArray.emptyOf patLen+                    return $ Partial $ SplitOnSeqKR acc 0 rb 0+            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.scanl' 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.scanl' 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 $ RingArray.unsafeInsert rb rh x+        if idx == maxIndex+        then do+            let fld = RingArray.unsafeFoldRing (RingArray.ringCapacity rb)+            let !ringHash = fld addCksum 0 rb+            if ringHash == patHash && RingArray.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 <- RingArray.unsafeGetIndex rh rb+        res <- fstep s old+        case res of+            Partial s1 -> do+                rh1 <- liftIO $ RingArray.unsafeInsert rb rh x+                let ringHash = deltaCksum cksum old x+                if ringHash == patHash && RingArray.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 <- RingArray.unsafeGetIndex rh rb+                    let rh1 = RingArray.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 0+            SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh++    extract = extractFunc fextract++    final = extractFunc ffinal+    -}++------------------------------------------------------------------------------+-- Distributing+------------------------------------------------------------------------------+--+-- | Distribute one copy of the stream to each scan and zip the results.+--+-- @+--                 |-------Scanl m a b--------|+-- ---stream m a---|                          |---m (b,c)+--                 |-------Scanl m a c--------|+-- @+--+--  Definition:+--+-- >>> tee = Scanl.teeWith (,)+--+-- Example:+--+-- >>> t = Scanl.tee Scanl.sum Scanl.length+-- >>> Stream.toList $ Stream.scanl t (Stream.enumerateFromTo 1.0 10.0)+-- [(0.0,0),(1.0,1),(3.0,2),(6.0,3),(10.0,4),(15.0,5),(21.0,6),(28.0,7),(36.0,8),(45.0,9),(55.0,10)]+--+{-# INLINE tee #-}+tee :: Monad m => Scanl m a b -> Scanl m a c -> Scanl m a (b,c)+tee = teeWith (,)++-- XXX use unboxed Array for output to scale it to a large number of consumers?++-- | Distribute one copy of the stream to each scan and collect the results in+-- a container.+--+-- @+--+--                 |-------Scanl m a b--------|+-- ---stream m a---|                          |---m [b]+--                 |-------Scanl m a b--------|+--                 |                          |+--                            ...+-- @+--+-- >>> Stream.toList $ Stream.scanl (Scanl.distribute [Scanl.sum, Scanl.length]) (Stream.enumerateFromTo 1 5)+-- [[0,0],[1,1],[3,2],[6,3],[10,4],[15,5]]+--+-- >>> distribute = Prelude.foldr (Scanl.teeWith (:)) (Scanl.const [])+--+-- This is the consumer side dual of the producer side 'sequence' operation.+--+-- Stops as soon as any of the scans stop.+--+{-# INLINE distribute #-}+distribute :: Monad m => [Scanl m a b] -> Scanl m a [b]+distribute = Prelude.foldr (teeWith (:)) (const [])++------------------------------------------------------------------------------+-- Partitioning+------------------------------------------------------------------------------++{-+{-# INLINE partitionByMUsing #-}+partitionByMUsing :: Monad m =>+       (  (x -> y -> (x, y))+       -> Scanl m (Either b c) x+       -> Scanl m (Either b c) y+       -> Scanl m (Either b c) (x, y)+       )+    -> (a -> m (Either b c))+    -> Scanl m b x+    -> Scanl m c y+    -> Scanl 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))+ -}++data PartState sL sR = PartLeft !sL !sR | PartRight !sL !sR++-- | Partition the input over two scans using an 'Either' partitioning+-- predicate.+--+-- @+--+--                                     |-------Scanl b x--------|+-- -----stream m a --> (Either b c)----|                        |----(x,y)+--                                     |-------Scanl c y--------|+-- @+--+-- Example, send input to either scan randomly:+--+-- >>> :set -package random+-- >>> import System.Random (randomIO)+-- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a+-- >>> f = Scanl.partitionByM randomly Scanl.length Scanl.length+-- >>> Stream.toList $ Stream.scanl f (Stream.enumerateFromTo 1 10)+-- ...+--+-- Example, send input to the two scans in a proportion of 2:1:+--+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial+-- >>> :{+-- 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 = Scanl.partitionByM g Scanl.length Scanl.length+--  r <- Stream.toList $ Stream.scanl f (Stream.enumerateFromTo (1 :: Int) 10)+--  print r+-- :}+--+-- >>> main+-- ...+--+--+-- This is the consumer side dual of the producer side 'mergeBy' operation.+--+-- Terminates as soon as any of the scans terminate.+--+-- /Pre-release/+{-# INLINE partitionByM #-}+partitionByM :: Monad m+    => (a -> m (Either b c)) -> Scanl m b x -> Scanl m c x -> Scanl m a x+partitionByM f+    (Scanl stepL initialL extractL finalL)+    (Scanl stepR initialR extractR finalR) =+    Scanl step initial extract final++    where++    initial = do+        resL <- initialL+        resR <- initialR+        return+            $ case resL of+                  Done bl -> Done bl+                  Partial sl ->+                      case resR of+                            Partial sr -> Partial $ PartLeft sl sr+                            Done br -> Done br++    runBoth sL sR a = do+        pRes <- f a+        case pRes of+            Left b -> do+                resL <- stepL sL b+                case resL of+                    Partial s -> return $ Partial $ PartLeft s sR+                    Done x -> return $ Done x+            Right c -> do+                resR <- stepR sR c+                case resR of+                    Partial s -> return $ Partial $ PartRight sL s+                    Done x -> return $ Done x++    step (PartLeft sL sR) = runBoth sL sR+    step (PartRight sL sR) = runBoth sL sR++    extract (PartLeft sL _) = extractL sL+    extract (PartRight _ sR) = extractR sR++    final (PartLeft sL sR) = finalR sR *> finalL sL+    final (PartRight sL sR) = finalL sL *> finalR sR++{-+-- | Similar to 'partitionByM' but terminates when the first fold terminates.+--+{-# INLINE partitionByFstM #-}+partitionByFstM :: Monad m+    => (a -> m (Either b c)) -> Scanl m b x -> Scanl m c y -> Scanl 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)) -> Scanl m b x -> Scanl m c y -> Scanl 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 scan.+-- 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 = Scanl.partitionBy (\n -> if even n then Left n else Right n)+--                      (fmap (("Even " ++) . show) Scanl.length)+--                      (fmap (("Odd "  ++) . show) Scanl.length)+--   in Stream.toList $ Stream.postscanl f (Stream.enumerateFromTo 1 10)+-- :}+-- ["Odd 1","Even 1","Odd 2","Even 2","Odd 3","Even 3","Odd 4","Even 4","Odd 5","Even 5"]+--+-- /Pre-release/+{-# INLINE partitionBy #-}+partitionBy :: Monad m+    => (a -> Either b c) -> Scanl m b x -> Scanl m c x -> Scanl m a x+partitionBy f = partitionByM (return . f)++-- | Compose two scans such that the combined scan accepts a stream of 'Either'+-- and routes the 'Left' values to the first scan and 'Right' values to the+-- second scan.+--+-- Definition:+--+-- >>> partition = Scanl.partitionBy id+--+{-# INLINE partition #-}+partition :: Monad m+    => Scanl m b x -> Scanl m c x -> Scanl m (Either b c) x+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 => [Scanl m a b] -> Scanl m a [b]+-- partitionN fs = Fold step begin done+-}++------------------------------------------------------------------------------+-- Unzipping+------------------------------------------------------------------------------++{-# INLINE unzipWithMUsing #-}+unzipWithMUsing :: Monad m =>+       (  (x -> y -> (x, y))+       -> Scanl m (b, c) x+       -> Scanl m (b, c) y+       -> Scanl m (b, c) (x, y)+       )+    -> (a -> m (b, c))+    -> Scanl m b x+    -> Scanl m c y+    -> Scanl m a (x, y)+unzipWithMUsing t f fld1 fld2 =+    let f1 = lmap fst fld1  -- :: Scanl m (b, c) b+        f2 = lmap snd fld2  -- :: Scanl m (b, c) c+     in lmapM f (t (,) f1 f2)++-- | Like 'unzipWith' but with a monadic splitter function.+--+-- Definition:+--+-- >>> unzipWithM k f1 f2 = Scanl.lmapM k (Scanl.unzip f1 f2)+--+-- /Pre-release/+{-# INLINE unzipWithM #-}+unzipWithM :: Monad m+    => (a -> m (b,c)) -> Scanl m b x -> Scanl m c y -> Scanl 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)) -> Scanl m b x -> Scanl m c y -> Scanl m a (x, y)+unzipWithFstM = unzipWithMUsing teeWithFst++-- | Similar to 'unzipWithM' but terminates when any fold terminates.+--+{-# INLINE unzipWithMaxM #-}+unzipWithMaxM :: Monad m =>+    (a -> m (b,c)) -> Scanl m b x -> Scanl m c y -> Scanl m a (x,y)+unzipWithMaxM = unzipWithMUsing teeWithMax+-}++-- | Split elements in the input stream into two parts using a pure splitter+-- function, direct each part to a different scan and zip the results.+--+-- Definitions:+--+-- >>> unzipWith f = Scanl.unzipWithM (return . f)+-- >>> unzipWith f fld1 fld2 = Scanl.lmap f (Scanl.unzip fld1 fld2)+--+-- This scan terminates as soon as any of the input scans terminate.+--+-- /Pre-release/+{-# INLINE unzipWith #-}+unzipWith :: Monad m+    => (a -> (b,c)) -> Scanl m b x -> Scanl m c y -> Scanl m a (x,y)+unzipWith f = unzipWithM (return . f)++-- | Send the elements of tuples in a stream of tuples through two different+-- scans.+--+-- @+--+--                           |-------Scanl m a x--------|+-- ---------stream of (a,b)--|                          |----m (x,y)+--                           |-------Scanl m b y--------|+--+-- @+--+-- Definition:+--+-- >>> unzip = Scanl.unzipWith id+--+-- This is the consumer side dual of the producer side 'zip' operation.+--+{-# INLINE unzip #-}+unzip :: Monad m => Scanl m a x -> Scanl m b y -> Scanl m (a,b) (x,y)+unzip = unzipWith id++------------------------------------------------------------------------------+-- Combining streams and scans - 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 scan using the supplied function.+--+-- /Unimplemented/+--+{-# INLINE zipStreamWithM #-}+zipStreamWithM :: -- Monad m =>+    (a -> b -> m c) -> Stream m a -> Scanl m c x -> Scanl m b x+zipStreamWithM = undefined++-- | Zip a stream with the input of a scan.+--+-- >>> zip = Scanl.zipStreamWithM (curry return)+--+-- /Unimplemented/+--+{-# INLINE zipStream #-}+zipStream :: Monad m => Stream m a -> Scanl m (a, b) x -> Scanl m b x+zipStream = zipStreamWithM (curry return)++-- | Pair each element of a scan input with its index, starting from index 0.+--+{-# INLINE indexingWith #-}+indexingWith :: Monad m => Int -> (Int -> Int) -> Scanl m a (Maybe (Int, a))+indexingWith i f = fmap toMaybe $ mkScanl step initial++    where++    initial = Nothing'++    step Nothing' a = Just' (i, a)+    step (Just' (n, _)) a = Just' (f n, a)++-- |+-- >>> indexing = Scanl.indexingWith 0 (+ 1)+--+{-# INLINE indexing #-}+indexing :: Monad m => Scanl m a (Maybe (Int, a))+indexing = indexingWith 0 (+ 1)++-- |+-- >>> indexingRev n = Scanl.indexingWith n (subtract 1)+--+{-# INLINE indexingRev #-}+indexingRev :: Monad m => Int -> Scanl m a (Maybe (Int, a))+indexingRev n = indexingWith n (subtract 1)++-- | Pair each element of a scan input with its index, starting from index 0.+--+-- >>> indexed = Scanl.postscanlMaybe Scanl.indexing+--+{-# INLINE indexed #-}+indexed :: Monad m => Scanl m (Int, a) b -> Scanl m a b+indexed = postscanlMaybe indexing++-- | Change the predicate function of a Scanl from @a -> b@ to accept an+-- additional state input @(s, a) -> b@. Convenient to filter with an+-- addiitonal index or time input.+--+-- >>> filterWithIndex = Scanl.with Scanl.indexed Scanl.filter+--+-- @+-- filterWithAbsTime = with timestamped filter+-- filterWithRelTime = with timeIndexed filter+-- @+--+-- /Pre-release/+{-# INLINE with #-}+with ::+       (Scanl m (s, a) b -> Scanl m a b)+    -> (((s, a) -> c) -> Scanl m (s, a) b -> Scanl m (s, a) b)+    -> (((s, a) -> c) -> Scanl m a b -> Scanl m a b)+with f comb g = f . comb g . lmap snd++-- XXX Implement as a filter+-- sampleFromthen :: Monad m => Int -> Int -> Scanl 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 -> Scanl m a b -> Scanl 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 (Scanl m a b) -> Scanl 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 -> Scanl m a b -> Scanl m b c -> Scanl m a c+chunksBetween _low _high _f1 _f2 = undefined+-}++-- | A scan 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 Scanl.toList+--+-- /Pre-release/+{-# INLINE toStream #-}+toStream :: (Monad m, Monad n) => Scanl 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 Scanl.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) => Scanl 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 scan.+--+-- @+-- Stream.scanl (unfoldMany u f) == Stream.scanl f . Stream.unfoldMany u+-- @+--+-- /Pre-release/+{-# INLINE unfoldMany #-}+unfoldMany :: Monad m => Unfold m a b -> Scanl m b c -> Scanl m a c+unfoldMany (Unfold ustep inject) (Scanl fstep initial extract final) =+    Scanl 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+    -> Scanl m a (MutArray a)+bottomBy cmp n = Scanl step initial extract extract++    where++    initial = do+        arr <- MA.emptyOf' 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.unsafeGetIndex (i - 1) arr+            case x `cmp` x1 of+                LT -> do+                    MA.unsafePutIndex (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 = Scanl.topBy (flip cmp)+--+-- Example:+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.toList (Stream.scanl (Scanl.topBy compare 3) stream) >>= mapM MutArray.toList+-- [[],[17],[17,11],[17,11,9],[17,11,9],[17,11,9],[17,11,9],[17,11,9],[17,11,9],[17,11,9]]+--+-- /Pre-release/+--+{-# INLINE topBy #-}+topBy :: (MonadIO m, Unbox a) =>+       (a -> a -> Ordering)+    -> Int+    -> Scanl m a (MutArray a)+topBy cmp = bottomBy (flip cmp)++-- | Scan the input stream to top n elements.+--+-- Definition:+--+-- >>> top = Scanl.topBy compare+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.toList (Stream.scanl (Scanl.top 3) stream) >>= mapM MutArray.toList+-- [[],[17],[17,11],[17,11,9],[17,11,9],[17,11,9],[17,11,9],[17,11,9],[17,11,9],[17,11,9]]+--+-- /Pre-release/+{-# INLINE top #-}+top :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (MutArray a)+top = bottomBy $ flip compare++-- | Scan the input stream to bottom n elements.+--+-- Definition:+--+-- >>> bottom = Scanl.bottomBy compare+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.toList (Stream.scanl (Scanl.bottom 3) stream) >>= mapM MutArray.toList+-- [[],[1],[1,2],[1,2,3],[1,2,3],[1,2,3],[1,2,3],[1,2,3],[1,2,3],[1,2,3]]+--+-- /Pre-release/+{-# INLINE bottom #-}+bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl 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 -> Scanl m a b -> Scanl m b c -> Scanl m a c+intersperseWithQuotes+    quote+    esc+    separator+    (Scanl stepL initialL _ finalL)+    (Scanl stepR initialR extractR finalR) = Scanl 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/Scanl/Container.hs view
@@ -0,0 +1,850 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl.Container+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.Data.Scanl.Container+    (+    -- * Set operations+      toSet+    , toIntSet+    , countDistinct+    , countDistinctInt+    , nub+    , nubInt++    -- * Map operations+    -- , frequency++    -- ** Demultiplexing+    -- | Direct values in the input stream to different scans using an n-ary+    -- scan selector. 'demux' is a generalization of 'classify' (and+    -- 'partition') where each key of the classifier can use a different scan.+    --+    -- 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+    , demuxIO++    -- TODO: These can be implemented using the above operations+    -- , demuxSel -- Stop when the fold for the specified key stops+    -- , demuxMin -- Stop when any of the folds stop+    -- , demuxAll -- Stop when all the folds stop (run once)++    -- ** Classifying+    -- | In an input stream of key value pairs fold values for different keys+    -- in individual output buckets using the given fold. 'classify' is a+    -- special case of 'demux' where all the branches of the demultiplexer use+    -- the same scan.+    --+    -- Different types of maps can be used with these combinators via the IsMap+    -- type class. Hashmap performs better when there are more collisions, trie+    -- Map performs better otherwise. Trie has an advantage of sorting the keys+    -- at the same time.  For example if we want to store a dictionary of words+    -- and their meanings then trie Map would be better if we also want to+    -- display them in sorted order.++    {-+    , kvToMap++    , toContainer+    , toContainerIO+    , toMap+    , toMapIO+    -}++    , classifyGeneric+    , classify+    , classifyGenericIO+    , classifyIO+    -- , toContainerSel+    -- , toContainerMin+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.Map.Strict (Map)+import Data.IntSet (IntSet)+import Data.Set (Set)+import Streamly.Internal.Data.IsMap (IsMap(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))++import qualified Data.IntSet as IntSet+import qualified Data.Set as Set+import qualified Streamly.Internal.Data.IsMap as IsMap++import Prelude hiding (Foldable(..))+import Streamly.Internal.Data.Scanl.Type+-- import Streamly.Internal.Data.Scanl.Combinators++#include "DocTestDataScanl.hs"++-- | Scan the input adding it to a set.+--+-- Definition:+--+-- >>> toSet = Scanl.mkScanl (flip Set.insert) Set.empty+--+{-# INLINE toSet #-}+toSet :: (Monad m, Ord a) => Scanl m a (Set a)+toSet = mkScanl (flip Set.insert) Set.empty++-- | Scan the input adding it to an int set. For integer inputs this performs+-- better than 'toSet'.+--+-- Definition:+--+-- >>> toIntSet = Scanl.mkScanl (flip IntSet.insert) IntSet.empty+--+{-# INLINE toIntSet #-}+toIntSet :: Monad m => Scanl m Int IntSet+toIntSet = mkScanl (flip IntSet.insert) IntSet.empty++-- XXX Name as nubOrd? Or write a nubGeneric++-- | Returns 'Just' for the first occurrence of an element, returns 'Nothing'+-- for any other occurrences.+--+-- Example:+--+-- >>> stream = Stream.fromList [1::Int,1,2,3,4,4,5,1,5,7]+-- >>> Stream.toList $ Stream.postscanlMaybe Scanl.nub stream+-- [1,2,3,4,5,7]+--+-- /Pre-release/+{-# INLINE nub #-}+nub :: (Monad m, Ord a) => Scanl m a (Maybe a)+nub = fmap (\(Tuple' _ x) -> x) $ mkScanl step initial++    where++    initial = Tuple' Set.empty Nothing++    step (Tuple' set _) x =+        if Set.member x set+        then Tuple' set Nothing+        else Tuple' (Set.insert x set) (Just x)++-- | Like 'nub' but specialized to a stream of 'Int', for better performance.+--+-- /Pre-release/+{-# INLINE nubInt #-}+nubInt :: Monad m => Scanl m Int (Maybe Int)+nubInt = fmap (\(Tuple' _ x) -> x) $ mkScanl step initial++    where++    initial = Tuple' IntSet.empty Nothing++    step (Tuple' set _) x =+        if IntSet.member x set+        then Tuple' set Nothing+        else Tuple' (IntSet.insert x set) (Just x)++-- XXX Try Hash set+-- XXX Add a countDistinct window fold+-- XXX Add a bloom filter fold++-- | Count non-duplicate elements in the stream.+--+-- Definition:+--+-- >>> countDistinct = fmap Set.size Scanl.toSet+-- >>> countDistinct = Scanl.postscanl Scanl.nub $ Scanl.catMaybes $ Scanl.length+--+-- The memory used is proportional to the number of distinct elements in the+-- stream, to guard against using too much memory use it as a scan and+-- terminate if the count reaches more than a threshold.+--+-- /Space/: \(\mathcal{O}(n)\)+--+-- /Pre-release/+--+{-# INLINE countDistinct #-}+countDistinct :: (Monad m, Ord a) => Scanl m a Int+-- countDistinct = postscan nub $ catMaybes length+countDistinct = fmap Set.size toSet+{-+countDistinct = fmap (\(Tuple' _ n) -> n) $ foldl' step initial++    where++    initial = Tuple' Set.empty 0++    step (Tuple' set n) x = do+        if Set.member x set+        then+            Tuple' set n+        else+            let cnt = n + 1+             in Tuple' (Set.insert x set) cnt+-}++-- | Like 'countDistinct' but specialized to a stream of 'Int', for better+-- performance.+--+-- Definition:+--+-- >>> countDistinctInt = fmap IntSet.size Scanl.toIntSet+-- >>> countDistinctInt = Scanl.postscanl Scanl.nubInt $ Scanl.catMaybes $ Scanl.length+--+-- /Pre-release/+{-# INLINE countDistinctInt #-}+countDistinctInt :: Monad m => Scanl m Int Int+-- countDistinctInt = postscan nubInt $ catMaybes length+countDistinctInt = fmap IntSet.size toIntSet+{-+countDistinctInt = fmap (\(Tuple' _ n) -> n) $ foldl' step initial++    where++    initial = Tuple' IntSet.empty 0++    step (Tuple' set n) x = do+        if IntSet.member x set+        then+            Tuple' set n+        else+            let cnt = n + 1+             in Tuple' (IntSet.insert x set) cnt+ -}++------------------------------------------------------------------------------+-- demux: in a key value stream fold each key sub-stream with a different fold+------------------------------------------------------------------------------++-- TODO Demultiplex an input element into a number of typed variants. We want+-- to statically restrict the target values within a set of predefined types,+-- an enumeration of a GADT.+--+-- This is the consumer side dual of the producer side 'mux' operation (XXX to+-- be implemented).+--+-- XXX If we use Refold in it, it can perhaps fuse/be more efficient. For+-- example we can store just the result rather than storing the whole fold in+-- the Map. This would be similar to a refold based classify.+--+-- Note: There are separate functions to determine Key and Fold from the input+-- because key is to be determined on each input whereas fold is to be+-- determined only once for a key.+--+-- XXX If a scan terminates do not start it again? This can be easily done by+-- installing a drain fold after a fold is done.+--+-- XXX We can use the Scan drain step to drain the buffered map in the end.++-- | This is the most general of all demux, classify operations.+--+-- The first component of the output tuple is a key-value Map of in-progress+-- scans. The scan returns the scan result as the second component of the+-- output tuple.+--+-- See 'demux' for documentation.+{-# INLINE demuxGeneric #-}+demuxGeneric :: (Monad m, IsMap f, Traversable f) =>+       (a -> Key f)+    -> (Key f -> m (Maybe (Scanl m a b)))+    -> Scanl m a (m (f b), Maybe (Key f, b))+demuxGeneric getKey getFold =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) extract final++    where++    initial = return $ Tuple' IsMap.mapEmpty Nothing++    {-# INLINE runFold #-}+    runFold kv (Scanl step1 initial1 extract1 final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                case res1 of+                        Partial ss -> do+                            b <- extract1 ss+                            let fld = Scanl step1 (return res1) extract1 final1+                            return+                                $ Tuple'+                                    (IsMap.mapInsert k fld kv) (Just (k, b))+                        Done b ->+                            return+                                $ Tuple' (IsMap.mapDelete k kv) (Just (k, b))+            Done b ->+                -- Done in "initial" is possible only for the very first time+                -- the fold is initialized, and in that case we have not yet+                -- inserted it in the Map, so we do not need to delete it.+                return $ Tuple' kv (Just (k, b))++    step (Tuple' kv _) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                mfld <- getFold k+                case mfld of+                    Nothing -> pure $ Tuple' kv Nothing+                    Just fld -> runFold kv fld (k, a)+            Just f -> runFold kv f (k, a)++    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f (Scanl _ i e _) = do+            r <- i+            case r of+                Partial s -> e s+                _ -> error "demuxGeneric: unreachable code"++    final (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f (Scanl _ i _ fin) = do+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxGeneric: unreachable code"++{-# INLINE demuxUsingMap #-}+demuxUsingMap :: (Monad m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Scanl m a b)))+    -> Scanl m a (m (Map k b), Maybe (k, b))+demuxUsingMap = demuxGeneric++-- | @demux getKey getScan@: In a key value stream, scan values corresponding+-- to each key using a key specific scan. @getScan@ is invoked to generate a+-- key specific scan when a key is encountered for the first time in the+-- stream. If a scan does not exist corresponding to the key then 'Nothing' is+-- returned otherwise the result of the scan is returned.+--+-- If a scan terminates, another instance of the scan is started upon receiving+-- an input with that key, @getScan@ is invoked again whenever the key is+-- encountered again.+--+-- This can be used to scan a stream, splitting it based on different keys.+--+-- Since the scan generator function is monadic we can add scans dynamically.+-- For example, we can maintain a Map of keys to scans in an IORef and lookup+-- the scan from that corresponding to a key. This Map can be changed+-- dynamically, scans for new keys can be added or scans for old keys can be+-- deleted or modified.+--+-- Compare with 'classify', the scan in 'classify' is a static scan.+--+-- /Pre-release/+--+{-# INLINE demux #-}+demux :: (Monad m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Scanl m a b)))+    -> Scanl m a (Maybe (k, b))+demux getKey = fmap snd . demuxUsingMap getKey++-- XXX We can use the Scan drain step to drain the buffered map in the end.++-- | This is specialized version of 'demuxGeneric' that uses mutable IO cells+-- as scan accumulators for better performance.+--+-- Keep in mind that the values in the returned Map may be changed by the+-- ongoing scan if you are using those concurrently in another thread.+--+{-# INLINE demuxGenericIO #-}+demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) =>+       (a -> Key f)+    -> (Key f -> m (Maybe (Scanl m a b)))+    -> Scanl m a (m (f b), Maybe (Key f, b))+demuxGenericIO getKey getFold =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) extract final++    where++    initial = return $ Tuple' IsMap.mapEmpty Nothing++    {-# INLINE initFold #-}+    initFold kv (Scanl step1 initial1 extract1 final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                case res1 of+                    Partial ss -> do+                        -- XXX Instead of using a Fold type here use a custom+                        -- type with an IORef (possibly unboxed) for the+                        -- accumulator. That will reduce the allocations.+                        let fld = Scanl step1 (return res1) extract1 final1+                        ref <- liftIO $ newIORef fld+                        b <- extract1 ss+                        return+                            $ Tuple' (IsMap.mapInsert k ref kv) (Just (k, b))+                    Done b -> return $ Tuple' kv (Just (k, b))+            Done b -> return $ Tuple' kv (Just (k, b))++    {-# INLINE runFold #-}+    runFold kv ref (Scanl step1 initial1 extract1 final1) (k, a) = do+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                case res1 of+                        Partial ss -> do+                            let fld = Scanl step1 (return res1) extract1 final1+                            liftIO $ writeIORef ref fld+                            b <- extract1 ss+                            return $ Tuple' kv (Just (k, b))+                        Done b ->+                            let kv1 = IsMap.mapDelete k kv+                             in return $ Tuple' kv1 (Just (k, b))+            Done _ -> error "demuxGenericIO: unreachable"++    step (Tuple' kv _) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                res <- getFold k+                case res of+                    Nothing -> pure $ Tuple' kv Nothing+                    Just f -> initFold kv f (k, a)+            Just ref -> do+                f <- liftIO $ readIORef ref+                runFold kv ref f (k, a)++    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f ref = do+            Scanl _ i e _ <- liftIO $ readIORef ref+            r <- i+            case r of+                Partial s -> e s+                _ -> error "demuxGenericIO: unreachable code"++    final (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f ref = do+            Scanl _ i _ fin <- liftIO $ readIORef ref+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxGenericIO: unreachable code"++{-# INLINE demuxUsingMapIO #-}+demuxUsingMapIO :: (MonadIO m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Scanl m a b)))+    -> Scanl m a (m (Map k b), Maybe (k, b))+demuxUsingMapIO = demuxGenericIO++-- | This is specialized version of 'demux' that uses mutable IO cells as scan+-- accumulators for better performance.+--+{-# INLINE demuxIO #-}+demuxIO :: (MonadIO m, Ord k) =>+       (a -> k)+    -> (k -> m (Maybe (Scanl m a b)))+    -> Scanl m a (Maybe (k, b))+demuxIO getKey = fmap snd . demuxUsingMapIO getKey++{-+-- | 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) => Scanl m (Key f, a) (f a)+kvToMapOverwriteGeneric =+    mkScanl (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty++{-# INLINE demuxToContainer #-}+demuxToContainer :: (Monad m, IsMap f, Traversable f) =>+    (a -> Key f) -> (Key f -> m (Scanl m a b)) -> Scanl m a (f b)+demuxToContainer getKey getFold =+    let+        classifier = demuxGeneric getKey getFold+        getMap Nothing = pure IsMap.mapEmpty+        getMap (Just action) = action+        aggregator =+            teeWith IsMap.mapUnion+                (rmapM getMap $ lmap fst latest)+                (lmap snd $ catMaybes kvToMapOverwriteGeneric)+    in postscan classifier aggregator++-- | This collects all the results of 'demux' in a Map.+--+{-# INLINE demuxToMap #-}+demuxToMap :: (Monad m, Ord k) =>+    (a -> k) -> (k -> m (Scanl m a b)) -> Scanl m a (Map k b)+demuxToMap = demuxToContainer++{-# INLINE demuxToContainerIO #-}+demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>+    (a -> Key f) -> (Key f -> m (Scanl m a b)) -> Scanl m a (f b)+demuxToContainerIO getKey getFold =+    let+        classifier = demuxGenericIO getKey getFold+        getMap Nothing = pure IsMap.mapEmpty+        getMap (Just action) = action+        aggregator =+            teeWith IsMap.mapUnion+                (rmapM getMap $ lmap fst latest)+                (lmap snd $ catMaybes kvToMapOverwriteGeneric)+    in postscan classifier aggregator++-- | Same as 'demuxToMap' but uses 'demuxIO' for better performance.+--+{-# INLINE demuxToMapIO #-}+demuxToMapIO :: (MonadIO m, Ord k) =>+    (a -> k) -> (k -> m (Scanl m a b)) -> Scanl m a (Map k b)+demuxToMapIO = demuxToContainerIO++{-# INLINE demuxKvToContainer #-}+demuxKvToContainer :: (Monad m, IsMap f, Traversable f) =>+    (Key f -> m (Scanl m a b)) -> Scanl m (Key f, a) (f b)+demuxKvToContainer f = demuxToContainer fst (fmap (lmap snd) . f)++-- | Fold a stream of key value pairs using a function that maps keys to folds.+--+-- Definition:+--+-- >>> demuxKvToMap f = Fold.demuxToContainer fst (Fold.lmap snd . f)+--+-- Example:+--+-- >>> import Data.Map (Map)+-- >>> :{+--  let f "SUM" = return Fold.sum+--      f _ = return Fold.product+--      input = Stream.fromList [("SUM",1),("PRODUCT",2),("SUM",3),("PRODUCT",4)]+--   in Stream.fold (Fold.demuxKvToMap f) input :: IO (Map String Int)+-- :}+-- fromList [("PRODUCT",8),("SUM",4)]+--+-- /Pre-release/+{-# INLINE demuxKvToMap #-}+demuxKvToMap :: (Monad m, Ord k) =>+    (k -> m (Scanl m a b)) -> Scanl m (k, a) (Map k b)+demuxKvToMap = demuxKvToContainer+-}++------------------------------------------------------------------------------+-- Classify: Like demux but uses the same fold for all keys.+------------------------------------------------------------------------------++-- XXX Change these to make the behavior similar to demux* variants. We can+-- implement this using classifyScanManyWith. Maintain a set of done folds in+-- the underlying monad, and when initial is called look it up, if the fold is+-- done then initial would set a flag in the state to ignore the input or+-- return an error.++-- XXX Use a Refold m k a b so that we can make the fold key specifc.+-- XXX Is using a function (a -> k) better than using the input (k,a)?+--+-- XXX We can use the Scan drain step to drain the buffered map in the end.++{-# INLINE classifyGeneric #-}+classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>+    -- Note: we need to return the Map itself to display the in-progress values+    -- e.g. to implement top. We could possibly create a separate abstraction+    -- 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) -> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))+classifyGeneric f (Scanl step1 initial1 extract1 final1) =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) extract final++    where++    -- XXX Instead of keeping a Set, after a scan terminates just install a+    -- scan that always returns Partial/Nothing.+    initial = return $ Tuple3' IsMap.mapEmpty Set.empty Nothing++    {-# INLINE initFold #-}+    initFold kv set k a = do+        x <- initial1+        case x of+              Partial s -> do+                r <- step1 s a+                case r of+                  Partial s1 -> do+                    b <- extract1 s1+                    return+                        $ Tuple3' (IsMap.mapInsert k s1 kv) set (Just (k, b))+                  Done b ->+                    return $ Tuple3' kv set (Just (k, b))+              Done b -> return (Tuple3' kv (Set.insert k set) (Just (k, b)))++    step (Tuple3' kv set _) a = do+        let k = f a+        case IsMap.mapLookup k kv of+            Nothing -> do+                if Set.member k set+                then return (Tuple3' kv set Nothing)+                else initFold kv set k a+            Just s -> do+                r <- step1 s a+                case r of+                  Partial s1 -> do+                    b <- extract1 s1+                    return $ Tuple3' (IsMap.mapInsert k s1 kv) set (Just (k,b))+                  Done b ->+                    let kv1 = IsMap.mapDelete k kv+                     in return $ Tuple3' kv1 (Set.insert k set) (Just (k, b))++    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+            -- XXX Why are we doing this? If it is in the set then it will not+            -- be in the map and vice-versa.+            then extract1 s+            else final1 s++{-# INLINE classifyUsingMap #-}+classifyUsingMap :: (Monad m, Ord k) =>+    (a -> k) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))+classifyUsingMap = classifyGeneric++-- XXX Make it consistent with denux.++-- | Scans the values for each key using the supplied scan.+--+-- Once the scan for a key terminates, any future values of the key are ignored.+--+-- Equivalent to the following except that the scan is not restarted:+--+-- >>> classify f fld = Scanl.demux f (const fld)+--+{-# INLINE classify #-}+classify :: (MonadIO m, Ord k) =>+    (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))+classify getKey = fmap snd . classifyUsingMap getKey++-- XXX we can use a Prim IORef if we can constrain the state "s" to be Prim+--+-- The code is almost the same as classifyGeneric except the IORef operations.+--+-- XXX We can use the Scan drain step to drain the buffered map in the end.++-- | Be aware that the values in the intermediate Maps would be mutable.+--+{-# INLINE classifyGenericIO #-}+classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>+    (a -> Key f) -> Scanl m a b -> Scanl m a (m (f b), Maybe (Key f, b))+classifyGenericIO f (Scanl step1 initial1 extract1 final1) =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) extract final++    where++    initial = return $ Tuple3' IsMap.mapEmpty Set.empty Nothing++    {-# INLINE initFold #-}+    initFold kv set k a = do+        x <- initial1+        case x of+              Partial s -> do+                r <- step1 s a+                case r of+                      Partial s1 -> do+                        ref <- liftIO $ newIORef s1+                        b <- extract1 s1+                        return+                            $ Tuple3'+                                (IsMap.mapInsert k ref kv) set (Just (k, b))+                      Done b ->+                        return $ Tuple3' kv set (Just (k, b))+              Done b -> return (Tuple3' kv (Set.insert k set) (Just (k, b)))++    step (Tuple3' kv set _) a = do+        let k = f a+        case IsMap.mapLookup k kv of+            Nothing -> do+                if Set.member k set+                then return (Tuple3' kv set Nothing)+                else initFold kv set k a+            Just ref -> do+                s <- liftIO $ readIORef ref+                r <- step1 s a+                case r of+                      Partial s1 -> do+                        liftIO $ writeIORef ref s1+                        b <- extract1 s1+                        return $ Tuple3' kv set (Just (k, b))+                      Done b ->+                        let kv1 = IsMap.mapDelete k kv+                         in return+                                $ Tuple3' kv1 (Set.insert k set) (Just (k, b))++    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++{-# INLINE classifyUsingMapIO #-}+classifyUsingMapIO :: (MonadIO m, Ord k) =>+    (a -> k) -> Scanl m a b -> Scanl m a (m (Map k b), Maybe (k, b))+classifyUsingMapIO = classifyGenericIO++-- | Same as classify except that it uses mutable IORef cells in the+-- Map, providing better performance.+--+-- Equivalent to the following except that the scan is not restarted:+--+-- >>> classifyIO f fld = Scanl.demuxIO f (const fld)+--+{-# INLINE classifyIO #-}+classifyIO :: (MonadIO m, Ord k) =>+    (a -> k) -> Scanl m a b -> Scanl m a (Maybe (k, b))+classifyIO getKey = fmap snd . classifyUsingMapIO getKey++{-+{-# INLINE toContainer #-}+toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>+    (a -> Key f) -> Scanl m a b -> Scanl m a (f b)+toContainer f fld =+    let+        classifier = classifyGeneric f fld+        getMap Nothing = pure IsMap.mapEmpty+        getMap (Just action) = action+        aggregator =+            teeWith IsMap.mapUnion+                (rmapM getMap $ lmap fst latest)+                (lmap snd $ catMaybes kvToMapOverwriteGeneric)+    in postscan classifier aggregator++-- | Split the input stream based on a key field and fold each split using the+-- given fold. Useful for map/reduce, bucketizing the input in different bins+-- or for generating histograms.+--+-- Example:+--+-- >>> import Data.Map.Strict (Map)+-- >>> :{+--  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]+--      classify = Fold.toMap fst (Fold.lmap snd Fold.toList)+--   in Stream.fold classify input :: IO (Map String [Double])+-- :}+-- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]+--+-- Once the classifier fold terminates for a particular key any further inputs+-- in that bucket are ignored.+--+-- Space used is proportional to the number of keys seen till now and+-- monotonically increases because it stores whether a key has been seen or+-- not.+--+-- See 'demuxToMap' for a more powerful version where you can use a different+-- fold for each key. A simpler version of 'toMap' retaining only the last+-- value for a key can be written as:+--+-- >>> toMap = Fold.foldl' (\kv (k, v) -> Map.insert k v kv) Map.empty+--+-- /Stops: never/+--+-- /Pre-release/+--+{-# INLINE toMap #-}+toMap :: (Monad m, Ord k) =>+    (a -> k) -> Scanl m a b -> Scanl m a (Map k b)+toMap = toContainer++{-# INLINE toContainerIO #-}+toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>+    (a -> Key f) -> Scanl m a b -> Scanl m a (f b)+toContainerIO f fld =+    let+        classifier = classifyGenericIO f fld+        getMap Nothing = pure IsMap.mapEmpty+        getMap (Just action) = action+        aggregator =+            teeWith IsMap.mapUnion+                (rmapM getMap $ lmap fst latest)+                (lmap snd $ catMaybes kvToMapOverwriteGeneric)+    in postscan classifier aggregator++-- | Same as 'toMap' but maybe faster because it uses mutable cells as+-- fold accumulators in the Map.+--+{-# INLINE toMapIO #-}+toMapIO :: (MonadIO m, Ord k) =>+    (a -> k) -> Scanl m a b -> Scanl m a (Map k b)+toMapIO = toContainerIO++-- | Given an input stream of key value pairs and a fold for values, fold all+-- the values belonging to each key.  Useful for map/reduce, bucketizing the+-- input in different bins or for generating histograms.+--+-- Definition:+--+-- >>> kvToMap = Fold.toMap fst . Fold.lmap snd+--+-- Example:+--+-- >>> :{+--  let input = Stream.fromList [("ONE",1),("ONE",1.1),("TWO",2), ("TWO",2.2)]+--   in Stream.fold (Fold.kvToMap Fold.toList) input+-- :}+-- fromList [("ONE",[1.0,1.1]),("TWO",[2.0,2.2])]+--+-- /Pre-release/+{-# INLINE kvToMap #-}+kvToMap :: (Monad m, Ord k) => Scanl m a b -> Scanl m (k, a) (Map k b)+kvToMap = toMap fst . lmap snd++-- | Determine the frequency of each element in the stream.+--+-- You can just collect the keys of the resulting map to get the unique+-- elements in the stream.+--+-- Definition:+--+-- >>> frequency = Fold.toMap id Fold.length+--+{-# INLINE frequency #-}+frequency :: (Monad m, Ord a) => Scanl m a (Map a Int)+frequency = toMap id length+-}
+ src/Streamly/Internal/Data/Scanl/Type.hs view
@@ -0,0 +1,2030 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl.Type+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Scanl vs Pipe:+--+-- A scanl is a simpler version of pipes. A scan always produces an output and+-- may or may not consume an input. It can consume at most one input on one+-- output. Whereas a pipe may consume input even without producing anything or+-- it can consume multiple inputs on a single output. Scans are simpler+-- abstractions to think about and easier for the compiler to optimize.+--+-- Returning a stream on "extract":+--+-- Make the extract function return a Step and call extract until Done or+-- alternatively if a fold wants to return multiple values during finalization+-- then we can make the fold output itself a list or stream (on each step).+--+-- Maybe the extract function draining the buffer should be represented by a+-- pipe rather than a scan? It makes the scan behave like a pipe in the+-- finalization case.+--+-- Scan type:+--+-- We can represent the scan as:+--+-- step ::+--  Partial s+--  Done b+-- extract :: s -> b+-- final :: s -> b+--+-- This type allows the accumulator to be returned even if there is no input,+-- using final. This can implement "scanl" as well as "scanl1".+--+-- We can call extract any time, means that it can always produce a valid+-- value. If the input is not last the driver can call "extract", if it is last+-- then it can call "final".+--+-- This does not allow "id" to be implemented for Category instance. Because it+-- requires an output even if there is no input.+--+-- How about the following type?+--+-- step ::+--  Partial s b+--  Done b+-- final :: ()+--+-- This cannot produce output without an input. It can implement scanl1 but not+-- scanl. This can allow category instance, because "id" can be implemented.+-- But this cannot compose with Foldl type, as "final" does not return a value,+-- so the fold cannot return a value.+--+-- How about the following type?+--+-- step ::+--  Partial s b+--  Done b+-- final :: s -> b+--+-- In this case we may not be able to avoid duplicate output. If the fold has+-- already consumed an input, Partial would have returned an output on the last+-- input, then we decide to stop the fold and use "final" on it, which will+-- again produce possibly the same output.+--+module Streamly.Internal.Data.Scanl.Type+    (+      module Streamly.Internal.Data.Fold.Step++    -- * Scanl Type+    , Scanl (..)++    -- * Constructors+    , mkScanl+    , mkScanlM+    , mkScanl1+    , mkScanl1M+    , mkScant+    , mkScantM+    , mkScanr+    , mkScanrM++    -- * Scans+    , const+    -- , fromPure+    , constM+    -- , fromEffect+    , fromRefold+    -- , fromScan+    , drain+    , latest+    , functionM+    , toList+    , toStreamK+    , toStreamKRev+    , genericLength+    , length -- call it "count"?++    , maximumBy+    , maximum+    , minimumBy+    , minimum+    , rangeBy+    , range++    -- * Combinators++    -- ** Mapping output+    , rmapM++    -- ** Mapping Input+    , lmap+    , lmapM+    , postscanl++    -- ** Filtering+    , catMaybes+    , postscanlMaybe+    , filter+    , filtering+    , filterM+    , catLefts+    , catRights+    , catEithers++    -- ** Trimming+    , take+    , taking+    , takeEndBy_+    , takeEndBy+    , dropping++    {-+    -- ** Sequential application+    -- , splitWith -- rename to "append"+    -- , split_++    -- ** Repeated Application (Splitting)+    , ManyState+    , many+    , manyPost+    , groupsOf+    , refoldMany+    , refoldMany1++    -- ** Nested Application+    -- , concatMap+    -- , duplicate+    , refold+    -}++    -- ** Parallel Distribution+    , teeWith+    -- , teeWithFst+    -- , teeWithMax++    {-+    -- ** Parallel Alternative+    , shortest+    , longest++    -- * Running A Fold+    , extractM+    , reduce+    , snoc+    , addOne+    , snocM+    , snocl+    , snoclM+    , close+    , isClosed+    -}++    -- * Transforming inner monad+    , morphInner+    , generalizeInner+    )+where++#include "inline.hs"++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Monad ((>=>))+-- import Data.Bifunctor (Bifunctor(..))+import Data.Either (fromLeft, fromRight, isLeft, isRight)+import Data.Functor ((<&>))+import Data.Functor.Identity (Identity(..))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Refold.Type (Refold(..))+-- import Streamly.Internal.Data.Scan (Scan(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))++--import qualified Streamly.Internal.Data.Stream.Step as Stream+import qualified Streamly.Internal.Data.StreamK.Type as K++import Prelude hiding (Foldable(..), concatMap, filter, map, take, const)++-- Entire module is exported, do not import selectively+import Streamly.Internal.Data.Fold.Step++#include "DocTestDataScanl.hs"++------------------------------------------------------------------------------+-- The Scanl type+------------------------------------------------------------------------------++-- An fold is akin to a writer. It is the streaming equivalent of a writer.+-- The type @b@ is the accumulator of the writer. That's the reason the+-- default folds in various modules are called "write".++-- 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.+--+-- 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.++-- XXX The "final" function in a scan should not return an output. The output+-- from final would only be a duplicate of the last generated output. Since a+-- scan generates an ouput at each input, there should be nothing remaining to+-- be emitted during finalization.++-- | The type @Scanl 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 scan is @Scanl step initial extract final@.+--+-- The scan 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 scan 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 scan terminates.+--+-- The @extract@ function is used by the scan+-- driver to map the current state @s@ of the scan to the scan result. Thus+-- @extract@ can be called multiple times.+--+-- Before a scan terminates, @final@ is called once and only once (unless the+-- scan terminated in @initial@ itself). Any resources allocated by @initial@+-- can be released in @final@. In scan that do not require any cleanup+-- @extract@ and @final@ are typically the same.+--+-- When implementing scan 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 scan. Also, @final@ should not be called+-- more than once. Note that if a scan terminates by 'Done' constructor, there+-- is no state to cleanup.+--+-- NOTE: The constructor is not yet released, smart constructors are provided+-- to create scans.+--+data Scanl m a b =+  -- | @Scanl@ @step@ @initial@ @extract@ @final@+  forall s. Scanl (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b) (s -> m b)++{-+-- XXX Change the type to as follows. This takes care of the unfoldMany case+-- where we need to continue in produce mode. Though we need to see how it+-- impacts the key-value scans.+--+data Step s b =+      YieldC s b -- ^ Yield and consume+    | YieldP s b -- ^ Yield and produce+    | Stop b++data Scanl m a b =+  forall s. Scanl+    (s -> a -> m (Step s b)) -- consume step+    (m (Step s b))           -- initial+    (s -> m (Step s b))      -- produce step+    (s -> m (Step s b))      -- drain step+-}++------------------------------------------------------------------------------+-- Mapping on the output+------------------------------------------------------------------------------++-- | Map a monadic function on the output of a scan.+--+{-# INLINE rmapM #-}+rmapM :: Monad m => (b -> m c) -> Scanl m a b -> Scanl m a c+rmapM f (Scanl step initial extract final) =+    Scanl step1 initial1 (extract >=> f) (final >=> f)++    where++    initial1 = initial >>= mapMStep f+    step1 s a = step s a >>= mapMStep f++------------------------------------------------------------------------------+-- Left fold constructors+------------------------------------------------------------------------------++-- | Make a scan from a left fold style pure step function and initial value of+-- the accumulator.+--+-- If your 'Scanl' returns only 'Partial' (i.e. never returns a 'Done') then+-- you can use @mkScanl*@ constructors.+--+{-# INLINE mkScanl #-}+mkScanl :: Monad m => (b -> a -> b) -> b -> Scanl m a b+mkScanl step initial =+    Scanl+        (\s a -> return $ Partial $ step s a)+        (return (Partial initial))+        return+        return++-- | Make a scan from a left fold style monadic step function and initial value+-- of the accumulator.+--+{-# INLINE mkScanlM #-}+mkScanlM :: Monad m => (b -> a -> m b) -> m b -> Scanl m a b+mkScanlM step initial =+    Scanl (\s a -> Partial <$> step s a) (Partial <$> initial) return return++-- | Maps a function on the output of the scan (the type @b@).+instance Functor m => Functor (Scanl m a) where+    {-# INLINE fmap #-}+    fmap f (Scanl step1 initial1 extract final) =+        Scanl step initial (fmap2 f extract) (fmap2 f final)++        where++        initial = fmap2 f initial1+        step s b = fmap2 f (step1 s b)+        fmap2 g = fmap (fmap g)++-- | Make a strict left scan, for non-empty streams, using first element as the+-- starting value. Returns Nothing if the stream is empty.+--+-- /Pre-release/+{-# INLINE mkScanl1 #-}+mkScanl1 :: Monad m => (a -> a -> a) -> Scanl m a (Maybe a)+mkScanl1 step = fmap toMaybe $ mkScanl step1 Nothing'++    where++    step1 Nothing' a = Just' a+    step1 (Just' x) a = Just' $ step x a++-- | Like 'mkScanl1' but with a monadic step function.+--+-- /Pre-release/+{-# INLINE mkScanl1M #-}+mkScanl1M :: Monad m => (a -> a -> m a) -> Scanl m a (Maybe a)+mkScanl1M  step = fmap toMaybe $ mkScanlM step1 (return Nothing')++    where++    step1 Nothing' a = return $ Just' a+    step1 (Just' x) a = Just' <$> step x a++{-+data FromScan s b = FromScanInit !s | FromScanGo !s !b++-- XXX we can attach a scan on the last fold e.g. "runScan s last". Or run a+-- scan on a fold that supplies a default value?+--+-- If we are pushing a value to a scan and the scan stops we will lose the+-- input. Only those scans that do not use the Stop constructor can be used as+-- folds or with folds? The Stop constructor makes them suitable to be composed+-- with pull based streams, push based folds cannot work with that. Do we need+-- two types of scans then, scans for streams and scans for folds? ScanR and+-- ScanL?++-- | This does not work correctly yet. We lose the last input.+--+{-# INLINE fromScan #-}+fromScan :: Monad m => Scan m a b -> Scanl m a (Maybe b)+fromScan (Scan consume initial) =+    Fold fstep (return $ Partial (FromScanInit initial)) fextract fextract++    where++    fstep (FromScanInit ss) a = do+        r <- consume ss a+        return $ case r of+            Stream.Yield b s -> Partial (FromScanGo s b)+            Stream.Skip s -> Partial (FromScanInit s)+            -- XXX We have lost the input here.+            -- XXX Need to change folds to always return Done on the next input+            Stream.Stop -> Done Nothing+    fstep (FromScanGo ss acc) a = do+        r <- consume ss a+        return $ case r of+            Stream.Yield b s -> Partial (FromScanGo s b)+            Stream.Skip s -> Partial (FromScanGo s acc)+            -- XXX We have lost the input here.+            Stream.Stop -> Done (Just acc)++    fextract (FromScanInit _) = return Nothing+    fextract (FromScanGo _ acc) = return (Just acc)+-}++------------------------------------------------------------------------------+-- Right fold constructors+------------------------------------------------------------------------------++-- | Make a scan using a right fold style step function and a terminal value.+-- It performs a strict right fold via a left fold using function composition.+-- Note that a strict right fold can only be useful for constructing strict+-- structures in memory. For reductions this will be very inefficient.+--+-- Definitions:+--+-- >>> mkScanr f z = fmap (flip appEndo z) $ Scanl.foldMap (Endo . f)+-- >>> mkScanr f z = fmap ($ z) $ Scanl.mkScanl (\g x -> g . f x) id+--+-- Example:+--+-- >>> Stream.toList $ Stream.scanl (Scanl.mkScanr (:) []) $ Stream.enumerateFromTo 1 5+-- [[],[1],[1,2],[1,2,3],[1,2,3,4],[1,2,3,4,5]]+--+{-# INLINE mkScanr #-}+mkScanr :: Monad m => (a -> b -> b) -> b -> Scanl m a b+mkScanr f z = fmap ($ z) $ mkScanl (\g x -> g . f x) id++-- XXX we have not seen any use of this yet, not releasing until we have a use+-- case.++-- | Like mkScanr but with a monadic step function.+--+-- Example:+--+-- >>> toList = Scanl.mkScanrM (\a xs -> return $ a : xs) (return [])+--+-- /Pre-release/+{-# INLINE mkScanrM #-}+mkScanrM :: Monad m => (a -> b -> m b) -> m b -> Scanl m a b+mkScanrM g z =+    rmapM (z >>=) $ mkScanlM (\f x -> return $ g x >=> f) (return return)++------------------------------------------------------------------------------+-- General scan constructors+------------------------------------------------------------------------------++-- XXX If the Step yield gives the result each time along with the state then+-- we can make the type of this as+--+-- mkFold :: Monad m => (s -> a -> Step s b) -> Step s b -> Scanl m a b+--+-- Then similar to foldl' and foldr we can just fmap extract on it to extend+-- it to the version where an 'extract' function is required. Or do we even+-- need that?+--+-- Until we investigate this we are not releasing these.+--+-- XXX The above text would apply to+-- Streamly.Internal.Data.Parser.ParserD.Type.parser++-- | Make a terminating scan using a pure step function, a pure initial state+-- and a pure state extraction function.+--+-- /Pre-release/+--+{-# INLINE mkScant #-}+mkScant :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Scanl m a b+mkScant step initial extract =+    Scanl+        (\s a -> return $ step s a)+        (return initial)+        (return . extract)+        (return . extract)++-- | Make a terminating scan with an effectful step function and initial state,+-- and a state extraction function.+--+-- >>> mkScantM = Scanl.Scanl+--+--  We can just use 'Scanl' but it is provided for completeness.+--+-- /Pre-release/+--+{-# INLINE mkScantM #-}+mkScantM :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Scanl m a b+mkScantM step initial extract = Scanl step initial extract extract++------------------------------------------------------------------------------+-- Refold+------------------------------------------------------------------------------++-- This is similar to how we run an Unfold to generate a Stream. A Fold is like+-- a Stream and a Fold2 is like an Unfold.++-- | Make a scan from a consumer.+--+-- /Internal/+fromRefold :: Refold m c a b -> c -> Scanl m a b+fromRefold (Refold step inject extract) c =+    Scanl step (inject c) extract extract++------------------------------------------------------------------------------+-- Basic Scans+------------------------------------------------------------------------------++-- | A scan that drains all its input, running the effects and discarding the+-- results.+--+-- >>> drain = Scanl.drainMapM (const (return ()))+-- >>> drain = Scanl.mkScanl (\_ _ -> ()) ()+--+{-# INLINE drain #-}+drain :: Monad m => Scanl m a ()+drain = mkScanl (\_ _ -> ()) ()++-- | Returns the latest element of the input stream, if any.+--+-- >>> latest = Scanl.mkScanl1 (\_ x -> x)+-- >>> latest = fmap getLast $ Scanl.foldMap (Last . Just)+--+{-# INLINE latest #-}+latest :: Monad m => Scanl m a (Maybe a)+latest = mkScanl1 (\_ x -> x)++-- | Lift a Maybe returning function to a scan.+functionM :: Monad m => (a -> m (Maybe b)) -> Scanl m a (Maybe b)+functionM f = Scanl step initial return return++    where++    initial = return $ Partial Nothing++    step _ x = f x <&> Partial++-- | Scans the input stream building a list.+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Data.Array"+-- instead.+--+-- >>> toList = Scanl.mkScanr (:) []+--+{-# INLINE toList #-}+toList :: Monad m => Scanl m a [a]+toList = mkScanr (:) []++-- | Buffers the input stream to a pure stream in the reverse order of the+-- input.+--+-- This is more efficient than 'toStreamK'. toStreamK has exactly the same+-- performance as reversing the stream after toStreamKRev.+--+-- /Pre-release/++--  xn : ... : x2 : x1 : []+{-# INLINE toStreamKRev #-}+toStreamKRev :: Monad m => Scanl m a (K.StreamK n a)+toStreamKRev = mkScanl (flip K.cons) K.nil++-- | Scans its input building a pure stream.+--+-- >>> toStreamK = fmap StreamK.reverse Scanl.toStreamKRev+--+-- /Internal/+{-# INLINE toStreamK #-}+toStreamK :: Monad m => Scanl m a (K.StreamK n a)+toStreamK = mkScanr K.cons K.nil++-- | Like 'length', except with a more general 'Num' return value+--+-- Definition:+--+-- >>> genericLength = fmap getSum $ Scanl.foldMap (Sum . const  1)+-- >>> genericLength = Scanl.mkScanl (\n _ -> n + 1) 0+--+-- /Pre-release/+{-# INLINE genericLength #-}+genericLength :: (Monad m, Num b) => Scanl m a b+genericLength = mkScanl (\n _ -> n + 1) 0++-- | Determine the length of the input stream.+--+-- Definition:+--+-- >>> length = Scanl.genericLength+-- >>> length = fmap getSum $ Scanl.foldMap (Sum . const  1)+--+{-# INLINE length #-}+length :: Monad m => Scanl m a Int+length = genericLength++------------------------------------------------------------------------------+-- To Summary (Maybe)+------------------------------------------------------------------------------++{-# INLINE maxBy #-}+maxBy :: (a -> a -> Ordering) -> a -> a -> a+maxBy cmp x y =+    case cmp x y of+        GT -> x+        _ -> y++-- | Determine the maximum element in a stream using the supplied comparison+-- function.+--+{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe a)+maximumBy cmp = mkScanl1 (maxBy cmp)++-- | Determine the maximum element in a stream.+--+-- Definitions:+--+-- >>> maximum = Scanl.maximumBy compare+-- >>> maximum = Scanl.mkScanl1 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 $ Scanl.foldMap Data.Semigroup.Max+--+{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => Scanl m a (Maybe a)+maximum = mkScanl1 max++{-# INLINE minBy #-}+minBy :: (a -> a -> Ordering) -> a -> a -> a+minBy cmp x y =+    case cmp x y of+        GT -> y+        _ -> x++-- | Computes the minimum element with respect to the given comparison function+--+{-# INLINE minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe a)+minimumBy cmp = mkScanl1 (minBy cmp)++-- | Determine the minimum element in a stream using the supplied comparison+-- function.+--+-- Definitions:+--+-- >>> minimum = Scanl.minimumBy compare+-- >>> minimum = Scanl.mkScanl1 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 $ Scanl.foldMap Data.Semigroup.Min+--+{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => Scanl m a (Maybe a)+minimum = mkScanl1 min++extractRange :: Range a -> Maybe (a, a)+extractRange RangeNone = Nothing+extractRange (Range mn mx) = Just (mn, mx)++data Range a = RangeNone | Range !a !a++-- | Find minimum and maximum element using the provided comparison function.+--+{-# INLINE rangeBy #-}+rangeBy :: Monad m => (a -> a -> Ordering) -> Scanl m a (Maybe (a, a))+rangeBy cmp = fmap extractRange $ mkScanl step RangeNone++    where++    step RangeNone x = Range x x+    step (Range mn mx) x = Range (minBy cmp mn x) (maxBy cmp mx x)++-- | Find minimum and maximum elements i.e. (min, max).+--+{-# INLINE range #-}+range :: (Monad m, Ord a) => Scanl m a (Maybe (a, a))+range = fmap extractRange $ mkScanl step RangeNone++    where++    step RangeNone x = Range x x+    step (Range mn mx) x = Range (min mn x) (max mx x)++------------------------------------------------------------------------------+-- Instances+------------------------------------------------------------------------------++-- XXX These are singleton folds that are closed for input. The correspondence+-- to a nil stream would be a nil fold that returns "Done" in "initial" i.e. it+-- does not produce any accumulator value. However, we do not have a+-- representation of an empty value in folds, because the Done constructor+-- always produces a value (Done b). We can potentially use "Partial s b" and+-- "Done" to make the type correspond to the stream type. That may be possible+-- if we introduce the "Skip" constructor as well because after the last+-- "Partial s b" we have to emit a "Skip to Done" state to keep cranking the+-- fold until it is done.+--+-- There is also the asymmetry between folds and streams because folds have an+-- "initial" to initialize the fold without any input. A similar concept is+-- possible in streams as well to stop the stream. That would be a "closing"+-- operation for the stream which can be called even without consuming any item+-- from the stream or when we are done consuming.+--+-- However, the initial action in folds creates a discrepancy with the CPS+-- folds, and the same may be the case if we have a stop/cleanup operation in+-- streams.++{-+-- | Make a scan that yields the supplied value without consuming any input.+--+-- /Pre-release/+--+{-# INLINE fromPure #-}+fromPure :: Applicative m => b -> Scanl m a b+fromPure b = Scanl undefined (pure $ Done b) pure pure+-}++-- | Make a scan that yields the supplied value on any input.+--+-- /Pre-release/+--+{-# INLINE const #-}+const :: Applicative m => b -> Scanl m a b+const b = Scanl (\s _ -> pure $ Partial s) (pure $ Partial b) pure pure++{-+-- | Make a scan that yields the result of the supplied effectful action+-- without consuming further input.+--+-- /Pre-release/+--+{-# INLINE fromEffect #-}+fromEffect :: Applicative m => m b -> Scanl m a b+fromEffect b = Scanl undefined (Done <$> b) pure pure+-}++-- | Make a scan that runs the supplied effect once and then yields the result+-- on any input.+--+-- /Pre-release/+--+{-# INLINE constM #-}+constM :: Applicative m => m b -> Scanl m a b+constM b = Scanl (\s _ -> pure $ Partial s) (Partial <$> b) pure pure++{-+{-# ANN type SeqFoldState Fuse #-}+data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr++-- | Sequential fold application. Apply two folds sequentially to an input+-- stream.  The input is provided to the first fold, when it is done - the+-- remaining input is provided to the second fold. When the second fold is done+-- or if the input stream is over, the outputs of the two folds are combined+-- using the supplied function.+--+-- Example:+--+-- >>> header = Scanl.take 8 Scanl.toList+-- >>> line = Scanl.takeEndBy (== '\n') Scanl.toList+-- >>> f = Scanl.splitWith (,) header line+-- >>> Stream.fold f $ Stream.fromList "header: hello\n"+-- ("header: ","hello\n")+--+-- Note: This is dual to appending streams using 'Data.Stream.append'.+--+-- Note: this implementation allows for stream fusion but has quadratic time+-- 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.+--+-- 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 _ finalL)+    (Fold stepR initialR _ finalR) =+    Scanl step initial extract final++    where++    {-# INLINE runR #-}+    runR action f = bimap (SeqFoldR f) f <$> action++    {-# INLINE runL #-}+    runL action = do+        resL <- action+        chainStepM (return . SeqFoldL) (runR initialR . func) resL++    initial = runL initialL++    step (SeqFoldL st) a = runL (stepL st a)+    step (SeqFoldR f st) a = runR (stepR st a) f++    -- 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 -> finalR sR+                Done rR -> return rR++{-# ANN type SeqFoldState_ Fuse #-}+data SeqFoldState_ sl sr = SeqFoldL_ !sl | SeqFoldR_ !sr++-- | Same as applicative '*>'. Run two folds serially one after the other+-- discarding the result of the first.+--+-- This was written in the hope that it might be faster than implementing it+-- using splitWith, but the current benchmarks show that it has the same+-- performance. So do not expose it unless some benchmark shows benefit.+--+{-# INLINE split_ #-}+split_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b+split_ (Fold stepL initialL _ finalL) (Fold stepR initialR _ finalR) =+    Scanl step initial extract final++    where++    initial = do+        resL <- initialL+        case resL of+            Partial sl -> return $ Partial $ SeqFoldL_ sl+            Done _ -> do+                resR <- initialR+                return $ first SeqFoldR_ resR++    step (SeqFoldL_ st) a = do+        r <- stepL st a+        case r of+            Partial s -> return $ Partial (SeqFoldL_ s)+            Done _ -> do+                resR <- initialR+                return $ first SeqFoldR_ resR+    step (SeqFoldR_ st) a = do+        resR <- stepR st a+        return $ first SeqFoldR_ resR++    -- 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 -> finalR sR+            Done rR -> return rR++-- | 'Applicative' form of 'splitWith'. Split the input serially over two+-- folds. Note that this fuses but performance degrades quadratically with+-- respect to the number of compositions. It should be good to use for less+-- than 8 compositions.+instance Monad m => Applicative (Fold m a) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = splitWith id++    {-# INLINE (*>) #-}+    (*>) = split_++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++{-# ANN type TeeState Fuse #-}+data TeeState sL sR bL bR+    = TeeBoth !sL !sR+    | TeeLeft !bR !sL+    | TeeRight !bL !sR++-- | @teeWithMax k f1 f2@ distributes its input to both @f1@ and @f2@ until+-- both of them terminate. The output of the two scans is combined using the+-- function @k@.+--+-- XXX There are two choices:+--+-- 1. If one of them terminates before the other, the final value of+-- the other is used in the zipping function.+-- 2. Use a (Maybe a -> Maybe b -> c) zipping function+--+-- Which is better? We will find out based on the actual use cases.+--+{-# INLINE teeWithMax #-}+teeWithMax :: Monad m =>+    (a -> b -> c) -> Scanl m x a -> Scanl m x b -> Scanl m x c+teeWithMax f+    (Scanl stepL initialL extractL finalL)+    (Scanl stepR initialR extractR finalR) =+    Scanl step initial extract final++    where++    {-# INLINE runBoth #-}+    runBoth actionL actionR = do+        resL <- actionL+        resR <- actionR+        return+            $ case resL of+                  Partial sl ->+                      Partial+                          $ case resR of+                                Partial sr -> TeeBoth sl sr+                                Done br -> TeeLeft br sl+                  Done bl -> bimap (TeeRight bl) (f bl) resR++    initial = runBoth initialL initialR++    step (TeeBoth sL sR) a = runBoth (stepL sL a) (stepR sR a)+    step (TeeLeft bR sL) a = bimap (TeeLeft bR) (`f` bR) <$> stepL sL a+    step (TeeRight bL sR) a = bimap (TeeRight bL) (f bL) <$> stepR sR a++    extract (TeeBoth sL sR) = f <$> extractL sL <*> extractR sR+    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+    | TeeFstLeft !b !sL++-- | Like 'teeWith' but terminates only when the first scan terminates. If the+-- second scan terminates earlier then its final value is used in the zipping+-- function.+--+-- /Pre-release/+--+{-# INLINE teeWithFst #-}+teeWithFst :: Monad m =>+    (b -> c -> d) -> Scanl m a b -> Scanl m a c -> Scanl m a d+teeWithFst f+    (Scanl stepL initialL extractL finalL)+    (Scanl stepR initialR extractR finalR) =+    Scanl step initial extract final++    where++    {-# INLINE runBoth #-}+    runBoth actionL actionR = do+        resL <- actionL+        resR <- actionR++        case resL of+            Partial sl ->+                return+                    $ Partial+                    $ case resR of+                        Partial sr -> TeeFstBoth sl sr+                        Done br -> TeeFstLeft br sl+            Done bl -> do+                Done . f bl <$>+                    case resR of+                        Partial sr -> finalR sr+                        Done br -> return br++    initial = runBoth initialL initialR++    step (TeeFstBoth sL sR) a = runBoth (stepL sL a) (stepR sR a)+    step (TeeFstLeft bR sL) a = bimap (TeeFstLeft bR) (`f` bR) <$> stepL sL a++    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+-}++-- | @teeWith k f1 f2@ distributes its input to both @f1@ and @f2@ until any+-- one of them terminates. The outputs of the two scans are combined using the+-- function @k@.+--+-- Definition:+--+-- >>> teeWith k f1 f2 = fmap (uncurry k) (Scanl.tee f1 f2)+--+-- Example:+--+-- >>> avg = Scanl.teeWith (/) Scanl.sum (fmap fromIntegral Scanl.length)+-- >>> Stream.toList $ Stream.postscanl avg $ Stream.fromList [1.0..10.0]+-- [1.0,1.5,2.0,2.5,3.0,3.5,4.0,4.5,5.0,5.5]+--+-- Note that nested applications of teeWith do not fuse.+--+-- /Pre-release/+--+{-# INLINE teeWith #-}+teeWith :: Monad m =>+    (b -> c -> d) -> Scanl m a b -> Scanl m a c -> Scanl m a d+teeWith f+    (Scanl stepL initialL extractL finalL)+    (Scanl stepR initialR extractR finalR) =+    Scanl step initial extract final++    where++    {-# INLINE runBoth #-}+    runBoth actionL actionR = do+        resL <- actionL+        resR <- actionR+        case resL of+            Partial sl -> do+                case resR of+                    Partial sr -> return $ Partial $ Tuple' sl sr+                    Done br -> Done . (`f` br) <$> finalL sl++            Done bl -> do+                Done . f bl <$>+                    case resR of+                        Partial sr -> finalR sr+                        Done br -> return br++    initial = runBoth initialL initialR++    step (Tuple' sL sR) a = runBoth (stepL sL a) (stepR sR a)++    extract (Tuple' sL sR) = f <$> extractL sL <*> extractR sR++    final (Tuple' sL sR) = f <$> finalL sL <*> finalR sR++instance Monad m => Applicative (Scanl m a) where+    {-# INLINE pure #-}+    pure = const++    (<*>) = teeWith id++{-+-- XXX this does not make sense as a scan.+--+-- | 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.+--+-- If both the folds finish at the same time or if the result is extracted+-- before any of the folds could finish then the left one is taken.+--+-- /Pre-release/+--+{-# INLINE shortest #-}+shortest :: Monad m => Scanl m x a -> Scanl m x b -> Scanl m x (Either a b)+shortest (Scanl stepL initialL extractL finalL) (Scanl stepR initialR _ finalR) =+    Scanl step initial extract final++    where++    {-# INLINE runBoth #-}+    runBoth actionL actionR = do+        resL <- actionL+        resR <- actionR+        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++    step (Tuple' sL sR) a = runBoth (stepL sL a) (stepR sR a)++    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+    | LongestLeft !sL+    | LongestRight !sR++-- | Longest alternative. Apply both folds in parallel but choose the result+-- from the one which consumed more input i.e. take the longest succeeding+-- fold.+--+-- If both the folds finish at the same time or if the result is extracted+-- before any of the folds could finish then the left one is taken.+--+-- /Pre-release/+--+{-# INLINE longest #-}+longest :: Monad m => Scanl m x a -> Scanl m x b -> Scanl m x (Either a b)+longest+    (Scanl stepL initialL _ finalL)+    (Scanl stepR initialR _ finalR) =+    Scanl step initial extract final++    where++    {-# INLINE runBoth #-}+    runBoth actionL actionR = do+        resL <- actionL+        resR <- actionR+        return $+            case resL of+                Partial sL ->+                    Partial $+                        case resR of+                            Partial sR -> LongestBoth sL sR+                            Done _ -> LongestLeft sL+                Done bL -> bimap LongestRight (const (Left bL)) resR++    initial = runBoth initialL initialR++    step (LongestBoth sL sR) a = runBoth (stepL sL a) (stepR sR a)+    step (LongestLeft sL) a = bimap LongestLeft Left <$> stepL sL a+    step (LongestRight sR) a = bimap LongestRight Right <$> stepR sR a++    -- 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."++    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 is akin to an n-ary version of 'splitWith' where the+-- next fold for splitting the input is decided dynamically using the previous+-- result. This operation can be used to express data dependencies+-- between fold operations.+--+-- Let's say the first element in the stream is a count of the following+-- elements that we have to add, then:+--+-- >>> import Data.Maybe (fromJust)+-- >>> count = fmap fromJust Scanl.one+-- >>> total n = Scanl.take n Scanl.sum+-- >>> Stream.fold (Scanl.concatMap total count) $ Stream.fromList [10,9..1]+-- 45+--+-- This does not fuse completely, see 'refold' for a fusible alternative.+--+-- /Time: O(n^2) where @n@ is the number of compositions./+--+-- See also: 'Streamly.Internal.Data.Stream.foldIterateM', 'refold'+--+{-# INLINE concatMap #-}+concatMap :: Monad m => (b -> Scanl m a c) -> Scanl m a b -> Scanl m a c+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 finala)+            Done b -> initInnerFold (f b)++    stepc (B s fin) a = do+        r <- stepa s a+        case r of+            Partial s1 -> return $ Partial (B s1 fin)+            Done b -> initInnerFold (f b)++    stepc (C stepInner s extractInner fin) a = do+        r <- stepInner s a+        return $ case r of+            Partial sc -> Partial (C stepInner sc extractInner fin)+            Done c -> Done c++    -- XXX Cannot use for scanning+    extractc _ = error "concatMap: cannot be used for scanning"++    initInnerFold (Scanl step i e fin) = do+        r <- i+        return $ case r of+            Partial s -> Partial (C step s e fin)+            Done c -> Done c++    initFinalize (Fold _ i _ fin) = do+        r <- i+        case r of+            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+------------------------------------------------------------------------------++-- | @lmap f scan@ maps the function @f@ on the input of the scan.+--+-- Definition:+--+-- >>> lmap = Scanl.lmapM return+--+-- Example:+--+-- >>> sumSquared = Scanl.lmap (\x -> x * x) Scanl.sum+-- >>> Stream.toList $ Stream.scanl sumSquared (Stream.enumerateFromTo 1 10)+-- [0,1,5,14,30,55,91,140,204,285,385]+--+{-# INLINE lmap #-}+lmap :: (a -> b) -> Scanl m b r -> Scanl m a r+lmap f (Scanl step begin done final) = Scanl step' begin done final+    where+    step' x a = step x (f a)++-- | @lmapM f scan@ maps the monadic function @f@ on the input of the scan.+--+{-# INLINE lmapM #-}+lmapM :: Monad m => (a -> m b) -> Scanl m b r -> Scanl m a r+lmapM f (Scanl step begin done final) = Scanl step' begin done final+    where+    step' x a = f a >>= step x++-- | Postscan the input of a 'Scanl' to change it in a stateful manner using+-- another 'Scanl'.+--+-- This is basically an append operation.+--+-- /Pre-release/+{-# INLINE postscanl #-}+postscanl :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+postscanl+    (Scanl stepL initialL extractL finalL)+    (Scanl stepR initialR extractR finalR) =+    Scanl 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 -> 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+        rR <- initialR+        case rR of+            Partial sR -> do+                rL <- initialL+                case rL of+                    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+------------------------------------------------------------------------------++-- | Modify a scan to receive a 'Maybe' input, the 'Just' values are unwrapped+-- and sent to the original scan, 'Nothing' values are discarded.+--+-- >>> catMaybes = Scanl.mapMaybe id+-- >>> catMaybes = Scanl.filter isJust . Scanl.lmap fromJust+--+{-# INLINE_NORMAL catMaybes #-}+catMaybes :: Monad m => Scanl m a b -> Scanl m (Maybe a) b+catMaybes (Scanl step initial extract final) =+    Scanl step1 initial extract final++    where++    step1 s a =+        case a of+            Nothing -> return $ Partial s+            Just x -> step s x++-- | Scan using a 'Maybe' returning scan, filter out 'Nothing' values.+--+-- >>> postscanlMaybe p f = Scanl.postscanl p (Scanl.catMaybes f)+--+-- /Pre-release/+{-# INLINE postscanlMaybe #-}+postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Scanl m b c -> Scanl m a c+postscanlMaybe f1 f2 = postscanl f1 (catMaybes f2)++-- | A scan for filtering elements based on a predicate.+--+{-# INLINE filtering #-}+filtering :: Monad m => (a -> Bool) -> Scanl m a (Maybe a)+filtering f = mkScanl step Nothing++    where++    step _ a = if f a then Just a else Nothing++-- | Include only those elements that pass a predicate.+--+-- >>> Stream.toList $ Stream.scanl (Scanl.filter (> 5) Scanl.sum) $ Stream.fromList [1..10]+-- [0,0,0,0,0,0,6,13,21,30,40]+--+-- >>> filter p = Scanl.postscanlMaybe (Scanl.filtering p)+-- >>> filter p = Scanl.filterM (return . p)+-- >>> filter p = Scanl.mapMaybe (\x -> if p x then Just x else Nothing)+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Scanl m a r -> Scanl m a r+-- filter p = postscanlMaybe (filtering p)+filter f (Scanl step begin extract final) = Scanl step' begin extract final+    where+    step' x a = if f a then step x a else return $ Partial x++-- | Like 'filter' but with a monadic predicate.+--+-- >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing+-- >>> filterM p = Scanl.mapMaybeM (f p)+--+{-# INLINE filterM #-}+filterM :: Monad m => (a -> m Bool) -> Scanl m a r -> Scanl m a r+filterM f (Scanl step begin extract final) = Scanl step' begin extract final+    where+    step' x a = do+      use <- f a+      if use then step x a else return $ Partial x++------------------------------------------------------------------------------+-- Either streams+------------------------------------------------------------------------------++-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.+--+-- /Pre-release/+--+{-# INLINE catLefts #-}+catLefts :: (Monad m) => Scanl m a c -> Scanl m (Either a b) c+catLefts = filter isLeft . lmap (fromLeft undefined)++-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.+--+-- /Pre-release/+--+{-# INLINE catRights #-}+catRights :: (Monad m) => Scanl m b c -> Scanl m (Either a b) c+catRights = filter isRight . lmap (fromRight undefined)++-- | Remove the either wrapper and flatten both lefts and as well as rights in+-- the output stream.+--+-- Definition:+--+-- >>> catEithers = Scanl.lmap (either id id)+--+-- /Pre-release/+--+{-# INLINE catEithers #-}+catEithers :: Scanl m a b -> Scanl m (Either a a) b+catEithers = lmap (either id id)++------------------------------------------------------------------------------+-- Parsing+------------------------------------------------------------------------------++-- Required to fuse "take" with "many" in "groupsOf", for ghc-9.x+{-# ANN type Tuple'Fused Fuse #-}+data Tuple'Fused a b = Tuple'Fused !a !b deriving Show++{-# INLINE taking #-}+taking :: Monad m => Int -> Scanl m a (Maybe a)+taking n = mkScant step initial extract++    where++    initial =+        if n <= 0+        then Done Nothing+        else Partial (Tuple'Fused n Nothing)++    step (Tuple'Fused i _) a =+        if i > 1+        then Partial (Tuple'Fused (i - 1) (Just a))+        else Done (Just a)++    extract (Tuple'Fused _ r) = r++{-# INLINE dropping #-}+dropping :: Monad m => Int -> Scanl m a (Maybe a)+dropping n = mkScant step initial extract++    where++    initial = Partial (Tuple'Fused n Nothing)++    step (Tuple'Fused i _) a =+        if i > 0+        then Partial (Tuple'Fused (i - 1) Nothing)+        else Partial (Tuple'Fused i (Just a))++    extract (Tuple'Fused _ r) = r++-- | Take at most @n@ input elements and scan them using the supplied scan. A+-- negative count is treated as 0.+--+-- >>> Stream.toList $ Stream.scanl (Scanl.take 2 Scanl.toList) $ Stream.fromList [1..10]+-- [[],[1],[1,2]]+--+{-# INLINE take #-}+take :: Monad m => Int -> Scanl m a b -> Scanl m a b+-- take n = postscanlMaybe (taking n)+take n (Scanl fstep finitial fextract ffinal) = Scanl step initial extract final++    where++    {-# INLINE next #-}+    next i res =+        case res of+            Partial s -> do+                let i1 = i + 1+                    s1 = Tuple'Fused i1 s+                if i1 < n+                then return $ Partial s1+                else Done <$> ffinal s+            Done b -> return $ Done b++    initial = finitial >>= next (-1)++    step (Tuple'Fused i r) a = fstep r a >>= next i++    extract (Tuple'Fused _ r) = fextract r++    final (Tuple'Fused _ r) = ffinal r++-- Note: Keep this consistent with S.splitOn. In fact we should eliminate+-- S.splitOn in favor of the fold.+--+-- XXX Use Scanl.many instead once it is fixed.+-- > Stream.splitOnSuffix p f = Stream.foldMany (Scanl.takeEndBy_ p f)++-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Scanl.takeEndBy_ (== '\n') Scanl.toList+-- >>> Stream.toList $ Stream.scanl line input+-- ["","h","he","hel","hell","hello","hello"]+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => (a -> Bool) -> Scanl m a b -> Scanl m a b+-- takeEndBy_ predicate = postscanlMaybe (takingEndBy_ predicate)+takeEndBy_ predicate (Scanl fstep finitial fextract ffinal) =+    Scanl 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 (Scanl.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 = Scanl.takeEndBy (== '\n') Scanl.toList+-- >>> Stream.toList $ Stream.scanl line input+-- ["","h","he","hel","hell","hello","hello\n"]+--+{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Scanl m a b -> Scanl m a b+-- takeEndBy predicate = postscanlMaybe (takingEndBy predicate)+takeEndBy predicate (Scanl fstep finitial fextract ffinal) =+    Scanl 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++------------------------------------------------------------------------------+-- Nesting+------------------------------------------------------------------------------++-- Similar to the comonad "duplicate" operation.++{-+-- | 'duplicate' provides the ability to run a fold in parts.  The duplicated+-- fold consumes the input and returns the same fold as output instead of+-- returning the final result, the returned fold can be run later to consume+-- more input.+--+-- 'duplicate' essentially appends a stream to the fold without finishing the+-- fold.  Compare with 'snoc' which appends a singleton value to the fold.+--+-- /Pre-release/+{-# INLINE duplicate #-}+duplicate :: Monad m => Scanl m a b -> Scanl m a (Scanl m a b)+duplicate (Fold step1 initial1 extract1 final1) =+    Scanl step initial extract final++    where++    initial = second fromPure <$> initial1++    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 Scanl. But we do not have a flushing+-- action in streams.++-- | Evaluate the initialization effect of a fold. If we are building the fold+-- by chaining lazy actions in fold init this would reduce the actions to a+-- strict accumulator value.+--+-- /Pre-release/+{-# INLINE reduce #-}+reduce :: Monad m => Scanl m a b -> m (Scanl m a b)+reduce (Scanl step initial extract final) = do+    i <- initial+    return $ Scanl step (return i) extract final++-- This is the dual of Stream @cons@.++-- | Append an effect to the fold lazily, in other words run a single+-- step of the fold.+--+-- /Pre-release/+{-# INLINE snoclM #-}+snoclM :: Monad m => Scanl m a b -> m a -> Scanl m a b+snoclM (Scanl fstep finitial fextract ffinal) action =+    Scanl fstep initial fextract ffinal++    where++    initial = do+        res <- finitial+        case res of+            Partial fs -> action >>= fstep fs+            Done b -> return $ Done b++-- | Append a singleton value to the fold lazily, in other words run a single+-- step of the fold.+--+-- Definition:+--+-- >>> snocl f = Scanl.snoclM f . return+--+-- Example:+--+-- >>> import qualified Data.Foldable as Foldable+-- >>> Scanl.extractM $ Foldable.foldl Scanl.snocl Scanl.toList [1..3]+-- [1,2,3]+--+-- /Pre-release/+{-# INLINE snocl #-}+snocl :: Monad m => Scanl m a b -> a -> Scanl m a b+-- snocl f = snoclM f . return+snocl (Scanl fstep finitial fextract ffinal) a =+    Scanl fstep initial fextract ffinal++    where++    initial = do+        res <- finitial+        case res of+            Partial fs -> fstep fs a+            Done b -> return $ Done b++-- | Append a singleton value to the fold in other words run a single step of+-- the fold.+--+-- Definition:+--+-- >>> snocM f = Scanl.reduce . Scanl.snoclM f+--+-- /Pre-release/+{-# INLINE snocM #-}+snocM :: Monad m => Scanl m a b -> m a -> m (Scanl m a b)+snocM (Scanl step initial extract final) action = do+    res <- initial+    r <- case res of+          Partial fs -> action >>= step fs+          Done _ -> return res+    return $ Scanl step (return r) extract final++-- Definitions:+--+-- >>> snoc f = Scanl.reduce . Scanl.snocl f+-- >>> snoc f = Scanl.snocM f . return++-- | Append a singleton value to the fold, in other words run a single step of+-- the fold.+--+-- Example:+--+-- >>> import qualified Data.Foldable as Foldable+-- >>> Foldable.foldlM Scanl.snoc Scanl.toList [1..3] >>= Scanl.drive Stream.nil+-- [1,2,3]+--+-- /Pre-release/+{-# INLINE snoc #-}+snoc :: Monad m => Scanl m a b -> a -> m (Scanl m a b)+snoc (Scanl step initial extract final) a = do+    res <- initial+    r <- case res of+          Partial fs -> step fs a+          Done _ -> return res+    return $ Scanl step (return r) extract final++-- | Append a singleton value to the fold.+--+-- See examples under 'addStream'.+--+-- /Pre-release/+{-# INLINE addOne #-}+addOne :: Monad m => a -> Scanl m a b -> m (Scanl m a b)+addOne = flip snoc++-- Similar to the comonad "extract" operation.+-- XXX rename to extract. We can use "extr" for the fold extract function.++-- | Extract the accumulated result of the fold.+--+-- Definition:+--+-- >>> extractM = Scanl.drive Stream.nil+--+-- Example:+--+-- >>> Scanl.extractM Scanl.toList+-- []+--+-- /Pre-release/+{-# INLINE extractM #-}+extractM :: Monad m => Scanl m a b -> m b+extractM (Scanl _ initial extract _) = do+    res <- initial+    case res of+          Partial fs -> extract fs+          Done b -> return b++-- | Close a fold so that it does not accept any more input.+{-# INLINE close #-}+close :: Monad m => Scanl m a b -> Scanl m a b+close (Scanl _ initial1 _ final1) =+    Scanl undefined initial undefined undefined++    where++    initial = do+        res <- initial1+        case res of+              Partial s -> Done <$> final1 s+              Done b -> return $ Done b++-- Corresponds to the null check for streams.++-- | Check if the fold has terminated and can take no more input.+--+-- /Pre-release/+{-# INLINE isClosed #-}+isClosed :: Monad m => Scanl m a b -> m Bool+isClosed (Scanl _ initial _ _) = do+    res <- initial+    return $ case res of+          Partial _ -> False+          Done _ -> True+-}++------------------------------------------------------------------------------+-- Parsing+------------------------------------------------------------------------------++-- All the grouping transformation that we apply to a stream can also be+-- applied to a fold input stream. groupBy et al can be written as terminating+-- folds and then we can apply "many" to use those repeatedly on a stream.++-- XXX many should have the following signature:+-- many :: Monad m => Foldl m a b -> Scanl m b c -> Scanl m a (Maybe c)+-- Should return Nothing in the intermediate state and Just when the first fold+-- completes and is fed to the second fold.++{-+{-# ANN type ManyState Fuse #-}+data ManyState s1 s2+    = ManyFirst !s1 !s2+    | ManyLoop !s1 !s2++-- | Collect zero or more applications of a fold.  @many first second@ applies+-- the @first@ fold repeatedly on the input stream and accumulates it's results+-- using the @second@ fold.+--+-- >>> two = Scanl.take 2 Scanl.toList+-- >>> twos = Scanl.many two Scanl.toList+-- >>> Stream.fold twos $ Stream.fromList [1..10]+-- [[1,2],[3,4],[5,6],[7,8],[9,10]]+--+-- Stops when @second@ fold stops.+--+-- See also: 'Data.Stream.concatMap', 'Data.Stream.foldMany'+--+{-# INLINE many #-}+many :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+many+    (Scanl sstep sinitial sextract sfinal)+    (Scanl cstep cinitial cextract cfinal) =+    Scanl step initial extract final++    where++    -- cs = collect state+    -- ss = split state+    -- cres = collect state result+    -- sres = split state result+    -- cb = collect done+    -- sb = split done++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    {-# INLINE split #-}+    split f cs sres =+        case sres of+            Partial ss -> return $ Partial $ f ss cs+            Done sb -> cstep cs sb >>= collect++    collect cres =+        case cres of+            Partial cs -> sinitial >>= split ManyFirst cs+            Done cb -> return $ Done cb++    -- A fold may terminate even without accepting a single input.  So we run+    -- the split fold's initial action even if no input is received.  However,+    -- this means that if no input was ever received by "step" we discard the+    -- fold's initial result which could have generated an effect. However,+    -- note that if "sinitial" results in Done we do collect its output even+    -- though the fold may not have received any input. XXX Is this+    -- inconsistent?+    initial = cinitial >>= collect++    {-# INLINE step_ #-}+    step_ ss cs a = sstep ss a >>= split ManyLoop cs++    {-# INLINE step #-}+    step (ManyFirst ss cs) a = step_ ss cs a+    step (ManyLoop ss cs) a = step_ ss cs a++    -- Do not extract the split fold if no item was consumed.+    extract (ManyFirst _ cs) = cextract cs+    extract (ManyLoop ss cs) = do+        cres <- sextract ss >>= cstep cs+        case cres of+            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.+--+-- /Internal/+--+-- See also: 'Data.Stream.concatMap', 'Data.Stream.foldMany'+--+{-# INLINE manyPost #-}+manyPost :: Monad m => Scanl m a b -> Scanl m b c -> Scanl m a c+manyPost+    (Scanl sstep sinitial sextract sfinal)+    (Scanl cstep cinitial cextract cfinal) =+    Scanl step initial extract final++    where++    -- cs = collect state+    -- ss = split state+    -- cres = collect state result+    -- sres = split state result+    -- cb = collect done+    -- sb = split done++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    {-# INLINE split #-}+    split cs sres =+        case sres of+            Partial ss1 -> return $ Partial $ Tuple' ss1 cs+            Done sb -> cstep cs sb >>= collect++    collect cres =+        case cres of+            Partial cs -> sinitial >>= split cs+            Done cb -> return $ Done cb++    initial = cinitial >>= collect++    {-# INLINE step #-}+    step (Tuple' ss cs) a = sstep ss a >>= split cs++    extract (Tuple' ss cs) = do+        cres <- sextract ss >>= cstep cs+        case cres of+            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.+--+-- Definition:+--+-- >>> groupsOf n split = Scanl.many (Scanl.take n split)+--+-- Example:+--+-- >>> twos = Scanl.groupsOf 2 Scanl.toList Scanl.toList+-- >>> Stream.fold twos $ Stream.fromList [1..10]+-- [[1,2],[3,4],[5,6],[7,8],[9,10]]+--+-- Stops when @collect@ stops.+--+{-# INLINE groupsOf #-}+groupsOf :: Monad m => Int -> Scanl m a b -> Scanl m b c -> Scanl m a c+groupsOf n split = many (take n split)++------------------------------------------------------------------------------+-- Refold and Fold Combinators+------------------------------------------------------------------------------++-- | Like 'many' but uses a 'Refold' for collecting.+--+{-# INLINE refoldMany #-}+refoldMany :: Monad m => Scanl m a b -> Refold m x b c -> Refold m x a c+refoldMany+    (Scanl sstep sinitial sextract _sfinal)+    -- XXX We will need a "final" in refold as well+    (Refold cstep cinject cextract) =+    Refold step inject extract++    where++    -- cs = collect state+    -- ss = split state+    -- cres = collect state result+    -- sres = split state result+    -- cb = collect done+    -- sb = split done++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    {-# INLINE split #-}+    split cs f sres =+        case sres of+            Partial ss -> return $ Partial $ Tuple' cs (f ss)+            Done sb -> cstep cs sb >>= collect++    collect cres =+        case cres of+            Partial cs -> sinitial >>= split cs Left+            Done cb -> return $ Done cb++    inject x = cinject x >>= collect++    {-# INLINE step_ #-}+    step_ ss cs a = sstep ss a >>= split cs Right++    {-# INLINE step #-}+    step (Tuple' cs (Left ss)) a = step_ ss cs a+    step (Tuple' cs (Right ss)) a = step_ ss cs a++    -- Do not extract the split fold if no item was consumed.+    extract (Tuple' cs (Left _)) = cextract cs+    extract (Tuple' cs (Right ss )) = do+        cres <- sextract ss >>= cstep cs+        case cres of+            Partial s -> cextract s+            Done b -> return b++{-# ANN type ConsumeManyState Fuse #-}+data ConsumeManyState x cs ss = ConsumeMany x cs (Either ss ss)++-- | Like 'many' but uses a 'Refold' for splitting.+--+-- /Internal/+{-# INLINE refoldMany1 #-}+refoldMany1 :: Monad m => Refold m x a b -> Scanl m b c -> Refold m x a c+refoldMany1+    (Refold sstep sinject sextract)+    (Scanl cstep cinitial cextract _cfinal) =+    Refold step inject extract++    where++    -- cs = collect state+    -- ss = split state+    -- cres = collect state result+    -- sres = split state result+    -- cb = collect done+    -- sb = split done++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    {-# INLINE split #-}+    split x cs f sres =+        case sres of+            Partial ss -> return $ Partial $ ConsumeMany x cs (f ss)+            Done sb -> cstep cs sb >>= collect x++    collect x cres =+        case cres of+            Partial cs -> sinject x >>= split x cs Left+            Done cb -> return $ Done cb++    inject x = cinitial >>= collect x++    {-# INLINE step_ #-}+    step_ x ss cs a = sstep ss a >>= split x cs Right++    {-# INLINE step #-}+    step (ConsumeMany x cs (Left ss)) a = step_ x ss cs a+    step (ConsumeMany x cs (Right ss)) a = step_ x ss cs a++    -- Do not extract the split fold if no item was consumed.+    extract (ConsumeMany _ cs (Left _)) = cextract cs+    extract (ConsumeMany _ cs (Right ss )) = do+        cres <- sextract ss >>= cstep cs+        case cres of+            Partial s -> cextract s+            Done b -> return b++-- | Extract the output of a fold and refold it using a 'Refold'.+--+-- A fusible alternative to 'concatMap'.+--+-- /Internal/+{-# INLINE refold #-}+refold :: Monad m => Refold m b a c -> Scanl m a b -> Scanl m a c+refold (Refold step inject extract) f =+    Scanl step (extractM f >>= inject) extract extract+-}++------------------------------------------------------------------------------+-- morphInner+------------------------------------------------------------------------------++-- | Change the underlying monad of a scan. Also known as hoist.+--+-- /Pre-release/+morphInner :: (forall x. m x -> n x) -> Scanl m a b -> Scanl n a b+morphInner f (Scanl step initial extract final) =+    Scanl (\x a -> f $ step x a) (f initial) (f . extract) (f . final)++-- | Adapt a pure scan to any monad.+--+-- >>> generalizeInner = Scanl.morphInner (return . runIdentity)+--+-- /Pre-release/+generalizeInner :: Monad m => Scanl Identity a b -> Scanl m a b+generalizeInner = morphInner (return . runIdentity)
+ src/Streamly/Internal/Data/Scanl/Window.hs view
@@ -0,0 +1,513 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Scanl.Window+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : Apache-2.0+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Simple incremental statistical measures over a stream of data. All+-- operations use numerically stable floating point arithmetic.+--+-- Measurements can be performed over the entire input stream or on a sliding+-- window of fixed or variable size.  Where possible, measures are computed+-- online without buffering the input stream.+--+-- Currently there is no overflow detection.+--+-- For more advanced statistical measures see the @streamly-statistics@+-- package.++-- XXX A window scan can be driven either using the RingArray.slidingWindow+-- combinator or by zipping nthLast scan and last scan.++module Streamly.Internal.Data.Scanl.Window+    (+    -- * Types+      Incr (..)++    -- * Running Incremental Scans+    -- | Scans of type @Scanl m (Incr a) b@ are incremental sliding-window+    -- scans. Names of such scans are prefixed with @incr@. An input of type+    -- @(Insert a)@ indicates that the input element @a@ is being inserted in+    -- the window without ejecting an old value, increasing the window size by+    -- 1. An input of type @(Replace a a)@ indicates that the first argument of+    -- Replace is being removed from the window and the second argument is being+    -- inserted in the window, the window size remains the same. The window+    -- size can only increase and never decrease.+    --+    -- You can compute the statistics over the entire stream using window scans+    -- by always supplying input of type @Insert a@.+    --+    -- The incremental scans are converted into scans over a window using the+    -- 'incrScan' operation which maintains a sliding window and supplies the+    -- new and/or exiting element of the window to the window scan in the form+    -- of an incremental operation. The names of window scans are prefixed with+    -- @window@.+    --+    , cumulativeScan+    , incrScan+    , incrScanWith++    -- * Incremental Scans+    , incrRollingMap -- XXX remove?+    , incrRollingMapM -- XXX remove?++    -- ** Sums+    , incrCount+    , incrSum+    , incrSumInt+    , incrPowerSum+    , incrPowerSumFrac++    -- ** Location+    , windowRange+    , windowMinimum+    , windowMaximum+    , incrMean+    )+where++import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Proxy (Proxy(..))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.RingArray (RingArray(..))+import Streamly.Internal.Data.Scanl.Type (Scanl(..), Step(..))+import Streamly.Internal.Data.Tuple.Strict+    (Tuple'(..), Tuple3Fused' (Tuple3Fused'))+import Streamly.Internal.Data.Unbox (Unbox(..))++import qualified Streamly.Internal.Data.MutArray.Type as MutArray+import qualified Streamly.Internal.Data.RingArray as RingArray+import qualified Streamly.Internal.Data.Scanl.Type as Scanl++import Prelude hiding (length, sum, minimum, maximum)++#include "ArrayMacros.h"+#include "DocTestDataScanl.hs"++-------------------------------------------------------------------------------+-- Incremental operations+-------------------------------------------------------------------------------++-- The delete operation could be quite useful e.g. if we are computing stats+-- over last one hour of trades. The window would be growing when trade+-- frequency is increasing, the window would remain constant when the trade+-- frequency is steady, but it would shrink when the trade frequency reduces.+-- If no trades are happening our clock would still be ticking and to maintain+-- a 1 hour window we would be ejecting the oldest elements from the window+-- even without any other elements entering the window. In fact, it is required+-- for time based windows.+--+-- Replace can be implemented using Insert and Delete.+--++-- | Represents incremental input for a scan. 'Insert' means a new element is+-- being added to the collection, 'Replace' means an old value in the+-- collection is being replaced with a new value.+data Incr a =+      Insert !a+    --  | Delete !a+    | Replace !a !a -- ^ Replace old new++instance Functor Incr where+    fmap f (Insert x) = Insert (f x)+    -- fmap f (Delete x) = Delete (f x)+    fmap f (Replace x y) = Replace (f x) (f y)++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++{-# ANN type SlidingWindow Fuse #-}+data SlidingWindow a r s = SWArray !a !Int !s | SWRing !r !s+-- data SlidingWindow a s = SWArray !a !Int !s !Int | SWRing !a !Int !s++-- | Like 'incrScan' but also provides the ring array to the scan. The ring+-- array reflects the state of the ring after inserting the incoming element.+--+-- IMPORTANT NOTE: The ring is mutable, therefore, references to it should not+-- be stored and used later, the state would have changed by then. If you need+-- to store it then copy it to an array or another ring and store it.+{-# INLINE incrScanWith #-}+incrScanWith :: forall m a b. (MonadIO m, Unbox a)+    => Int -> Scanl m (Incr a, RingArray a) b -> Scanl m a b+incrScanWith n (Scanl step1 initial1 extract1 final1) =+    Scanl step initial extract final++    where++    initial = do+        if n <= 0+        then error "Window size must be > 0"+        else do+            r <- initial1+            arr <- liftIO $ MutArray.emptyOf n+            return $+                case r of+                    Partial s -> Partial $ SWArray arr (0 :: Int) s+                    Done b -> Done b++    step (SWArray arr i st) a = do+        -- XXX compare this with the slidingWindow impl+        arr1 <- liftIO $ MutArray.unsafeSnoc arr a+        r <- step1 st (Insert a, RingArray.unsafeCastMutArray arr1)+        return $ case r of+            Partial s ->+                let i1 = i + 1+                in if i1 < n+                   then Partial $ SWArray arr1 i1 s+                   else Partial $ SWRing (RingArray.unsafeCastMutArray arr1) s+            Done b -> Done b++    step (SWRing rb st) a = do+        (rb1, old) <- RingArray.replace rb a+        r <- step1 st (Replace old a, rb1)+        return $+            case r of+                Partial s -> Partial $ SWRing rb1 s+                Done b -> Done b++    extract (SWArray _ _ st) = extract1 st+    extract (SWRing _ st) = extract1 st++    final (SWArray _ _ st) = final1 st+    final (SWRing _ st) = final1 st++    -- Alternative implementation flattening the constructors+    -- Improves some benchmarks, worsens some others, need more investigation.+    {-+    initial = do+        if n <= 0+        then error "Window size must be > 0"+        else do+            r <- initial1+            arr :: MutArray.MutArray a <- liftIO $ MutArray.emptyOf n+            return $+                case r of+                    Partial s -> Partial+                        $ SWArray (MutArray.arrContents arr) 0 s n+                    Done b -> Done b++    step (SWArray mba rh st i) a = do+        RingArray _ _ rh1 <- RingArray.insert_ (RingArray mba (n * SIZE_OF(a)) rh) a+        r <- step1 st (Insert a, RingArray mba ((n - i) * SIZE_OF(a)) rh1)+        return $+            case r of+                Partial s ->+                    if i > 0+                    then Partial $ SWArray mba rh1 s (i-1)+                    else Partial $ SWRing mba rh1 s+                Done b -> Done b++    step (SWRing mba rh st) a = do+        (rb1@(RingArray _ _ rh1), old) <-+            RingArray.insert (RingArray mba (n * SIZE_OF(a)) rh) a+        r <- step1 st (Replace old a, rb1)+        return $+            case r of+                Partial s -> Partial $ SWRing mba rh1 s+                Done b -> Done b++    extract (SWArray _ _ st _) = extract1 st+    extract (SWRing _ _ st) = extract1 st++    final (SWArray _ _ st _) = final1 st+    final (SWRing _ _ st) = final1 st+    -}++-- | @incrScan collector@ is an incremental sliding window scan that does not+-- require all the intermediate elements in each step of the scan computation.+-- This maintains @n@ elements in the window, when a new element comes it+-- slides out the oldest element. The new element along with the old element+-- are supplied to the collector scan.+--+{-# INLINE incrScan #-}+incrScan :: forall m a b. (MonadIO m, Unbox a)+    => Int -> Scanl m (Incr a) b -> Scanl m a b+incrScan n f = incrScanWith n (Scanl.lmap fst f)++-- | Convert an incremental scan to a cumulative scan using the entire input+-- stream as a single window.+--+-- >>> cumulativeScan = Scanl.lmap Scanl.Insert+--+{-# INLINE cumulativeScan #-}+cumulativeScan :: Scanl m (Incr a) b -> Scanl m a b+cumulativeScan = Scanl.lmap Insert++-- | Apply an effectful function on the entering and the exiting element of the+-- window. The first argument of the mapped function is the exiting element and+-- the second argument is the entering element.+{-# INLINE incrRollingMapM #-}+incrRollingMapM :: Monad m =>+    (Maybe a -> a -> m (Maybe b)) -> Scanl m (Incr a) (Maybe b)+incrRollingMapM f = Scanl.mkScanlM f1 initial++    where++    initial = return Nothing++    f1 _ (Insert a) = f Nothing a+    -- f1 _ (Delete _) = return Nothing+    f1 _ (Replace old new) = f (Just old) new++-- | Apply a pure function on the latest and the oldest element of the window.+--+-- >>> incrRollingMap f = Scanl.incrRollingMapM (\x y -> return $ f x y)+--+{-# INLINE incrRollingMap #-}+incrRollingMap :: Monad m =>+    (Maybe a -> a -> Maybe b) -> Scanl m (Incr a) (Maybe b)+incrRollingMap f = Scanl.mkScanl f1 initial++    where++    initial = Nothing++    f1 _ (Insert a) = f Nothing a+    -- f1 _ (Delete _) = Nothing+    f1 _ (Replace old new) = f (Just old) new++-------------------------------------------------------------------------------+-- Sum+-------------------------------------------------------------------------------++-- XXX Overflow.++-- | The sum of all the elements in a rolling window. The input elements are+-- required to be integral numbers.+--+-- This was written in the hope that it would be a tiny bit faster than 'incrSum'+-- for 'Integral' values. But turns out that 'incrSum' is 2% faster than this even+-- for integral values!+--+-- /Internal/+--+{-# INLINE incrSumInt #-}+incrSumInt :: forall m a. (Monad m, Integral a) => Scanl m (Incr a) a+incrSumInt = Scanl step initial extract extract++    where++    initial = return $ Partial (0 :: a)++    step s (Insert a) = return $ Partial (s + a)+    -- step s (Delete a) = return $ Partial (s - a)+    step s (Replace old new) = return $ Partial (s + new - old)++    extract = return++-- XXX Overflow.++-- | Sum of all the elements in a rolling window:+--+-- \(S = \sum_{i=1}^n x_{i}\)+--+-- This is the first power sum.+--+-- >>> incrSum = Scanl.incrPowerSum 1+--+-- Uses Kahan-Babuska-Neumaier style summation for numerical stability of+-- floating precision arithmetic.+--+-- /Space/: \(\mathcal{O}(1)\)+--+-- /Time/: \(\mathcal{O}(n)\)+--+{-# INLINE incrSum #-}+incrSum :: forall m a. (Monad m, Num a) => Scanl m (Incr a) a+incrSum = Scanl step initial extract extract++    where++    initial =+        return+            $ Partial+            $ Tuple'+                (0 :: a) -- running sum+                (0 :: a) -- accumulated rounding error++    add total incr =+        let+            -- total is large and incr may be small, we may round incr here but+            -- we will accumulate the rounding error in err1 in the next step.+            total1 = total + incr+            -- Accumulate any rounding error in err1+            -- XXX In the Insert case we may lose err, therefore we+            -- should use ((total1 - total) - new) + err here.+            -- Or even in the Replace case if (new - old) is large we may lose+            -- err, so we should use ((total1 - total) + (old - new)) + err.+            err1 = (total1 - total) - incr+        in return $ Partial $ Tuple' total1 err1++    step (Tuple' total err) (Insert new) =+        -- XXX if new is large we may lose err+        let incr = new - err+         in add total incr+    {-+    step (Tuple' total err) (Delete new) =+        -- XXX if new is large we may lose err+        let incr = -new - err+         in add total incr+    -}+    step (Tuple' total err) (Replace old new) =+        -- XXX if (new - old) is large we may lose err+        let incr = (new - old) - err+         in add total incr++    extract (Tuple' total _) = return total++-- | The number of elements in the rolling window.+--+-- This is the \(0\)th power sum.+--+-- >>> incrCount = Scanl.incrPowerSum 0+--+{-# INLINE incrCount #-}+incrCount :: (Monad m, Num b) => Scanl m (Incr a) b+incrCount = Scanl.mkScanl step 0++    where++    step w (Insert _) = w + 1+    -- step w (Delete _) = w - 1+    step w (Replace _ _) = w++-- | Sum of the \(k\)th power of all the elements in a rolling window:+--+-- \(S_k = \sum_{i=1}^n x_{i}^k\)+--+-- >>> incrPowerSum k = Scanl.lmap (fmap (^ k)) Scanl.incrSum+--+-- /Space/: \(\mathcal{O}(1)\)+--+-- /Time/: \(\mathcal{O}(n)\)+{-# INLINE incrPowerSum #-}+incrPowerSum :: (Monad m, Num a) => Int -> Scanl m (Incr a) a+incrPowerSum k = Scanl.lmap (fmap (^ k)) incrSum++-- | Like 'incrPowerSum' but powers can be negative or fractional. This is+-- slower than 'incrPowerSum' for positive intergal powers.+--+-- >>> incrPowerSumFrac p = Scanl.lmap (fmap (** p)) Scanl.incrSum+--+{-# INLINE incrPowerSumFrac #-}+incrPowerSumFrac :: (Monad m, Floating a) => a -> Scanl m (Incr a) a+incrPowerSumFrac p = Scanl.lmap (fmap (** p)) incrSum++-------------------------------------------------------------------------------+-- Location+-------------------------------------------------------------------------------++{-# INLINE ringRange #-}+ringRange :: (MonadIO m, Unbox a, Ord a) => RingArray a -> m (Maybe (a, a))+-- Ideally this should perform the same as the implementation below, but it is+-- 2x worse, need to investigate why.+-- ringRange = RingArray.fold (Fold.fromScanl Scanl.range)+ringRange rb@RingArray{..} = do+    if ringSize == 0+    then return Nothing+    else do+        x <- liftIO $ peekAt 0 ringContents+        let accum (mn, mx) a = return (min mn a, max mx a)+         in fmap Just $ RingArray.foldlM' accum (x, x) rb++-- | Determine the maximum and minimum in a rolling window.+--+-- This implementation traverses the entire window buffer to compute the+-- range whenever we demand it.  It performs better than the dequeue based+-- implementation in @streamly-statistics@ package when the window size is+-- small (< 30).+--+-- If you want to compute the range of the entire stream+-- 'Streamly.Data.Scanl.range' would be much faster.+--+-- /Space/: \(\mathcal{O}(n)\) where @n@ is the window size.+--+-- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size.+--+{-# INLINE windowRange #-}+windowRange :: forall m a. (MonadIO m, Unbox a, Ord a) =>+    Int -> Scanl m a (Maybe (a, a))+-- windowRange = RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.range)++-- Ideally this should perform the same as the implementation below which is+-- just expanded form of this. Some inlining/exitify optimization makes this+-- perform much worse. Need to investigate and fix that.+-- windowRange = RingArray.scanCustomFoldRingsBy ringRange++windowRange n = Scanl step initial extract extract++    where++    initial =+        if n <= 0+        then error "ringsOf: window size must be > 0"+        else do+            arr :: MutArray.MutArray a <- liftIO $ MutArray.emptyOf n+            return $ Partial $ Tuple3Fused' (MutArray.arrContents arr) 0 0++    step (Tuple3Fused' mba rh i) a = do+        RingArray _ _ rh1 <- RingArray.replace_ (RingArray mba (n * SIZE_OF(a)) rh) a+        return $ Partial $ Tuple3Fused' mba rh1 (i + 1)++    -- XXX exitify optimization causes a problem here when modular scans are+    -- used. Sometimes inlining "extract" is helpful.+    -- {-# INLINE extract #-}+    extract (Tuple3Fused' mba rh i) =+    -- XXX If newest is lower than the current min than new is the min.+    -- XXX Otherwise if exiting one was equal to min only then we need to find+    -- new min+        let rs = min i n * SIZE_OF(a)+            rh1 = if i <= n then 0 else rh+         in ringRange $ RingArray mba rs rh1++-- | Find the minimum element in a rolling window.+--+-- See the performance related comments in 'windowRange'.+--+-- If you want to compute the minimum of the entire stream+-- 'Streamly.Data.Scanl.minimum' is much faster.+--+-- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size.+--+{-# INLINE windowMinimum #-}+windowMinimum :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (Maybe a)+windowMinimum n = fmap (fmap fst) $ windowRange n+-- windowMinimum = RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.minimum)++-- | The maximum element in a rolling window.+--+-- See the performance related comments in 'windowRange'.+--+-- If you want to compute the maximum of the entire stream+-- 'Streamly.Data.Scanl.maximum' would be much faster.+--+-- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size.+--+{-# INLINE windowMaximum #-}+windowMaximum :: (MonadIO m, Unbox a, Ord a) => Int -> Scanl m a (Maybe a)+windowMaximum n = fmap (fmap snd) $ windowRange n+-- windowMaximum = RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.maximum)++-- XXX Returns NaN on empty stream.+-- XXX remove teeWith for better fusion?++-- | Arithmetic mean of elements in a sliding window:+--+-- \(\mu = \frac{\sum_{i=1}^n x_{i}}{n}\)+--+-- This is also known as the Simple Moving Average (SMA) when used in the+-- sliding window and Cumulative Moving Avergae (CMA) when used on the entire+-- stream.+--+-- >>> incrMean = Scanl.teeWith (/) Scanl.incrSum Scanl.incrCount+--+-- /Space/: \(\mathcal{O}(1)\)+--+-- /Time/: \(\mathcal{O}(n)\)+{-# INLINE incrMean #-}+incrMean :: forall m a. (Monad m, Fractional a) => Scanl m (Incr a) a+incrMean = Scanl.teeWith (/) incrSum incrCount
+ src/Streamly/Internal/Data/Scanr.hs view
@@ -0,0 +1,401 @@+-- |+-- Module      : Streamly.Internal.Data.Scanr+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Right scans.+--+-- == Scanr vs Stream+--+-- A scan is a generalization of a stream. Like streams, a scan has an internal+-- state. Unlike a stream, a scan produces an output only on an input, the+-- output is a function of the scan state and the input. A scan produces at+-- most one output on one input, in other words it is driven solely by the+-- input, it cannot produce output on its own. A @Scanr m () a@ can represent a+-- @Stream m a@ by supplying the scan with () inputs.+--+-- == Scans vs pipes:+--+-- A scan is a simpler version of pipes. It can produce at most one output on+-- one input. Whereas a pipe may produce output even without consuming anything+-- or it can produce multiple outputs on a single input. Scans are simpler+-- abstractions to think about compared to pipes and easier for the compiler to+-- optimize and fuse.+--+-- == Compositions+--+-- Append: this is the easiest. The behavior is simple even in presence of+-- filtering (Skip) and termination (Stop). Skip translates to Skip, Stop+-- translates to Stop.+--+-- demux: we select one of n scans to run. Behaviour with Skip is straight+-- forward. Termination behavior has multiple options, stop when first one+-- stops, stop when the last one stops, or stop when a selected one stops.+--+-- zip: run all and zip the outputs. If one of them Skips we Skip the output.+-- If one of them stops we stop. It may be possible to collect the outputs as+-- Just/Nothing values.+--+-- Another option could be if a Scan terminates do we want to start it again or+-- not.++module Streamly.Internal.Data.Scanr+    (+    -- * Type+      Scanr (..)++    -- * Primitive Scans+    , identity+    , function+    , functionM+    , filter+    , filterM++    -- * Combinators+    , compose+    , teeWithMay+    , teeWith+    , tee++    -- * Scans+    , length+    , sum+    )+where++#include "inline.hs"+import Control.Arrow (Arrow(..))+import Control.Category (Category(..))+import Data.Maybe (isJust, fromJust)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Stream.Step (Step (..))++import qualified Prelude++import Prelude hiding+    (filter, length, sum, zipWith, map, mapM, id, unzip, null)++-- $setup+-- >>> :m+-- >>> :set -XFlexibleContexts+-- >>> import Control.Category+--+-- >>> import qualified Streamly.Internal.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Data.Scanr as Scanr+-- >>> import qualified Streamly.Internal.Data.Stream as Stream++------------------------------------------------------------------------------+-- Scans+------------------------------------------------------------------------------++-- A core difference between the Scan type and the Fold type is that Scan can+-- stop without producing an output, this is required to represent an empty+-- stream. For this reason a Scan cannot be represented using a Fold because a+-- fold requires a value to be produced on Stop.++-- A core difference between a Scan and a Stream is that a scan produces an+-- output only on an input while a stream can produce output without consuming+-- an input.+--+-- XXX A scan may have buffered data which may have to be drained if the driver+-- has no more input to supply. So we need a finalizer which produces a+-- (possibly empty) stream.+--+-- XXX We should add finalizer (and Error constructor?) to it before we+-- release it.++-- | Represents a stateful transformation over an input stream of values of+-- type @a@ to outputs of type @b@ in 'Monad' @m@.+--+-- The constructor is @Scan consume initial@.+data Scanr m a b =+    forall s. Scanr+        (s -> a -> m (Step s b))+        s++------------------------------------------------------------------------------+-- Functor: Mapping on the output+------------------------------------------------------------------------------++-- | 'fmap' maps a pure function on a scan output.+--+-- >>> Stream.toList $ Stream.scanr (fmap (+1) Scanr.identity) $ Stream.fromList [1..5::Int]+-- [2,3,4,5,6]+--+instance Functor m => Functor (Scanr m a) where+    {-# INLINE_NORMAL fmap #-}+    fmap f (Scanr consume initial) = Scanr consume1 initial++        where++        {-# INLINE_LATE consume1 #-}+        consume1 s b = fmap (fmap f) (consume s b)++-------------------------------------------------------------------------------+-- Category+-------------------------------------------------------------------------------++-- XXX We can call this append, because corresponding operation in stream is+-- also append.++-- | Connect two scans in series. Attach the first scan on the output of the+-- second scan.+--+-- >>> import Control.Category+-- >>> Stream.toList $ Stream.scanr (Scanr.function (+1) >>> Scanr.function (+1)) $ Stream.fromList [1..5::Int]+-- [3,4,5,6,7]+--+{-# INLINE_NORMAL compose #-}+compose :: Monad m => Scanr m b c -> Scanr m a b -> Scanr m a c+compose+    (Scanr stepR initialR)+    (Scanr stepL initialL) = Scanr step (initialL, initialR)++    where++    -- XXX Use strict tuple?+    step (sL, sR) x = do+        rL <- stepL sL x+        case rL of+            Yield bL sL1 -> do+                rR <- stepR sR bL+                return+                    $ case rR of+                        Yield br sR1 -> Yield br (sL1, sR1)+                        Skip sR1 -> Skip (sL1, sR1)+                        Stop -> Stop+            Skip sL1 -> return $ Skip (sL1, sR)+            Stop -> return Stop++-- | A scan representing mapping of a monadic action.+--+-- >>> Stream.toList $ Stream.scanr (Scanr.functionM print) $ Stream.fromList [1..5::Int]+-- 1+-- 2+-- 3+-- 4+-- 5+-- [(),(),(),(),()]+--+{-# INLINE functionM #-}+functionM :: Monad m => (a -> m b) -> Scanr m a b+functionM f = Scanr (\() a -> fmap (`Yield` ()) (f a)) ()++-- | A scan representing mapping of a pure function.+--+-- >>> Stream.toList $ Stream.scanr (Scanr.function (+1)) $ Stream.fromList [1..5::Int]+-- [2,3,4,5,6]+--+{-# INLINE function #-}+function :: Monad m => (a -> b) -> Scanr m a b+function f = functionM (return Prelude.. f)++{- HLINT ignore "Redundant map" -}++-- | An identity scan producing the same output as input.+--+-- >>> identity = Scanr.function Prelude.id+--+-- >>> Stream.toList $ Stream.scanr (Scanr.identity) $ Stream.fromList [1..5::Int]+-- [1,2,3,4,5]+--+{-# INLINE identity #-}+identity :: Monad m => Scanr m a a+identity = function Prelude.id++instance Monad m => Category (Scanr m) where+    {-# INLINE id #-}+    id = identity++    {-# INLINE (.) #-}+    (.) = compose++-------------------------------------------------------------------------------+-- Applicative Zip+-------------------------------------------------------------------------------++{-# ANN type TeeWith Fuse #-}+data TeeWith sL sR = TeeWith !sL !sR++-- XXX zipWith?++-- | Connect two scans in parallel. Distribute the input across two scans and+-- zip their outputs. If the scan filters the output, 'Nothing' is emitted+-- otherwise 'Just' is emitted. The scan stops if any of the scans stop.+--+-- >>> Stream.toList $ Stream.scanr (Scanr.teeWithMay (,) Scanr.identity (Scanr.function (\x -> x * x))) $ Stream.fromList [1..5::Int]+-- [(Just 1,Just 1),(Just 2,Just 4),(Just 3,Just 9),(Just 4,Just 16),(Just 5,Just 25)]+--+{-# INLINE_NORMAL teeWithMay #-}+teeWithMay :: Monad m =>+    (Maybe b -> Maybe c -> d) -> Scanr m a b -> Scanr m a c -> Scanr m a d+teeWithMay f (Scanr stepL initialL) (Scanr stepR initialR) =+    Scanr step (TeeWith initialL initialR)++    where++    step (TeeWith sL sR) a = do+        resL <- stepL sL a+        resR <- stepR sR a+        return+            $ case resL of+                  Yield bL sL1 ->+                    case resR of+                        Yield bR sR1 ->+                            Yield+                                (f (Just bL) (Just bR))+                                (TeeWith sL1 sR1)+                        Skip sR1 ->+                            Yield+                                (f (Just bL) Nothing)+                                (TeeWith sL1 sR1)+                        Stop -> Stop+                  Skip sL1 ->+                    case resR of+                        Yield bR sR1 ->+                            Yield+                                (f Nothing (Just bR))+                                (TeeWith sL1 sR1)+                        Skip sR1 ->+                            Yield+                                (f Nothing Nothing)+                                (TeeWith sL1 sR1)+                        Stop -> Stop+                  Stop -> Stop++-- | Produces an output only when both the scans produce an output. If any of+-- the scans skips the output then the composed scan also skips. Stops when any+-- of the scans stop.+--+-- >>> Stream.toList $ Stream.scanr (Scanr.teeWith (,) Scanr.identity (Scanr.function (\x -> x * x))) $ Stream.fromList [1..5::Int]+-- [(1,1),(2,4),(3,9),(4,16),(5,25)]+--+{-# INLINE_NORMAL teeWith #-}+teeWith :: Monad m =>+    (b -> c -> d) -> Scanr m a b -> Scanr m a c -> Scanr m a d+teeWith f s1 s2 =+    fmap fromJust+        $ compose (filter isJust)+        $ teeWithMay (\b c -> f <$> b <*> c) s1 s2++-- | Zips the outputs only when both scans produce outputs, discards otherwise.+instance Monad m => Applicative (Scanr m a) where+    {-# INLINE pure #-}+    pure b = Scanr (\_ _ -> pure $ Yield b ()) ()++    (<*>) = teeWith id++{-# INLINE_NORMAL tee #-}+tee :: Monad m => Scanr m a b -> Scanr m a c -> Scanr m a (b,c)+tee = teeWith (,)++-------------------------------------------------------------------------------+-- Arrow+-------------------------------------------------------------------------------++-- | Use the first scan for the first element of the tuple and second scan for+-- the second. Zip the outputs. Emits 'Nothing' if no output is generated by+-- the scan, otherwise emits 'Just'. Stops as soon as any one of the scans+-- stop.+--+{-# INLINE_NORMAL unzipMay #-}+unzipMay :: Monad m =>+    Scanr m a x -> Scanr m b y -> Scanr m (a, b) (Maybe x, Maybe y)+unzipMay (Scanr stepL initialL) (Scanr stepR initialR) =+    Scanr step (Tuple' initialL initialR)++    where++    step (Tuple' sL sR) (a, b) = do+        resL <- stepL sL a+        resR <- stepR sR b+        return+            $ case resL of+                  Yield bL sL1 ->+                    case resR of+                        Yield bR sR1 ->+                            Yield+                                (Just bL, Just bR)+                                (Tuple' sL1 sR1)+                        Skip sR1 ->+                            Yield+                                (Just bL, Nothing)+                                (Tuple' sL1 sR1)+                        Stop -> Stop+                  Skip sL1 ->+                    case resR of+                        Yield bR sR1 ->+                            Yield+                                (Nothing, Just bR)+                                (Tuple' sL1 sR1)+                        Skip sR1 ->+                            Yield+                                (Nothing, Nothing)+                                (Tuple' sL1 sR1)+                        Stop -> Stop+                  Stop -> Stop++-- | Like 'unzipMay' but produces an output only when both the scans produce an+-- output. Other outputs are filtered out.+{-# INLINE_NORMAL unzip #-}+unzip :: Monad m => Scanr m a x -> Scanr m b y -> Scanr m (a, b) (x, y)+unzip s1 s2 = fmap (fromJust Prelude.. f) $ unzipMay s1 s2++    where++    f (mx, my) =+        case mx of+            Just x ->+                case my of+                    Just y -> Just (x, y)+                    Nothing -> Nothing+            Nothing -> Nothing++instance Monad m => Arrow (Scanr m) where+    {-# INLINE arr #-}+    arr = function++    {-# INLINE (***) #-}+    (***) = unzip++    {-# INLINE (&&&) #-}+    (&&&) = teeWith (,)++-------------------------------------------------------------------------------+-- Primitive scans+-------------------------------------------------------------------------------++-- | A filtering scan using a monadic predicate.+{-# INLINE filterM #-}+filterM :: Monad m => (a -> m Bool) -> Scanr m a a+filterM f = Scanr (\() a -> f a >>= g a) ()++    where++    {-# INLINE g #-}+    g a b =+        return+            $ if b+              then Yield a ()+              else Skip ()++-- | A filtering scan using a pure predicate.+--+-- >>> Stream.toList $ Stream.scanr (Scanr.filter odd) $ Stream.fromList [1..5::Int]+-- [1,3,5]+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Scanr m a a+filter f = filterM (return Prelude.. f)++{-# INLINE length #-}+length :: Monad m => Scanr m a Int+length = Scanr (\acc _ -> pure $ let !n = acc + 1 in Yield n n) 0++{-# INLINE sum #-}+sum :: (Monad m, Num a) => Scanr m a a+sum = Scanr (\acc x -> pure $ let !n = acc + x in Yield n n) 0
src/Streamly/Internal/Data/Serialize/TH.hs view
@@ -7,7 +7,11 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC---++-- XXX Instead of applying the product constructor in one go can we apply it+-- one at a time in case of too many arguments, compiler may not have to save+-- them in local vars.+ module Streamly.Internal.Data.Serialize.TH     (     -- Deriving@@ -26,9 +30,9 @@ -- Imports -------------------------------------------------------------------------------- +import Data.Foldable (length, foldMap) import Data.List (foldl') import Data.Word (Word16, Word32, Word64, Word8)-import Data.Foldable (length)  import Language.Haskell.TH import Language.Haskell.TH.Syntax@@ -170,8 +174,7 @@             cfgRecordSyntaxWithHeader             (typeOfType headTy cons)     pure-        ( maybe-            []+        ( foldMap             (\x -> [PragmaD (InlineP 'addSizeTo x FunLike AllPhases)])             cfgInlineSize          ++ [FunD 'addSizeTo [Clause [] (NormalB sizeOfMethod) []]]@@ -238,7 +241,7 @@                 , noBindS                       (caseE                            (sigE (varE _tag) (conT tagType))-                           (map peekMatch (zip [0 ..] cons) ++ [peekErr]))+                           (fmap peekMatch (zip [0 ..] cons) ++ [peekErr]))                 ]   where     peekMatch (i, con) =@@ -280,8 +283,7 @@             headTy             (typeOfType headTy cons)     pure-        ( maybe-            []+        ( foldMap             (\x -> [PragmaD (InlineP 'deserializeAt x FunLike AllPhases)])             cfgInlineDeserialize          ++@@ -306,7 +308,7 @@     [|serializeAt           $(varE _initialOffset)           $(varE _arr)-          $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]+          $(sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType))|]  mkSerializeExpr :: Bool -> Bool -> TypeOfType -> Q Exp mkSerializeExpr True False tyOfTy =@@ -363,7 +365,7 @@                 tagType = getTagType lenCons             caseE                 (varE _val)-                (map (\(tagVal, (SimpleDataCon cname fields)) ->+                (fmap (\(tagVal, SimpleDataCon cname fields) ->                           matchConstructor                               cname                               (length fields)@@ -390,8 +392,7 @@             cfgRecordSyntaxWithHeader             (typeOfType headTy cons)     pure-        ( maybe-            []+        ( foldMap             (\x -> [PragmaD (InlineP 'serializeAt x FunLike AllPhases)])             cfgInlineSerialize          ++
src/Streamly/Internal/Data/Serialize/TH/Bottom.hs view
@@ -56,8 +56,8 @@  import Data.Maybe (isJust) import Data.Char (chr, ord)-import Data.List (foldl') import Data.Foldable (length)+import Data.List (foldl') import Data.Word (Word16, Word32, Word64, Word8) import Data.Bits (Bits, (.|.), shiftL, zeroBits, xor) import Streamly.Internal.System.IO (unsafeInlineIO)@@ -86,7 +86,8 @@ -- configuration is opaque and is modified by composing config modifier -- functions, for example: ----- >>> (inlineSerializeAt (Just NoInline)) . (inlineSerializeAt (Just Inlinable))+-- >>> import Language.Haskell.TH (Inline(..))+-- >>> configOpts = (inlineDeserializeAt (Just NoInline)) . (inlineSerializeAt (Just Inlinable)) -- -- The default configuration settings are: --@@ -251,7 +252,7 @@  openConstructor :: Name -> Int -> Q Pat openConstructor cname numFields =-    conP cname (map varP (map mkFieldName [0 .. (numFields - 1)]))+    conP cname (map (varP. mkFieldName) [0 .. (numFields - 1)])  matchConstructor :: Name -> Int -> Q Exp -> Q Match matchConstructor cname numFields exp0 =@@ -278,9 +279,9 @@ typeOfType headTy [] =     error         ("Attempting to get size with no constructors (" ++-         (pprint headTy) ++ ")")+         pprint headTy ++ ")") typeOfType _ [DataCon cname _ _ []] = UnitType cname-typeOfType _ [con@(DataCon _ _ _ _)] = TheType $ simplifyDataCon con+typeOfType _ [con@DataCon{}] = TheType $ simplifyDataCon con typeOfType _ cons = MultiType $ map simplifyDataCon cons  isUnitType :: [DataCon] -> Bool@@ -288,7 +289,7 @@ isUnitType _ = False  isRecordSyntax :: SimpleDataCon -> Bool-isRecordSyntax (SimpleDataCon _ fields) = and (isJust . fst <$> fields)+isRecordSyntax (SimpleDataCon _ fields) = all (isJust . fst) fields  -------------------------------------------------------------------------------- -- Type casting@@ -328,7 +329,7 @@ shiftAdd :: Bits a => (b -> a) -> [b] -> a shiftAdd conv xs =     foldl' (.|.) zeroBits $-    map (\(j, x) -> shiftL x (j * 8)) $ zip [0 ..] $ map conv xs+    fmap (\(j, x) -> shiftL x (j * 8)) $ zip [0 ..] $ map conv xs  -- Note: This only works in little endian machines -- TODO:@@ -425,7 +426,7 @@ serializeW8List off arr w8List = do     [|let $(varP (makeN 0)) = $(varE off)        in $(doE (fmap makeBind [0 .. (lenW8List - 1)] ++-                 [noBindS ([|pure $(varE (makeN lenW8List))|])]))|]+                 [noBindS [|pure $(varE (makeN lenW8List))|]]))|]      where
src/Streamly/Internal/Data/Serialize/TH/Common.hs view
@@ -40,8 +40,8 @@                                        [ varE (makeI numFields)                                        , appsE                                              (conE cname :-                                              (map (varE . makeA)-                                                   [0 .. (numFields - 1)]))+                                              map (varE . makeA)+                                                   [0 .. (numFields - 1)])                                        ]))                        ]                      ])@@ -60,7 +60,7 @@         _ ->             doE                 (fmap makeBind [0 .. (numFields - 1)] ++-                 [noBindS ([|pure $(varE (makeI numFields))|])])+                 [noBindS [|pure $(varE (makeI numFields))|]])   where     numFields = length fields     makeBind i =
src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs view
@@ -21,8 +21,8 @@ --------------------------------------------------------------------------------  import Control.Monad (void)-import Data.List (foldl') import Data.Foldable (length, sum)+import Data.List (foldl') import Data.Word (Word32, Word8) import Data.Maybe (fromJust) import Language.Haskell.TH@@ -107,7 +107,7 @@      -- {-# INLINE addSizeTo #-}     addSizeTo acc (CompactList xs) =-        foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Word8))) xs+        foldl' addSizeTo (acc + Unbox.sizeOf (Proxy :: Proxy Word8)) xs      -- Inlining this causes large compilation times for tests     {-# INLINABLE deserializeAt #-}@@ -177,10 +177,10 @@ mkRecSizeOfExpr con = do     n_acc <- newName "acc"     n_x <- newName "x"-    (lamE+    lamE          [varP n_acc, varP n_x]          [|$(litIntegral hlen) +-            $(caseE (varE n_x) [matchCons (varE n_acc) con])|])+            $(caseE (varE n_x) [matchCons (varE n_acc) con])|]      where @@ -196,7 +196,7 @@  headerValue :: SimpleDataCon -> [Word8] headerValue (SimpleDataCon _ fields) =-    int_w8 numFields : concat (fmap lengthPrependedFieldEncoding fields)+    int_w8 numFields : concatMap lengthPrependedFieldEncoding fields      where @@ -217,7 +217,7 @@                     else                         errorUnsupported                             "Length of any key should be <= 255."-         in (int_w8 (length fEnc)) : fEnc+         in int_w8 (length fEnc) : fEnc  -------------------------------------------------------------------------------- -- Peek@@ -234,7 +234,7 @@     pure off1  mkRecSerializeExpr :: Name -> SimpleDataCon -> Q Exp-mkRecSerializeExpr initialOffset (con@(SimpleDataCon cname fields)) = do+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@@ -266,7 +266,7 @@ {-# INLINE deserializeWithSize #-} deserializeWithSize ::        Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)-deserializeWithSize off arr endOff = deserializeAt (off + 4) arr endOff+deserializeWithSize off = deserializeAt (off + 4)  conUpdateFuncDec :: Name -> [Field] -> Q [Dec] conUpdateFuncDec funcName fields = do@@ -276,7 +276,7 @@     arr <- newName "arr"     key <- newName "key"     method <--        (caseE+        caseE              (varE key)              (concat                   [ map (matchField arr endOff (prevAcc, curOff)) fnames@@ -293,7 +293,7 @@                                         , valOff + w32_int valLen)|])                           []                     ]-                  ]))+                  ])     pure         [ PragmaD (InlineP funcName NoInline FunLike AllPhases)         , FunD
src/Streamly/Internal/Data/Serialize/Type.hs view
@@ -1,3 +1,4 @@+{- HLINT ignore -} -- | -- Module      : Streamly.Internal.Data.Serialize.Type -- Copyright   : (c) 2023 Composewell Technologies@@ -24,11 +25,12 @@ import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..)) import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..)) import GHC.Stable (StablePtr(..))+import GHC.Fingerprint.Type (Fingerprint) +import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.MutArray.Type as MutArray 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 import Prelude hiding (Foldable(..))@@ -157,7 +159,7 @@ {-# INLINE checkBounds #-} checkBounds :: String -> Int -> MutByteArray -> IO () checkBounds _label _size _arr = do-    sz <- MBA.sizeOfMutableByteArray _arr+    sz <- MBA.length _arr     if (_size > sz)     then error         $ _label@@ -168,7 +170,7 @@ #endif  -- Note: Instead of passing around the size parameter, we can use--- (sizeOfMutableByteArray arr) for checking the array bound, but that turns+-- (MBA.length 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@@ -191,7 +193,7 @@     let next = off + Unbox.sizeOf (Proxy :: Proxy a)      in do         -- Keep likely path in the straight branch.-        if (next <= sz)+        if next <= sz         then Unbox.peekAt off arr >>= \val -> pure (next, val)         else error             $ "deserializeAt: accessing array at offset = "@@ -237,12 +239,13 @@ DERIVE_SERIALIZE_FROM_UNBOX((StablePtr a)) DERIVE_SERIALIZE_FROM_UNBOX((Ptr a)) DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))+DERIVE_SERIALIZE_FROM_UNBOX(Fingerprint)  instance forall a. Serialize a => Serialize [a] where      -- {-# INLINE addSizeTo #-}     addSizeTo acc xs =-        foldl' addSizeTo (acc + (Unbox.sizeOf (Proxy :: Proxy Int))) xs+        foldl' addSizeTo (acc + Unbox.sizeOf (Proxy :: Proxy Int)) xs      -- Inlining this causes large compilation times for tests     {-# INLINABLE deserializeAt #-}@@ -298,7 +301,7 @@     serializeAt off arr (Array {..}) = do         let arrLen = arrEnd - arrStart         off1 <- serializeAt off arr arrLen-        MBA.putSliceUnsafe arrContents arrStart arr off1 arrLen+        MBA.unsafePutSlice arrContents arrStart arr off1 arrLen         pure (off1 + arrLen)  instance (Serialize a, Serialize b) => Serialize (a, b) where
src/Streamly/Internal/Data/Stream.hs view
@@ -7,12 +7,11 @@ -- 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+-- "Streamly.Internal.Data.StreamK". GHC is able to INLINE and fuse direct -- style better, providing better performance than CPS implementation. -- -- @--- import qualified Streamly.Internal.Data.Stream as D+-- import qualified Streamly.Internal.Data.Stream as Stream -- @  module Streamly.Internal.Data.Stream
src/Streamly/Internal/Data/Stream/Container.hs view
@@ -11,16 +11,17 @@  module Streamly.Internal.Data.Stream.Container     (-      nub+    -- * Deduplication+      ordNub -    -- * Joins for unconstrained types-    , joinLeftGeneric-    , joinOuterGeneric+    -- * Joins+    , leftJoin+    , outerJoin -    -- * Joins with Ord constraint-    , joinInner-    , joinLeft-    , joinOuter+    -- * Ord Joins+    , innerOrdJoin+    , leftOrdJoin+    , outerOrdJoin     ) where @@ -31,8 +32,7 @@ import Data.Function ((&)) import Data.Maybe (isJust) import Streamly.Internal.Data.Stream.Step (Step(..))-import Streamly.Internal.Data.Stream.Type-    (Stream(..), mkCross, unCross)+import Streamly.Internal.Data.Stream.Type (Stream(..), Nested(..))  import qualified Data.Map.Strict as Map import qualified Data.Set as Set@@ -40,19 +40,21 @@ 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)+-- | @nub@ specialized to 'Ord' types for better performance. Returns a+-- subsequence of the stream removing any duplicate elements.+--+-- The memory used is proportional to the number of unique elements in the+-- stream. One way to limit the memory is to  use @take@ on the resulting+-- stream to limit the unique elements in the stream.+{-# INLINE_NORMAL ordNub #-}+ordNub :: (Monad m, Ord a) => Stream m a -> Stream m a+ordNub (Stream step1 state1) = Stream step (Set.empty, state1)      where @@ -78,8 +80,8 @@ -- -- 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.++-- | 'innerJoin' specialized to 'Ord' types for better performance. -- -- If the input streams have duplicate keys, the behavior is undefined. --@@ -90,10 +92,10 @@ -- Time: O(m + n) -- -- /Pre-release/-{-# INLINE joinInner #-}-joinInner :: (Monad m, Ord k) =>+{-# INLINE innerOrdJoin #-}+innerOrdJoin :: (Monad m, Ord k) =>     Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)-joinInner s1 s2 =+innerOrdJoin s1 s2 =     Stream.concatEffect $ do         km <- toMap s2         pure $ Stream.mapMaybe (joinAB km) s1@@ -106,65 +108,64 @@             Nothing -> Nothing  -- XXX We can do this concurrently.+-- XXX Check performance of StreamD vs StreamK -- 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)@.+-- | Like 'innerJoin' but emits @(a, Just b)@ whenever a and b are equal, for+-- those @a@'s that are not equal to any @b@ emits @(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.+-- This is a generalization of 'innerJoin' to include all elements from the+-- left stream and not just those which have an equal in the right stream. This+-- is not a commutative operation, the order of the stream arguments matters. ----- >>> joinRightGeneric eq = flip (Stream.joinLeftGeneric eq)+-- All the caveats mentioned in 'innerJoin' apply here as well. Right join is+-- not provided because it is just a flipped left join: --+-- >>> rightJoin eq = flip (Stream.leftJoin eq)+-- -- Space: O(n) assuming the second stream is cached in memory. -- -- Time: O(m x n) -- -- /Unimplemented/-{-# INLINE joinLeftGeneric #-}-joinLeftGeneric :: Monad m =>+{-# INLINE leftJoin #-}+leftJoin :: 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)+leftJoin eq s1 s2 = Stream.evalStateT (return False) $ unNested $ do+    a <- Nested (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)+    Nested (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)+    b <- Nested (fmap Just (Stream.liftInner s2) `Stream.append` final)     case b of         Just b1 ->             if a `eq` b1             then do-                mkCross (Stream.fromEffect $ put True)+                Nested (Stream.fromEffect $ put True)                 return (a, Just b1)-            else mkCross Stream.nil+            else Nested Stream.nil         Nothing -> return (a, Nothing) --- XXX rename to joinLeftOrd?---- | A more efficient 'joinLeft' using a hashmap for efficiency.+-- | 'leftJoin' specialized to 'Ord' types for better performance. -- -- Space: O(n) -- -- Time: O(m + n) -- -- /Pre-release/-{-# INLINE joinLeft #-}-joinLeft :: (Ord k, Monad m) =>+{-# INLINE leftOrdJoin #-}+leftOrdJoin :: (Ord k, Monad m) =>     Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)-joinLeft s1 s2 =+leftOrdJoin s1 s2 =     Stream.concatEffect $ do         km <- toMap s2         return $ fmap (joinAB km) s1@@ -177,14 +178,19 @@                     Nothing -> (k, a, Nothing)  -- XXX We can do this concurrently.---- XXX Check performance of StreamD vs StreamK+-- XXX Check performance of StreamD vs StreamK cross operation. --- | Like 'joinLeft' but emits a @(Just a, Just b)@. Like 'joinLeft', for those+-- | Like 'leftJoin' but emits a @(Just a, Just b)@. Like 'leftJoin', 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)@. --+-- This is a generalization of left join to include all the elements from the+-- right stream as well, in other words it is a combination of left and right+-- joins. This is a commutative operation. The order of stream arguments can be+-- changed without affecting results, except for the ordering of elements in+-- the resulting tuple.+-- -- For space efficiency use the smaller stream as the second stream. -- -- Space: O(n)@@ -192,19 +198,19 @@ -- Time: O(m x n) -- -- /Pre-release/-{-# INLINE joinOuterGeneric #-}-joinOuterGeneric :: MonadIO m =>+{-# INLINE outerJoin #-}+outerJoin :: MonadIO m =>        (a -> b -> Bool)     -> Stream m a     -> Stream m b     -> Stream m (Maybe a, Maybe b)-joinOuterGeneric eq s1 s =+outerJoin eq s1 s2 =     Stream.concatEffect $ do-        inputArr <- Array.fromStream s+        inputArr <- Array.fromStream s2         let len = Array.length inputArr         foundArr <-             Stream.fold-            (MA.writeN len)+            (MA.createOf len)             (Stream.fromList (Prelude.replicate len False))         return $ go inputArr foundArr `Stream.append` leftOver inputArr foundArr @@ -222,14 +228,14 @@                         ) stream1 stream2                     ) & Stream.catMaybes -    evalState = Stream.evalStateT (return False) . unCross+    evalState = Stream.evalStateT (return False) . unNested      go inputArr foundArr = evalState $ do-        a <- mkCross (Stream.liftInner s1)+        a <- Nested (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)+        Nested (Stream.fromEffect $ put False)         let final = Stream.concatEffect $ do                 r <- get                 if r@@ -237,35 +243,35 @@                 else pure (Stream.fromPure Nothing)         (i, b) <-             let stream = Array.read inputArr-             in mkCross+             in Nested                 (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)+                    Nested (Stream.fromEffect $ put True)                     MA.putIndex i foundArr True                     return (Just a, Just b1)-                else mkCross Stream.nil+                else Nested 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.+-- | 'outerJoin' specialized to 'Ord' types for better performance. -- -- Space: O(m + n) -- -- Time: O(m + n) -- -- /Pre-release/-{-# INLINE joinOuter #-}-joinOuter ::+{-# INLINE outerOrdJoin #-}+outerOrdJoin ::     (Ord k, MonadIO m) =>     Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)-joinOuter s1 s2 =+outerOrdJoin s1 s2 =     Stream.concatEffect $ do         km1 <- kvFold s1         km2 <- kvFold s2
src/Streamly/Internal/Data/Stream/Eliminate.hs view
@@ -13,36 +13,22 @@ -- module Streamly.Internal.Data.Stream.Eliminate     (-    -- * Running a 'Fold'-      fold--    -- -- * Running a 'Parser'-    , parse-    , parseD+    -- * Running a Parser+      parse+    , parsePos     , parseBreak-    , parseBreakD+    , parseBreakPos -    -- * Stream Deconstruction+    -- * 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+    , init     , tail     , last     , elem@@ -60,16 +46,9 @@     , 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@@ -79,18 +58,20 @@     , stripPrefix     , stripSuffix     , stripSuffixUnbox++    -- * Deprecated+    , parseD+    , parseBreakD     ) where  #include "inline.hs"+#include "deprecation.h" -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.Parser (ParseError(..), ParseErrorPos(..))+import Streamly.Internal.Data.SVar.Type (adaptState, defState) import Streamly.Internal.Data.Unbox (Unbox)  import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))@@ -98,16 +79,14 @@ 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 as PRD-import qualified Streamly.Internal.Data.Stream.Generate as StreamD+import qualified Streamly.Internal.Data.ParserDrivers as Drivers import qualified Streamly.Internal.Data.Stream.Nesting as Nesting import qualified Streamly.Internal.Data.Stream.Transform as StreamD  import Prelude hiding        ( Foldable(..), all, any, head, last, lookup, mapM, mapM_-       , notElem, splitAt, tail, (!!))-import Data.Foldable (length)-import Streamly.Internal.Data.Stream.Type+       , notElem, splitAt, init, tail, (!!))+import Streamly.Internal.Data.Stream.Type hiding (splitAt)  #include "DocTestDataStream.hs" @@ -131,38 +110,30 @@ -- 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+-- 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. --- 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 'Parser'.+--+{-# INLINE parseBreak #-}+parseBreak, parseBreakD :: Monad m =>+    PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+parseBreak = Drivers.parseBreak --- | 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+RENAME(parseBreakD,parseBreak) +-- | Like 'parseBreak' but includes stream position information in the error+-- messages.+--+{-# INLINE parseBreakPos #-}+parseBreakPos :: Monad m =>+    PR.Parser a m b -> Stream m a -> m (Either ParseErrorPos b, Stream m a)+parseBreakPos = Drivers.parseBreakPos+ -- | Parse a stream using the supplied 'Parser'. -- -- Parsers (See "Streamly.Internal.Data.Parser") are more powerful folds that@@ -176,195 +147,24 @@ -- 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 -> 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)+parse, parseD :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b)+parse parser strm = do+    (b, _) <- parseBreak parser strm+    return b -    -- 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)+RENAME(parseD,parse) --- | Parse a stream using the supplied 'Parser'.+-- | Like 'parse' but includes stream position information in the error+-- messages. ---{-# INLINE parseBreak #-}-parseBreak :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)-parseBreak = parseBreakD+-- >>> Stream.parsePos (Parser.takeEQ 2 Fold.drain) (Stream.fromList [1])+-- Left (ParseErrorPos 1 "takeEQ: Expecting exactly 2 elements, input terminated on 1")+--+{-# INLINE [3] parsePos #-}+parsePos :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseErrorPos b)+parsePos parser strm = do+    (b, _) <- parseBreakPos parser strm+    return b  ------------------------------------------------------------------------------ -- Specialized Folds@@ -379,21 +179,35 @@ 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 init #-}+init :: Monad m => Stream m a -> m (Maybe (Stream m a))+init stream = do+    r <- uncons stream+    case r of+        Nothing -> return Nothing+        Just (h, Stream step1 state1) ->+            return $ Just $ Stream step (h, state1) -{-# INLINE_NORMAL headElse #-}-headElse :: Monad m => a -> Stream m a -> m a-headElse a = foldrM (\x _ -> return x) (return a)+            where +            step gst (a, s1) = do+                res <- step1 (adaptState gst) s1+                return $+                    case res of+                        Yield x s -> Yield a (x, s)+                        Skip s -> Skip (a, s)+                        Stop -> Stop++-- | Same as:+--+-- >>> tail = fmap (fmap snd) . Stream.uncons+-- -- 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 = fmap (fmap snd) . uncons+{- tail (UnStream step state) = go SPEC state   where     go !_ st = do@@ -402,6 +216,7 @@             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 #-}@@ -433,7 +248,7 @@  {-# INLINE_NORMAL notElem #-} notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-notElem e s = fmap not (elem e s)+notElem e s = fmap not (e `elem` s)  {-# INLINE_NORMAL all #-} all :: Monad m => (a -> Bool) -> Stream m a -> m Bool@@ -764,12 +579,12 @@ -- /Requires 'Storable' constraint/ -- {-# INLINE isInfixOf #-}-isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)+isInfixOf :: (MonadIO m, Eq a, Enum a, Unbox a)     => Stream m a -> Stream m a -> m Bool isInfixOf infx stream = do-    arr <- fold Array.write infx+    arr <- fold Array.create infx     -- XXX can use breakOnSeq instead (when available)-    r <- null $ StreamD.drop 1 $ Nesting.splitOnSeq arr Fold.drain stream+    r <- null $ StreamD.drop 1 $ Nesting.splitSepBySeq_ arr Fold.drain stream     return (not r)  -- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf
src/Streamly/Internal/Data/Stream/Exception.hs view
@@ -9,17 +9,27 @@  module Streamly.Internal.Data.Stream.Exception     (-      gbracket_-    , gbracket-    , before-    , afterUnsafe+    -- * Resources+      before     , afterIO+    , afterUnsafe+    , finallyIO+    , finallyIO'+    , finallyIO''+    , finallyUnsafe+    , gbracket_+    , gbracket     , bracketUnsafe     , bracketIO3     , bracketIO+    , bracketIO'+    , bracketIO''++    , withAcquireIO+    , withAcquireIO'++    -- * Exceptions     , onException-    , finallyUnsafe-    , finallyIO     , ghandle     , handle     )@@ -30,11 +40,15 @@ import Control.Monad.IO.Class (MonadIO(..)) import Control.Exception (Exception, SomeException, mask_) import Control.Monad.Catch (MonadCatch)+import Data.IORef (newIORef) import GHC.Exts (inline)+import Streamly.Internal.Control.Exception+    (AcquireIO(..), acquire, allocator, releaser) import Streamly.Internal.Data.IOFinalizer     (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)  import qualified Control.Monad.Catch as MC+import qualified Data.IntMap.Strict as Map  import Streamly.Internal.Data.Stream.Type @@ -136,10 +150,9 @@     -- 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+        -- allocation of resource and installation of finalizer must be atomic+        -- with respect to async exception, otherwise we may leave a window+        -- where the resource may not be freed.         (r, ref) <- liftIO $ mask_ $ do             r <- bef             ref <- newIOFinalizer (onGC r)@@ -147,6 +160,10 @@         return $ Skip $ GBracketIONormal (action r) r ref      step gst (GBracketIONormal (UnStream step1 st) v ref) = do+        -- IMPORTANT: Note that if an async exception occurs before try or+        -- after try, in those cases the exception will not be intercepted and+        -- the cleanup handler won't run. In those cases the cleanup handler+        -- will run via GC.         res <- ftry $ step1 gst st         case res of             Right r -> case r of@@ -177,7 +194,6 @@ -- -- 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 #-}@@ -311,6 +327,8 @@ -- the process in case of exception or garbage collection, but waits for the -- process to terminate in normal cases. +-- XXX Just use bracketIO2 instead - stop and exception.+ -- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the -- mode of termination: --@@ -344,28 +362,55 @@         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+-- XXX Fix the early termination case not being prompt. Will require a "final"+-- function in the stream constructor.++-- Examples of cases where the stream is not fully consumed:+--+-- * a bracketed stream is folded but before the stream ends, the fold+-- terminates or encounters an exception abandoning the original stream.+-- * 'take' on a bracketed stream terminates without draining the stream+-- completely. To avoid this, bracket should be outermost combinator on a+-- stream.+-- * A synchronous exception is handled using 'handle', in that case the+-- original stream is abandoned and collected by GC.+--+-- In case of async exceptions, if the async exception occurs when we are+-- executing the stream code then it will be intercepted. After the stream+-- element is generated, control is handed over to the consumer (fold), async+-- exceptions occurring in this period are not intercepted by bracketIO, they+-- are intercepted by the fold's bracket instead. If an async exceptions occurs+-- in this part and the stream is abandoned, the cleanup handler runs on GC.++-- | The alloc action @IO b@ is executed with async exceptions disabled but keeping+-- blocking operations interruptible (see 'Control.Exception.mask').  Uses the -- 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--- (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.+-- @b@ is usually a resource allocated under the IO monad, e.g. a file handle, that+-- requires a cleanup after use. The cleanup is done using the @b -> IO c@+-- action. bracketIO guarantees that the allocated resource is eventually (see+-- details below) cleaned up even in the face of sync or async exceptions. If+-- an exception occurs it is not caught, simply rethrown. -- -- 'bracketIO' only guarantees that the cleanup action runs, and it runs with--- async exceptions enabled. The action must ensure that it can successfully+-- __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.--- 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.+-- /Best case/: Cleanup happens immediately in the following cases: --+-- * the stream is consumed completely+-- * an exception occurs in the bracketed part of the pipeline+--+-- /Worst case/: In the following cases cleanup is deferred to GC.+--+-- * the bracketed stream is partially consumed and abandoned+-- * pipeline is aborted due to an exception outside the bracket+--+-- Use Streamly.Control.Exception.'Streamly.Control.Exception.withAcquireIO'+-- for covering the entire pipeline with guaranteed cleanup at the end of+-- bracket.+-- -- Observes exceptions only in the stream generation, and not in stream -- consumers. --@@ -378,6 +423,251 @@     => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a bracketIO bef aft = bracketIO3 bef aft aft aft +-- If you are recovering from exceptions using 'handle' then you should use+-- bracketIO'' which releases the resource promptly on exception before the+-- exception handler generates another stream. But for better performance+-- bracketIO' may be better and leave the resource to be freed by GC.+--+-- XXX If we want to recover from exceptions then we should probably have an+-- integrated combinator combining handling with bracketIO'' otherwise we will+-- have multiple layers of "try" which will not be good for perf.++data GbracketIO'State s ref release+    = GBracketIO'Init+    | GBracketIO'Normal s ref release++-- | Like 'bracketIO' but requires an 'Streamly.Control.Exception.AcquireIO' reference in the underlying monad+-- of the stream, and guarantees that all resources are freed before the+-- scope of the monad level resource manager+-- (Streamly.Control.Exception.'Streamly.Control.Exception.withAcquireIO')+-- ends. Where fusion matters, this combinator can be much faster than 'bracketIO' as it+-- allows stream fusion.+--+-- /Best case/: Cleanup happens immediately if the stream is consumed+-- completely.+--+-- /Worst case/: In the following cases cleanup is guaranteed to occur at the+-- end of the monad level bracket. However, if a GC occurs then cleanup will+-- occur even earlier than that.+--+-- * the bracketed stream is partially consumed and abandoned+-- * pipeline is aborted due to an exception+--+-- __This is the recommended default bracket operation.__+--+-- Note: You can use 'Streamly.Control.Exception.acquire' directly, instead of using this combinator, if+-- you don’t need to release the resource when the stream ends. However, if+-- you're using the stream inside another stream (like with concatMap), you+-- usually do want to release it at the end of the stream.+--+-- /Allows stream fusion/+--+{-# INLINE bracketIO' #-}+bracketIO' :: MonadIO m+    => AcquireIO -> IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+bracketIO' bracket alloc free action =+    Stream step GBracketIO'Init++    where++    -- In nested stream cases, where the inner stream is abandoned due to early+    -- termination or due to exception handling, we use GC based cleanup as+    -- fallback because the monad level cleanup may not occur in deterministic+    -- amount of time, but GC may. Users can also implement backpressure+    -- themselves e.g. if the number of open fds is greater than n then perform+    -- GC until it comes down.+    {-# INLINE_LATE step #-}+    step _ GBracketIO'Init = do+        (r, ref, release) <- liftIO $ mask_ $ do+            (r, release) <- liftIO $ acquire bracket alloc free+            ref <- newIOFinalizer release+            return (r, ref, release)+        return $ Skip $ GBracketIO'Normal (action r) ref release++    step gst (GBracketIO'Normal (UnStream step1 st) ref release) = do+        res <- step1 gst st+        case res of+            Yield x s ->+                return $ Yield x (GBracketIO'Normal (Stream step1 s) ref release)+            Skip s ->+                return $ Skip (GBracketIO'Normal (Stream step1 s) ref release)+            Stop ->+                liftIO (clearingIOFinalizer ref release) >> return Stop++-- | Like bracketIO, the only difference is that there is a guarantee that the+-- resources will be freed at the end of the monad level bracket+-- ('Streamly.Control.Exception.AcquireIO').+--+-- /Best case/: Cleanup happens immediately in the following cases:+--+-- * the stream is consumed completely+-- * an exception occurs in the bracketed part of the pipeline+--+-- /Worst case/: In the following cases cleanup is guaranteed to occur at the+-- end of the monad level bracket. However, if a GC occurs before that then+-- cleanup will occur early.+--+-- * the bracketed stream is partially consumed and abandoned+-- * pipeline is aborted due to an exception outside the bracket+--+-- Note: Instead of using this combinator you can directly use+-- 'Streamly.Control.Exception.acquire'+-- if you do not care about releasing the resource at the end of the stream+-- and if you are not recovering from an exception using 'handle'. You may want+-- to care about releasing the resource at the end of a stream if you are using+-- it in a nested manner (e.g. in concatMap).+--+-- /Inhibits stream fusion/+--+{-# INLINE bracketIO'' #-}+bracketIO'' :: (MonadIO m, MonadCatch m)+    => AcquireIO -> IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+bracketIO'' bracket alloc free action =+    Stream step GBracketIO'Init++    where++    {-# INLINE_LATE step #-}+    step _ GBracketIO'Init = do+        (r, ref, release) <- liftIO $ mask_ $ do+            (r, release) <- liftIO $ acquire bracket alloc free+            ref <- newIOFinalizer release+            return (r, ref, release)+        return $ Skip $ GBracketIO'Normal (action r) ref release++    step gst (GBracketIO'Normal (UnStream step1 st) ref release) = do+        -- If an async exception occurs before try or after try, in those cases+        -- the exception will not be intercepted here. In those cases the+        -- release action will run via AcquireIO release hook.+        res <- MC.try $ step1 gst st+        case res of+            Right r ->+                case r of+                    Yield x s ->+                        return+                            $ Yield x (GBracketIO'Normal (Stream step1 s) ref release)+                    Skip s ->+                        return+                            $ Skip (GBracketIO'Normal (Stream step1 s) ref release)+                    Stop ->+                        liftIO (clearingIOFinalizer ref release) >> return Stop+            Left (e :: SomeException) ->+                liftIO (clearingIOFinalizer ref release) >> MC.throwM e++-- | Like finallyIO, based on bracketIO' semantics.+{-# INLINE finallyIO' #-}+finallyIO' :: MonadIO m => AcquireIO -> IO b -> Stream m a -> Stream m a+finallyIO' bracket free stream =+    bracketIO' bracket (return ()) (const free) (const stream)++-- | Like finallyIO, based on bracketIO'' semantics.+{-# INLINE finallyIO'' #-}+finallyIO'' :: (MonadIO m, MonadCatch m) =>+    AcquireIO -> IO b -> Stream m a -> Stream m a+finallyIO'' bracket free stream =+    bracketIO'' bracket (return ()) (const free) (const stream)++-- | Like 'bracketIO' but with on-demand allocations and manual release+-- facility.+--+-- Here is an example:+--+-- >>> :{+-- close x h = do+--  putStrLn $ "closing: " ++ x+--  hClose h+-- :}+--+-- >>> :{+-- generate ref =+--      Stream.fromList ["file1", "file2"]+--    & Stream.mapM+--        (\x -> do+--            (h, release) <- Exception.acquire ref (openFile x ReadMode) (close x)+--            -- use h here+--            threadDelay 1000000+--            when (x == "file1") $ do+--                putStrLn $ "Manually releasing: " ++ x+--                release+--            return x+--        )+--    & Stream.trace print+-- :}+--+-- >>> :{+-- run =+--     Stream.withAcquireIO generate+--         & Stream.fold Fold.drain+-- :}+--+-- In the above code, you should see the \"closing:\" message for both the+-- files, and only once for each file. Make sure you create "file1" and "file2"+-- before running it.+--+-- Here is an example for just registering hooks to be called eventually:+--+-- >>> :{+-- generate ref =+--      Stream.fromList ["file1", "file2"]+--    & Stream.mapM+--        (\x -> do+--            Exception.register ref $ putStrLn $ "saw: " ++ x+--            threadDelay 1000000+--            return x+--        )+--    & Stream.trace print+-- :}+--+-- >>> :{+-- run =+--     Stream.withAcquireIO generate+--         & Stream.fold Fold.drain+-- :}+--+-- In the above code, even if you interrupt the program with CTRL-C you should+-- still see the "saw:" message for the elements seen before the interrupt.+--+-- See 'bracketIO' documentation for the caveats related to partially consumed+-- streams and async exceptions.+--+-- Use monad level bracket Streamly.Control.Exception.'Streamly..Control.Exception.withAcquireIO'+-- for guaranteed cleanup in the entire pipeline, however, monad level bracket does not provide+-- an automatic cleanup at the end of the stream; you can only release+-- resources manually or via automatic cleanup at the end of the monad bracket.+-- The end of stream cleanup is useful especially in nested streams where we+-- want to cleanup at the end of every inner stream instead of waiting for the+-- outer stream to end for cleaning up to happen.+--+{-# INLINE withAcquireIO #-}+withAcquireIO :: (MonadIO m, MonadCatch m) =>+    (AcquireIO -> Stream m a) -> Stream m a+withAcquireIO action = do+    bracketIO bef (releaser . fst) (\(_, alloc) -> action alloc)++    where++    bef = do+        -- Assuming 64-bit int counter will never overflow+        ref <- liftIO $ newIORef (0 :: Int, Map.empty, Map.empty)+        return (ref, AcquireIO (allocator ref))++-- | We can also combine the stream local 'withAcquireIO' with the global monad+-- level bracket+-- Streamly.Internal.Control.Exception.'Streamly.Internal.Control.Exception.withAcquireIO'.+-- The release actions returned by the local allocator can be registered to be+-- called by the monad level bracket. This way we can guarantee that in the+-- worst case release actions happen at the end of bracket and do not depend on+-- GC. This is the most powerful way of allocating resources on-demand with+-- manual release inside a stream. If required a custom combinator can be+-- written to register the local allocator's release in the global allocator+-- automatically.+--+-- /Unimplemented/+{-# INLINE withAcquireIO' #-}+withAcquireIO' :: -- (MonadIO m, MonadCatch m) =>+    AcquireIO -> (AcquireIO -> Stream m a) -> Stream m a+withAcquireIO' _globalAlloc _action = undefined+ data BracketState s v = BracketInit | BracketRun s v  -- | Alternate (custom) implementation of 'bracket'.@@ -425,7 +715,9 @@ -- 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)+-- >>> finallyIO release stream = Stream.bracketIO (return ()) (const release) (const stream)+--+-- See also finallyIO' for stricter resource release guarantees. -- -- /See also 'finallyUnsafe'/ --
src/Streamly/Internal/Data/Stream/Generate.hs view
@@ -16,20 +16,13 @@   (     -- * Primitives       nil-    , nilM     , cons-    , consM -    -- * From 'Unfold'-    , unfold-     -- * Unfolding     , unfoldr     , unfoldrM      -- * From Values-    , fromPure-    , fromEffect     , repeat     , repeatM     , replicate@@ -95,7 +88,6 @@     -- * From Containers     -- | Transform an input structure into a stream. -    , fromList     , fromListM     , fromFoldable     , fromFoldableM@@ -103,11 +95,11 @@     -- * From Pointers     , fromPtr     , fromPtrN-    , fromByteStr#+    , fromCString#+    , fromW16CString# -    -- * Conversions-    , fromStreamK-    , toStreamK+    -- * Deprecated+    , fromByteStr#     ) where @@ -262,6 +254,7 @@ ------------------------------------------------------------------------------  -- |+-- >>> repeatM act = Stream.iterateM (const act) act -- >>> repeatM = Stream.sequence . Stream.repeat -- -- Generate a stream by repeatedly executing a monadic action forever.@@ -284,6 +277,7 @@ -- | -- Generate an infinite stream by repeating a pure value. --+-- >>> repeat = Stream.iterate id -- >>> repeat x = Stream.repeatM (pure x) -- {-# INLINE_NORMAL repeat #-}@@ -1188,16 +1182,33 @@ -- byte is not included in the stream. -- -- >>> :set -XMagicHash--- >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr+-- >>> fromCString# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ (Ptr addr :: Ptr Word8) -- -- /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"#+-- >>> Stream.toList $ Stream.fromCString# "\1\2\3\0"# -- [1,2,3] --+{-# INLINE fromCString# #-}+fromCString# :: Monad m => Addr# -> Stream m Word8+fromCString# addr = takeWhile (/= 0) $ fromPtr $ Ptr addr++{-# DEPRECATED fromByteStr# "Please use fromCString# instead" #-} {-# INLINE fromByteStr# #-} fromByteStr# :: Monad m => Addr# -> Stream m Word8-fromByteStr# addr = takeWhile (/= 0) $ fromPtr $ Ptr addr+fromByteStr# = fromCString#++-- | Read Word16 from an immutable 'Addr#' until a 0 Word16 is encountered, the+-- 0 Word16 is not included in the stream.+--+-- >>> :set -XMagicHash+-- >>> fromW16CString# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ (Ptr addr :: Ptr Word16)+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+{-# INLINE fromW16CString# #-}+fromW16CString# :: Monad m => Addr# -> Stream m Word16+fromW16CString# addr = takeWhile (/= 0) $ fromPtr $ Ptr addr
src/Streamly/Internal/Data/Stream/Lift.hs view
@@ -13,7 +13,7 @@     (     -- * Generalize Inner Monad       morphInner-    , generalizeInner+    , generalizeInner -- XXX rename to morphPure      -- * Transform Inner Monad     , liftInnerWith
src/Streamly/Internal/Data/Stream/Nesting.hs view
@@ -17,3058 +17,3961 @@ -- -- 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--    -- 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.Type (Fold(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.SVar.Type (adaptState)-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----------------------------------------------------------------------------------- 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-    => (f a -> Bool)                  -- isEmpty?-    -> (f a -> m (f a, Maybe (f a)))  -- splitter-    -> (f a -> f a -> m (f a))        -- joiner-    -> Stream m (f a)-    -> Stream m (f a)-splitInnerBySuffix isEmpty 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 isEmpty buf-                    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.++-- The zipWithM combinator in this module has been adapted from the vector+-- package (c) Roman Leshchinskiy.+--+-- Flipped versions can be named as:+-- mapFor/forEach, concatFor, unfoldStepFor (only step function)+-- foreach would be better for streams than mapFor as map could be used for any+-- type not just containers with multiple elements.+--+-- Flipped versions for folding streams:+-- groupsFor :: stream -> fold -> stream (flipped groupsWhile)+--+-- Flipped versions for folds:+-- foldMany :: outer fold -> inner fold -> fold (original version)+-- groupFoldFor :: inner fold -> outer fold -> fold (flipped version)+-- groupStepFor :: inner fold -> outer fold step -> fold (flipped version)+-- This can be convenient for defining the outer fold step using a lambda.+--+module Streamly.Internal.Data.Stream.Nesting+    (+    -- * Generate+    -- | Combining streams to generate streams.++    -- ** Combine Two Streams+    -- | Functions ending in the shape:+    --+    -- @Stream m a -> Stream m a -> Stream m a@.++    -- *** Interleaving+    -- | Interleave elements from two streams alternately. A special case of+    -- unfoldEachInterleave. Interleave is equivalent to mergeBy with a round+    -- robin merge function.+      InterleaveState(..)+    , interleave+    , interleaveEndBy'+    , interleaveSepBy'+    , interleaveBeginBy+    , interleaveEndBy+    , interleaveSepBy++    -- *** Co-operative Scheduling+    -- | Execute streams alternately irrespective of whether they generate+    -- elements or not. Note that scheduling is affected by the Skip+    -- constructor; implementations with more skips receive proportionally less+    -- scheduling time. A more programmer controlled approach would be to emit+    -- a Maybe in a stream and use the output driven scheduling combinators+    -- instead of Skip driven, even if a stream emits Nothing, the output will+    -- force scheduling of another stream.+    --+    , roundRobin -- interleaveFair?/ParallelFair++    -- *** Merging+    -- | Interleave elements from two streams based on a condition.+    , mergeBy+    , mergeByM+    , mergeMinBy+    , mergeFstBy++    -- ** Combine N Streams+    -- | Functions generally ending in these shapes:+    --+    -- @+    -- concat: f (Stream m a) -> Stream m a+    -- concatMap: (a -> Stream m b) -> Stream m a -> Stream m b+    -- unfoldEach: Unfold m a b -> Stream m a -> Stream m b+    -- @++    -- *** unfoldEach+    -- | Generate streams by using an unfold on each element of an input+    -- stream, append the resulting streams and flatten. A special case of+    -- intercalate.+    , unfoldEachFoldBy+    , ConcatUnfoldInterleaveState (..)+    , bfsUnfoldEach+    , altBfsUnfoldEach+    , fairUnfoldEach++    -- *** unfoldEach joined by elements+    -- | Like unfoldEach but intersperses an element between the streams after+    -- unfolding. A special case of intercalate.+    , unfoldEachSepBy+    , unfoldEachSepByM+    , unfoldEachEndBy+    , unfoldEachEndByM++    -- *** unfoldEach joined by sequences+    -- | Like unfoldEach but intersperses a sequence between the unfolded+    -- streams before unfolding. A special case of intercalate.+    , unfoldEachSepBySeq+    , unfoldEachEndBySeq++    -- *** unfoldEach joined by streams+    -- | Like unfoldEach but intersperses streams between the unfolded streams.+    , intercalateSepBy+    , intercalateEndBy++    -- *** concatMap+    , fairConcatMapM+    , fairConcatMap+    , fairConcatForM+    , fairConcatFor++    -- *** unfoldSched+    -- Note appending does not make sense for sched, only bfs or diagonal.++    -- | Like unfoldEach but schedules the generated streams based on time+    -- slice instead of based on the outputs.+    , unfoldSched+    -- , altUnfoldSched -- alternating directions+    , fairUnfoldSched++    -- *** schedMap+    , schedMapM+    , schedMap+    , fairSchedMapM+    , fairSchedMap++    -- *** schedFor+    , schedForM+    , schedFor+    , fairSchedForM+    , fairSchedFor++    -- * Eliminate+    -- | Folding and Parsing chunks of streams to eliminate nested streams.+    -- Functions generally ending in these shapes:+    --+    -- @+    -- f (Fold m a b) -> t m a -> t m b+    -- f (Parser a m b) -> t m a -> t m b+    -- @++    -- ** Folding+    -- | Apply folds on a stream.+    , foldSequence+    , foldIterateM++    -- ** Parsing+    -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or+    -- unfoldEach concatMap generates a stream from single values in a+    -- stream and flattens, parseMany does the opposite of flattening by+    -- splitting the stream and then folds each such split to single value in+    -- the output stream.+    , parseMany+    , parseManyPos+    , parseSequence+    , parseManyTill+    , parseIterate+    , parseIteratePos++    -- ** Grouping+    -- | Group segments of a stream and fold. Special case of parsing.+    , groupsWhile+    , groupsRollingBy++    -- ** Splitting+    -- | A special case of parsing.+    , takeEndBySeq+    , takeEndBySeq_+    , wordsBy+    , splitSepBySeq_+    , splitEndBySeq+    , splitEndBySeq_+    , splitOnSuffixSeq -- internal++    , splitBeginBy_+    , splitEndBySeqOneOf+    , splitSepBySeqOneOf++    -- * Transform (Nested Containers)+    -- | Opposite to compact in ArrayStream+    , splitInnerBy -- XXX innerSplitOn+    , splitInnerBySuffix -- XXX innerSplitOnSuffix++    -- * Reduce By Streams+    , dropPrefix+    , dropInfix+    , dropSuffix++    -- * Deprecated+    , interpose+    , interposeM+    , interposeSuffix+    , interposeSuffixM+    , gintercalate+    , gintercalateSuffix+    , intercalate+    , intercalateSuffix+    , unfoldInterleave+    , unfoldRoundRobin+    , interleaveMin+    , interleaveFst+    , interleaveFstSuffix+    , parseManyD+    , parseIterateD+    , groupsBy+    , splitOnSeq+    )+where++#include "deprecation.h"+#include "inline.hs"+#include "ArrayMacros.h"++import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bits (shiftR, shiftL, (.|.), (.&.))+import Data.Proxy (Proxy(..))+import Data.Word (Word32)+import Fusion.Plugin.Types (Fuse(..))+import GHC.Types (SPEC(..))++import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos)+import Streamly.Internal.Data.RingArray (RingArray(..))+import Streamly.Internal.Data.SVar.Type (adaptState)+import Streamly.Internal.Data.Unbox (Unbox(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Array.Type as A+import qualified Streamly.Internal.Data.MutArray.Type as MutArray+import qualified Streamly.Internal.Data.Fold as FL+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.Parser as PRD+import qualified Streamly.Internal.Data.ParserDrivers as Drivers+import qualified Streamly.Internal.Data.RingArray as RB+import qualified Streamly.Internal.Data.Stream.Generate as Stream+import qualified Streamly.Internal.Data.Unfold.Type as Unfold++import Streamly.Internal.Data.Stream.Transform+    (intersperse, intersperseEndByM)+import Streamly.Internal.Data.Stream.Type hiding (splitAt)++import Prelude hiding (concatMap, mapM, zipWith, splitAt)++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Interleaving+------------------------------------------------------------------------------++data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2+    | InterleaveSecondOnly s2 | InterleaveFirstOnly s1++-- XXX Ideally we should change the order of the arguments but we have the same+-- convention in append as well, we will have to change that too. Also, the+-- argument order of append makes sense for infix use.++-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for+-- statically fusing a small number of streams. Use the O(n) complexity+-- StreamK.'Streamly.Data.StreamK.interleave' otherwise.+--+-- Interleaves two streams, yielding one element from each stream alternately,+-- starting from the first stream. When one stream is exhausted, all the+-- remaining elements of the other stream are emitted in the output stream.+--+-- Both the streams are completely exhausted.+--+-- @+-- (a b c) (. . .) => a . b . c .+-- (a b c) (. .  ) => a . b . c+-- (a b  ) (. . .) => a . b .  .+-- @+--+-- Examples:+--+-- >>> f x y = Stream.toList $ Stream.interleave (Stream.fromList x) (Stream.fromList y)+-- >>> f "abc" "..."+-- "a.b.c."+-- >>> f "abc" ".."+-- "a.b.c"+-- >>> f "ab" "..."+-- "a.b.."+--+{-# INLINE_NORMAL interleave #-}+interleave :: Monad m => Stream m a -> Stream m a -> Stream m a+interleave (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++-- XXX Check the performance of the implementation, we can write a custom one.++{-# ANN module "HLint: ignore Use zip" #-}++-- | Interleave the two streams such that the elements of the second stream are+-- ended by the elements of the first stream. If one of the streams is+-- exhausted then interleaving stops.+--+-- @+-- (. . .) (a b c) => a . b . c .+-- (. .  ) (a b c) => a . b .      -- c is discarded+-- (. . .) (a b  ) => a . b .      -- . is discarded+-- @+--+-- Examples:+--+-- >>> f x y = Stream.toList $ Stream.interleaveEndBy' (Stream.fromList x) (Stream.fromList y)+-- >>> f "..." "abc"+-- "a.b.c."+-- >>> f ".." "abc"+-- "a.b."+-- >>> f "..." "ab"+-- "a.b."+--+-- Definition:+--+-- >>> interleaveEndBy' s1 s2 = Stream.unfoldEach Unfold.fromTuple $ Stream.zipWith (,) s2 s1+--+-- Similarly, we can defined interleaveBeginBy' as:+--+-- >>> interleaveBeginBy' = flip interleaveEndBy'+--+{-# INLINE_NORMAL interleaveEndBy' #-}+interleaveEndBy' :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveEndBy' s1 s2 = unfoldEach Unfold.fromTuple $ zipWith (,) s2 s1++-- | Like `interleave` but stops interleaving as soon as any of the two streams+-- stops. The suffix 'Min' in the name determines the stop behavior.+--+-- This is the same as interleaveEndBy' but it might emit an additional element+-- at the end.+--+{-# DEPRECATED interleaveMin "Please use flip interleaveEndBy' instead." #-}+{-# INLINE_NORMAL interleaveMin #-}+interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveMin (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++-- | Interleave the two streams such that the elements of the first stream are+-- infixed between the elements of the second stream. If one of the streams is+-- exhausted then interleaving stops.+--+-- @+-- (. . .) (a b c) => a . b . c    -- additional . is discarded+-- (. .  ) (a b c) => a . b . c+-- (.    ) (a b c) => a . b        -- c is discarded+-- @+--+-- >>> f x y = Stream.toList $ Stream.interleaveSepBy' (Stream.fromList x) (Stream.fromList y)+-- >>> f "..." "abc"+-- "a.b.c"+-- >>> f ".." "abc"+-- "a.b.c"+-- >>> f "." "abc"+-- "a.b"+--+{-# INLINE_NORMAL interleaveSepBy' #-}+interleaveSepBy' :: Monad m => Stream m a -> Stream m a -> Stream m a+-- XXX Not an efficient implementation, need to write a fused one.+interleaveSepBy' s1 s2 = concatEffect $ do+    r <- uncons s2+    case r of+        Nothing -> return Stream.nil+        Just (h, t) ->+            return $ h `Stream.cons`+                unfoldEach Unfold.fromTuple (zipWith (,) s1 t)++-- | Interleave the two streams such that the elements of the second stream are+-- prefixed by the elements of the first stream. Interleaving stops when and+-- only when the second stream is exhausted. Shortfall of the prefix stream is+-- ignored and excess is discarded.+--+-- @+-- (. . .) (a b c) => . a . b . c+-- (. . .) (a b  ) => . a . b      -- additional . is discarded+-- (. .  ) (a b c) => . a . b c    -- missing . is ignored+-- @+--+-- /Unimplemented/+--+{-# INLINE_NORMAL interleaveBeginBy #-}+interleaveBeginBy :: -- Monad m =>+    Stream m a -> Stream m a -> Stream m a+interleaveBeginBy = undefined++-- | Like 'interleaveEndBy'' but interleaving stops when and only when the+-- second stream is exhausted. Shortfall of the suffix stream is ignored and+-- excess is discarded.+--+-- @+-- (. . .) (a b c) => a . b . c .+-- (. .  ) (a b c) => a . b . c    -- missing . is ignored+-- (. . .) (a b  ) => a . b .      -- additional . is discarded+-- @+--+-- >>> f x y = Stream.toList $ Stream.interleaveEndBy (Stream.fromList x) (Stream.fromList y)+-- >>> f "..." "abc"+-- "a.b.c."+-- >>> f ".." "abc"+-- "a.b.c"+-- >>> f "..." "ab"+-- "a.b."+--+{-# INLINE_NORMAL interleaveEndBy #-}+interleaveEndBy :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveEndBy (Stream step2 state2) (Stream step1 state1) =+    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++{-# INLINE interleaveFstSuffix #-}+{-# DEPRECATED interleaveFstSuffix "Please use flip interleaveEndBy instead." #-}+interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveFstSuffix = flip interleaveEndBy++data InterleaveInfixState s1 s2 a+    = InterleaveInfixFirst s1 s2+    | InterleaveInfixSecondBuf s1 s2+    | InterleaveInfixSecondYield s1 s2 a+    | InterleaveInfixFirstYield s1 s2 a+    | InterleaveInfixFirstOnly s1++-- | Like 'interleaveSepBy'' but interleaving stops when and only when the+-- second stream is exhausted. Shortfall of the infix stream is ignored and+-- excess is discarded.+--+-- @+-- (. . .) (a b c) => a . b . c    -- additional . is discarded+-- (. .  ) (a b c) => a . b . c+-- (.    ) (a b c) => a . b c      -- missing . is ignored+-- @+--+-- Examples:+--+-- >>> f x y = Stream.toList $ Stream.interleaveSepBy (Stream.fromList x) (Stream.fromList y)+-- >>> f "..." "abc"+-- "a.b.c"+-- >>> f ".." "abc"+-- "a.b.c"+-- >>> f "." "abc"+-- "a.bc"+--+{-# INLINE_NORMAL interleaveSepBy #-}+interleaveSepBy :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveSepBy (Stream step2 state2) (Stream step1 state1) =+    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++{-# DEPRECATED interleaveFst "Please use flip interleaveSepBy instead." #-}+{-# INLINE_NORMAL interleaveFst #-}+interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a+interleaveFst = flip interleaveSepBy++------------------------------------------------------------------------------+-- Scheduling+------------------------------------------------------------------------------++-- | Schedule the execution of two streams in a fair round-robin manner,+-- executing each stream once, alternately. Execution of a stream may not+-- necessarily result in an output, a stream may choose to @Skip@ producing an+-- element until later giving the other stream a chance to run. Therefore, this+-- combinator fairly interleaves the execution of two streams rather than+-- fairly interleaving the output of the two streams. This can be useful in+-- co-operative multitasking without using explicit threads. This can be used+-- as an alternative to `async`.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+-- /Pre-release/+{-# INLINE_NORMAL roundRobin #-}+roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a+roundRobin (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:+--+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial+-- >>> :{+-- do+--  let s1 = Stream.fromList [1,1,1,1,1,1]+--      s2 = Stream.fromList [2,2,2]+--  let proportionately m n = do+--       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]+--       return $ \_ _ -> do+--          r <- readIORef ref+--          writeIORef ref $ Prelude.tail r+--          return $ Prelude.head r+--  f <- proportionately 2 1+--  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2+--  print xs+-- :}+-- [1,1,2,1,1,2,1,1,2]+--+{-# INLINE_NORMAL mergeByM #-}+mergeByM+    :: (Monad m)+    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+mergeByM 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)++------------------------------------------------------------------------------+-- Combine N Streams - unfoldEach+------------------------------------------------------------------------------++-- XXX If we want to have strictly N elements in each batch then we can supply a+-- Maybe input to the fold. That could be another variant of this combinator.++-- | Stream must be finite. Unfolds each element of the input stream to+-- generate streams. After generating one element from each stream fold those+-- using the supplied fold and emit the result in the output stream. Continue+-- doing this until the streams are exhausted.+--+-- /Unimplemented/+{-# INLINE_NORMAL unfoldEachFoldBy #-}+unfoldEachFoldBy :: -- Monad m =>+    Fold m b c -> Unfold m a b -> Stream m a -> Stream m c+unfoldEachFoldBy = undefined++data BfsUnfoldEachState o i =+      BfsUnfoldEachOuter o ([i] -> [i])+    | BfsUnfoldEachInner [i] ([i] -> [i])++-- XXX use arrays to store state instead of lists?+--+-- XXX In general we can use different scheduling strategies e.g. how to+-- schedule the outer vs inner loop or assigning weights to different streams+-- or outer and inner loops.++-- After a yield, switch to the next stream. Do not switch streams on Skip.+-- Yield from outer stream switches to the inner stream.+--+-- There are two choices here, (1) exhaust the outer stream first and then+-- start yielding from the inner streams, this is much simpler to implement,+-- (2) yield at least one element from an inner stream before going back to+-- outer stream and opening the next stream from it.+--+-- Ideally, we need some scheduling bias to inner streams vs outer stream.+-- Maybe we can configure the behavior.++-- | Like 'unfoldEach' but interleaves the resulting streams in a breadth first+-- manner instead of appending them. Unfolds each element in the input stream+-- to a stream and then interleave the resulting streams.+--+-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]+-- >>> Stream.toList $ Stream.bfsUnfoldEach Unfold.fromList lists+-- [1,2,3,4,5,6,7,8,9]+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE_NORMAL bfsUnfoldEach #-}+bfsUnfoldEach :: Monad m =>+    Unfold m a b -> Stream m a -> Stream m b+bfsUnfoldEach (Unfold istep inject) (Stream ostep ost) =+    Stream step (BfsUnfoldEachOuter ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (BfsUnfoldEachOuter o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (BfsUnfoldEachOuter o' (ls . (i :))))+            Skip o' -> return $ Skip (BfsUnfoldEachOuter o' ls)+            Stop -> return $ Skip (BfsUnfoldEachInner (ls []) id)++    step _ (BfsUnfoldEachInner [] rs) =+        case rs [] of+            [] -> return Stop+            ls -> return $ Skip (BfsUnfoldEachInner ls id)++    step _ (BfsUnfoldEachInner (st:ls) rs) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (BfsUnfoldEachInner ls (rs . (s :)))+            Skip s    -> Skip (BfsUnfoldEachInner (s:ls) rs)+            Stop      -> Skip (BfsUnfoldEachInner ls rs)++data ConcatUnfoldInterleaveState o i =+      ConcatUnfoldInterleaveOuter o [i]+    | ConcatUnfoldInterleaveInner o [i]+    | ConcatUnfoldInterleaveInnerL [i] [i]+    | ConcatUnfoldInterleaveInnerR [i] [i]++-- | Like 'bfsUnfoldEach' but reverses the traversal direction after reaching+-- the last stream and then after reaching the first stream, thus alternating+-- the directions. This could be a little bit more efficient if the order of+-- traversal is not important.+--+-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]+-- >>> Stream.toList $ Stream.altBfsUnfoldEach Unfold.fromList lists+-- [1,2,3,6,5,4,7,8,9]+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE_NORMAL altBfsUnfoldEach #-}+altBfsUnfoldEach, unfoldInterleave :: Monad m =>+    Unfold m a b -> Stream m a -> Stream m b+altBfsUnfoldEach (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)++RENAME(unfoldInterleave,altBfsUnfoldEach)++-- XXX In general we can use different scheduling strategies e.g. how to+-- schedule the outer vs inner loop or assigning weights to different streams+-- or outer and inner loops.+--+-- This could be inefficient if the tasks are too small.+--+-- Compared to unfoldEachInterleave this one switches streams on Skips.++-- | Similar to 'bfsUnfoldEach' but scheduling is independent of output.+--+-- This is an N-ary version of 'roundRobin'.+--+-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]+-- >>> Stream.toList $ Stream.unfoldSched Unfold.fromList lists+-- [1,2,3,4,5,6,7,8,9]+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE_NORMAL unfoldSched #-}+unfoldSched, unfoldRoundRobin :: Monad m =>+    Unfold m a b -> Stream m a -> Stream m b+unfoldSched (Unfold istep inject) (Stream ostep ost) =+    Stream step (BfsUnfoldEachOuter ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (BfsUnfoldEachOuter o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (BfsUnfoldEachOuter o' (ls . (i :))))+            Skip o' -> return $ Skip (BfsUnfoldEachOuter o' ls)+            Stop -> return $ Skip (BfsUnfoldEachInner (ls []) id)++    step _ (BfsUnfoldEachInner [] rs) =+        case rs [] of+            [] -> return Stop+            ls -> return $ Skip (BfsUnfoldEachInner ls id)++    step _ (BfsUnfoldEachInner (st:ls) rs) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (BfsUnfoldEachInner ls (rs . (s :)))+            Skip s    -> Skip (BfsUnfoldEachInner ls (rs . (s :)))+            Stop      -> Skip (BfsUnfoldEachInner ls rs)++RENAME(unfoldRoundRobin,unfoldSched)++-- | Round robin co-operative scheduling of multiple streams.+--+-- Like concatMap but schedules the generated streams in a round robin+-- fashion. Note that it does not strive to interleave the outputs of the+-- streams, just gives the streams a chance to run whether it produces an+-- output or not. Therefore, the outputs may not seem to be fairly interleaved+-- if a stream decides to skip the output.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE_NORMAL schedMapM #-}+schedMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+schedMapM f (Stream ostep ost) =+    Stream step (BfsUnfoldEachOuter ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (BfsUnfoldEachOuter o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- f a+                return (Skip (BfsUnfoldEachOuter o' (ls . (i :))))+            Skip o' -> return $ Skip (BfsUnfoldEachOuter o' ls)+            Stop -> return $ Skip (BfsUnfoldEachInner (ls []) id)++    step _ (BfsUnfoldEachInner [] rs) =+        case rs [] of+            [] -> return Stop+            ls -> return $ Skip (BfsUnfoldEachInner ls id)++    step gst (BfsUnfoldEachInner (UnStream istep st:ls) rs) = do+        r <- istep gst st+        return $ case r of+            Yield x s -> Yield x (BfsUnfoldEachInner ls (rs . (Stream istep s :)))+            Skip s    -> Skip (BfsUnfoldEachInner ls (rs . (Stream istep s :)))+            Stop      -> Skip (BfsUnfoldEachInner ls rs)++-- | See 'SchedFor' for documentation.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE schedMap #-}+schedMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+schedMap f = schedMapM (return . f)++-- | See 'SchedFor' for documentation.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE schedForM #-}+schedForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+schedForM = flip schedMapM++-- | Similar to 'bfsConcatFor' but scheduling is independent of output.+--+-- >>> lists = Stream.fromList [[1,4,7],[2,5,8],[3,6,9]]+-- >>> Stream.toList $ Stream.schedFor lists $ \xs -> Stream.fromList xs+-- [1,2,3,4,5,6,7,8,9]+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+-- CAUTION! Do not use on infinite streams.+--+{-# INLINE schedFor #-}+schedFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+schedFor = flip schedMap++-- | Similar to 'fairUnfoldEach' but scheduling is independent of the output.+--+-- >>> :{+-- outerLoop = Stream.fromList [1,2,3]+-- innerLoop = Unfold.carry $ Unfold.lmap (const [4,5,6]) Unfold.fromList+-- :}+--+-- >>> Stream.toList $ Stream.fairUnfoldSched innerLoop outerLoop+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+{-# INLINE_NORMAL fairUnfoldSched #-}+fairUnfoldSched :: Monad m =>+    Unfold m a b -> Stream m a -> Stream m b+fairUnfoldSched (Unfold istep inject) (Stream ostep ost) =+    Stream step (FairUnfoldInit ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (FairUnfoldInit o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (FairUnfoldNext o' id (ls [i])))+            Skip o' -> return $ Skip (FairUnfoldNext o' id (ls []))+            Stop -> return $ Skip (FairUnfoldDrain id (ls []))++    step _ (FairUnfoldNext o ys []) =+            return $ Skip (FairUnfoldInit o ys)++    step _ (FairUnfoldNext o ys (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldNext o (ys . (s :)) ls)+            Skip s    -> Skip (FairUnfoldNext o (ys . (s :)) ls)+            Stop      -> Skip (FairUnfoldNext o ys ls)++    step _ (FairUnfoldDrain ys []) =+        case ys [] of+            [] -> return Stop+            xs -> return $ Skip (FairUnfoldDrain id xs)++    step _ (FairUnfoldDrain ys (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldDrain (ys . (s :)) ls)+            Skip s    -> Skip (FairUnfoldDrain (ys . (s :)) ls)+            Stop      -> Skip (FairUnfoldDrain ys ls)++-- | See 'fairConcatFor' for more details. This is similar except that this+-- uses unfolds, therefore, it is much faster due to fusion.+--+-- >>> :{+-- outerLoop = Stream.fromList [1,2,3]+-- innerLoop = Unfold.carry $ Unfold.lmap (const [4,5,6]) Unfold.fromList+-- :}+--+-- >>> Stream.toList $ Stream.fairUnfoldEach innerLoop outerLoop+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+--+{-# INLINE_NORMAL fairUnfoldEach #-}+fairUnfoldEach :: Monad m =>+    Unfold m a b -> Stream m a -> Stream m b+fairUnfoldEach (Unfold istep inject) (Stream ostep ost) =+    Stream step (FairUnfoldInit ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (FairUnfoldInit o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (FairUnfoldNext o' id (ls [i])))+            Skip o' -> return $ Skip (FairUnfoldInit o' ls)+            Stop -> return $ Skip (FairUnfoldDrain id (ls []))++    step _ (FairUnfoldNext o ys []) =+            return $ Skip (FairUnfoldInit o ys)++    step _ (FairUnfoldNext o ys (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldNext o (ys . (s :)) ls)+            Skip s    -> Skip (FairUnfoldNext o ys (s : ls))+            Stop      -> Skip (FairUnfoldNext o ys ls)++    step _ (FairUnfoldDrain ys []) =+        case ys [] of+            [] -> return Stop+            xs -> return $ Skip (FairUnfoldDrain id xs)++    step _ (FairUnfoldDrain ys (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldDrain (ys . (s :)) ls)+            Skip s    -> Skip (FairUnfoldDrain ys (s : ls))+            Stop      -> Skip (FairUnfoldDrain ys ls)++-- | See 'fairSchedFor' for documentation.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+{-# INLINE_NORMAL fairSchedMapM #-}+fairSchedMapM :: Monad m =>+    (a -> m (Stream m b)) -> Stream m a -> Stream m b+fairSchedMapM f (Stream ostep ost) =+    Stream step (FairUnfoldInit ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (FairUnfoldInit o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- f a+                i `seq` return (Skip (FairUnfoldNext o' id (ls [i])))+            Skip o' -> return $ Skip (FairUnfoldNext o' id (ls []))+            Stop -> return $ Skip (FairUnfoldDrain id (ls []))++    step _ (FairUnfoldNext o ys []) =+            return $ Skip (FairUnfoldInit o ys)++    step gst (FairUnfoldNext o ys (UnStream istep st:ls)) = do+        r <- istep gst st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldNext o (ys . (Stream istep s :)) ls)+            Skip s    -> Skip (FairUnfoldNext o (ys . (Stream istep s :)) ls)+            Stop      -> Skip (FairUnfoldNext o ys ls)++    step _ (FairUnfoldDrain ys []) =+        case ys [] of+            [] -> return Stop+            xs -> return $ Skip (FairUnfoldDrain id xs)++    step gst (FairUnfoldDrain ys (UnStream istep st:ls)) = do+        r <- istep gst st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldDrain (ys . (Stream istep s :)) ls)+            Skip s    -> Skip (FairUnfoldDrain (ys . (Stream istep s :)) ls)+            Stop      -> Skip (FairUnfoldDrain ys ls)++-- | See 'fairSchedFor' for documentation.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+{-# INLINE fairSchedMap #-}+fairSchedMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+fairSchedMap f = fairSchedMapM (return . f)++-- | See 'fairSchedFor' for documentation.+--+-- Scheduling is affected by the Skip constructor; implementations with more+-- skips receive proportionally less scheduling time.+--+{-# INLINE fairSchedForM #-}+fairSchedForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+fairSchedForM = flip fairSchedMapM++-- | 'fairSchedFor' is just like 'fairConcatFor', it traverses the depth and+-- breadth of nesting equally. It maintains fairness among different levels of+-- loop iterations.  Therefore, the outer and the inner loops in a nested loop+-- get equal priority. It can be used to nest infinite streams without starving+-- outer streams due to inner ones.+--+-- There is one crucial difference, while 'fairConcatFor' necessarily produces+-- an output from one stream before it schedules the next, 'fairSchedFor'+-- schedules the next stream even if a stream did not produce an output. Thus+-- it interleaves the CPU rather than the outputs of the streams. Thus even if+-- an infinite stream does not produce an output it can not block all other+-- streams.+--+-- Note that the order of emitting the output from different streams may not be+-- predictable, it depends on the skip points inside the stream. Scheduling is+-- affected by the Skip constructor; implementations with more skips receive+-- proportionally less scheduling time.+--+-- == Non-Productive Streams+--+-- Unlike in 'fairConcatFor', if one of the two interleaved streams does not+-- produce an output at all and continues forever then the other stream will+-- still get scheduled. The following program will hang forever for+-- 'fairConcatFor' but will work fine with 'fairSchedFor'.+--+-- >>> :{+-- oddsIf x = Stream.fromList (if x then [1,3..] else [2,4..])+-- filterEven x = if even x then Stream.fromPure x else Stream.nil+-- :}+--+-- >>> :{+-- evens =+--     Stream.fairSchedFor (Stream.fromList [True,False]) $ \r ->+--      Stream.fairSchedFor (oddsIf r) filterEven+-- :}+--+-- >>> Stream.toList $ Stream.take 3 $ evens+-- [2,4,6]+--+-- When @r@ is True, the nested 'fairSchedFor' is a non-productive infinite+-- loop, but still the outer loop gets a chance to generate the @False@ value,+-- and the @evens@ function can produce output. The same code won't terminate+-- if we use 'fairConcatFor' instead of 'fairSchedFor'. Thus even without+-- explicit concurrency we can schedule multiple streams on the same CPU.+--+-- == Logic Programming+--+-- When exploring large streams in logic programming, 'fairSchedFor' can be+-- used as a safe alternative to 'fairConcatFor' as it cannot block due to+-- non-productive infinite streams.+--+{-# INLINE fairSchedFor #-}+fairSchedFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+fairSchedFor = flip fairSchedMap++-- | See 'fairConcatFor' for documentation.+{-# INLINE_NORMAL fairConcatMapM #-}+fairConcatMapM :: Monad m =>+    (a -> m (Stream m b)) -> Stream m a -> Stream m b+fairConcatMapM f (Stream ostep ost) =+    Stream step (FairUnfoldInit ost id)++    where++    {-# INLINE_LATE step #-}+    step gst (FairUnfoldInit o ls) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- f a+                i `seq` return (Skip (FairUnfoldNext o' id (ls [i])))+            Skip o' -> return $ Skip (FairUnfoldInit o' ls)+            Stop -> return $ Skip (FairUnfoldDrain id (ls []))++    step _ (FairUnfoldNext o ys []) =+            return $ Skip (FairUnfoldInit o ys)++    step gst (FairUnfoldNext o ys (UnStream istep st:ls)) = do+        r <- istep gst st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldNext o (ys . (Stream istep s :)) ls)+            Skip s    -> Skip (FairUnfoldNext o ys (UnStream istep s:ls))+            Stop      -> Skip (FairUnfoldNext o ys ls)++    step _ (FairUnfoldDrain ys []) =+        case ys [] of+            [] -> return Stop+            xs -> return $ Skip (FairUnfoldDrain id xs)++    step gst (FairUnfoldDrain ys (UnStream istep st:ls)) = do+        r <- istep gst st+        return $ case r of+            Yield x s -> Yield x (FairUnfoldDrain (ys . (Stream istep s :)) ls)+            Skip s    -> Skip (FairUnfoldDrain ys (Stream istep s : ls))+            Stop      -> Skip (FairUnfoldDrain ys ls)++-- | See 'fairConcatFor' for documentation.+{-# INLINE fairConcatMap #-}+fairConcatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+fairConcatMap f = fairConcatMapM (return . f)++-- | See 'fairConcatFor' for documentation.+{-# INLINE fairConcatForM #-}+fairConcatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+fairConcatForM = flip fairConcatMapM++-- | 'fairConcatFor' is like 'concatFor' but traverses the depth and breadth of+-- nesting equally. Therefore, the outer and the inner loops in a nested loop+-- get equal priority. It can be used to nest infinite streams without starving+-- outer streams due to inner ones.+--+-- Given a stream of three streams:+--+-- @+-- 1. [1,2,3]+-- 2. [4,5,6]+-- 3. [7,8,9]+-- @+--+-- Here, outer loop is the stream of streams and the inner loops are the+-- individual streams. The traversal sweeps the diagonals in the above grid to+-- give equal chance to outer and inner loops. The resulting stream is+-- @(1),(2,4),(3,5,7),(6,8),(9)@, diagonals are parenthesized for emphasis.+--+-- == Looping+--+-- A single stream case is equivalent to 'concatFor':+--+-- >>> Stream.toList $ Stream.fairConcatFor (Stream.fromList [1,2]) $ \x -> Stream.fromPure x+-- [1,2]+--+-- == Fair Nested Looping+--+-- Multiple streams nest like @for@ loops. The result is a cross product of the+-- streams. However, the ordering of the results of the cross product is such+-- that each stream gets consumed equally. In other words, inner iterations of+-- a nested loop get the same priority as the outer iterations. Inner+-- iterations do not finish completely before the outer iterations start.+--+-- >>> :{+-- Stream.toList $ do+--     Stream.fairConcatFor (Stream.fromList [1,2,3]) $ \x ->+--      Stream.fairConcatFor (Stream.fromList [4,5,6]) $ \y ->+--       Stream.fromPure (x, y)+-- :}+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+--+-- == Nesting Infinite Streams+--+-- Example with infinite streams. Print all pairs in the cross product with sum+-- less than a specified number.+--+-- >>> :{+-- Stream.toList+--  $ Stream.takeWhile (\(x,y) -> x + y < 6)+--  $ Stream.fairConcatFor (Stream.fromList [1..]) $ \x ->+--     Stream.fairConcatFor (Stream.fromList [1..]) $ \y ->+--      Stream.fromPure (x, y)+-- :}+-- [(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]+--+-- == How the nesting works?+--+-- If we look at the cross product of [1,2,3], [4,5,6], the streams being+-- combined using 'fairConcatFor' are the following sequential loop iterations:+--+-- @+-- (1,4) (1,5) (1,6) -- first iteration of the outer loop+-- (2,4) (2,5) (2,6) -- second iteration of the outer loop+-- (3,4) (3,5) (3,6) -- third iteration of the outer loop+-- @+--+-- The result is a triangular or diagonal traversal of these iterations:+--+-- @+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+-- @+--+-- == Non-Termination Cases+--+-- If one of the two interleaved streams does not produce an output at all and+-- continues forever then the other stream will never get scheduled. This is+-- because a stream is unscheduled only after it produces an output. This can+-- lead to non-terminating programs, an example is provided below.+--+-- >>> :{+-- oddsIf x = Stream.fromList (if x then [1,3..] else [2,4..])+-- filterEven x = if even x then Stream.fromPure x else Stream.nil+-- :}+--+-- >>> :{+-- evens =+--     Stream.fairConcatFor (Stream.fromList [True,False]) $ \r ->+--      Stream.concatFor (oddsIf r) filterEven+-- :}+--+-- The @evens@ function does not terminate because, when r is True, the nested+-- 'concatFor' is a non-productive infinite loop, therefore, the outer loop+-- never gets a chance to generate the @False@ value.+--+-- But the following refactoring of the above code works as expected:+--+-- >>> :{+-- mixed =+--      Stream.fairConcatFor (Stream.fromList [True,False]) $ \r ->+--          Stream.concatFor (oddsIf r) Stream.fromPure+-- :}+--+-- >>> evens = Stream.fairConcatFor mixed filterEven+-- >>> Stream.toList $ Stream.take 3 $ evens+-- [2,4,6]+--+-- This works because in @mixed@ both the streams being interleaved are+-- productive.+--+-- Care should be taken how you write your program, keep in mind the scheduling+-- implications. To avoid such scheduling problems in serial interleaving, you+-- can use 'fairSchedFor' or concurrent scheduling i.e. parFairConcatFor. Due+-- to concurrent scheduling the other branch will make progress even if one is+-- an infinite loop producing nothing.+--+-- == Logic Programming+--+-- Streamly provides all operations for logic programming. It provides+-- functionality equivalent to 'LogicT' type from the 'logict' package.+-- The @MonadLogic@ operations can be implemented using the available stream+-- operations. For example, 'uncons' is @msplit@, 'interleave' corresponds to+-- the @interleave@ operation of MonadLogic, 'fairConcatFor' is the+-- fair bind (@>>-@) operation. 'fairSchedFor' is an even better alternative+-- for fair bind, it guarantees that non-productive infinite streams cannot+-- block progress.+--+-- == Related Operations+--+-- See also "Streamly.Internal.Data.StreamK.fairConcatFor".+--+{-# INLINE fairConcatFor #-}+fairConcatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+fairConcatFor = flip fairConcatMap++------------------------------------------------------------------------------+-- Combine N Streams - interpose+------------------------------------------------------------------------------++{-# ANN type InterposeSuffixState Fuse #-}+data InterposeSuffixState s1 i1 =+      InterposeSuffixFirst s1+    -- | InterposeSuffixFirstYield s1 i1+    | InterposeSuffixFirstInner s1 i1+    | InterposeSuffixSecond s1++-- XXX Note that if an unfolded layer turns out to be nil we still emit the+-- separator effect. An alternate behavior could be to emit the separator+-- effect only if at least one element has been yielded by the unfolding.+-- However, that becomes a bit complicated, so we have chosen the former+-- behavior for now.++-- | Monadic variant of 'unfoldEachEndBy'.+--+-- Definition:+--+-- >>> unfoldEachEndByM x = Stream.intercalateEndBy Unfold.identity (Stream.repeatM x)+--+{-# INLINE_NORMAL unfoldEachEndByM #-}+unfoldEachEndByM, interposeSuffixM :: Monad m =>+    m c -> Unfold m b c -> Stream m b -> Stream m c+unfoldEachEndByM+    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)++-- | Unfold the elements of a stream, append the given element after each+-- unfolded stream and then concat them into a single stream.+--+-- Definition:+--+-- >>> unfoldEachEndBy x = Stream.intercalateEndBy Unfold.identity (Stream.repeat x)+--+-- Usage:+--+-- >>> unlines = Stream.unfoldEachEndBy '\n'+--+-- /Pre-release/+{-# INLINE unfoldEachEndBy #-}+unfoldEachEndBy, interposeSuffix :: Monad m+    => c -> Unfold m b c -> Stream m b -> Stream m c+unfoldEachEndBy x = unfoldEachEndByM (return x)++RENAME(interposeSuffix,unfoldEachEndBy)+RENAME(interposeSuffixM,unfoldEachEndByM)++{-# ANN type InterposeState Fuse #-}+data InterposeState s1 i1 a =+      InterposeFirst s1+    -- | InterposeFirstYield s1 i1+    | InterposeFirstInner s1 i1+    | InterposeFirstInject s1+    -- | InterposeFirstBuf s1 i1+    | InterposeSecondYield s1 i1+    -- -- | InterposeSecondYield s1 i1 a+    -- -- | InterposeFirstResume s1 i1 a++-- Note that this only interposes the pure values, we may run many effects to+-- generate those values as some effects may not generate anything (Skip).++-- | Monadic variant of 'unfoldEachSepBy'.+--+-- Definition:+--+-- >>> unfoldEachSepByM x = Stream.intercalateSepBy Unfold.identity (Stream.repeatM x)+--+{-# INLINE_NORMAL unfoldEachSepByM #-}+unfoldEachSepByM, interposeM :: Monad m =>+    m c -> Unfold m b c -> Stream m b -> Stream m c+unfoldEachSepByM+    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)+    -}++-- | Unfold the elements of a stream, intersperse the given element between the+-- unfolded streams and then concat them into a single stream.+--+-- Definition:+--+-- >>> unfoldEachSepBy x = Stream.unfoldEachSepByM (return x)+-- >>> unfoldEachSepBy x = Stream.intercalateSepBy Unfold.identity (Stream.repeat x)+--+-- Usage:+--+-- >>> unwords = Stream.unfoldEachSepBy ' '+--+-- /Pre-release/+{-# INLINE unfoldEachSepBy #-}+unfoldEachSepBy, interpose :: Monad m+    => c -> Unfold m b c -> Stream m b -> Stream m c+unfoldEachSepBy x = unfoldEachSepByM (return x)++RENAME(interposeM,unfoldEachSepByM)+RENAME(interpose,unfoldEachSepBy)++------------------------------------------------------------------------------+-- Combine N Streams - intercalate+------------------------------------------------------------------------------++data ICUState s1 s2 i1 i2 =+      ICUFirst s1 s2+    | ICUSecond s1 s2+    | ICUSecondOnly s2+    | ICUFirstOnly s1+    | ICUFirstInner s1 s2 i1+    | ICUSecondInner s1 s2 i2+    | ICUFirstOnlyInner s1 i1+    | ICUSecondOnlyInner s2 i2++-- | See 'intercalateSepBy' for detailed documentation.+--+-- You can think of this as 'interleaveEndBy' on the stream of streams followed+-- by concat. Same as the following but more efficient:+--+-- >>> intercalateEndBy u1 s1 u2 s2 = Stream.concat $ Stream.interleaveEndBy (fmap (Stream.unfold u1) s1) (fmap (Stream.unfold u2) s2)+--+-- /Pre-release/+{-# INLINE_NORMAL intercalateEndBy #-}+intercalateEndBy :: Monad m =>+       Unfold m a c -> Stream m a+    -> Unfold m b c -> Stream m b+    -> Stream m c+intercalateEndBy+    (Unfold istep2 inject2) (Stream step2 state2)+    (Unfold istep1 inject1) (Stream step1 state1) =+    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++-- |+--+-- >>> gintercalateSuffix u1 s1 u2 s2 = Stream.intercalateEndBy u2 s2 u1 s1+--+{-# DEPRECATED gintercalateSuffix "Please use intercalateEndBy instead. Note the change in argument order." #-}+{-# INLINE gintercalateSuffix #-}+gintercalateSuffix+    :: Monad m+    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+gintercalateSuffix u1 s1 u2 s2 = intercalateEndBy u2 s2 u1 s1++data ICALState s1 s2 i1 i2 a =+      ICALFirst s1 s2+    -- | ICALFirstYield s1 s2 i1+    | ICALFirstInner s1 s2 i1+    | ICALFirstOnly s1+    | ICALFirstOnlyInner s1 i1+    | ICALSecondInject s1 s2+    | ICALFirstInject s1 s2 i2+    -- | ICALFirstBuf s1 s2 i1 i2+    | ICALSecondInner s1 s2 i1 i2+    -- -- | ICALSecondInner s1 s2 i1 i2 a+    -- -- | ICALFirstResume s1 s2 i1 i2 a++-- | The first stream @Stream m b@ is turned into a stream of streams by+-- unfolding each element using the first unfold, similarly @Stream m a@ is+-- also turned into a stream of streams.  The second stream of streams is+-- interspersed with the streams from the first stream in an infix manner and+-- then the resulting stream is flattened.+--+-- You can think of this as 'interleaveSepBy' on the stream of streams followed+-- by concat. Same as the following but more efficient:+--+-- >>> intercalateSepBy u1 s1 u2 s2 = Stream.concat $ Stream.interleaveSepBy (fmap (Stream.unfold u1) s1) (fmap (Stream.unfold u2) s2)+--+-- If the separator stream consists of nil streams then it becomes equivalent+-- to 'unfoldEach':+--+-- >>> unfoldEach = Stream.intercalateSepBy (Unfold.nilM (const (return ()))) (Stream.repeat ())+--+-- /Pre-release/+{-# INLINE_NORMAL intercalateSepBy #-}+intercalateSepBy+    :: Monad m+    => Unfold m b c -> Stream m b+    -> Unfold m a c -> Stream m a+    -> Stream m c+{-+intercalateSepBy u1 s1 u2 s2 =+    Stream.concat $ interleaveSepBy (fmap (unfold u1) s1) (fmap (unfold u2) s2)+-}+intercalateSepBy+    (Unfold istep2 inject2) (Stream step2 state2)+    (Unfold istep1 inject1) (Stream step1 state1) =+    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)+    -}++-- |+--+-- >>> gintercalate u1 s1 u2 s2 = Stream.intercalateSepBy u2 s2 u1 s1+--+{-# DEPRECATED gintercalate "Please use intercalateSepBy instead." #-}+{-# INLINE gintercalate #-}+gintercalate :: Monad m =>+    Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+gintercalate u1 s1 u2 s2 = intercalateSepBy u2 s2 u1 s1++-- | Unfold each element of the stream, end each unfold by a sequence generated+-- by unfolding the supplied value.+--+-- Definition:+--+-- >>> unfoldEachEndBySeq a u = Stream.unfoldEach u . Stream.intersperseEndByM a+-- >>> unfoldEachEndBySeq a u = Stream.intercalateEndBy u (Stream.repeat a) u+--+-- Idioms:+--+-- >>> intersperseEndByM x = Stream.unfoldEachEndBySeq x Unfold.identity+-- >>> unlines = Stream.unfoldEachEndBySeq "\n" Unfold.fromList+--+-- Usage:+--+-- >>> input = Stream.fromList ["abc", "def", "ghi"]+-- >>> Stream.toList $ Stream.unfoldEachEndBySeq "\n" Unfold.fromList input+-- "abc\ndef\nghi\n"+--+{-# INLINE unfoldEachEndBySeq #-}+unfoldEachEndBySeq :: Monad m+    => b -> Unfold m b c -> Stream m b -> Stream m c+unfoldEachEndBySeq seed unf = unfoldEach unf . intersperseEndByM (return seed)++{-# DEPRECATED intercalateSuffix "Please use unfoldEachEndBySeq instead." #-}+{-# INLINE intercalateSuffix #-}+intercalateSuffix :: Monad m+    => Unfold m b c -> b -> Stream m b -> Stream m c+intercalateSuffix u x = unfoldEachEndBySeq x u++-- | Unfold each element of the stream, separate the successive unfolds by a+-- sequence generated by unfolding the supplied value.+--+-- Definition:+--+-- >>> unfoldEachSepBySeq a u = Stream.unfoldEach u . Stream.intersperse a+-- >>> unfoldEachSepBySeq a u = Stream.intercalateSepBy u (Stream.repeat a) u+--+-- Idioms:+--+-- >>> intersperse x = Stream.unfoldEachSepBySeq x Unfold.identity+-- >>> unwords = Stream.unfoldEachSepBySeq " " Unfold.fromList+--+-- Usage:+--+-- >>> input = Stream.fromList ["abc", "def", "ghi"]+-- >>> Stream.toList $ Stream.unfoldEachSepBySeq " " Unfold.fromList input+-- "abc def ghi"+--+{-# INLINE unfoldEachSepBySeq #-}+unfoldEachSepBySeq :: Monad m+    => b -> Unfold m b c -> Stream m b -> Stream m c+unfoldEachSepBySeq seed unf str = unfoldEach unf $ intersperse seed str++{-# DEPRECATED intercalate "Please use unfoldEachSepBySeq instead." #-}+{-# INLINE intercalate #-}+intercalate :: Monad m+    => Unfold m b c -> b -> Stream m b -> Stream m c+intercalate u x = unfoldEachSepBySeq x u++------------------------------------------------------------------------------+-- Folding+------------------------------------------------------------------------------++-- | Apply a stream of folds to an input stream and emit the results in the+-- output stream.+--+-- /Unimplemented/+--+{-# INLINE foldSequence #-}+foldSequence+       :: -- Monad m =>+       Stream m (Fold m a b)+    -> Stream m a+    -> Stream m b+foldSequence _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.+--+-- Usage:+--+-- >>> import Data.Monoid (Sum(..))+-- >>> f x = return (Fold.take 2 (Fold.sconcat x))+-- >>> s = fmap Sum $ Stream.fromList [1..10]+-- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s+-- [3,10,21,36,55,55]+--+-- This is the streaming equivalent of monad like sequenced application of+-- folds where next fold is dependent on the previous fold.+--+-- /Pre-release/+--+{-# INLINE_NORMAL foldIterateM #-}+foldIterateM ::+       Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b+foldIterateM 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++------------------------------------------------------------------------------+-- Parsing+------------------------------------------------------------------------------++-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the+-- output stream.+--+-- Usage:+--+-- >>> s = Stream.fromList [1..10]+-- >>> parser = Parser.takeBetween 0 2 Fold.sum+-- >>> Stream.toList $ Stream.parseMany parser s+-- [Right 3,Right 7,Right 11,Right 15,Right 19]+--+-- This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse+-- combinator.+--+-- Known Issues: When the parser fails there is no way to get the remaining+-- stream.+--+{-# INLINE parseMany #-}+parseMany+    :: Monad m+    => PRD.Parser a m b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseMany = Drivers.parseMany++-- | Like 'parseMany' but includes stream position information in the error+-- messages.+--+{-# INLINE parseManyPos #-}+parseManyPos+    :: Monad m+    => PRD.Parser a m b+    -> Stream m a+    -> Stream m (Either ParseErrorPos b)+parseManyPos = Drivers.parseManyPos++{-# DEPRECATED parseManyD "Please use parseMany instead." #-}+{-# INLINE parseManyD #-}+parseManyD+    :: Monad m+    => PR.Parser a m b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseManyD = parseMany++-- | Apply a stream of parsers to an input stream and emit the results in the+-- output stream.+--+-- /Unimplemented/+--+{-# INLINE parseSequence #-}+parseSequence+       :: -- Monad m =>+       Stream m (PR.Parser a m b)+    -> Stream m a+    -> Stream m b+parseSequence _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++-- | Iterate a parser generating function on a stream. The initial value @b@ is+-- used to generate the first parser, the parser is applied on the stream and+-- the result is used to generate the next parser and so on.+--+-- Example:+--+-- >>> import Data.Monoid (Sum(..))+-- >>> s = Stream.fromList [1..10]+-- >>> Stream.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s+-- [3,10,21,36,55,55]+--+-- This is the streaming equivalent of monad like sequenced application of+-- parsers where next parser is dependent on the previous parser.+--+-- /Pre-release/+--+{-# INLINE parseIterate #-}+parseIterate+    :: Monad m+    => (b -> PRD.Parser a m b)+    -> b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseIterate = Drivers.parseIterate++-- | Like 'parseIterate' but includes stream position information in the error+-- messages.+--+{-# INLINE parseIteratePos #-}+parseIteratePos+    :: Monad m+    => (b -> PRD.Parser a m b)+    -> b+    -> Stream m a+    -> Stream m (Either ParseErrorPos b)+parseIteratePos = Drivers.parseIteratePos++{-# DEPRECATED parseIterateD "Please use parseIterate instead." #-}+{-# INLINE parseIterateD #-}+parseIterateD+    :: Monad m+    => (b -> PR.Parser a m b)+    -> b+    -> Stream m a+    -> Stream m (Either ParseError b)+parseIterateD = parseIterate++------------------------------------------------------------------------------+-- Grouping+------------------------------------------------------------------------------++data GroupByState st fs a b+    = GroupingInit st+    | GroupingDo st !fs+    | GroupingInitWith st !a+    | GroupingDoWith st !fs !a+    | GroupingYield !b (GroupByState st fs a b)+    | GroupingDone++-- | Keep collecting items in a group as long as the comparison function+-- returns true. The comparison function is @cmp old new@ where @old@ is the+-- first item in the group and @new@ is the incoming item being tested for+-- membership of the group. The collected items are folded by the supplied+-- fold.+--+-- Definition:+--+-- >>> groupsWhile cmp f = Stream.parseMany (Parser.groupBy cmp f)+{-# INLINE_NORMAL groupsWhile #-}+groupsWhile :: Monad m+    => (a -> a -> Bool)+    -> Fold m a b+    -> Stream m a+    -> Stream m b+{-+groupsWhile eq fld = parseMany (PRD.groupBy eq fld)+-}+groupsWhile 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++-- | The argument order of the comparison function in `groupsWhile` is+-- different than that of `groupsBy`.+--+-- In `groupsBy` the comparison function takes the next element as the first+-- argument and the previous element as the second argument. In `groupsWhile`+-- the first argument is the previous element and second argument is the next+-- element.+{-# DEPRECATED groupsBy "Please use groupsWhile instead. Please note the change in the argument order of the comparison function." #-}+{-# INLINE_NORMAL groupsBy #-}+groupsBy :: Monad m+    => (a -> a -> Bool)+    -> Fold m a b+    -> Stream m a+    -> Stream m b+groupsBy cmp = groupsWhile (flip cmp)++-- |+--+-- Definition:+--+-- >>> groupsRollingBy cmp f = Stream.parseMany (Parser.groupByRolling cmp f)+--+{-# INLINE_NORMAL groupsRollingBy #-}+groupsRollingBy :: Monad m+    => (a -> a -> Bool)+    -> Fold m a b+    -> Stream m a+    -> Stream m b+{-+groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)+-}+groupsRollingBy 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 determined by the predicate supplied. The tokens after splitting+-- are collected by the supplied fold. In other words, the tokens are parsed in+-- the same way as words are parsed from whitespace separated text.+--+-- >>> f x = Stream.toList $ Stream.wordsBy (== '.') Fold.toList $ Stream.fromList x+-- >>> f "a.b"+-- ["a","b"]+-- >>> f "a..b"+-- ["a","b"]+-- >>> f ".a..b."+-- ["a","b"]+--+{-# INLINE_NORMAL wordsBy #-}+wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+wordsBy 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++-- XXX Can GHC find a way to modularise this? Can we write different cases+-- i.e.g single element, word hash, karp-rabin as different functions and then+-- be able to combine them into a single state machine?++{-# ANN type TakeEndBySeqState Fuse #-}+data TakeEndBySeqState mba rb rh ck w s b x =+      TakeEndBySeqInit+    | TakeEndBySeqYield !b (TakeEndBySeqState mba rb rh ck w s b x)+    | TakeEndBySeqDone++    | TakeEndBySeqSingle s x++    | TakeEndBySeqWordInit !Int !w s+    | TakeEndBySeqWordLoop !w s+    | TakeEndBySeqWordDone !Int !w++    | TakeEndBySeqKRInit s mba+    | TakeEndBySeqKRInit1 s mba !Int+    | TakeEndBySeqKRLoop s mba !rh !ck+    | TakeEndBySeqKRCheck s mba !rh+    | TakeEndBySeqKRDone !Int rb++-- | If the pattern is empty the output stream is empty.+{-# INLINE_NORMAL takeEndBySeqWith #-}+takeEndBySeqWith+    :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a)+    => Bool+    -> Array a+    -> Stream m a+    -> Stream m a+takeEndBySeqWith withSep patArr (Stream step state) =+    Stream stepOuter TakeEndBySeqInit++    where++    patLen = A.length patArr+    patBytes = A.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)+    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++    {-# INLINE yield #-}+    yield x !s = skip $ TakeEndBySeqYield x s++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ TakeEndBySeqInit = do+        -- XXX When we statically specify the method compiler is able to+        -- simplify the code better and removes the handling of other states.+        -- When it is determined dynamically, the code is less efficient. For+        -- example, the single element search degrades by 80% if the handling+        -- of other cases is present. We need to investigate this further but+        -- until then we can guide the compiler statically where we can. If we+        -- want to use single element search statically then we can use+        -- takeEndBy instead.+        --+        -- XXX Is there a way for GHC to statically determine patLen when we+        -- use an array created from a static string as pattern e.g. "\n".+        case () of+            _ | patLen == 0 -> return Stop+              | patLen == 1 -> do+                    pat <- liftIO $ A.unsafeGetIndexIO 0 patArr+                    return $ Skip $ TakeEndBySeqSingle state pat+              | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->+                    return $ Skip $ TakeEndBySeqWordInit 0 0 state+              | otherwise -> do+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MutArray.emptyOf patLen+                    skip $ TakeEndBySeqKRInit state mba++    ---------------------+    -- Single yield point+    ---------------------++    stepOuter _ (TakeEndBySeqYield x next) = return $ Yield x next++    -----------------+    -- Done+    -----------------++    stepOuter _ TakeEndBySeqDone = return Stop++    -----------------+    -- Single Pattern+    -----------------++    stepOuter gst (TakeEndBySeqSingle st pat) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s ->+                if pat /= x+                then yield x (TakeEndBySeqSingle s pat)+                else do+                    if withSep+                    then yield x TakeEndBySeqDone+                    else return Stop+            Skip s -> skip $ TakeEndBySeqSingle s pat+            Stop -> return Stop++    ---------------------------+    -- Short Pattern - Shift Or+    ---------------------------++    -- Note: Karp-Rabin is roughly 15% slower than word hash for a 2 element+    -- pattern. This may be useful for common cases like splitting lines using+    -- "\r\n".+    stepOuter _ (TakeEndBySeqWordDone 0 _) = do+        return Stop+    stepOuter _ (TakeEndBySeqWordDone n wrd) = do+        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))+         in yield+                (toEnum $ fromIntegral old)+                (TakeEndBySeqWordDone (n - 1) wrd)++    -- XXX If we remove this init state for perf experiment the time taken+    -- reduces to half, there may be some optimization opportunity here.+    stepOuter gst (TakeEndBySeqWordInit idx wrd st) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                let wrd1 = addToWord wrd x+                    next+                      | idx /= maxIndex =+                            TakeEndBySeqWordInit (idx + 1) wrd1 s+                      | wrd1 .&. wordMask /= wordPat =+                            TakeEndBySeqWordLoop wrd1 s+                      | otherwise = TakeEndBySeqDone+                if withSep+                then yield x next+                else skip next+            Skip s -> skip $ TakeEndBySeqWordInit idx wrd s+            Stop ->+                if withSep+                then return Stop+                else skip $ TakeEndBySeqWordDone idx wrd++    stepOuter gst (TakeEndBySeqWordLoop wrd st) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                -- XXX Never use a lazy expression as state, that causes issues+                -- in simplification because the state argument of Yield is+                -- lazy, maybe we can make that strict.+                let wrd1 = addToWord wrd x+                    old = (wordMask .&. wrd)+                            `shiftR` (elemBits * (patLen - 1))+                    !y =+                            if withSep+                            then x+                            else toEnum $ fromIntegral old+                -- Note: changing the nesting order of if and yield makes a+                -- difference in performance.+                if wrd1 .&. wordMask /= wordPat+                then yield y (TakeEndBySeqWordLoop wrd1 s)+                else yield y TakeEndBySeqDone+            Skip s -> skip $ TakeEndBySeqWordLoop wrd s+            Stop ->+                 if withSep+                 then return Stop+                 else skip $ TakeEndBySeqWordDone patLen wrd++    -------------------------------+    -- General Pattern - Karp Rabin+    -------------------------------++    stepOuter gst (TakeEndBySeqKRInit st0 mba) = do+        res <- step (adaptState gst) st0+        case res of+            Yield x s -> do+                liftIO $ pokeAt 0 mba x+                if withSep+                then yield x (TakeEndBySeqKRInit1 s mba (SIZE_OF(a)))+                else skip $ TakeEndBySeqKRInit1 s mba (SIZE_OF(a))+            Skip s -> skip $ TakeEndBySeqKRInit s mba+            Stop -> return Stop++    stepOuter gst (TakeEndBySeqKRInit1 st mba offset) = do+        res <- step (adaptState gst) st+        let arr :: Array a = Array+                    { arrContents = mba+                    , arrStart = 0+                    , arrEnd = patBytes+                    }+        case res of+            Yield x s -> do+                liftIO $ pokeAt offset mba x+                let next =+                        if offset /= maxOffset+                        then TakeEndBySeqKRInit1 s mba (offset + SIZE_OF(a))+                        else+                            let ringHash = A.foldl' addCksum 0 arr+                             in if ringHash == patHash+                                then TakeEndBySeqKRCheck s mba 0+                                else TakeEndBySeqKRLoop s mba 0 ringHash+                if withSep+                then yield x next+                else skip next+            Skip s -> skip $ TakeEndBySeqKRInit1 s mba offset+            Stop -> do+                if withSep+                then return Stop+                else do+                    let rb = RingArray+                            { ringContents = mba+                            , ringSize = offset+                            , ringHead = 0+                            }+                     in skip $ TakeEndBySeqKRDone offset rb++    stepOuter gst (TakeEndBySeqKRLoop st mba rh cksum) = do+        res <- step (adaptState gst) st+        let rb = RingArray+                { ringContents = mba+                , ringSize = patBytes+                , ringHead = rh+                }+        case res of+            Yield x s -> do+                (rb1, old) <- liftIO (RB.replace rb x)+                let cksum1 = deltaCksum cksum old x+                let rh1 = ringHead rb1+                    next =+                        if cksum1 /= patHash+                        then TakeEndBySeqKRLoop s mba rh1 cksum1+                        else TakeEndBySeqKRCheck s mba rh1+                if withSep+                then yield x next+                else yield old next+            Skip s -> skip $ TakeEndBySeqKRLoop s mba rh cksum+            Stop -> do+                if withSep+                then return Stop+                else skip $ TakeEndBySeqKRDone patBytes rb++    stepOuter _ (TakeEndBySeqKRCheck st mba rh) = do+        let rb = RingArray+                    { ringContents = mba+                    , ringSize = patBytes+                    , ringHead = rh+                    }+        matches <- liftIO $ RB.eqArray rb patArr+        if matches+        then return Stop+        else skip $ TakeEndBySeqKRLoop st mba rh patHash++    stepOuter _ (TakeEndBySeqKRDone 0 _) = return Stop+    stepOuter _ (TakeEndBySeqKRDone len rb) = do+        assert (len >= 0) (return ())+        old <- RB.unsafeGetHead rb+        let rb1 = RB.moveForward rb+        yield old $ TakeEndBySeqKRDone (len - SIZE_OF(a)) rb1++-- | Take the stream until the supplied sequence is encountered. Take the+-- sequence as well and stop.+--+-- Usage:+--+-- >>> f pat xs = Stream.toList $ Stream.takeEndBySeq (Array.fromList pat) $ Stream.fromList xs+-- >>> f "fgh" "abcdefghijk"+-- "abcdefgh"+-- >>> f "lmn" "abcdefghijk"+-- "abcdefghijk"+-- >>> f "" "abcdefghijk"+-- ""+--+{-# INLINE takeEndBySeq #-}+takeEndBySeq+    :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a)+    => Array a+    -> Stream m a+    -> Stream m a+takeEndBySeq = takeEndBySeqWith True++-- | Take the stream until the supplied sequence is encountered. Do not take+-- the sequence.+--+-- Usage:+--+-- >>> f pat xs = Stream.toList $ Stream.takeEndBySeq_ (Array.fromList pat) $ Stream.fromList xs+-- >>> f "fgh" "abcdefghijk"+-- "abcde"+-- >>> f "lmn" "abcdefghijk"+-- "abcdefghijk"+-- >>> f "" "abcdefghijk"+-- ""+--+{-# INLINE takeEndBySeq_ #-}+takeEndBySeq_+    :: forall m a. (MonadIO m, Unbox a, Enum a, Eq a)+    => Array a+    -> Stream m a+    -> Stream m a+takeEndBySeq_ = takeEndBySeqWith False++{-+-- TODO can we unify the splitting operations using a splitting configuration+-- like in the split package.+--+data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)+data SplitOptions = SplitOptions+    { style    :: SplitStyle+    , withSep  :: Bool  -- ^ keep the separators in output+    -- , compact  :: Bool  -- ^ treat multiple consecutive separators as one+    -- , trimHead :: Bool  -- ^ drop blank at head+    -- , trimTail :: Bool  -- ^ drop blank at tail+    }+-}++-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,+-- because we can use the constructor directly without having to create "jump"+-- functions.+{-# ANN type SplitOnSeqState Fuse #-}+data SplitOnSeqState mba rb rh ck w fs s b x =+      SplitOnSeqInit+    | SplitOnSeqYield b (SplitOnSeqState mba rb rh ck w fs s b x)+    | SplitOnSeqDone++    | SplitOnSeqEmpty !fs s++    | SplitOnSeqSingle0 !fs s x+    | SplitOnSeqSingle !fs s x++    | SplitOnSeqWordInit0 !fs s+    | SplitOnSeqWordInit Int Word !fs s+    | SplitOnSeqWordLoop !w s !fs+    | SplitOnSeqWordDone Int !fs !w++    | SplitOnSeqKRInit0 Int !fs s mba+    | SplitOnSeqKRInit Int !fs s mba+    | SplitOnSeqKRLoop fs s mba !rh !ck+    | SplitOnSeqKRCheck fs s mba !rh+    | SplitOnSeqKRDone Int !fs rb++    | SplitOnSeqReinit (fs -> SplitOnSeqState mba rb rh ck w fs s b x)++-- XXX Need to fix empty stream split behavior++-- | Like 'splitSepBy_' but splits the stream on a sequence of elements rather than+-- a single element. Parses a sequence of tokens separated by an infixed+-- separator e.g. @a;b;c@ is parsed as @a@, @b@, @c@. If the pattern is empty+-- then each element is a match, thus the fold is finalized on each element.+--+-- >>> splitSepBy p xs = Stream.fold Fold.toList $ Stream.splitSepBySeq_ (Array.fromList p) Fold.toList (Stream.fromList xs)+--+-- >>> splitSepBy "" ""+-- []+--+-- >>> splitSepBy "" "a...b"+-- ["a",".",".",".","b"]+--+-- >>> splitSepBy ".." ""+-- []+--+-- >>> splitSepBy ".." "a...b"+-- ["a",".b"]+--+-- >>> splitSepBy ".." "abc"+-- ["abc"]+--+-- >>> splitSepBy ".." ".."+-- ["",""]+--+-- >>> splitSepBy "." ".a"+-- ["","a"]+--+-- >>> splitSepBy "." "a."+-- ["a",""]+--+-- Uses Rabin-Karp algorithm for substring search.+--+{-# INLINE_NORMAL splitSepBySeq_ #-}+splitSepBySeq_, splitOnSeq+    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)+    => Array a+    -> Fold m a b+    -> Stream m a+    -> Stream m b+splitSepBySeq_ patArr (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter SplitOnSeqInit++    where++    patLen = A.length patArr+    patBytes = A.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)+    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 yieldReinit #-}+    yieldReinit nextGen fs =+        initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ SplitOnSeqInit = do+        res <- initial+        case res of+            FL.Partial acc+                | patLen == 0 ->+                    return $ Skip $ SplitOnSeqEmpty acc state+                | patLen == 1 -> do+                    pat <- liftIO $ A.unsafeGetIndexIO 0 patArr+                    return $ Skip $ SplitOnSeqSingle0 acc state pat+                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->+                    return $ Skip $ SplitOnSeqWordInit0 acc state+                | otherwise -> do+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MutArray.emptyOf patLen+                    skip $ SplitOnSeqKRInit0 0 acc state mba+            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 yieldReinit jump b1+            Skip s -> skip (SplitOnSeqEmpty acc s)+            Stop -> final acc >> return Stop++    -----------------+    -- Done+    -----------------++    stepOuter _ SplitOnSeqDone = return Stop++    -----------------+    -- Single Pattern+    -----------------++    stepOuter gst (SplitOnSeqSingle0 fs st pat) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                -- XXX This code block is duplicated in SplitOnSeqSingle state+                let jump c = SplitOnSeqSingle c s pat+                if pat == x+                then final fs >>= yieldReinit jump+                else do+                    r <- fstep fs x+                    case r of+                        FL.Partial fs1 ->+                            pure $ Skip $ SplitOnSeqSingle fs1 s pat+                        FL.Done b -> yieldReinit jump b+            Skip s -> pure $ Skip $ SplitOnSeqSingle0 fs s pat+            Stop -> final fs >> pure Stop++    stepOuter gst (SplitOnSeqSingle fs0 st0 pat) = do+        go SPEC fs0 st0++        where++        -- The local loop increases allocations by 6% but improves CPU+        -- performance by 14%.+        go !_ !fs !st = 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 >>= yieldReinit jump+                    else do+                        r <- fstep fs x+                        case r of+                            FL.Partial fs1 -> go SPEC fs1 s+                            FL.Done b -> yieldReinit jump b+                Skip s -> go SPEC fs s+                Stop -> do+                    r <- final fs+                    return $ Skip $ SplitOnSeqYield r SplitOnSeqDone++    ---------------------------+    -- Short Pattern - Shift Or+    ---------------------------++    -- Note: We fill the matching buffer before we emit anything, in case it+    -- matches and we have to drop it. Though we could be more eager in+    -- emitting as soon as we know that the pattern cannot match. But still the+    -- worst case will remain the same, in case a match is going to happen we+    -- will have to delay until the very end.++    stepOuter _ (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+                 yieldReinit jump b++    stepOuter gst (SplitOnSeqWordInit0 fs st) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s ->+                let wrd1 = addToWord 0 x+                 in pure $ Skip $ SplitOnSeqWordInit 1 wrd1 fs s+            Skip s -> pure $ Skip $ SplitOnSeqWordInit0 fs s+            Stop -> final fs >> pure Stop++    stepOuter gst (SplitOnSeqWordInit idx0 wrd0 fs st0) =+        go SPEC idx0 wrd0 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 0 0 c s+                            final fs >>= yieldReinit 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++        -- This loop does not affect allocations but it improves the CPU+        -- performance signifcantly compared to looping using state.+        {-# INLINE go #-}+        go !_ !wrd !st !fs = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    let jump c = SplitOnSeqWordInit 0 0 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 >>= yieldReinit jump+                            else go SPEC wrd1 s fs1+                        FL.Done b -> yieldReinit jump b+                Skip s -> go SPEC wrd s fs+                Stop -> skip $ SplitOnSeqWordDone patLen fs wrd++    -------------------------------+    -- General Pattern - Karp Rabin+    -------------------------------++    -- XXX Document this pattern for writing efficient code. Loop around only+    -- required elements in the recursive loop, build the structures being+    -- manipulated locally e.g. we are passing only mba, here and build an+    -- array using patLen and arrStart from the surrounding context.++    stepOuter gst (SplitOnSeqKRInit0 offset fs st mba) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                liftIO $ pokeAt offset mba x+                skip $ SplitOnSeqKRInit (offset + SIZE_OF(a)) fs s mba+            Skip s -> skip $ SplitOnSeqKRInit0 offset fs s mba+            Stop -> final fs >> pure Stop++    stepOuter gst (SplitOnSeqKRInit offset fs st mba) = do+        res <- step (adaptState gst) st+        case res of+            Yield x s -> do+                liftIO $ pokeAt offset mba x+                if offset == maxOffset+                then do+                    let arr :: Array a = Array+                                { arrContents = mba+                                , arrStart = 0+                                , arrEnd = patBytes+                                }+                    let ringHash = A.foldl' addCksum 0 arr+                    if ringHash == patHash && A.byteEq arr patArr+                    then skip $ SplitOnSeqKRCheck fs s mba 0+                    else skip $ SplitOnSeqKRLoop fs s mba 0 ringHash+                else skip $ SplitOnSeqKRInit (offset + SIZE_OF(a)) fs s mba+            Skip s -> skip $ SplitOnSeqKRInit offset fs s mba+            Stop -> do+                let rb = RingArray+                        { ringContents = mba+                        , ringSize = offset+                        , ringHead = 0+                        }+                skip $ SplitOnSeqKRDone offset fs rb++    -- XXX The recursive "go" is more efficient than the state based recursion+    -- code commented out below. Perhaps its more efficient because of+    -- factoring out "mba" outside the loop.+    --+    stepOuter gst (SplitOnSeqKRLoop fs0 st0 mba rh0 cksum0) =+        go SPEC fs0 st0 rh0 cksum0++        where++        go !_ !fs !st !rh !cksum = do+            res <- step (adaptState gst) st+            let rb = RingArray+                    { ringContents = mba+                    , ringSize = patBytes+                    , ringHead = rh+                    }+            case res of+                Yield x s -> do+                    (rb1, old) <- liftIO (RB.replace rb x)+                    r <- fstep fs old+                    case r of+                        FL.Partial fs1 -> do+                            let cksum1 = deltaCksum cksum old x+                            let rh1 = ringHead rb1+                            if cksum1 == patHash+                            then skip $ SplitOnSeqKRCheck fs1 s mba rh1+                            else go SPEC fs1 s rh1 cksum1+                        FL.Done b -> do+                            -- XXX the old code looks wrong as we are resetting+                            -- the ring head but the ring still has old+                            -- elements as we are not resetting the size.+                            let jump c = SplitOnSeqKRInit 0 c s mba+                            yieldReinit jump b+                Skip s -> go SPEC fs s rh cksum+                Stop -> skip $ SplitOnSeqKRDone patBytes fs rb++    -- XXX The following code is 5 times slower compared to the recursive loop+    -- based code above. Need to investigate why. One possibility is that the+    -- go loop above does not thread around the ring buffer (rb). This code may+    -- be causing the state to bloat and getting allocated on each iteration.+    -- We can check the cmm/asm code to confirm.  If so a good GHC solution to+    -- such problem is needed. One way to avoid this could be to use unboxed+    -- mutable state?+    {-+    stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do+            res <- step (adaptState gst) st+            case res of+                Yield x s -> do+                    old <- liftIO $ peek rh+                    let cksum1 = deltaCksum cksum old x+                    fs1 <- fstep fs old+                    if (cksum1 == patHash)+                    then do+                        r <- done fs1+                        skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh+                    else do+                        rh1 <- liftIO (RB.unsafeInsert rb rh x)+                        skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1+                Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum+                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh+    -}++    stepOuter _ (SplitOnSeqKRCheck fs st mba rh) = do+        let rb = RingArray+                    { ringContents = mba+                    , ringSize = patBytes+                    , ringHead = rh+                    }+        res <- liftIO $ RB.eqArray rb patArr+        if res+        then do+            r <- final fs+            let jump c = SplitOnSeqKRInit 0 c st mba+            yieldReinit jump r+        else skip $ SplitOnSeqKRLoop fs st mba rh patHash++    stepOuter _ (SplitOnSeqKRDone 0 fs _) = do+        r <- final fs+        skip $ SplitOnSeqYield r SplitOnSeqDone+    stepOuter _ (SplitOnSeqKRDone len fs rb) = do+        assert (len >= 0) (return ())+        old <- RB.unsafeGetHead rb+        let rb1 = RB.moveForward rb+        r <- fstep fs old+        case r of+            FL.Partial fs1 -> skip $ SplitOnSeqKRDone (len - SIZE_OF(a)) fs1 rb1+            FL.Done b -> do+                 let jump c = SplitOnSeqKRDone (len - SIZE_OF(a)) c rb1+                 yieldReinit jump b++RENAME(splitOnSeq,splitSepBySeq_)++{-# ANN type SplitOnSuffixSeqState Fuse #-}+data SplitOnSuffixSeqState mba rb rh ck w fs s b x =+      SplitOnSuffixSeqInit+    | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState mba rb rh ck w fs s b x)+    | SplitOnSuffixSeqDone++    | SplitOnSuffixSeqEmpty !fs s++    | SplitOnSuffixSeqSingleInit !fs s x+    | SplitOnSuffixSeqSingle !fs s x++    | SplitOnSuffixSeqWordInit !fs s+    | SplitOnSuffixSeqWordLoop !w s !fs+    | SplitOnSuffixSeqWordDone Int !fs !w++    | SplitOnSuffixSeqKRInit !fs s mba+    | SplitOnSuffixSeqKRInit1 !fs s mba+    | SplitOnSuffixSeqKRLoop fs s mba !rh !ck+    | SplitOnSuffixSeqKRCheck fs s mba !rh+    | SplitOnSuffixSeqKRDone Int !fs rb++    | SplitOnSuffixSeqReinit+          (fs -> SplitOnSuffixSeqState mba rb rh ck w fs s b x)++-- | @splitOnSuffixSeq withSep pat fld input@ splits the input using @pat@ as a+-- suffixed separator, the resulting split segments are fed to the fold @fld@.+-- If @withSep@ is True then the separator sequence is also suffixed with the+-- split segments.+--+-- /Internal/+{-# INLINE_NORMAL splitOnSuffixSeq #-}+splitOnSuffixSeq+    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)+    => Bool+    -> Array a+    -> Fold m a b+    -> Stream m a+    -> Stream m b+splitOnSuffixSeq withSep patArr (Fold fstep initial _ final) (Stream step state) =+    Stream stepOuter SplitOnSuffixSeqInit++    where++    patLen = A.length patArr+    patBytes = A.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)+    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 yieldReinit #-}+    yieldReinit 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+            yieldReinit jump b1+        else do+            r <- fstep fs x+            case r of+                FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat+                FL.Done b -> yieldReinit 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+                | patLen == 0 ->+                    skip $ SplitOnSuffixSeqEmpty fs state+                | patLen == 1 -> do+                    pat <- liftIO $ A.unsafeGetIndexIO 0 patArr+                    skip $ SplitOnSuffixSeqSingleInit fs state pat+                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->+                    skip $ SplitOnSuffixSeqWordInit fs state+                | otherwise -> do+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MutArray.emptyOf patLen+                    skip $ SplitOnSuffixSeqKRInit fs state mba+            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+                yieldReinit 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+                yieldReinit 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+                        yieldReinit 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+                            | idx /= maxIndex ->+                                go SPEC (idx + 1) wrd1 s fs1+                            | wrd1 .&. wordMask /= wordPat ->+                                skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1+                            | otherwise ->+                                final fs1 >>= yieldReinit jump+                        FL.Done b -> yieldReinit jump b+                Skip s -> go SPEC idx wrd s fs+                Stop ->+                    if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else 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 >>= yieldReinit jump+                            else go SPEC wrd1 s fs1+                        FL.Done b -> yieldReinit jump b+                Skip s -> go SPEC wrd s fs+                Stop ->+                    if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else skip $ SplitOnSuffixSeqWordDone patLen fs wrd++    -------------------------------+    -- General Pattern - Karp Rabin+    -------------------------------++    stepOuter gst (SplitOnSuffixSeqKRInit fs st0 mba) = do+        res <- step (adaptState gst) st0+        case res of+            Yield x s -> do+                liftIO $ pokeAt 0 mba x+                r <- if withSep then fstep fs x else return $ FL.Partial fs+                case r of+                    FL.Partial fs1 ->+                        skip $ SplitOnSuffixSeqKRInit1 fs1 s mba+                    FL.Done b -> do+                        let jump c = SplitOnSuffixSeqKRInit c s mba+                        yieldReinit jump b+            Skip s -> skip $ SplitOnSuffixSeqKRInit fs s mba+            Stop -> final fs >> return Stop++    stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 mba) = do+        go SPEC (SIZE_OF(a)) st0 fs0++        where++        go !_ !offset st !fs = do+            res <- step (adaptState gst) st+            let arr :: Array a = Array+                        { arrContents = mba+                        , arrStart = 0+                        , arrEnd = patBytes+                        }+            case res of+                Yield x s -> do+                    liftIO $ pokeAt offset mba x+                    r <- if withSep then fstep fs x else return $ FL.Partial fs+                    let ringHash = A.foldl' addCksum 0 arr+                    case r of+                        FL.Partial fs1+                            | offset /= maxOffset ->+                                go SPEC (offset + SIZE_OF(a)) s fs1+                            | ringHash == patHash ->+                                skip $ SplitOnSuffixSeqKRCheck fs1 s mba 0+                            | otherwise ->+                                skip $ SplitOnSuffixSeqKRLoop+                                    fs1 s mba 0 ringHash+                        FL.Done b -> do+                            let jump c = SplitOnSuffixSeqKRInit c s mba+                            yieldReinit jump b+                Skip s -> go SPEC offset s fs+                Stop -> do+                    -- do not issue a blank segment when we end at pattern+                    if offset == maxOffset && A.byteEq arr patArr+                    then final fs >> return Stop+                    else if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else do+                        let rb = RingArray+                                { ringContents = mba+                                , ringSize = offset+                                , ringHead = 0+                                }+                         in skip $ SplitOnSuffixSeqKRDone offset fs rb++    stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 mba rh0 cksum0) =+        go SPEC fs0 st0 rh0 cksum0++        where++        go !_ !fs !st !rh !cksum = do+            res <- step (adaptState gst) st+            let rb = RingArray+                    { ringContents = mba+                    , ringSize = patBytes+                    , ringHead = rh+                    }+            case res of+                Yield x s -> do+                    (rb1, old) <- liftIO (RB.replace rb x)+                    let cksum1 = deltaCksum cksum old x+                    let rh1 = ringHead rb1+                    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 mba rh1+                        FL.Done b -> do+                            let jump c = SplitOnSuffixSeqKRInit c s mba+                            yieldReinit jump b+                Skip s -> go SPEC fs s rh cksum+                Stop -> do+                    if withSep+                    then do+                        r <- final fs+                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+                    else skip $ SplitOnSuffixSeqKRDone patBytes fs rb++    stepOuter _ (SplitOnSuffixSeqKRCheck fs st mba rh) = do+        let rb = RingArray+                    { ringContents = mba+                    , ringSize = patBytes+                    , ringHead = rh+                    }+        matches <- liftIO $ RB.eqArray rb patArr+        if matches+        then do+            r <- final fs+            let jump c = SplitOnSuffixSeqKRInit c st mba+            yieldReinit jump r+        else skip $ SplitOnSuffixSeqKRLoop fs st mba rh patHash++    stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _) = do+        r <- final fs+        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone+    stepOuter _ (SplitOnSuffixSeqKRDone len fs rb) = do+        assert (len >= 0) (return ())+        old <- RB.unsafeGetHead rb+        let rb1 = RB.moveForward rb+        r <- fstep fs old+        case r of+            FL.Partial fs1 ->+                skip $ SplitOnSuffixSeqKRDone (len - SIZE_OF(a)) fs1 rb1+            FL.Done b -> do+                let jump c = SplitOnSuffixSeqKRDone (len - SIZE_OF(a)) c rb1+                yieldReinit jump b++-- | Parses a sequence of tokens suffixed by a separator e.g. @a;b;c;@ is+-- parsed as @a;@, @b;@, @c;@. If the pattern is empty the input stream is+-- returned as it is.+--+-- Equivalent to the following:+--+-- >>> splitEndBySeq pat f = Stream.foldMany (Fold.takeEndBySeq pat f)+--+-- Usage:+--+-- >>> f p = Stream.splitEndBySeq (Array.fromList p) Fold.toList+-- >>> splitEndBy p xs = Stream.fold Fold.toList $ f p (Stream.fromList xs)+--+-- >>> splitEndBy "" ""+-- []+--+-- >>> splitEndBy "" "a...b"+-- ["a",".",".",".","b"]+--+-- >>> splitEndBy ".." ""+-- []+--+--+-- >>> splitEndBy ".." "a...b"+-- ["a..",".b"]+--+--+-- >>> splitEndBy ".." "abc"+-- ["abc"]+--+-- >>> splitEndBy ".." ".."+-- [".."]+--+-- >>> splitEndBy "." ".a"+-- [".","a"]+--+-- >>> splitEndBy "." "a."+-- ["a."]+--+-- Uses Rabin-Karp algorithm for substring search.+--+{-# INLINE_NORMAL splitEndBySeq #-}+splitEndBySeq+    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)+    => Array a+    -> Fold m a b+    -> Stream m a+    -> Stream m b+splitEndBySeq = splitOnSuffixSeq True++-- | Like 'splitEndBySeq' but drops the separators and returns only the tokens.+--+-- Equivalent to the following:+--+-- >>> splitEndBySeq_ pat f = Stream.foldMany (Fold.takeEndBySeq_ pat f)+--+-- Usage:+--+-- >>> f p = Stream.splitEndBySeq_ (Array.fromList p) Fold.toList+-- >>> splitEndBy_ p xs = Stream.fold Fold.toList $ f p (Stream.fromList xs)+--+-- >>> splitEndBy_ "" ""+-- []+--+-- >>> splitEndBy_ "" "a...b"+-- ["a",".",".",".","b"]+--+-- >>> splitEndBy_ ".." ""+-- []+--+-- >>> splitEndBy_ ".." "a...b"+-- ["a",".b"]+--+-- >>> splitEndBy_ ".." "abc"+-- ["abc"]+--+-- >>> splitEndBy_ ".." ".."+-- [""]+--+-- >>> splitEndBy_ "." ".a"+-- ["","a"]+--+-- >>> splitEndBy_ "." "a."+-- ["a"]+--+-- Uses Rabin-Karp algorithm for substring search.+--+{-# INLINE_NORMAL splitEndBySeq_ #-}+splitEndBySeq_+    :: forall m a b. (MonadIO m, Unbox a, Enum a, Eq a)+    => Array a+    -> Fold m a b+    -> Stream m a+    -> Stream m b+splitEndBySeq_ = splitOnSuffixSeq False++-- Implement this as a fold or a parser instead.+-- This can be implemented easily using Rabin Karp++-- | Split post any one of the given patterns.+--+-- /Unimplemented/+{-# INLINE splitEndBySeqOneOf #-}+splitEndBySeqOneOf :: -- (Monad m, Unboxed a, Integral a) =>+    [Array a] -> Fold m a b -> Stream m a -> Stream m b+splitEndBySeqOneOf _subseq _f _m = undefined++-- | Split on a prefixed separator element, dropping the separator.  The+-- supplied 'Fold' is applied on the split segments.+--+-- @+-- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)+-- > splitOnPrefix' (== '.') ".a.b"+-- ["a","b"]+-- @+--+-- An empty stream results in an empty output stream:+-- @+-- > splitOnPrefix' (== '.') ""+-- []+-- @+--+-- An empty segment consisting of only a prefix is folded to the default output+-- of the fold:+--+-- @+-- > splitOnPrefix' (== '.') "."+-- [""]+--+-- > splitOnPrefix' (== '.') ".a.b."+-- ["a","b",""]+--+-- > splitOnPrefix' (== '.') ".a..b"+-- ["a","","b"]+--+-- @+--+-- A prefix is optional at the beginning of the stream:+--+-- @+-- > splitOnPrefix' (== '.') "a"+-- ["a"]+--+-- > splitOnPrefix' (== '.') "a.b"+-- ["a","b"]+-- @+--+-- 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:+--+-- > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id+--+-- /Unimplemented/+{-# INLINE splitBeginBy_ #-}+splitBeginBy_ :: -- (MonadCatch m) =>+    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+splitBeginBy_ _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 splitSepBySeqOneOf #-}+splitSepBySeqOneOf :: -- (Monad m, Unboxed a, Integral a) =>+    [Array a] -> Fold m a b -> Stream m a -> Stream m b+splitSepBySeqOneOf _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+    => (f a -> Bool)                  -- isEmpty?+    -> (f a -> m (f a, Maybe (f a)))  -- splitter+    -> (f a -> f a -> m (f a))        -- joiner+    -> Stream m (f a)+    -> Stream m (f a)+splitInnerBySuffix isEmpty 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 isEmpty buf+                    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)@+--+-- See also stripPrefix.+--+-- /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.+--+-- See also stripInfix.+--+-- /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.+--+-- See also stripSuffix. -- -- /Unimplemented/ {-# INLINE dropSuffix #-}
src/Streamly/Internal/Data/Stream/Top.hs view
@@ -8,38 +8,69 @@ -- Portability : GHC -- -- Top level module that can depend on all other lower level Stream modules.+--+-- Design notes:+--+-- The order of arguments in the join operations should ideally be opposite. It+-- should be such that the infinite stream is the last one. The transformation+-- should be on the last argument, so if you curry the functions with all other+-- arguments we get a @Stream -> Stream@ function. The first stream argument+-- may be considered as a config or modifier for the operation.+--+-- Benefit of changing the order is that we get a more intuitive Stream ->+-- Stream transformation after currying all other arguments. The inner loop+-- streams become arguments for the transformation, more like local modifiers+-- for the global outer stream as the last argument. Thus we can continue using+-- transformations on the outer stream in a composed pipeline. Otherwise we can+-- use flip to flip the order.+--+-- The fact that the inner stream can be used in the loop multiple times also+-- tells that this is not the real effectful stream, it is more like a pure+-- stream or an array. In fact we may consider using an Identity streams as+-- inner streams in which case these functions will not look nice.+--+-- Downsides:+--+-- * Maybe less intuitive to think about, because we usually think the first+--   stream as the outer loop and second as the inner.+-- * Zip and merge operations will continue using the opposite order.+-- * Need to change the order of cross, crossWith operations as well+-- * It will be inconsistent with Data.List. The functions cannot be used as+-- intuitive operators.+--+-- The choice is similar to concatMap vs bind. concatMap is pipeline+-- composition friendly but bind is user intuition friendly. Another option is+-- to have other functions with a different argument order e.g. flippedCross+-- instead of cross.+--+-- If we change the order we have to make sure that we have a consistent+-- convention for set-like and the cross join operations.  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+    -- * Straight Joins+    -- | These are set-like operations but 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 or Map structures see the+    -- Streamly.Internal.Data.Stream.Container module.+      intersectBy+    , deleteFirstsBy+    , unionBy -    -- ** Set like operations on sorted streams-    , filterInStreamAscBy-    , deleteInStreamAscBy-    , unionWithStreamAscBy+    -- Set like operations on sorted streams+    , sortedIntersectBy+    , sortedDeleteFirstsBy+    , sortedUnionBy -    -- ** Join operations-    , joinInnerGeneric+    -- * Cross Joins+    , innerJoin -    -- * Joins on sorted stream-    , joinInnerAscBy-    , joinLeftAscBy-    , joinOuterAscBy+    -- Joins on sorted stream+    , innerSortedJoin+    , leftSortedJoin+    , outerSortedJoin     ) where @@ -48,12 +79,12 @@ 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 Streamly.Internal.Data.Stream.Type (Stream(..), Step(..), cross)  import qualified Data.List as List import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.Scanl as Scanl 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)@@ -61,25 +92,6 @@ #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 ------------------------------------------------------------------------------ --@@ -110,29 +122,40 @@ -- 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.+-- | Like 'cross' but emits only those tuples where @a == b@ using the supplied+-- equality predicate. This is essentially a @cross intersection@ of two+-- streams. -- -- Definition: ----- >>> joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ Stream.cross s1 s2+-- >>> innerJoin 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.+-- The second (inner) stream must be finite. Moreover, it must be either pure+-- or capable of multiple evaluations. If not then the caller should cache it+-- in an 'Data.Array.Array', if the type does not have an 'Unbox' instance then+-- use the Generic 'Data.Array.Generic.Array'. Convert the array to stream+-- before calling this function. Caching may also improve performance if the+-- stream is expensive to evaluate. ----- See 'Streamly.Internal.Data.Unfold.joinInnerGeneric' for a much faster fused--- alternative.+-- If you care about performance this function should be your last choice among+-- all inner joins. 'Streamly.Internal.Data.Unfold.innerJoin' is a much faster+-- fused alternative. 'innerSortedJoin' is a faster alternative when streams+-- are sorted. 'innerOrdJoin' is an order of magnitude faster alternative when+-- the type has an 'Ord' instance. --+-- Note: Conceptually, this is a commutative operation. Result includes all the+-- elements from the left and the right stream. The order of streams can be+-- changed without affecting results, except for the ordering within the tuple.+-- -- Time: O(m x n) -- -- /Pre-release/-{-# INLINE joinInnerGeneric #-}-joinInnerGeneric :: Monad m =>+{-# INLINE innerJoin #-}+innerJoin :: 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+innerJoin eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ cross s1 s2 {--joinInnerGeneric eq s1 s2 = do+innerJoin eq s1 s2 = do     -- ConcatMap works faster than bind     Stream.concatMap (\a ->         Stream.concatMap (\b ->@@ -143,44 +166,44 @@         ) s1 -} --- | A more efficient 'joinInner' for sorted streams.+-- | A more efficient 'innerJoin' for sorted streams. -- -- Space: O(1) -- -- Time: O(m + n) -- -- /Unimplemented/-{-# INLINE joinInnerAscBy #-}-joinInnerAscBy ::+{-# INLINE innerSortedJoin #-}+innerSortedJoin ::     (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)-joinInnerAscBy = undefined+innerSortedJoin = undefined --- | A more efficient 'joinLeft' for sorted streams.+-- | A more efficient 'leftJoin' for sorted streams. -- -- Space: O(1) -- -- Time: O(m + n) -- -- /Unimplemented/-{-# INLINE joinLeftAscBy #-}-joinLeftAscBy :: -- Monad m =>+{-# INLINE leftSortedJoin #-}+leftSortedJoin :: -- Monad m =>     (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)-joinLeftAscBy _eq _s1 _s2 = undefined+leftSortedJoin _eq _s1 _s2 = undefined --- | A more efficient 'joinOuter' for sorted streams.+-- | A more efficient 'outerJoin' for sorted streams. -- -- Space: O(1) -- -- Time: O(m + n) -- -- /Unimplemented/-{-# INLINE joinOuterAscBy #-}-joinOuterAscBy :: -- Monad m =>+{-# INLINE outerSortedJoin #-}+outerSortedJoin :: -- Monad m =>        (a -> b -> Ordering)     -> Stream m a     -> Stream m b     -> Stream m (Maybe a, Maybe b)-joinOuterAscBy _eq _s1 _s2 = undefined+outerSortedJoin _eq _s1 _s2 = undefined  ------------------------------------------------------------------------------ -- Set operations (special joins)@@ -190,8 +213,8 @@ -- 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+-- | Keep only those elements in the first stream that are present in the+-- second stream too. The second 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. --@@ -206,23 +229,30 @@ filterStreamWith fld member s1 s2 =     Stream.concatEffect         $ do-            xs <- Stream.fold fld s1-            return $ Stream.filter (`member` xs) s2+            xs <- Stream.fold fld s2+            return $ Stream.filter (`member` xs) s1 --- | '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]+-- XXX instead of folding the second stream to a list we could use it directly.+-- If the user wants they can generate the stream from an array and also call+-- uniq or nub on it. We can provide a convenience Stream -> Stream to cache+-- a finite stream in an array and serve it from the cache. The user can decide+-- what is best based on the context. They can also choose to use a boxed or+-- unboxed array for caching. To force caching we can make the second stream+-- monad type Identity. But that may be less flexible. One option is to use+-- cachedIntersectBy etc for automatic caching.++-- | 'intersectBy' returns a subsequence of the first stream which intersects+-- with the second stream. Note that this is not a commutative operation unlike+-- a set intersection, because of duplicate elements in the stream the order of+-- the streams matters. This is similar to 'Data.List.intersectBy'. Note that+-- intersectBy is a special case of 'innerJoin'. ----- Similar to the list intersectBy operation but with the stream argument order--- flipped.+-- >>> f s1 s2 = Stream.fold Fold.toList $ Stream.intersectBy (==) (Stream.fromList s1) (Stream.fromList s2)+-- >>> f [1,3,4,4,5] [2,3,4,5,5]+-- [3,4,4,5] ----- The first stream must be finite and must not block. Second stream is--- processed only after the first stream is fully realized.+-- First stream can be infinite, the second stream must be finite and must be+-- capable of multiple evaluations. -- -- Space: O(n) where @n@ is the number of elements in the second stream. --@@ -230,46 +260,87 @@ -- @n@ is the number of elements in the second stream. -- -- /Pre-release/-{-# INLINE filterInStreamGenericBy #-}-filterInStreamGenericBy :: Monad m =>+{-# INLINE intersectBy #-}+intersectBy :: Monad m =>     (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-filterInStreamGenericBy eq =+intersectBy eq =     -- XXX Use an (unboxed) array instead.     filterStreamWith-        (Fold.scanMaybe (Fold.uniqBy eq) Fold.toListRev)+        (Fold.postscanlMaybe (Scanl.uniqBy eq) Fold.toListRev)         (List.any . eq) --- | Like 'filterInStreamGenericBy' but assumes that the input streams are sorted in+-------------------------------------------------------------------------------+-- Intersection of sorted streams+-------------------------------------------------------------------------------++-- XXX The sort order is not important as long both the streams have the same+-- sort order. We need to move only in one direction in each stream.+-- XXX Fix the argument order to use the same behavior as intersectBy.++-- | Like 'intersectBy' 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. --+-- Both streams can be infinite.+-- -- Space: O(1) -- -- Time: O(m+n) -- -- /Pre-release/-{-# INLINE filterInStreamAscBy #-}-filterInStreamAscBy :: Monad m =>+{-# INLINE_NORMAL sortedIntersectBy #-}+sortedIntersectBy :: Monad m =>     (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-filterInStreamAscBy eq s1 s2 = Stream.intersectBySorted eq s2 s1+sortedIntersectBy cmp (Stream stepa ta) (Stream stepb tb) =+    Stream step+        ( ta -- left stream state+        , tb -- right stream state+        , Nothing -- left value+        , Nothing -- right value+        ) --- | 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]+    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++-- | Returns a subsequence of the first stream, deleting first occurrences of+-- those elements that are present in the second stream. Note that this is not+-- a commutative operation. This is similar to the 'Data.List.deleteFirstsBy'. ----- The following laws hold:+-- >>> f xs ys = Stream.fold Fold.toList $ Stream.deleteFirstsBy (==) (Stream.fromList xs) (Stream.fromList ys)+-- >>> f [1,2,2,3,3,5] [1,2,2,3,4]+-- [3,5] ----- > deleteInStreamGenericBy (==) s1 (s1 `append` s2) === s2--- > deleteInStreamGenericBy (==) s1 (s1 `interleave` s2) === s2+-- The following holds: ----- Same as the list 'Data.List.//' operation but with argument order flipped.+-- > deleteFirstsBy (==) (Stream.ordNub s2 `append` s1) s2 === s1+-- > deleteFirstsBy (==) (Stream.ordNub s2 `interleave` s1) s2 === s1 ----- The first stream must be finite and must not block. Second stream is--- processed only after the first stream is fully realized.+-- First stream can be infinite, second stream must be finite. -- -- Space: O(m) where @m@ is the number of elements in the first stream. --@@ -277,58 +348,83 @@ -- @n@ is the number of elements in the second stream. -- -- /Pre-release/-{-# INLINE deleteInStreamGenericBy #-}-deleteInStreamGenericBy :: Monad m =>+{-# INLINE deleteFirstsBy #-}+deleteFirstsBy :: 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+deleteFirstsBy eq s2 s1 =+    -- XXX s2 can be a sorted mutable array and we can use binary+    -- search to find. Mark the element deleted, count the deletions+    -- and reconsolidate the array when a min number of elements is+    -- deleted. --- | A more efficient 'deleteInStreamGenericBy' for streams sorted in ascending order.+    -- XXX Use StreamK or list as second argument instead of Stream to avoid+    -- concatEffect?+    Stream.concatEffect $ do+        xs <- Stream.toList s1+        -- It reverses the list but that is fine.+        let del x =+                List.foldl' (\(ys,res) y ->+                    if not res && x `eq` y+                    then (ys, True)+                    else (y:ys, res)) ([], False)+            g (ys,_) x =+                let (ys1, deleted) = del x ys+                 in if deleted+                    then (ys1, Nothing)+                    else (ys1, Just x)+         in return+                $ Stream.catMaybes+                $ fmap snd+                $ Stream.postscanl' g (xs, Nothing) s2++-- | A more efficient 'deleteFirstsBy' for streams sorted in ascending order. --+-- Both streams can be infinite.+-- -- Space: O(1) -- -- /Unimplemented/-{-# INLINE deleteInStreamAscBy #-}-deleteInStreamAscBy :: -- (Monad m) =>+{-# INLINE sortedDeleteFirstsBy #-}+sortedDeleteFirstsBy :: -- (Monad m) =>     (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-deleteInStreamAscBy _eq _s1 _s2 = undefined+sortedDeleteFirstsBy _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.+-- | Returns the first stream appended with those unique elements from the+-- second stream that are not already present in the first stream. Note that+-- this is not a commutative operation unlike a set union, argument order+-- matters. The behavior is similar to 'Data.List.unionBy'. -- -- Equivalent to the following except that @s2@ is evaluated only once: ----- >>> unionWithStreamGenericBy eq s1 s2 = s2 `Stream.append` (Stream.deleteInStreamGenericBy eq s2 s1)+-- >>> unionBy eq s1 s2 = s1 `Stream.append` Stream.deleteFirstsBy eq s1 (Stream.ordNub s2) -- -- Example: ----- >>> Stream.fold Fold.toList $ Stream.unionWithStreamGenericBy (==) (Stream.fromList [1,1,2,3]) (Stream.fromList [1,2,2,4])+-- >>> f s1 s2 = Stream.fold Fold.toList $ Stream.unionBy (==) (Stream.fromList s1) (Stream.fromList s2)+-- >>> f [1,2,2,4] [1,1,2,3,3] -- [1,2,2,4,3] --+-- First stream can be infinite, but second stream must be finite. Note that if+-- the first stream is infinite the union means just the first stream. Thus+-- union is useful only when both streams are finite. See 'sortedUnionBy' where+-- union can work on infinite streams if they are sorted.+-- -- Space: O(n) -- -- Time: O(m x n) -- -- /Pre-release/-{-# INLINE unionWithStreamGenericBy #-}-unionWithStreamGenericBy :: MonadIO m =>+{-# INLINE unionBy #-}+unionBy :: MonadIO m =>     (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-unionWithStreamGenericBy eq s1 s2 =+unionBy eq s2 s1 =     Stream.concatEffect         $ do+            -- XXX use a rewrite rule such that if a list converted to stream+            -- is passed to unionBy then this becomes an identity operation.             xs <- Stream.fold Fold.toList  s1             -- XXX we can use postscanlMAfter' instead of IORef             ref <- liftIO $ newIORef $! List.nubBy eq xs@@ -341,12 +437,21 @@                             return $ Stream.fromList xs1             return $ Stream.mapM f s2 `Stream.append` s3 --- | A more efficient 'unionWithStreamGenericBy' for sorted streams.+-- | A more efficient 'unionBy' for sorted streams. --+-- Note that the behavior is different from 'unionBy'. In 'unionBy' we append+-- the unique elements from second stream only after exhausting the first one+-- whereas in sorted streams we can determine unique elements early even when+-- we are going through the first stream. Thus the result is an interleaving of+-- the two streams, merging those elements from the second stream that are not+-- present in the first.+-- -- Space: O(1) --+-- Both streams can be infinite.+-- -- /Unimplemented/-{-# INLINE unionWithStreamAscBy #-}-unionWithStreamAscBy :: -- (Monad m) =>+{-# INLINE sortedUnionBy #-}+sortedUnionBy :: -- (Monad m) =>     (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-unionWithStreamAscBy _eq _s1 _s2 = undefined+sortedUnionBy _eq _s1 _s2 = undefined
src/Streamly/Internal/Data/Stream/Transform.hs view
@@ -7,23 +7,15 @@ -- 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+      sequence      -- * Mapping Effects     , tap@@ -35,21 +27,23 @@     , foldrS     , foldlS -    -- * Scanning By 'Fold'-    , postscan-    , scan-    , scanMany+    -- * Composable Scans+    , postscanl+    , scanl+    , scanlMany+    , scanr+    , pipe      -- * Splitting-    , splitOn+    , splitSepBy_ -    -- * Scanning+    -- * Ad-hoc Scans     -- | Left scans. Stateful, mostly one-to-one maps.     , scanlM'     , scanlMAfter'     , scanl'     , scanlM-    , scanl+    , scanlBy     , scanl1M'     , scanl1'     , scanl1M@@ -58,7 +52,7 @@     , prescanl'     , prescanlM' -    , postscanl+    , postscanlBy     , postscanlM     , postscanl'     , postscanlM'@@ -70,44 +64,63 @@     , scanlx'      -- * Filtering+    -- delete is for once like insert, filter is for many like intersperse.+     -- | Produce a subset of the stream.     , with-    , scanMaybe-    , filter+    , postscanlMaybe+    , filter -- retainBy     , filterM-    , deleteBy+    , deleteBy -- deleteOnceBy/deleteFirstBy?     , uniqBy     , uniq     , prune     , repeated +    -- * Sampling+    -- | Value agnostic filtering.+    , sampleFromThen+    -- keepEvery/filterEvery -- sampling+    -- deleteEvery/dropEvery/removeEvery -- dual of intersperseEvery+    -- deintersperse - drop infixed elements+     -- * Trimming     -- | Produce a subset of the stream trimmed at ends.-    , take-    , takeWhile-    , takeWhileM-    , takeWhileLast-    , takeWhileAround+    , initNonEmpty+    , tailNonEmpty     , drop     , dropWhile     , dropWhileM++    -- * Trimming from end+    -- | RingArray array based or buffering operations.+    --+    , takeWhileLast+    , takeWhileAround     , dropLast     , dropWhileLast     , dropWhileAround      -- * Inserting Elements-    -- | Produce a superset of the stream.-    , insertBy+    -- insert is for once like delete, intersperse is for many like filter+    -- | Produce a superset of the stream. Value agnostic insertion.     , intersperse     , intersperseM-    , intersperseMWith-    , intersperseMSuffix-    , intersperseMSuffixWith+    , intersperseEveryM+    , intersperseEndByM+    , intersperseEndByEveryM +    -- Value aware insertion.+    , insertBy -- insertCmpBy+    -- insertBeforeBy+    -- insertAfterBy+    -- intersperseBeforeBy+    -- intersperseAfterBy+     -- * Inserting Side Effects     , intersperseM_-    , intersperseMSuffix_-    , intersperseMPrefix_+    , intersperseEndByM_+    , intersperseBeginByM_      , delay     , delayPre@@ -132,7 +145,6 @@     -- * Searching     , findIndices     , elemIndices-    , slicesBy      -- * Rolling map     -- | Map using the previous element.@@ -149,9 +161,22 @@     , catLefts     , catRights     , catEithers++    -- * Deprecated+    , postscan+    , scan+    , scanMany+    , scanMaybe+    , intersperseMSuffix+    , intersperseMSuffixWith+    , intersperseMSuffix_+    , intersperseMPrefix_+    , strideFromThen+    , splitOn     ) where +#include "deprecation.h" #include "inline.hs"  import Control.Concurrent (threadDelay)@@ -163,7 +188,9 @@ import Fusion.Plugin.Types (Fuse(..))  import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Pipe.Type (Pipe(..), PipeState(..))+import Streamly.Internal.Data.Pipe.Type (Pipe(..))+import Streamly.Internal.Data.Scanl.Type (Scanl(..))+import Streamly.Internal.Data.Scanr (Scanr(..)) import Streamly.Internal.Data.SVar.Type (adaptState) import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64) import Streamly.Internal.Data.Unbox (Unbox)@@ -171,13 +198,13 @@  -- 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.Fold.Type 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)+       , scanl, scanl1, scanr, sequence, take, takeWhile, zipWith)  import Streamly.Internal.Data.Stream.Generate     (absTimesWith, relTimesWith)@@ -189,36 +216,86 @@ -- Piping ------------------------------------------------------------------------------ +{-# ANN type PipeState Fuse #-}+data PipeState st sc ps = PipeConsume st sc | PipeProduce st ps+ -- | 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)+{-# INLINE_NORMAL pipe #-}+pipe :: Monad m => Pipe m a b -> Stream m a -> Stream m b+pipe (Pipe consume produce initial) (Stream stream_step state) =+    Stream step (PipeConsume state initial) -  where+    where -    {-# INLINE_LATE step' #-}+    {-# INLINE goConsume #-}+    goConsume st cs x = do+        res <- consume cs x+        return+            $ case res of+                Pipe.YieldC s b -> Yield b (PipeConsume st s)+                Pipe.SkipC s -> Skip (PipeConsume st s)+                Pipe.Stop -> Stop+                Pipe.YieldP ps b -> Yield b (PipeProduce st ps)+                Pipe.SkipP ps -> Skip (PipeProduce st ps) -    step' gst (Consume pst, st) = pst `seq` do-        r <- step (adaptState gst) st+    {-# INLINE_LATE step #-}+    step gst (PipeConsume st cs) = do+        r <- stream_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+            Yield x s -> goConsume s cs x+            Skip s -> return $ Skip (PipeConsume s cs)+            Stop -> return Stop+    step _ (PipeProduce st ps) = do+        r <- produce ps+        return+            $ case r of+                Pipe.YieldC cs b -> Yield b (PipeConsume st cs)+                Pipe.SkipC cs -> Skip (PipeConsume st cs)+                Pipe.Stop -> Stop+                Pipe.YieldP ps1 b -> Yield b (PipeProduce st ps1)+                Pipe.SkipP ps1 -> Skip (PipeProduce st ps1) -    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)+{-# ANN type RunScanState Fuse #-}+data RunScanState st sc ps = ScanConsume st sc +-- | Use a lazy right 'Scanr' to transform a stream.+--+-- 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 = Scanr.teeWith (/) Scanr.sum (fmap fromIntegral Scanr.length)+-- >>> s = Stream.enumerateFromTo 1.0 100.0+-- >>> :{+--  Stream.fold Fold.toList+--   $ fmap fst+--   $ Stream.takeWhile (\(_,x) -> x <= 10)+--   $ Stream.scanr (Scanr.tee Scanr.identity 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 scanr #-}+scanr :: Monad m => Scanr m a b -> Stream m a -> Stream m b+scanr (Scanr consume initial) (Stream stream_step state) =+    Stream step (ScanConsume state initial)++    where++    {-# INLINE_LATE step #-}+    step gst (ScanConsume st cs) = do+        r <- stream_step (adaptState gst) st+        case r of+            Yield x s -> do+                res <- consume cs x+                return+                    $ case res of+                        Yield b cs1 -> Yield b (ScanConsume s cs1)+                        Skip cs1 -> Skip (ScanConsume s cs1)+                        Stop -> Stop+            Skip s -> return $ Skip (ScanConsume s cs)+            Stop -> return Stop+ ------------------------------------------------------------------------------ -- Transformation Folds ------------------------------------------------------------------------------@@ -419,25 +496,40 @@  data ScanState s f = ScanInit s | ScanDo s !f | ScanDone --- | Postscan a stream using the given monadic fold.+-- NOTE: Lazy postscans can be useful e.g. to use a lazy postscan on "latest".+-- We can keep the initial state undefined in lazy postscans which do not use+-- it at all. Otherwise we have to wrap the accumulator in a Maybe type.+-- Unfortunately, we cannot define lazy scans because the Partial constructor+-- itself is strict.++-- | Postscan a stream using the given fold. A postscan omits the initial+-- (default) value of the accumulator and includes the final value. --+-- >>> Stream.toList $ Stream.postscanl Scanl.latest (Stream.fromList [])+-- []+--+-- Compare with 'scan' which includes the initial value as well:+--+-- >>> Stream.toList $ Stream.scanl Scanl.latest (Stream.fromList [])+-- [Nothing]+-- -- 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)+-- >>> let avg = Scanl.teeWith (/) Scanl.sum (fmap fromIntegral Scanl.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+--   $ Stream.postscanl (Scanl.tee Scanl.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) =+{-# INLINE_NORMAL postscanl #-}+postscanl :: Monad m => Scanl m a b -> Stream m a -> Stream m b+postscanl (Scanl fstep initial extract final) (Stream sstep state) =     Stream step (ScanInit state)      where@@ -463,10 +555,16 @@             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) =+{-# DEPRECATED postscan "Please use postscanl instead" #-}+{-# INLINE_NORMAL postscan #-}+postscan :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b+postscan (FL.Fold fstep initial extract final) =+    postscanl (Scanl fstep initial extract final)++{-# INLINE scanlWith #-}+scanlWith :: Monad m+    => Bool -> Scanl m a b -> Stream m a -> Stream m b+scanlWith restart (Scanl fstep initial extract final) (Stream sstep state) =     Stream step (ScanInit state)      where@@ -492,6 +590,13 @@             Stop -> final fs >> return Stop     step _ ScanDone = return Stop +{-# DEPRECATED scanWith "Please use scanlWith instead" #-}+{-# INLINE scanWith #-}+scanWith :: Monad m+    => Bool -> Fold m a b -> Stream m a -> Stream m b+scanWith restart (Fold fstep initial extract final) =+    scanlWith restart (Scanl fstep initial extract final)+ -- 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@@ -501,17 +606,19 @@ -- 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.+-- | Strict left scan. Scan a stream using the given fold. Scan includes+-- the initial (default) value of the accumulator as well as the final value.+-- Compare with 'postscan' which omits the initial value. -- -- >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s+-- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scanl Scanl.sum s -- [0,1,3,6] -- -- See also: 'usingStateT' --  -- EXPLANATION:--- >>> scanl' step z = Stream.scan (Fold.foldl' step z)+-- >>> scanl' step z = Stream.scanl (Scanl.mkScanl step z) -- -- Like 'map', 'scanl'' too is a one to one transformation, -- however it adds an extra element.@@ -535,7 +642,7 @@ -- 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' step z = Stream.fold (Scanl.mkScanl step z) -- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s -- (10,24) --@@ -553,14 +660,26 @@ -- lazy expressions inside the accumulator, it is recommended that a strict -- data structure is used for accumulator. --+{-# INLINE_NORMAL scanl #-}+scanl :: Monad m+    => Scanl m a b -> Stream m a -> Stream m b+scanl = scanlWith False++-- | Like 'scanl' but restarts scanning afresh when the scanning fold+-- terminates.+--+{-# INLINE_NORMAL scanlMany #-}+scanlMany :: Monad m+    => Scanl m a b -> Stream m a -> Stream m b+scanlMany = scanlWith True++{-# DEPRECATED scan "Please use scanl instead" #-} {-# 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.---+{-# DEPRECATED scanMany "Please use scanlMany instead" #-} {-# INLINE_NORMAL scanMany #-} scanMany :: Monad m     => FL.Fold m a b -> Stream m a -> Stream m b@@ -728,9 +847,9 @@             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)+{-# INLINE_NORMAL postscanlBy #-}+postscanlBy :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+postscanlBy f seed = postscanlM (\a b -> return (f a b)) (return seed)  -- | Like 'scanl'' but with a monadic step function and a monadic seed. --@@ -808,7 +927,7 @@ -- 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' step z = Stream.scanl (Scanl.mkScanl step z) -- >>> scanl' f z xs = Stream.scanlM' (\a b -> return (f a b)) (return z) xs -- -- See also: 'usingStateT'@@ -834,9 +953,9 @@             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)+{-# INLINE scanlBy #-}+scanlBy :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanlBy f seed = scanlM (\a b -> return (f a b)) (return seed)  -- Adapted from the vector package {-# INLINE_NORMAL scanl1M #-}@@ -946,7 +1065,7 @@ -- -- >>> 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)+-- >>> filter p = Stream.postscanlMaybe (Scanl.filtering p) -- {-# INLINE filter #-} filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a@@ -1071,9 +1190,80 @@ repeated = undefined  ------------------------------------------------------------------------------+-- Sampling+------------------------------------------------------------------------------++-- XXX We can implement this using addition instead of "mod" to make it more+-- efficient.++-- | @sampleFromThen offset stride@ takes the element at @offset@ index and+-- then every element at strides of @stride@.+--+-- >>> Stream.fold Fold.toList $ Stream.sampleFromThen 2 3 $ Stream.enumerateFromTo 0 10+-- [2,5,8]+--+{-# INLINE sampleFromThen #-}+sampleFromThen, strideFromThen :: Monad m =>+    Int -> Int -> Stream m a -> Stream m a+sampleFromThen offset stride =+    with indexed filter+        (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0)++RENAME(strideFromThen,sampleFromThen)++------------------------------------------------------------------------------ -- Trimming ------------------------------------------------------------------------------ +-- | init for non-empty streams, fails for empty stream case.+--+{-# INLINE initNonEmpty #-}+initNonEmpty :: Monad m => Stream m a -> Stream m a+initNonEmpty (Stream step1 state1) = Stream step (Nothing, state1)++    where++    step gst (Nothing, s1) = do+        r <- step1 (adaptState gst) s1+        return $+            case r of+                Yield x s -> Skip (Just x, s)+                Skip s -> Skip (Nothing, s)+                Stop -> error "initNonEmpty: empty Stream"++    step gst (Just a, s1) = do+        r <- step1 (adaptState gst) s1+        return $+            case r of+                Yield x s -> Yield a (Just x, s)+                Skip s -> Skip (Just a, s)+                Stop -> Stop++-- | tail for non-empty streams, fails for empty stream case.+--+-- See also 'tail' for a non-partial version of this function..+{-# INLINE tailNonEmpty #-}+tailNonEmpty :: Monad m => Stream m a -> Stream m a+tailNonEmpty (Stream step1 state1) = Stream step (Nothing, state1)++    where++    step gst (Nothing, s1) = do+        r <- step1 (adaptState gst) s1+        return $+            case r of+                Yield x s -> Skip (Just x, s)+                Skip s -> Skip (Nothing, s)+                Stop -> error "tailNonEmpty: empty Stream"++    step gst (Just a, s1) = do+        r <- step1 (adaptState gst) s1+        return $+            case r of+                Yield x s -> Yield x (Just x, s)+                Skip s -> Skip (Just a, s)+                Stop -> Stop+ -- | Take all consecutive elements at the end of the stream for which the -- predicate is true. --@@ -1235,21 +1425,13 @@                    | 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"+-- | Effectful variant of 'intersperse'. Insert an effect and its output+-- between successive elements of a stream. It does nothing if stream has less+-- than two elements. ----- 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".+-- Definition: ----- >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input--- he.l.l.o."h,e,l,l,o"+-- >>> intersperseM x = Stream.interleaveSepBy (Stream.repeatM x) -- {-# INLINE_NORMAL intersperseM #-} intersperseM :: Monad m => m a -> Stream m a -> Stream m a@@ -1275,22 +1457,36 @@      step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st) --- | Insert a pure value between successive elements of a stream.+-- | Insert a pure value between successive elements of a stream. It does+-- nothing if stream has less than two elements. ----- >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input--- "h,e,l,l,o"+-- Definition: --+-- >>> intersperse x = Stream.intersperseM (return x)+-- >>> intersperse x = Stream.unfoldEachSepBy x Unfold.identity+-- >>> intersperse x = Stream.unfoldEachSepBySeq x Unfold.identity+-- >>> intersperse x = Stream.interleaveSepBy (Stream.repeat x)+--+-- Example:+--+-- >>> f x y = Stream.toList $ Stream.intersperse x $ Stream.fromList y+-- >>> f ',' "abc"+-- "a,b,c"+-- >>> f ',' "a"+-- "a"+-- {-# 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.+-- | Perform a side effect between two successive elements of a stream. It does+-- nothing if the stream has less than two elements. ----- >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input--- h.e.l.l.o+-- >>> f x y = Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ x $ Stream.fromList y+-- >>> f (putChar '.') "abc"+-- a.b.c+-- >>> f (putChar '.') "a"+-- a -- -- /Pre-release/ {-# INLINE_NORMAL intersperseM_ #-}@@ -1310,31 +1506,51 @@ -- | Intersperse a monadic action into the input stream after every @n@ -- elements. --+-- Definition:+--+-- >> intersperseEveryM n x = Stream.interleaveEverySepBy n (Stream.repeatM x)+--+-- Idioms:+--+-- >>> intersperseM = Stream.intersperseEveryM 1+-- >>> intersperse x = Stream.intersperseEveryM 1 (return x)+--+-- Usage:+-- -- >> input = Stream.fromList "hello"--- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input+-- >> Stream.toList $ Stream.intersperseEveryM 2 (return ',') input -- "he,ll,o" -- -- /Unimplemented/-{-# INLINE intersperseMWith #-}-intersperseMWith :: -- Monad m =>+{-# INLINE intersperseEveryM #-}+intersperseEveryM :: -- Monad m =>     Int -> m a -> Stream m a -> Stream m a-intersperseMWith _n _f _xs = undefined+intersperseEveryM _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.+-- | Insert an effect and its output after every 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,"+-- Definition: --+-- >>> intersperseEndByM x = Stream.interleaveEndBy (Stream.repeatM x)+--+-- Usage:+--+-- >>> f x y = Stream.toList $ Stream.intersperseEndByM (pure x) $ Stream.fromList y+-- >>> f ',' "abc"+-- "a,b,c,"+-- >>> f ',' "a"+-- "a,"+-- -- /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)+{-# INLINE_NORMAL intersperseEndByM #-}+intersperseEndByM, intersperseMSuffix :: forall m a. Monad m =>+    m a -> Stream m a -> Stream m a+intersperseEndByM action (Stream step state) = Stream step' (SuffixElem state)     where     {-# INLINE_LATE step' #-}     step' gst (SuffixElem st) = do@@ -1349,17 +1565,23 @@      step' _ (SuffixYield x next) = return $ Yield x next --- | Insert a side effect after consuming an element of a stream.+RENAME(intersperseMSuffix,intersperseEndByM)++-- | Insert an effect after every element of a stream. ----- >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input--- "hello"+-- Example: --+-- >>> f x y = Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseEndByM_ x $ Stream.fromList y+-- >>> f (putChar '.') "abc"+-- a.b.c.+-- >>> f (putChar '.') "a"+-- a.+-- -- /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)+{-# INLINE_NORMAL intersperseEndByM_ #-}+intersperseEndByM_, intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a+intersperseEndByM_ m (Stream step1 state1) = Stream step (Left state1)   where     {-# INLINE_LATE step #-}     step gst (Left st) = do@@ -1371,6 +1593,8 @@      step _ (Right st) = m >> return (Skip (Left st)) +RENAME(intersperseMSuffix_,intersperseEndByM_)+ data SuffixSpanState s a     = SuffixSpanElem s Int     | SuffixSpanSuffix s@@ -1378,19 +1602,28 @@     | SuffixSpanLast     | SuffixSpanStop --- | Like 'intersperseMSuffix' but intersperses an effectful action into the--- input stream after every @n@ elements and after the last element.+-- | Like 'intersperseEndByM' but intersperses an effectful action into the+-- input stream after every @n@ elements and also after the last element. --+-- Example:+-- -- >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input+-- >>> Stream.toList $ Stream.intersperseEndByEveryM 2 (return ',') input -- "he,ll,o,"+-- >>> f n x y = Stream.toList $ Stream.intersperseEndByEveryM n (pure x) $ Stream.fromList y+-- >>> f 2 ',' "abcdef"+-- "ab,cd,ef,"+-- >>> f 2 ',' "abcdefg"+-- "ab,cd,ef,g,"+-- >>> f 2 ',' "a"+-- "a," -- -- /Pre-release/ ---{-# INLINE_NORMAL intersperseMSuffixWith #-}-intersperseMSuffixWith :: forall m a. Monad m+{-# INLINE_NORMAL intersperseEndByEveryM #-}+intersperseEndByEveryM, intersperseMSuffixWith :: forall m a. Monad m     => Int -> m a -> Stream m a -> Stream m a-intersperseMSuffixWith n action (Stream step state) =+intersperseEndByEveryM n action (Stream step state) =     Stream step' (SuffixSpanElem state n)     where     {-# INLINE_LATE step' #-}@@ -1412,24 +1645,32 @@      step' _ SuffixSpanStop = return Stop --- | Insert a side effect before consuming an element of a stream.+RENAME(intersperseMSuffixWith,intersperseEndByEveryM)++-- | Insert a side effect before every element of a stream. -- -- Definition: ----- >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x)+-- >>> intersperseBeginByM_ = Stream.trace_+-- >>> intersperseBeginByM_ 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"+-- Usage: --+-- >>> f x y = Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseBeginByM_ x $ Stream.fromList y+-- >>> f (putChar '.') "abc"+-- .a.b.c+-- -- 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)+{-# INLINE intersperseBeginByM_ #-}+intersperseBeginByM_, intersperseMPrefix_ :: Monad m =>+    m b -> Stream m a -> Stream m a+intersperseBeginByM_ m = mapM (\x -> void m >> return x) +RENAME(intersperseMPrefix_,intersperseBeginByM_)+ ------------------------------------------------------------------------------ -- Inserting Time ------------------------------------------------------------------------------@@ -1466,7 +1707,7 @@ -- Definition: -- -- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPost = Stream.intersperseMSuffix_ . sleep+-- >>> delayPost = Stream.intersperseEndByM_ . sleep -- -- Example: --@@ -1488,7 +1729,7 @@ -- Definition: -- -- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPre = Stream.intersperseMPrefix_. sleep+-- >>> delayPre = Stream.intersperseBeginByM_ . sleep -- -- Example: --@@ -1565,8 +1806,8 @@ -- Adapted from the vector package  -- |--- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined)--- >>> indexed = Stream.postscan f+-- >>> f = Scanl.mkScanl (\(i, _) x -> (i + 1, x)) (-1,undefined)+-- >>> indexed = Stream.postscanl f -- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0) -- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed --@@ -1591,8 +1832,8 @@ -- Adapted from the vector package  -- |--- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)--- >>> indexedR n = Stream.postscan (f n)+-- >>> f n = Scanl.mkScanl (\(i, _) x -> (i - 1, x)) (n + 1,undefined)+-- >>> indexedR n = Stream.postscanl (f n) -- -- >>> s n = Stream.enumerateFromThen n (n - 1) -- >>> indexedR n = Stream.zipWith (,) (s n)@@ -1686,7 +1927,7 @@ -- | Find all the indices where the element in the stream satisfies the given -- predicate. ----- >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)+-- >>> findIndices p = Stream.postscanlMaybe (Scanl.findIndices p) -- {-# INLINE_NORMAL findIndices #-} findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int@@ -1709,25 +1950,6 @@ 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 ------------------------------------------------------------------------------@@ -1757,7 +1979,7 @@ -- 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)+-- > fld f = slidingWindow 1 (Scanl.mkScanl (\_ (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@@ -1843,10 +2065,15 @@             Skip s -> return $ Skip s             Stop -> return Stop --- | Use a filtering fold on a stream.+-- | Use a filtering scan on a stream. ----- >>> scanMaybe f = Stream.catMaybes . Stream.postscan f+-- >>> postscanlMaybe f = Stream.catMaybes . Stream.postscanl f --+{-# INLINE postscanlMaybe #-}+postscanlMaybe :: Monad m => Scanl m a (Maybe b) -> Stream m a -> Stream m b+postscanlMaybe f = catMaybes . postscanl f++{-# DEPRECATED scanMaybe "Use postscanlMaybe instead" #-} {-# INLINE scanMaybe #-} scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b scanMaybe f = catMaybes . postscan f@@ -1890,56 +2117,173 @@ -- Splitting ------------------------------------------------------------------------------ +-- Design note: If we use splitSepBy_ on an empty stream what should be the+-- result? Let's try the splitOn function in the "split" package:+--+-- > splitOn "a" ""+-- [""]+--+-- Round tripping the result through intercalate gives identity:+--+-- > intercalate "a" [""]+-- ""+--+-- Now let's try intercalate on empty list:+--+-- > intercalate "a" []+-- ""+--+-- Round tripping it with splitOn is not identity:+--+-- > splitOn "a" ""+-- [""]+--+-- Because intercalate flattens the two layers, both [] and [""] produce the+-- same result after intercalate. Therefore, inverse of intercalate is not+-- possible. We have to choose one of the two options for splitting an empty+-- stream.+--+-- Choosing empty stream as the result of splitting empty stream makes better+-- sense. This is different from the split package's choice. Splitting an empty+-- stream resulting into a non-empty stream seems a bit odd. Also, splitting+-- empty stream to empty stream is consistent with splitEndBy operation as+-- well.++{-# ANN type SplitSepBy Fuse #-}+data SplitSepBy s fs b a+    = SplitSepByInit s+    | SplitSepByInitFold0 s+    | SplitSepByInitFold1 s fs+    | SplitSepByCheck s a fs+    | SplitSepByNext s fs+    | SplitSepByYield b (SplitSepBy s fs b a)+    | SplitSepByDone+ -- | 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"+-- Definition:+--+--+-- Usage:+--+-- >>> splitOn p xs = Stream.fold Fold.toList $ Stream.splitSepBy_ p Fold.toList (Stream.fromList xs)+-- >>> splitOn (== '.') "a.b" -- ["a","b"] ----- An empty stream is folded to the default value of the fold:+-- Splitting an empty stream results in an empty stream i.e. zero splits: ----- >>> splitOn' (== '.') ""--- [""]+-- >>> splitOn (== '.') ""+-- [] --+-- If the stream does not contain the separator then it results in a single+-- split:+--+-- >>> splitOn (== '.') "abc"+-- ["abc"]+-- -- 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 (== '.') "." -- ["",""] ----- >>> splitOn' (== '.') ".a"+-- >>> splitOn (== '.') ".a" -- ["","a"] ----- >>> splitOn' (== '.') "a."+-- >>> splitOn (== '.') "a." -- ["a",""] ----- >>> splitOn' (== '.') "a..b"+-- >>> splitOn (== '.') "a..b" -- ["a","","b"] ----- splitOn is an inverse of intercalating single element:+-- 'splitSepBy_' is an inverse of 'unfoldEachSepBy': ----- > Stream.intercalate (Stream.fromPure '.') Unfold.fromList . Stream.splitOn (== '.') Fold.toList === id+-- > Stream.unfoldEachSepBy '.' Unfold.fromList . Stream.splitSepBy_ (== '.') Fold.toList === id -- -- Assuming the input stream does not contain the separator: ----- > Stream.splitOn (== '.') Fold.toList . Stream.intercalate (Stream.fromPure '.') Unfold.fromList === id+-- > Stream.splitSepBy_ (== '.') Fold.toList . Stream.unfoldEachSepBy '.' Unfold.fromList === id --+{-# INLINE splitSepBy_ #-}+splitSepBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+-- 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.+--+splitSepBy_ predicate (Fold fstep initial _ final) (Stream step1 state1) =+    Stream step (SplitSepByInit state1)++    where++    -- Note: there is a question of whether we should initialize the fold+    -- before we run the stream or only after the stream yields an element. If+    -- we initialize it before then we may have to discard an effect if the+    -- stream does not yield anything. If we initialize it after then we may+    -- have to discard the stream element if the fold terminates without+    -- consuming anything. Though the state machine is simpler if we initialize+    -- the fold first. Also, in most common cases the fold is not effectful.+    -- On the other hand, in most cases the fold will not terminate without+    -- consuming anything. So both ways are similar.+    {-# INLINE_LATE step #-}+    step _ (SplitSepByInit st) = do+        fres <- initial+        return+            $ Skip+            $ case fres of+                  FL.Done b -> SplitSepByYield b (SplitSepByInit st)+                  FL.Partial fs -> SplitSepByInitFold1 st fs++    step _ (SplitSepByInitFold0 st) = do+        fres <- initial+        return+            $ Skip+            $ case fres of+                  FL.Done b -> SplitSepByYield b (SplitSepByInitFold0 st)+                  FL.Partial fs -> SplitSepByNext st fs++    step gst (SplitSepByInitFold1 st fs) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield x s -> return $ Skip $ SplitSepByCheck s x fs+            Skip s -> return $ Skip (SplitSepByInitFold1 s fs)+            Stop -> final fs >> return Stop++    step _ (SplitSepByCheck st x fs) = do+        if predicate x+        then do+            b <- final fs+            return $ Skip $ SplitSepByYield b (SplitSepByInitFold0 st)+        else do+            fres <- fstep fs x+            return+                $ Skip+                $ case fres of+                      FL.Done b -> SplitSepByYield b (SplitSepByInitFold0 st)+                      FL.Partial fs1 -> SplitSepByNext st fs1++    step gst (SplitSepByNext st fs) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield x s -> return $ Skip $ SplitSepByCheck s x fs+            Skip s -> return $ Skip (SplitSepByNext s fs)+            Stop -> do+                b <- final fs+                return $ Skip $ SplitSepByYield b SplitSepByDone++    step _ (SplitSepByYield b next) = return $ Yield b next+    step _ SplitSepByDone = return Stop++{-# DEPRECATED splitOn "Please use splitSepBy_ instead. Note the difference in behavior on splitting empty stream." #-} {-# 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
@@ -11,13 +11,18 @@  module Streamly.Internal.Data.Stream.Transformer     (+    -- * Fold to Transformer Monad       foldlT     , foldrT -    -- * Transform Inner Monad+    -- * Inner Monad Operations     , liftInner+     , runReaderT     , usingReaderT+    , withReaderT+    , localReaderT+     , evalStateT     , runStateT     , usingStateT@@ -129,6 +134,28 @@     -> Stream m a usingReaderT r f xs = runReaderT r $ f $ liftInner xs +-- | Modify the environment of the underlying ReaderT monad.+{-# INLINABLE withReaderT #-}+withReaderT :: Monad m =>+    (r2 -> r1) -> Stream (ReaderT r1 m) a -> Stream (ReaderT r2 m) a+withReaderT f (Stream step state) = Stream step1 state++    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- Reader.withReaderT f (step (adaptState gst) st)+        return $ case r of+            Yield x s -> Yield x s+            Skip  s   -> Skip s+            Stop      -> Stop++-- | Modify the environment of the underlying ReaderT monad.+{-# INLINABLE localReaderT #-}+localReaderT :: Monad m =>+    (r -> r) -> Stream (ReaderT r m) a -> Stream (ReaderT r m) a+localReaderT = withReaderT+ ------------------------------------------------------------------------------ -- Sharing read write state in a stream ------------------------------------------------------------------------------@@ -176,7 +203,7 @@ usingStateT     :: Monad m     => m s-    -> (Stream (StateT s m) a -> Stream (StateT s m) a)-    -> Stream m a+    -> (Stream (StateT s m) a -> Stream (StateT s m) b)     -> Stream m a+    -> Stream m b usingStateT s f = evalStateT s . f . liftInner
src/Streamly/Internal/Data/Stream/Type.hs view
@@ -1,5 +1,11 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ViewPatterns #-}  -- | -- Module      : Streamly.Internal.Data.Stream.Type@@ -16,18 +22,16 @@  module Streamly.Internal.Data.Stream.Type     (-    -- * The stream type+    -- * 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+    -- * Nested+    , Nested(..) -    -- * Conversion to StreamK+    -- * To StreamK     , fromStreamK     , toStreamK @@ -70,6 +74,8 @@      -- ** Specific Folds     , drain+    , head+    , headElse     , Streamly.Internal.Data.Stream.Type.toList      -- * Mapping@@ -80,11 +86,21 @@     , take     , takeWhile     , takeWhileM+    , takeEndBy_     , takeEndBy     , takeEndByM      -- * Combining Two Streams+    -- ** Appending+    -- | Append a stream after another. A special case of concatMap or+    -- unfoldEach Note, appending more than two streams is called @concat@+    -- which could be called appendMany or appendAll in append terminology and+    -- is equivalent to @concatMap id@. Append is equivalent to @mergeBy fst@.+    , AppendState(..)+    , append+     -- ** Zipping+    -- | Zip corresponding elements of two streams.     , zipWithM     , zipWith @@ -94,53 +110,87 @@     , crossApplySnd     , crossWith     , cross+    , FairUnfoldState (..)+    , fairCrossWithM+    , fairCrossWith+    , fairCross+    , loop -- forEach+    , loopBy      -- * Unfold Many     , ConcatMapUState (..)-    , unfoldMany+    , unfoldEach -    -- * Concat+    -- * UnfoldCross+    , unfoldCross++    -- * ConcatMap+    -- | Generate streams by mapping a stream generator on each element of an+    -- input stream, append the resulting streams and flatten.     , concatEffect     , concatMap     , concatMapM     , concat +    -- * ConcatFor+    , concatFor+    , concatForM+     -- * Unfold Iterate-    , unfoldIterateDfs-    , unfoldIterateBfs-    , unfoldIterateBfsRev+    , unfoldIterate+    , bfsUnfoldIterate+    , altBfsUnfoldIterate      -- * Concat Iterate     , concatIterateScan-    , concatIterateDfs-    , concatIterateBfs-    , concatIterateBfsRev+    , concatIterate+    , bfsConcatIterate+    , altBfsConcatIterate      -- * Fold Many     , FoldMany (..) -- for inspection testing     , FoldManyPost (..)     , foldMany     , foldManyPost+    , foldManySepBy     , groupsOf     , refoldMany     , refoldIterateM      -- * Fold Iterate-    , reduceIterateBfs-    , foldIterateBfs+    , bfsReduceIterate+    , bfsFoldIterate      -- * Splitting-    , indexOnSuffix+    , indexEndBy+    , indexEndBy_      -- * Multi-stream folds+    -- | These should probably be expressed using zipping operations.     , eqBy     , cmpBy +    -- * Utilities+    , splitAt+     -- * Deprecated     , sliceOnSuffix+    , unfoldMany+    , indexOnSuffix+    , CrossStream+    , mkCross+    , unCross+    , reduceIterateBfs+    , unfoldIterateDfs+    , unfoldIterateBfs+    , unfoldIterateBfsRev+    , concatIterateDfs+    , concatIterateBfs+    , concatIterateBfsRev     ) where +#include "deprecation.h" #include "inline.hs"  #if !MIN_VERSION_base(4,18,0)@@ -149,16 +199,21 @@ import Control.Monad.Catch (MonadThrow, throwM) import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.IO.Class (MonadIO(..))+import Data.Bifunctor (first) import Data.Foldable (Foldable(foldl'), fold, foldr) import Data.Functor (($>)) import Data.Functor.Identity (Identity(..))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif 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 Prelude hiding+    (head, map, mapM, take, concatMap, takeWhile, zipWith, concat, splitAt) import Text.Read        ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec        , readListPrecDefault)@@ -174,9 +229,7 @@  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" @@ -211,6 +264,7 @@ -- | A stream that terminates without producing any output, but produces a side -- effect. --+-- >>> nilM action = Stream.before action Stream.nil -- >>> Stream.fold Fold.toList (Stream.nilM (print "nil")) -- "nil" -- []@@ -220,9 +274,12 @@ nilM :: Applicative m => m b -> Stream m a nilM m = Stream (\_ _ -> m $> Stop) () - infixr 5 `consM` +-- XXX see https://github.com/composewell/streamly/issues/3126 - for using a+-- list or maybe an effect "m (Stream m a)" along with "step" in the stream+-- structure for better cons and append performance.+ -- | 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@@ -453,7 +510,7 @@     nil = Stream (\_ _ -> return Stop) ()  -- >>> fold f = Fold.extractM . Stream.foldAddLazy f--- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f+-- >>> fold f = Stream.fold Fold.one . Stream.foldMany0 f -- >>> fold f = Fold.extractM <=< Stream.foldAdd f  -- | Fold a stream using the supplied left 'Fold' and reducing the resulting@@ -562,8 +619,12 @@ -- >>> Stream.foldrM step (return False) s -- True --+-- >>> import Control.Monad (join)+-- >>> foldrM f z = join . Stream.foldr f z+-- {-# INLINE_NORMAL foldrM #-} foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+-- foldrM f z = join . Streamly.Internal.Data.Stream.StreamD.Type.foldr f z foldrM f z (Stream step state) = go SPEC state   where     {-# INLINE_LATE go #-}@@ -708,6 +769,18 @@             Skip s    -> go SPEC s             Stop      -> return () +{-# 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)+ ------------------------------------------------------------------------------ -- To Containers ------------------------------------------------------------------------------@@ -853,6 +926,8 @@ -- >>> Stream.fold Fold.drain $ Stream.mapM putStr s -- abc --+-- This is functional equivalent of an imperative loop.+-- {-# INLINE_NORMAL mapM #-} mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b mapM f (Stream step state) = Stream step' state@@ -1086,7 +1161,63 @@ takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a takeEndBy f = takeEndByM (return . f) +-- |+-- >>> takeEndBy_ f = Stream.takeWhile (not . f)+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeEndBy_ f = takeWhile (not . f)+ ------------------------------------------------------------------------------+-- Appending+------------------------------------------------------------------------------++data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2++-- Performance Note: 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++------------------------------------------------------------------------------ -- Zipping ------------------------------------------------------------------------------ @@ -1142,6 +1273,8 @@ -- Combine N Streams - concatAp ------------------------------------------------------------------------------ +-- XXX unfoldApplyEach+ -- | Apply a stream of functions to a stream of values and flatten the results. -- -- Note that the second stream is evaluated multiple times.@@ -1169,6 +1302,59 @@             Stop      -> Skip (Left os))         (stepb (adaptState gst) st) +-- This is shared by all fairUnfold, fairConcat combinators.+data FairUnfoldState o i =+      FairUnfoldInit o ([i] -> [i])+    | FairUnfoldNext o ([i] -> [i]) [i]+    | FairUnfoldDrain ([i] -> [i]) [i]++-- XXX will it perform better if we write it in the same way as crossApply?+-- crossApply is faster than unfoldCross in equation solving benchmarks.++-- | Like 'fairCrossWith' but with monadic function argument.+--+{-# INLINE_NORMAL fairCrossWithM #-}+fairCrossWithM :: Monad m =>+    (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+fairCrossWithM f (Stream step1 state1) (Stream step2 state2) =+    Stream step (FairUnfoldInit state1 id)++    where++    {-# INLINE_LATE step #-}+    step gst (FairUnfoldInit o ls) = do+        r <- step1 (adaptState gst) o+        return $ case r of+            Yield b o' -> Skip (FairUnfoldNext o' id (ls [(b,state2)]))+            Skip o' -> Skip (FairUnfoldInit o' ls)+            Stop -> Skip (FairUnfoldDrain id (ls []))++    step _ (FairUnfoldNext o ys []) =+            return $ Skip (FairUnfoldInit o ys)++    step gst (FairUnfoldNext o ys ((b,st):ls)) = do+        r <- step2 (adaptState gst) st+        case r of+            Yield c s ->+                f b c >>= \x ->+                    return $ Yield x (FairUnfoldNext o (ys . ((b, s) :)) ls)+            Skip s    -> return $ Skip (FairUnfoldNext o ys ((b,s) : ls))+            Stop      -> return $ Skip (FairUnfoldNext o ys ls)++    step _ (FairUnfoldDrain ys []) =+        case ys [] of+            [] -> return Stop+            xs -> return $ Skip (FairUnfoldDrain id xs)++    step gst (FairUnfoldDrain ys ((b,st):ls)) = do+        r <- step2 (adaptState gst) st+        case r of+            Yield c s ->+                f b c >>= \x ->+                    return $ Yield x (FairUnfoldDrain (ys . ((b,s) :)) ls)+            Skip s    -> return $ Skip (FairUnfoldDrain ys ((b,s) : ls))+            Stop      -> return $ Skip (FairUnfoldDrain ys ls)+ {-# INLINE_NORMAL crossApplySnd #-} crossApplySnd :: Functor f => Stream f a -> Stream f b -> Stream f b crossApplySnd (Stream stepa statea) (Stream stepb stateb) =@@ -1233,6 +1419,10 @@     (<*) = crossApplyFst -} +-- XXX We can use @Stream Identity b@ as the second stream to avoid running+-- effects multiple times. Or it could be an array or an unfold i.e.+-- unfoldCross.+ -- | -- Definition: --@@ -1240,10 +1430,21 @@ -- -- Note that the second stream is evaluated multiple times. --+-- Also see "Streamly.Data.Unfold.crossWith" for fast fusible static cross+-- product option.+-- {-# 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 +-- | Like 'crossWith' but interleaves the outer and inner loops fairly. See+-- 'fairConcatFor' for more details.+--+{-# INLINE fairCrossWith #-}+fairCrossWith :: Monad m =>+    (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+fairCrossWith f = fairCrossWithM (\a b -> return $ f a b)+ -- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible -- combinations of the tuple @(a, b)@. --@@ -1256,9 +1457,6 @@ -- 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/@@ -1266,8 +1464,36 @@ cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b) cross = crossWith (,) +-- | Like 'cross' but interleaves the outer and inner loops fairly. See+-- 'fairConcatFor' for more details.+{-# INLINE fairCross #-}+fairCross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+fairCross = fairCrossWith (,)++-- crossWith/cross should ideally use Stream m b as the first stream, because+-- we are transforming Stream m a using that. We provide loop with arguments+-- flipped.++-- crossMap or crossInner?++-- | Loop the supplied stream (first argument) around each element of the input+-- stream (second argument) generating tuples.  This is an argument flipped+-- version of 'cross'.+{-# INLINE loop #-}+loop :: Monad m => Stream m b -> Stream m a -> Stream m (a, b)+loop = crossWith (\b a -> (a,b))++-- | Loop by unfold. Unfold a value into a stream and nest it with the input+-- stream. This is much faster than 'loop' due to stream fusion.+{-# INLINE loopBy #-}+loopBy :: Monad m => Unfold m x b -> x -> Stream m a -> Stream m (a, b)+loopBy u x s =+    let u1 = Unfold.lmap snd u+        u2 = Unfold.map (first fst) (Unfold.carry u1)+     in unfoldEach u2 $ fmap (, x) s+ --------------------------------------------------------------------------------- Combine N Streams - unfoldMany+-- Combine N Streams - unfoldEach ------------------------------------------------------------------------------  {-# ANN type ConcatMapUState Fuse #-}@@ -1275,7 +1501,7 @@       ConcatMapUOuter o     | ConcatMapUInner o i --- | @unfoldMany unfold stream@ uses @unfold@ to map the input stream elements+-- | @unfoldEach unfold stream@ uses @unfold@ to map the input stream elements -- to streams and then flattens the generated streams into a single output -- stream. @@ -1283,14 +1509,44 @@ -- generate the stream instead of a 'Stream' type generator. This allows better -- optimization via fusion.  This can be many times more efficient than -- 'concatMap'.+--+-- 'unfoldEach' is equivalent in expressive power to 'concatMap'. However,+-- using it as concatMap — by lifting a function 'f :: a -> Stream m b' into+-- an 'Unfold' — results in the same degraded performance as '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) =+-- >>> concatMap f = Stream.unfoldEach (Unfold.lmap f Unfold.fromStream)+--+-- Here is an example of a two level nested loop much faster than+-- 'concatMap' based nesting.+--+-- >>> :{+-- outerLoop =+--   flip Stream.mapM (Stream.fromList [1,2,3]) $ \x -> do+--       liftIO $ putStrLn (show x)+--       return x+-- innerUnfold = Unfold.carry $ Unfold.lmap (const [4,5,6]) Unfold.fromList+-- innerLoop =+--      flip Unfold.mapM innerUnfold $ \(x, y) -> do+--          when (x == 1) $ liftIO $ putStrLn (show y)+--          pure $ (x, y)+-- :}+--+-- >>> Stream.toList $ Stream.unfoldEach innerLoop outerLoop+-- 1+-- 4+-- 5+-- 6+-- 2+-- 3+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+{-# INLINE_NORMAL unfoldEach #-}+unfoldEach, unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b+unfoldEach (Unfold istep inject) (Stream ostep ost) =     Stream step (ConcatMapUOuter ost)   where     {-# INLINE_LATE step #-}@@ -1310,18 +1566,68 @@             Skip i'    -> Skip (ConcatMapUInner o i')             Stop       -> Skip (ConcatMapUOuter o) +RENAME(unfoldMany,unfoldEach)++-- XXX unfoldEach generates faster code than unfoldCross with+-- everything unboxed i.e. 0 allocations.++-- | Generates a cross product of two streams and then unfolds each tuple.+--+-- A two level nested loop much faster than 'concatMap' based nesting.+--+-- >>> :{+-- outerLoop =+--   flip Stream.mapM (Stream.fromList [1,2,3]) $ \x -> do+--       liftIO $ putStrLn (show x)+--       return x+-- innerLoop =+--   flip Stream.mapM (Stream.fromList [4,5,6]) $ \y -> do+--       -- liftIO $ putStrLn (show y)+--       return y+-- innerUnfold =+--   flip Unfold.mapM Unfold.identity $ \(x,y) -> do+--      when (x == 1) $ liftIO $ putStrLn (show y)+--      pure $ (x, y)+-- :}+--+-- >>> Stream.toList $ Stream.unfoldCross innerUnfold outerLoop innerLoop+-- 1+-- 4+-- 5+-- 6+-- 2+-- 3+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+-- Note: 'unfoldEach' may generate faster code, so use that when possible.+-- Also see "Streamly.Data.Unfold.cross" for fast fusible static cross product+-- option.+--+{-# INLINE unfoldCross #-}+unfoldCross :: Monad m =>+    Unfold m (a,b) c -> Stream m a -> Stream m b -> Stream m c+unfoldCross unf m1 m2 = unfoldEach unf $ crossWith (,) m1 m2+ ------------------------------------------------------------------------------ -- Combine N Streams - concatMap ------------------------------------------------------------------------------  -- Adapted from the vector package. +-- If we are iterating over n elements flat vs m nesting of n^{1/m} elements.+-- The total iterations in the nesting case will be+-- let x = n^{1/m} in {x + x^2 + x^3 + ... + x^m} = x * {(x^m - 1)/(x-1)}+-- i.e. (n-1)/(1-1/x) which is not very high. However, the decision tree in the+-- state of concatMap is traversed from root to leaf for each element, and the+-- state updates also updates the tree from leaf to root upon yielding an+-- element which makes the allocations as well as CPU performance quadratic.+ -- | 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.+-- See 'unfoldEach' for a faster alternative. -- {-# INLINE_NORMAL concatMapM #-} concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b@@ -1337,10 +1643,6 @@             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?@@ -1356,16 +1658,131 @@ -- | 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)+-- >>> concatMap f = Stream.concatMapM (return . f)+-- >>> concatMap f = Stream.unfoldEach (Unfold.lmap f Unfold.fromStream) ----- See 'unfoldMany' for a fusible alternative.+-- See argument flipped version 'concatFor' for more detailed documentation. --+-- NOTE: We recommend using 'unfoldEach' or 'unfoldCross' instead of+-- 'concatMap' especially in performance critical code. 'unfoldEach' is much+-- faster than 'concatMap' and matches its expressive power in terms of+-- generating dependent inner streams, there is one important distinction+-- though: the nesting structure when using 'unfoldEach' is fixed statically in+-- the code. In contrast, 'concatMap' allows dynamic and arbitrary nesting+-- through monadic composition. This means that deeply nested or+-- programmatically determined levels of nesting are easier to express and+-- compose with 'concatMap', though often at the cost of performance and+-- fusion.+-- {-# INLINE concatMap #-} concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b concatMap f = concatMapM (return . f) +-- XXX Add smap/sfor (mapAccum) as a more ergonomic substitute for scan, not+-- exposing the state in the output stream.+-- XXX add sconcatMap/sconcatFor as stateful alternatives.++-- | Map a stream generating function on each element of a stream and+-- concatenate the results. This is the same as the bind function of the monad+-- instance. It is just a flipped 'concatMap' but more convenient to use for+-- nested use case, feels like an imperative @for@ loop. It is in fact+-- equivalent to @concat . for@.+--+-- >>> concatFor = flip Stream.concatMap+--+-- A concatenating @for@ loop:+--+-- >>> :{+-- Stream.toList $+--     Stream.concatFor (Stream.fromList [1,2,3]) $ \x ->+--       Stream.fromPure x+-- :}+-- [1,2,3]+--+-- Use 'unfoldEach' instead of 'concatFor' where possible, unfoldEach is much+-- faster due to fusion.+--+-- Nested concatenating @for@ loops:+--+-- >>> :{+-- Stream.toList $+--     Stream.concatFor (Stream.fromList [1,2,3]) $ \x ->+--      Stream.concatFor (Stream.fromList [4,5,6]) $ \y ->+--       Stream.fromPure (x, y)+-- :}+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+-- If total iterations are kept the same, each increase in the nesting level+-- increases the cost by roughly 2 times.+--+-- For significantly faster multi-level nesting, prefer using the better+-- fusible, applicative-like 'crossWith' over 'concatFor' where possible.+--+-- 'concatFor' is monad-like: it allows expressing dependencies between the+-- outer and the inner loops of the nesting, it means that the stream generated+-- by the inner loop is dynamically governed by the outer loop. This expressive+-- power comes at a significant performance cost.+--+-- NOTE: We recommend using 'unfoldEach' or 'unfoldCross' instead of+-- 'concatFor' especially in performance critical code. 'unfoldEach' is much+-- faster than 'concatFor' and matches its expressive power in terms of+-- generating dependent inner streams, there is one important distinction+-- though: the nesting structure when using 'unfoldEach' is fixed statically in+-- the code. In contrast, 'concatFor' allows dynamic and arbitrary nesting+-- through monadic composition. This means that deeply nested or+-- programmatically determined levels of nesting are easier to express and+-- compose with 'concatFor', though often at the cost of performance and+-- fusion.+--+--+{-# INLINE concatFor #-}+concatFor :: Monad m => Stream m a -> (a -> Stream m b) -> Stream m b+concatFor = flip concatMap++-- NOTE: A monad instance can do with just concatMap because we lift an effect+-- explicitly using liftIO and then bind/applicative concats it. Not sure if it+-- gets fused and the overhead of additional concat removed. However, for+-- explicit use concatForM is more ergonomic as we do not need to lift and+-- concat, we can just use the do notation in the underlying monad..++-- | Like 'concatFor' but maps an effectful function. It allows conveniently+-- mixing monadic effects with streams.+--+-- >>> import Control.Monad.IO.Class (liftIO)+-- >>> :{+-- Stream.toList $+--     Stream.concatForM (Stream.fromList [1,2,3]) $ \x -> do+--       liftIO $ putStrLn (show x)+--       pure $ Stream.fromPure x+-- :}+-- 1+-- 2+-- 3+-- [1,2,3]+--+-- Nested concatentating @for@ loops:+--+-- >>> :{+-- Stream.toList $+--     Stream.concatForM (Stream.fromList [1,2,3]) $ \x -> do+--       liftIO $ putStrLn (show x)+--       pure $ Stream.concatForM (Stream.fromList [4,5,6]) $ \y -> do+--         when (x == 1) $ liftIO $ putStrLn (show y)+--         pure $ Stream.fromPure (x, y)+-- :}+-- 1+-- 4+-- 5+-- 6+-- 2+-- 3+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+{-# INLINE concatForM #-}+concatForM :: Monad m => Stream m a -> (a -> m (Stream m b)) -> Stream m b+concatForM = flip concatMapM+ -- | Flatten a stream of streams to a single stream. -- -- >>> concat = Stream.concatMap id@@ -1375,22 +1792,11 @@ 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.+-- | Flatten a stream generated by an effect i.e. concat the effect monad with+-- the stream monad. -- -- >>> concatEffect = Stream.concat . Stream.fromEffect -- >>> concatEffect eff = Stream.concatMapM (\() -> eff) (Stream.fromPure ())@@ -1466,12 +1872,12 @@ -- element (reversed ordering). This may be slightly faster than -- 'concatIterateBfs'. ---{-# INLINE_NORMAL concatIterateBfsRev #-}-concatIterateBfsRev :: Monad m =>+{-# INLINE_NORMAL altBfsConcatIterate #-}+altBfsConcatIterate, concatIterateBfsRev :: Monad m =>        (a -> Maybe (Stream m a))     -> Stream m a     -> Stream m a-concatIterateBfsRev f stream = Stream step (stream, [])+altBfsConcatIterate f stream = Stream step (stream, [])      where @@ -1491,23 +1897,25 @@                     (y:ys) -> return $ Skip (y, ys)                     [] -> return Stop --- | Similar to 'concatIterateDfs' except that it traverses the stream in+RENAME(concatIterateBfsRev,altBfsConcatIterate)++-- | Similar to 'concatIterate' 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+-- >>> f = either (Just . Dir.readEitherPaths id) (const Nothing)+-- >>> input = Stream.fromEffect (Left <$> Path.fromString ".")+-- >>> ls = Stream.bfsConcatIterate f input -- -- /Pre-release/-{-# INLINE_NORMAL concatIterateBfs #-}-concatIterateBfs :: Monad m =>+{-# INLINE_NORMAL bfsConcatIterate #-}+bfsConcatIterate, concatIterateBfs :: Monad m =>        (a -> Maybe (Stream m a))     -> Stream m a     -> Stream m a-concatIterateBfs f stream = Stream step (stream, [], [])+bfsConcatIterate f stream = Stream step (stream, [], [])      where @@ -1530,25 +1938,27 @@                             (x:xs1) -> return $ Skip (x, xs1, [])                             [] -> return Stop +RENAME(concatIterateBfs,bfsConcatIterate)+ -- | 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+-- >>> f = either (Just . Dir.readEitherPaths id) (const Nothing)+-- >>> input = Stream.fromEffect (Left <$> Path.fromString ".")+-- >>> ls = Stream.concatIterate f input -- -- This is equivalent to using @concatIterateWith StreamK.append@. -- -- /Pre-release/-{-# INLINE_NORMAL concatIterateDfs #-}-concatIterateDfs :: Monad m =>+{-# INLINE_NORMAL concatIterate #-}+concatIterate, concatIterateDfs :: Monad m =>        (a -> Maybe (Stream m a))     -> Stream m a     -> Stream m a-concatIterateDfs f stream = Stream step (stream, [])+concatIterate f stream = Stream step (stream, [])      where @@ -1568,26 +1978,28 @@                     (y:ys) -> return $ Skip (y, ys)                     [] -> return Stop +RENAME(concatIterateDfs,concatIterate)+ {-# ANN type IterateUnfoldState Fuse #-} data IterateUnfoldState o i =       IterateUnfoldOuter o     | IterateUnfoldInner o i [i] --- | Same as @concatIterateDfs@ but more efficient due to stream fusion.+-- | Same as 'concatIterate' 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+-- >>> f = Unfold.either (Dir.eitherReaderPaths id) Unfold.nil+-- >>> input = Stream.fromEffect (Left <$> Path.fromString ".")+-- >>> ls = Stream.unfoldIterate f input -- -- /Pre-release/-{-# INLINE_NORMAL unfoldIterateDfs #-}-unfoldIterateDfs :: Monad m =>+{-# INLINE_NORMAL unfoldIterate #-}+unfoldIterate, unfoldIterateDfs :: Monad m =>        Unfold m a a     -> Stream m a     -> Stream m a-unfoldIterateDfs (Unfold istep inject) (Stream ostep ost) =+unfoldIterate (Unfold istep inject) (Stream ostep ost) =     Stream step (IterateUnfoldOuter ost)      where@@ -1614,21 +2026,23 @@                     (y:ys) -> return $ Skip (IterateUnfoldInner o y ys)                     [] -> return $ Skip (IterateUnfoldOuter o) +RENAME(unfoldIterateDfs,unfoldIterate)+ {-# ANN type IterateUnfoldBFSRevState Fuse #-} data IterateUnfoldBFSRevState o i =       IterateUnfoldBFSRevOuter o [i]     | IterateUnfoldBFSRevInner i [i] --- | Like 'unfoldIterateBfs' but processes the children in reverse order,+-- | Like 'bfsUnfoldIterate' but processes the children in reverse order, -- therefore, may be slightly faster. -- -- /Pre-release/-{-# INLINE_NORMAL unfoldIterateBfsRev #-}-unfoldIterateBfsRev :: Monad m =>+{-# INLINE_NORMAL altBfsUnfoldIterate #-}+altBfsUnfoldIterate, unfoldIterateBfsRev :: Monad m =>        Unfold m a a     -> Stream m a     -> Stream m a-unfoldIterateBfsRev (Unfold istep inject) (Stream ostep ost) =+altBfsUnfoldIterate (Unfold istep inject) (Stream ostep ost) =     Stream step (IterateUnfoldBFSRevOuter ost [])      where@@ -1658,20 +2072,22 @@                     (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)                     [] -> return Stop +RENAME(unfoldIterateBfsRev,altBfsUnfoldIterate)+ {-# ANN type IterateUnfoldBFSState Fuse #-} data IterateUnfoldBFSState o i =       IterateUnfoldBFSOuter o [i]     | IterateUnfoldBFSInner i [i] [i] --- | Like 'unfoldIterateDfs' but uses breadth first style traversal.+-- | Like 'unfoldIterate' but uses breadth first style traversal. -- -- /Pre-release/-{-# INLINE_NORMAL unfoldIterateBfs #-}-unfoldIterateBfs :: Monad m =>+{-# INLINE_NORMAL bfsUnfoldIterate #-}+bfsUnfoldIterate, unfoldIterateBfs :: Monad m =>        Unfold m a a     -> Stream m a     -> Stream m a-unfoldIterateBfs (Unfold istep inject) (Stream ostep ost) =+bfsUnfoldIterate (Unfold istep inject) (Stream ostep ost) =     Stream step (IterateUnfoldBFSOuter ost [])      where@@ -1704,6 +2120,8 @@                             (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])                             [] -> return Stop +RENAME(unfoldIterateBfs,bfsUnfoldIterate)+ ------------------------------------------------------------------------------ -- Folding a tree bottom up ------------------------------------------------------------------------------@@ -1712,10 +2130,10 @@ -- 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 =>+{-# INLINE_NORMAL bfsReduceIterate #-}+bfsReduceIterate, reduceIterateBfs :: Monad m =>     (a -> a -> m a) -> Stream m a -> m (Maybe a)-reduceIterateBfs f (Stream step state) = go SPEC state [] Nothing+bfsReduceIterate f (Stream step state) = go SPEC state [] Nothing      where @@ -1751,14 +2169,16 @@         y <- f x1 x2         goBuf SPEC xs (y:ys) +RENAME(reduceIterateBfs,bfsReduceIterate)+ -- | 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 ::+bfsFoldIterate ::     Fold m a (Either a a) -> Stream m a -> m (Maybe a)-foldIterateBfs = undefined+bfsFoldIterate = undefined  ------------------------------------------------------------------------------ -- Grouping/Splitting@@ -1766,44 +2186,43 @@  -- s = stream state, fs = fold state {-# ANN type FoldManyPost Fuse #-}+#if __GLASGOW_HASKELL__ >= 810+type FoldManyPost :: Type -> Type -> Type -> Type -> Type+#endif 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.+-- Note that using a closed fold e.g. @Fold.take 0@, would result in an+-- infinite stream without consuming the input.+--+-- We can call foldManyPost as foldMany0, but we should probably remove it.+-- Like foldMany0, "scan" should ideally be "scan0" always resulting in a+-- non-empty stream, and "postscan" should be called just "scan" because it is+-- much more common. But those names cannot be changed now.  -- | 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:+-- Example, empty stream, compare with 'foldMany': ----- >>> f = Fold.take 2 Fold.sum+-- >>> f = Fold.take 2 Fold.toList -- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f -- >>> fmany $ Stream.fromList []--- [0]+-- [[]] ----- Example, last fold empty:+-- Example, last empty fold is included, compare with 'foldMany': -- -- >>> fmany $ Stream.fromList [1..4]--- [3,7,0]+-- [[1,2],[3,4],[]] ----- Example, last fold non-empty:+-- Example, last fold non-empty, same as 'foldMany': -- -- >>> 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.+-- [[1,2],[3,4],[5]] -- -- /Pre-release/ --@@ -1842,7 +2261,18 @@     step' _ (FoldManyPostYield b next) = return $ Yield b next     step' _ FoldManyPostDone = return Stop +-- | Apply fold f1 infix separated by fold f2.+--+-- /Unimplemented/+{-# INLINE_NORMAL foldManySepBy #-}+foldManySepBy :: -- Monad m =>+    Fold m a b -> Fold m a b -> Stream m a -> Stream m b+foldManySepBy _f1 _f2 = undefined+ {-# ANN type FoldMany Fuse #-}+#if __GLASGOW_HASKELL__ >= 810+type FoldMany :: Type -> Type -> Type -> Type -> Type+#endif data FoldMany s fs b a     = FoldManyStart s     | FoldManyFirst fs s@@ -1852,29 +2282,32 @@  -- XXX Nested foldMany does not fuse. --- | Apply a 'Fold' repeatedly on a stream and emit the results in the output--- stream.+-- | Apply a terminating 'Fold' repeatedly on a stream and emit the results in+-- the output stream. If the last fold is empty, it's result is not emitted.+-- This means if the input stream is empty the result is also an empty stream.+-- See 'foldManyPost' for an alternate behavior which always results in a+-- non-empty stream even if the input stream is empty. -- -- Definition: -- -- >>> foldMany f = Stream.parseMany (Parser.fromFold f) ----- Example, empty stream:+-- Example, empty stream, omits the empty fold value: ----- >>> f = Fold.take 2 Fold.sum+-- >>> f = Fold.take 2 Fold.toList -- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f -- >>> fmany $ Stream.fromList [] -- [] ----- Example, last fold empty:+-- Example, omits the last empty fold value: -- -- >>> fmany $ Stream.fromList [1..4]--- [3,7]+-- [[1,2],[3,4]] -- -- Example, last fold non-empty: -- -- >>> fmany $ Stream.fromList [1..5]--- [3,7,5]+-- [[1,2],[3,4],[5]] -- -- Note that using a closed fold e.g. @Fold.take 0@, would result in an -- infinite stream on a non-empty input stream.@@ -1923,11 +2356,15 @@ -- | 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)@+-- Definition: ----- >>> Stream.toList $ Stream.groupsOf 2 Fold.sum (Stream.enumerateFromTo 1 10)--- [3,7,11,15,19]+-- >>> groupsOf n f = Stream.foldMany (Fold.take n f) --+-- Usage:+--+-- >>> Stream.toList $ Stream.groupsOf 2 Fold.toList (Stream.enumerateFromTo 1 10)+-- [[1,2],[3,4],[5,6],[7,8],[9,10]]+-- -- This can be considered as an n-fold version of 'take' where we apply -- 'take' repeatedly on the leftover stream until the stream exhausts. --@@ -2049,29 +2486,68 @@      extract (Tuple' i s) = (i,) <$> extract1 s --- | Like 'splitOnSuffix' but generates a stream of (index, len) tuples marking+-- | Like 'splitEndBy_' but generates a stream of (index, len) tuples marking -- the places where the predicate matches in the stream. --+-- >>> Stream.toList $ Stream.indexEndBy_ (== '/') $ Stream.fromList "/home/harendra"+-- [(0,0),(1,4),(6,8)]+-- -- /Pre-release/-{-# INLINE indexOnSuffix #-}-indexOnSuffix :: Monad m =>+{-# INLINE indexEndBy_ #-}+indexEndBy_, indexOnSuffix :: Monad m =>     (a -> Bool) -> Stream m a -> Stream m (Int, Int)-indexOnSuffix predicate =-    -- Scan the stream with the given refold+indexEndBy_ predicate =     refoldIterateM         (indexerBy (FL.takeEndBy_ predicate FL.length) 1)         (return (-1, 0)) -{-# DEPRECATED sliceOnSuffix "Please use indexOnSuffix instead." #-}+RENAME(indexOnSuffix,indexEndBy_)++-- Alternate implementation+{-# INLINE_NORMAL _indexEndBy_ #-}+_indexEndBy_ :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+_indexEndBy_ 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++{-# DEPRECATED sliceOnSuffix "Please use indexEndBy_ instead." #-} sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)-sliceOnSuffix = indexOnSuffix+sliceOnSuffix = indexEndBy_ +-- | Like 'splitEndBy' but generates a stream of (index, len) tuples marking+-- the places where the predicate matches in the stream.+--+-- >>> Stream.toList $ Stream.indexEndBy (== '/') $ Stream.fromList "/home/harendra"+-- [(0,1),(1,5),(6,8)]+--+-- /Pre-release/+{-# INLINE indexEndBy #-}+indexEndBy :: Monad m =>+    (a -> Bool) -> Stream m a -> Stream m (Int, Int)+indexEndBy predicate =+    refoldIterateM+        (indexerBy (FL.takeEndBy predicate FL.length) 0)+        (return (0, 0))+ ------------------------------------------------------------------------------ -- 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,+-- XXX Nested performs better than the StreamK.Nested when nesting two+-- loops, however, StreamK.Nested 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@@ -2080,8 +2556,8 @@ -- A 'Monad' bind behaves like a @for@ loop: -- -- >>> :{--- Stream.fold Fold.toList $ Stream.unCross $ do---     x <- Stream.mkCross $ Stream.fromList [1,2]+-- Stream.fold Fold.toList $ Stream.unNested $ do+--     x <- Stream.Nested $ Stream.fromList [1,2] --     -- Perform the following actions for each x in the stream --     return x -- :}@@ -2090,40 +2566,44 @@ -- 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]+-- Stream.fold Fold.toList $ Stream.unNested $ do+--     x <- Stream.Nested $ Stream.fromList [1,2]+--     y <- Stream.Nested $ 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}+newtype Nested m a = Nested {unNested :: Stream m a}         deriving (Functor, Foldable) +{-# DEPRECATED CrossStream "Use Nested instead." #-}+type CrossStream = Nested++{-# DEPRECATED mkCross "Use Nested instead." #-} {-# INLINE mkCross #-}-mkCross :: Stream m a -> CrossStream m a-mkCross = CrossStream+mkCross :: Stream m a -> Nested m a+mkCross = Nested  {-# INLINE unCross #-}-unCross :: CrossStream m a -> Stream m a-unCross = unCrossStream+unCross :: Nested m a -> Stream m a+unCross = unNested  -- 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)+deriving instance IsList (Nested Identity a)+deriving instance (a ~ Char) => IsString (Nested Identity a)+deriving instance Eq a => Eq (Nested Identity a)+deriving instance Ord a => Ord (Nested 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+instance Show a => Show (Nested Identity a) where     {-# INLINE show #-}-    show (CrossStream xs) = show xs+    show (Nested xs) = show xs -instance Read a => Read (CrossStream Identity a) where+instance Read a => Read (Nested Identity a) where     {-# INLINE readPrec #-}-    readPrec = fmap CrossStream readPrec+    readPrec = fmap Nested readPrec  ------------------------------------------------------------------------------ -- Applicative@@ -2131,30 +2611,30 @@  -- Note: we need to define all the typeclass operations because we want to -- INLINE them.-instance Monad m => Applicative (CrossStream m) where+instance Monad m => Applicative (Nested m) where     {-# INLINE pure #-}-    pure x = CrossStream (fromPure x)+    pure x = Nested (fromPure x)      {-# INLINE (<*>) #-}-    (CrossStream s1) <*> (CrossStream s2) =-        CrossStream (crossApply s1 s2)+    (Nested s1) <*> (Nested s2) =+        Nested (crossApply s1 s2)      {-# INLINE liftA2 #-}     liftA2 f x = (<*>) (fmap f x)      {-# INLINE (*>) #-}-    (CrossStream s1) *> (CrossStream s2) =-        CrossStream (crossApplySnd s1 s2)+    (Nested s1) *> (Nested s2) =+        Nested (crossApplySnd s1 s2)      {-# INLINE (<*) #-}-    (CrossStream s1) <* (CrossStream s2) =-        CrossStream (crossApplyFst s1 s2)+    (Nested s1) <* (Nested s2) =+        Nested (crossApplyFst s1 s2)  ------------------------------------------------------------------------------ -- Monad ------------------------------------------------------------------------------ -instance Monad m => Monad (CrossStream m) where+instance Monad m => Monad (Nested m) where     return = pure      -- Benchmarks better with StreamD bind and pure:@@ -2166,7 +2646,7 @@     -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)     --     {-# INLINE (>>=) #-}-    (>>=) (CrossStream m) f = CrossStream (concatMap (unCrossStream . f) m)+    (>>=) (Nested m) f = Nested (concatMap (unNested . f) m)      {-# INLINE (>>) #-}     (>>) = (*>)@@ -2175,12 +2655,50 @@ -- Transformers ------------------------------------------------------------------------------ -instance (MonadIO m) => MonadIO (CrossStream m) where-    liftIO x = CrossStream (fromEffect $ liftIO x)+instance (MonadIO m) => MonadIO (Nested m) where+    liftIO x = Nested (fromEffect $ liftIO x) -instance MonadTrans CrossStream where+instance MonadTrans Nested where     {-# INLINE lift #-}-    lift x = CrossStream (fromEffect x)+    lift x = Nested (fromEffect x) -instance (MonadThrow m) => MonadThrow (CrossStream m) where+instance (MonadThrow m) => MonadThrow (Nested m) where     throwM = lift . throwM++------------------------------------------------------------------------------+-- Utilities+------------------------------------------------------------------------------++-- | 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 :: String -> Int -> [a] -> ([a],[a])+splitAt desc n ls+  | n < 0 = seekOver n+  | n == 0 = ([], ls)+  | otherwise = splitAt' n ls++    where++    splitAt' :: Int -> [a] -> ([a], [a])+    splitAt' 0  []     = ([], [])+    splitAt' m  []     = seekUnder n m+    splitAt' 1  (x:xs) = ([x], xs)+    splitAt' m  (x:xs) = (x:xs', xs'')++        where++        (xs', xs'') = splitAt' (m - 1) xs++    seekOver x =+        error $ desc ++ ": bug in parser, seeking ["+            ++ show (negate x)+            ++ "] elements in future"++    seekUnder x y =+        error $ desc ++ ": bug in parser, backtracking ["+            ++ show x+            ++ "] elements. Goes ["+            ++ show y+            ++ "] elements beyond backtrack buffer"
src/Streamly/Internal/Data/StreamK.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{- HLINT ignore "Eta reduce" -} -- | -- Module      : Streamly.Internal.Data.StreamK -- Copyright   : (c) 2017 Composewell Technologies@@ -16,16 +17,14 @@     --     -- $setup -    -- * The stream type       module Streamly.Internal.Data.StreamK.Type+    -- * Transformer     , module Streamly.Internal.Data.StreamK.Transformer -    , StreamK(..)-    , fromList+    -- * From containers     , fromStream-    , toStream -    -- ** Specialized Generation+    -- * Specialized Generation     , repeatM     , replicate     , replicateM@@ -41,14 +40,13 @@     , foldBreak     , foldEither     , foldConcat+    , ParserK.toParserK -- XXX move the code to this module     , parseDBreak     , parseD-    , parseBreakChunks-    , parseChunks     , parseBreak+    , parseBreakPos     , parse-    , parseBreakChunksGeneric-    , parseChunksGeneric+    , parsePos      -- ** Specialized Folds     , head@@ -67,13 +65,13 @@     , find     , (!!) +    -- ** To Containers+    , toList+    , toStream+     -- ** Map and Fold     , mapM_ -    -- ** Conversions-    , toList-    , hoist-     -- * Transformation     -- ** By folding (scans)     , scanl'@@ -100,6 +98,7 @@      -- ** Reordering     , sortBy+    , sortOn      -- ** Map and Filter     , mapMaybe@@ -115,23 +114,34 @@     -- ** Transformation comprehensions     , the +    -- ** Transforming Inner Monad+    , morphInner+     -- * Exceptions     , handle      -- * Resource Management     , bracketIO++    -- * Deprecated+    , hoist+    , parseBreakChunks+    , parseChunks+    , parseBreakChunksGeneric+    , parseChunksGeneric     ) where  #include "ArrayMacros.h" #include "inline.hs" #include "assert.hs"+#include "deprecation.h"  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 Data.Ord (comparing) import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Fold.Type (Fold(..))@@ -139,13 +149,14 @@ 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 Streamly.Internal.Data.Unbox (Unbox)  import qualified Control.Monad.Catch as MC-import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Array 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.ParserDrivers as Drivers 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@@ -156,10 +167,10 @@                take, filter, all, any, takeWhile, drop, dropWhile,                notElem, head, tail, init, zipWith, lookup,                (!!), replicate, reverse, concatMap, iterate, splitAt)-import Data.Foldable (sum, length)+import Data.Foldable (length) import Streamly.Internal.Data.StreamK.Type import Streamly.Internal.Data.StreamK.Transformer-import Streamly.Internal.Data.Parser (ParseError(..))+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))  #include "DocTestDataStreamK.hs" @@ -279,14 +290,6 @@ iterateM = iterateMWith consM  ---------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------{-# INLINE fromList #-}-fromList :: [a] -> StreamK m a-fromList = fromFoldable--------------------------------------------------------------------------------- -- Elimination by Folding ------------------------------------------------------------------------------- @@ -682,16 +685,17 @@ toList = foldr (:) []  -- Based on suggestions by David Feuer and Pranay Sashank-{-# INLINE hoist #-}-hoist :: (Monad m, Monad n)+{-# INLINE morphInner #-}+morphInner, hoist :: (Monad m, Monad n)     => (forall x. m x -> n x) -> StreamK m a -> StreamK n a-hoist f str =+morphInner 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+RENAME(hoist,morphInner)  ------------------------------------------------------------------------------- -- Transformation by folding (Scans)@@ -1153,112 +1157,108 @@ -- 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)+    -> m (Either ParseErrorPos b, StreamK m a) parseDBreak (PR.Parser pstep initial extract) stream = do     res <- initial     case res of-        PR.IPartial s -> goStream stream [] s+        PR.IPartial s -> goStream stream [] s 0         PR.IDone b -> return (Right b, stream)-        PR.IError err -> return (Left (ParseError err), stream)+        PR.IError err -> return (Left (ParseErrorPos 0 err), stream)      where +    {-# INLINE splitAt #-}+    splitAt = Stream.splitAt "Data.StreamK.parseDBreak"+     -- "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 =+    goStream st buf !pst i =         let stop = do                 r <- extract pst                 case r of-                    PR.Error err -> do+                    PR.FError err -> do                         let src = Prelude.reverse buf-                        return (Left (ParseError err), fromList src)-                    PR.Done n b -> do+                        return (Left (ParseErrorPos i err), fromList src)+                    PR.FDone m b -> do+                        let n = (- m)                         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+                    PR.FContinue 0 s -> goStream nil buf s i+                    PR.FContinue m s -> do+                        let n = (- m)                         assertM(n <= length buf)                         let (src0, buf1) = splitAt n buf                             src = Prelude.reverse src0-                        goBuf nil buf1 src s+                        goBuf nil buf1 src s (i + m)             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+                    PR.SPartial 1 s -> goStream r [] s (i + 1)+                    PR.SPartial m s -> do+                        let n = 1 - m                         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+                        goBuf r [] src s (i + m)+                    PR.SContinue 1 s -> goStream r (x:buf) s (i + 1)+                    PR.SContinue m s -> do+                        let n = 1 - m                         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+                        goBuf r buf1 src s (i + m)+                    PR.SDone 1 b -> return (Right b, r)+                    PR.SDone m b -> do+                        let n = 1 - m                         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+                    PR.SError err -> do                         let src = Prelude.reverse (x:buf)-                        return (Left (ParseError err), append (fromList src) r)+                        return (Left (ParseErrorPos (i + 1) 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+    goBuf st buf [] !pst i = goStream st buf pst i+    goBuf st buf (x:xs) !pst i = do         pRes <- pstep pst x         case pRes of-            PR.Partial 0 s -> goBuf st [] xs s-            PR.Partial n s -> do+            PR.SPartial 1 s -> goBuf st [] xs s (i + 1)+            PR.SPartial m s -> do+                let n = 1 - m                 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+                goBuf st [] src s (i + m)+            PR.SContinue 1 s -> goBuf st (x:buf) xs s (i + 1)+            PR.SContinue m s -> do+                let n = 1 - m                 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+                goBuf st buf1 src s (i + m)+            PR.SDone m b -> do+                let n = 1 - m                 assert (n <= length (x:buf)) (return ())                 let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0+                    src  = Prelude.reverse src0 ++ xs                 return (Right b, append (fromList src) st)-            PR.Error err -> do+            PR.SError err -> do                 let src = Prelude.reverse buf ++ x:xs-                return (Left (ParseError err), append (fromList src) st)+                return (Left (ParseErrorPos (i + 1) 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@@ -1266,274 +1266,58 @@ -- 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)+    Parser.Parser a m b -> StreamK m a -> m (Either ParseErrorPos 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+-- XXX parseDBreakChunks may be faster than converting parserD to toParserK 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.+{-# DEPRECATED parseBreakChunks "Use Streamly.Data.Array.parseBreak instead" #-} {-# 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+parseBreakChunks = Array.parseBreak +{-# DEPRECATED parseChunks "Use Streamly.Data.Array.parse instead" #-} {-# 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+parseChunks = Array.parse  ------------------------------------------------------------------------------- -- 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 #-}+{-# INLINE 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)+parseBreak = Drivers.parseBreakStreamK -    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+-- | Like 'parseBreak' but includes stream position information in the error+-- messages.+--+{-# INLINE parseBreakPos #-}+parseBreakPos+    :: forall m a b. Monad m+    => ParserK.ParserK a m b+    -> StreamK m a+    -> m (Either ParseErrorPos b, StreamK m a)+parseBreakPos = Drivers.parseBreakStreamKPos  -- | Run a 'ParserK' over a 'StreamK'. Please use 'parseChunks' where possible, -- for better performance.@@ -1542,150 +1326,37 @@     ParserK.ParserK a m b -> StreamK m a -> m (Either ParseError b) parse f = fmap fst . parseBreak f +-- | Like 'parse' but includes stream position information in the error+-- messages.+--+{-# INLINE parsePos #-}+parsePos :: Monad m =>+    ParserK.ParserK a m b -> StreamK m a -> m (Either ParseErrorPos b)+parsePos f = fmap fst . parseBreakPos 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 --+{-# DEPRECATED parseBreakChunksGeneric "Use Streamly.Data.Array.Generic.parseBreak" #-} {-# 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+parseBreakChunksGeneric = GenArr.parseBreak +{-# DEPRECATED parseChunksGeneric "Use Streamly.Data.Array.Generic.parse" #-} {-# 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+parseChunksGeneric = GenArr.parse  ------------------------------------------------------------------------------- -- Sorting@@ -1717,3 +1388,10 @@         . Stream.catRights -- its a non-failing backtracking parser         . Stream.parseMany (fmap (either id id) p)         . Stream.fromStreamK++{-# INLINE sortOn #-}+sortOn :: (Monad m, Ord b) => (a -> b) -> StreamK m a -> StreamK m a+sortOn f =+      fmap snd+    . sortBy (comparing fst)+    . fmap (\x -> let y = f x in y `seq` (y, x))
src/Streamly/Internal/Data/StreamK/Transformer.hs view
@@ -13,13 +13,16 @@      , liftInner     , evalStateT++    , localReaderT     ) 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)+    (StreamK(..), nil, cons, uncons, concatEffect, foldStream, mkStream)+import Control.Monad.Trans.Reader (ReaderT, local)  import qualified Control.Monad.Trans.State.Strict as State @@ -77,3 +80,12 @@         case res of             Just (h, t) -> cons h (go t)             Nothing -> nil++-- | Modify the environment of the underlying ReaderT monad.+{-# INLINABLE localReaderT #-}+localReaderT :: (r -> r) -> StreamK (ReaderT r m) a -> StreamK (ReaderT r m) a+localReaderT f m =+    mkStream $ \st yld sng stp ->+        let single = local f . sng+            yieldk a r = local f $ yld a (localReaderT f r)+        in foldStream st yieldk single (local f stp) m
src/Streamly/Internal/Data/StreamK/Type.hs view
@@ -1,2104 +1,3126 @@ {-# 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'-    , foldlMx'-    , foldlM'--    -- ** 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---- 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---- | 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----------------------------------------------------------------------------------- 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+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-}+{-# 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 (..)++    -- * Nested type wrapper+    , Nested(..)+    , FairNested(..) -- experimental, do not release, associativity issues++    -- * 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+    , Streamly.Internal.Data.StreamK.Type.fromList++    -- ** Cyclic+    , mfix++    -- * Elimination+    -- ** Primitives+    , uncons++    -- ** Strict Left Folds+    , Streamly.Internal.Data.StreamK.Type.foldl'+    , foldlx'+    , foldlMx'+    , foldlM'++    -- ** Lazy Right Folds+    , Streamly.Internal.Data.StreamK.Type.foldr++    -- ** Specific Folds+    , drain+    , null+    , headNonEmpty+    , tail+    , tailNonEmpty+    , init+    , initNonEmpty++    -- * Mapping+    , map+    , mapMWith+    , mapMSerial+    , mapMAccum++    -- * Combining Two Streams+    -- ** Appending+    , conjoin+    , append++    -- ** Interleave+    , interleave+    , interleaveEndBy'+    , interleaveSepBy++    -- ** Cross Product+    , crossApplyWith+    , crossApply+    , crossApplySnd+    , crossApplyFst+    , crossWith+    , cross++    -- * Concat++    -- ** Concat Effects+    , before+    , concatEffect+    , concatMapEffect++    -- ** ConcatMap+    , concatMapWith+    , concatMap+    , bfsConcatMap+    , fairConcatMap+    , concatMapMAccum++    -- ** concatFor (bind)+    , concatFor+    , bfsConcatFor+    , fairConcatFor+    , concatForWith++    -- ** concatForM+    , concatForM+    , bfsConcatForM+    , fairConcatForM+    , concatForWithM++    -- ** Iterated concat+    , concatIterateWith+    , concatIterateLeftsWith+    , concatIterateScanWith++    -- * Merge+    , mergeMapWith+    , mergeIterateWith++    -- * Buffered Operations+    , foldlS+    , reverse++    -- * Deprecated+    , interleaveFst+    , interleaveMin+    , CrossStreamK+    , mkCross+    , unCross+    , bindWith+    )+where++#include "inline.hs"+#include "deprecation.h"++import Control.Applicative (Alternative(..))+import Control.Monad ((>=>), ap, MonadPlus(..))+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(..))+#if __GLASGOW_HASKELL__ >= 810+import Data.Kind (Type)+#endif+import Data.Maybe (fromMaybe)+import Data.Semigroup (Endo(..))+import GHC.Exts (IsList(..), IsString(..), oneShot, inline)+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 Control.Monad.Fail as Fail+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 can we replace it with a direct style type? With foldr/build fusion.+-- StreamK (m (Maybe (a, StreamK m a)))+-- 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.+#if __GLASGOW_HASKELL__ >= 810+type StopK :: (Type -> Type) -> Type+#endif+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.+#if __GLASGOW_HASKELL__ >= 810+type YieldK :: (Type -> Type) -> Type -> Type+#endif+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]+--+-- Unlike "Streamly.Data.Stream" cons StreamK cons can be used+-- recursively:+--+-- >>> repeat x = let xs = StreamK.cons x xs in xs+-- >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil+--+-- cons is 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 =+    foldlMx' (\x a -> return (step x a)) (return begin) (return . done)++-- | 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++-- | Like 'foldx', but with a monadic step function.+{-# INLINE foldlMx' #-}+foldlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b+foldlMx' step begin done stream =+    -- Note: Unrolling improves the last benchmark significantly.+    let stop = begin >>= done+        single a = begin >>= \x -> step x a >>= done+        yieldk a r = begin >>= \x -> step x a >>= go r+     in foldStream defState yieldk single stop stream++    where++    go m1 !acc =+        let stop = done $! acc+            single a = step acc a >>= done+            yieldk a r = step acc a >>= go r+         in foldStream defState yieldk single stop m1++-- | 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+------------------------------------------------------------------------------++-- 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, maybe 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`++-- | Unlike the fused "Streamly.Data.Stream" append, StreamK append can be used+-- at scale, recursively, with linear performance:+--+-- >>> cycle xs = let ys = xs `StreamK.append` ys in ys+--+-- 'concatMapWith' 'append' (same as concatMap) flattens a stream of streams in a+-- depth-first manner i.e. it yields each stream fully and then the next and so+-- on. Given a stream of three streams:+--+-- @+-- 1. [1,2,3]+-- 2. [4,5,6]+-- 3. [7,8,9]+-- @+--+-- The resulting stream will be @[1,2,3,4,5,6,7,8,9]@.+--+-- Best used in a right associative manner.+--+{-# 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 =+    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 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++-- $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 -> t m a -> t m b+--++-- | A stateful map aka scan but with a slight difference.+--+-- This is similar to a scan except that instead of emitting the state it emits+-- a separate result. This is also similar to mapAccumL but does not return the+-- final value of the state.+--+-- 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.+--+-- /Unimplemented/+--+{-# INLINE mapMAccum #-}+mapMAccum :: -- Monad m =>+       (s -> a -> m (s, b))+    -> m s+    -> StreamK m a+    -> StreamK m b+mapMAccum _step _initial _stream = undefined+{-+    -- XXX implement this directly instead of using scanlM'+    -- Once we have postscanlM' with monadic initial we can use this code+    -- let r = postscanlM'+    --              (\(s, _) a -> step s a)+    --              (fmap (,undefined) initial)+    --              stream+    let r = postscanlM'+                (\(s, _) a -> step s a)+                (fmap (,undefined) initial)+                stream+     in map snd r+-}++-- | Like 'concatMapWith' but carries a state which can be used to share+-- information across multiple steps of concat.+--+-- @+-- concatSmapMWith combine f initial = concatMapWith combine id . smapM f initial+-- @+--+-- /Unimplemented/+--+{-# INLINE concatMapMAccum #-}+concatMapMAccum :: -- (Monad m) =>+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> (s -> a -> m (s, StreamK m b))+    -> m s+    -> StreamK m a+    -> StreamK m b+concatMapMAccum combine f initial =+    concatMapWith combine id . mapMAccum f initial++------------------------------------------------------------------------------+-- 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+        GHC.Exts.fromList <$> readPrec++    readListPrec = readListPrecDefault++instance (a ~ Char) => IsString (StreamK Identity a) where+    {-# INLINE fromString #-}+    fromString = GHC.Exts.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 concatForWith #-}+bindWith, concatForWith ::+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> StreamK m a+    -> (a -> StreamK m b)+    -> StreamK m b+concatForWith combine m1 f = go m1+{-+    -- There is a small improvement by unrolling the first iteration+    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) `combine` go r+        in foldStreamShared (adaptState st) yieldk single stp 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) `combine` go r+            in foldStreamShared (adaptState st) yieldk single stp m++RENAME(bindWith,concatForWith)++-- 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.+--+-- For example, interleaving n streams in a left biased manner:+--+-- >>> lists = mk [[1,5],[2,6],[3,7],[4,8]]+-- >>> un $ StreamK.concatMapWith StreamK.interleave mk lists+-- [1,2,5,3,6,4,7,8]+--+-- For a fair interleaving example see 'bfsConcatMap' and 'mergeMapWith'.+--+{-# 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 = concatForWith par xs f++-- | Like 'concatForWith' but maps an effectful function.+{-# INLINE concatForWithM #-}+concatForWithM :: Monad m =>+       (StreamK m b -> StreamK m b -> StreamK m b)+    -> StreamK m a+    -> (a -> m (StreamK m b))+    -> StreamK m b+concatForWithM combine s f = concatForWith combine s (concatEffect . f)++-- |+-- If total iterations are kept the same, each increase in the nesting level+-- increases the cost by roughly 1.5 times.+--+{-# 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)+-}++-- | Map a stream generating function on each element of a stream and+-- concatenate the results. This is the same as the bind function of the monad+-- instance. It is just a flipped 'concatMap' but more convenient to use for+-- nested use case, feels like an imperative @for@ loop.+--+-- >>> concatFor = flip StreamK.concatMap+--+-- A concatenating @for@ loop:+--+-- >>> :{+-- un $+--     StreamK.concatFor (mk [1,2,3]) $ \x ->+--       StreamK.fromPure x+-- :}+-- [1,2,3]+--+-- Nested concatenating @for@ loops:+--+-- >>> :{+-- un $+--     StreamK.concatFor (mk [1,2,3]) $ \x ->+--      StreamK.concatFor (mk [4,5,6]) $ \y ->+--       StreamK.fromPure (x, y)+-- :}+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+{-# INLINE concatFor #-}+concatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+concatFor = concatForWith append++-- | Like 'concatFor' but maps an effectful function. It allows conveniently+-- mixing monadic effects with streams.+--+-- >>> import Control.Monad.IO.Class (liftIO)+-- >>> :{+-- un $+--     StreamK.concatForM (mk [1,2,3]) $ \x -> do+--       liftIO $ putStrLn (show x)+--       pure $ StreamK.fromPure x+-- :}+-- 1+-- 2+-- 3+-- [1,2,3]+--+-- Nested concatentating @for@ loops:+--+-- >>> :{+-- un $+--     StreamK.concatForM (mk [1,2,3]) $ \x -> do+--       liftIO $ putStrLn (show x)+--       pure $ StreamK.concatFor (mk [4,5,6]) $ \y ->+--         StreamK.fromPure (x, y)+-- :}+-- 1+-- 2+-- 3+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+{-# INLINE concatForM #-}+concatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+concatForM s f =+    -- This should be better than implementing a custom concatForWithM because+    -- here we do not need to inline concatFor, "concatEffect . f" should get+    -- fused right here.+    concatFor s (concatEffect . f)++-- XXX Instead of using "mergeMapWith interleave" we can implement an N-way+-- interleaving CPS combinator which behaves like unfoldEachInterleave. 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.++-- | 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, 'mergeMapWith interleave' gives the following result:+--+-- >>> lists = mk [[1,2,3],[4,5,6],[7,8,9],[10,11,12]]+-- >>> un $ StreamK.mergeMapWith StreamK.interleave mk lists+-- [1,7,4,10,2,8,5,11,3,9,6,12]+--+-- The above example is equivalent to the following pairings:+--+-- >>> pair1 = mk [1,2,3] `StreamK.interleave` mk [4,5,6]+-- >>> pair2 = mk [7,8,9] `StreamK.interleave` mk [10,11,12]+-- >>> un $ pair1 `StreamK.interleave` pair2+-- [1,7,4,10,2,8,5,11,3,9,6,12]+--+-- If the number of streams being combined is not a power of 2, the binary tree+-- composed by mergeMapWith is not balanced, therefore, the output may not look+-- fairly interleaved, it will be biased towards the unpaired streams:+--+-- >>> lists = mk [[1,2,3],[4,5,6],[7,8,9]]+-- >>> un $ StreamK.mergeMapWith StreamK.interleave mk lists+-- [1,7,4,8,2,9,5,3,6]+--+-- An efficient merge sort can be implemented by using 'mergeBy' as the+-- combining function:+--+-- >>> combine = StreamK.mergeBy compare+-- >>> un $ StreamK.mergeMapWith combine StreamK.fromPure (mk [5,1,7,9,2])+-- [1,2,5,7,9]+--+-- /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++-- | See 'bfsConcatFor' for detailed documentation.+--+-- >>> bfsConcatMap = flip StreamK.bfsConcatFor+--+{-# INLINE bfsConcatMap #-}+bfsConcatMap ::+       (a -> StreamK m b)+    -> StreamK m a+    -> StreamK m b+bfsConcatMap f m1 = go id m1++    where++    go xs m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                stop       = foldStream st yld sng stp (goLoop id (xs []))+                single a   = foldShared $ goLast xs (f a)+                yieldk a r = foldShared $ goNext xs r (f a)+            in foldStream (adaptState st) yieldk single stop m++    -- generate first element from cur stream, and then put it back in the+    -- queue xs.+    goNext xs m cur =+        mkStream $ \st yld sng stp -> do+            let stop       = foldStream st yld sng stp (go xs m)+                single a   = yld a (go xs m)+                yieldk a r = yld a (go (xs . (r :)) m)+            foldStream st yieldk single stop cur++    goLast xs cur =+        mkStream $ \st yld sng stp -> do+            let stop       = foldStream st yld sng stp (goLoop id (xs []))+                single a   = yld a (goLoop id (xs []))+                yieldk a r = yld a (goLoop id ((xs . (r :)) []))+            foldStream st yieldk single stop cur++    -- Loop through all streams in the queue ys until they are over+    goLoop ys [] =+            -- We will do this optimization only after two iterations are+            -- over, if doing this earlier is helpful we can do it in+            -- goLast as well, before calling goLoop.+           let xs = ys []+            in case xs of+                    [] -> nil+                    (z:[]) -> z+                    (z1:z2:[]) -> interleave z1 z2+                    zs -> goLoop id zs+    goLoop ys (x:xs) =+        mkStream $ \st yld sng stp -> do+            let stop       = foldStream st yld sng stp (goLoop ys xs)+                single a   = yld a (goLoop ys xs)+                yieldk a r = yld a (goLoop (ys . (r :)) xs)+            foldStream st yieldk single stop x++-- | While 'concatFor' flattens a stream of streams in a depth first manner,+-- 'bfsConcatFor' flattens it in a breadth-first manner. It yields one item+-- from the first stream, then one item from the next stream and so on. In+-- nested loops it has the effect of prioritizing the new outer loop iteration+-- over the inner loops, thus inverting the looping.+-- Given a stream of three streams:+--+-- @+-- 1. [1,2,3]+-- 2. [4,5,6]+-- 3. [7,8,9]+-- @+--+-- The resulting stream is @(1,4,7),(2,5,8),(3,6,9)@. The parenthesis are added+-- to emphasize the iterations.+--+-- For example:+--+-- >>> stream = mk [[1,2,3],[4,5,6],[7,8,9]]+-- >>> :{+--  un $+--      StreamK.bfsConcatFor stream $ \x ->+--          StreamK.fromStream $ Stream.fromList x+-- :}+-- [1,4,7,2,5,8,3,6,9]+--+-- Compare with 'concatForWith' 'interleave' which explores the depth+-- exponentially more compared to the breadth, such that each stream yields+-- twice as many items compared to the next stream.+--+-- See also the equivalent fused version 'Data.Stream.unfoldEachInterleave'.+--+{-# INLINE bfsConcatFor #-}+bfsConcatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+bfsConcatFor = flip bfsConcatMap++-- | Like 'bfsConcatFor' but maps a monadic function.+{-# INLINE bfsConcatForM #-}+bfsConcatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+bfsConcatForM s f = bfsConcatMap (concatEffect . f) s++-- | See 'fairConcatFor' for detailed documentation.+--+-- >>> fairConcatMap = flip StreamK.fairConcatFor+--+{-# INLINE fairConcatMap #-}+fairConcatMap ::+       (a -> StreamK m b)+    -> StreamK m a+    -> StreamK m b+fairConcatMap f m1 = go id m1++    where++    go xs m =+        mkStream $ \st yld sng stp ->+            let foldShared = foldStreamShared st yld sng stp+                stop       = foldStream st yld sng stp (goLoop id (xs []))+                single a   = foldShared $ goLoop id (xs [f a])+                yieldk a r = foldShared $ goNext r id (xs [f a])+            in foldStream (adaptState st) yieldk single stop m++    goNext m ys [] = go ys m+    goNext m ys (x:xs) =+        mkStream $ \st yld sng stp -> do+            let stop       = foldStream st yld sng stp (goNext m ys xs)+                single a   = yld a (goNext m ys xs)+                yieldk a r = yld a (goNext m (ys . (r :)) xs)+            foldStream st yieldk single stop x++    -- Loop through all streams in the queue ys until they are over+    goLoop ys [] =+            -- We will do this optimization only after two iterations are+            -- over, if doing this earlier is helpful we can do it in+            -- goLast as well, before calling goLoop.+           let xs = ys []+            in case xs of+                    [] -> nil+                    (z:[]) -> z+                    (z1:z2:[]) -> interleave z1 z2+                    zs -> goLoop id zs+    goLoop ys (x:xs) =+        mkStream $ \st yld sng stp -> do+            let stop       = foldStream st yld sng stp (goLoop ys xs)+                single a   = yld a (goLoop ys xs)+                yieldk a r = yld a (goLoop (ys . (r :)) xs)+            foldStream st yieldk single stop x++-- | 'fairConcatFor' is like 'concatFor' but traverses the depth and breadth of+-- nesting equally. Therefore, the outer and the inner loops in a nested loop+-- get equal priority. It can be used to nest infinite streams without starving+-- outer streams due to inner ones.+--+-- Given a stream of three streams:+--+-- @+-- 1. [1,2,3]+-- 2. [4,5,6]+-- 3. [7,8,9]+-- @+--+-- Here, outer loop is the stream of streams and the inner loops are the+-- individual streams. The traversal sweeps the diagonals in the above grid to+-- give equal chance to outer and inner loops. The resulting stream is+-- @(1),(2,4),(3,5,7),(6,8),(9)@, diagonals are parenthesized for emphasis.+--+-- == Looping+--+-- A single stream case is equivalent to 'concatFor':+--+-- >>> un $ StreamK.fairConcatFor (mk [1,2]) $ \x -> StreamK.fromPure x+-- [1,2]+--+-- == Fair Nested Looping+--+-- Multiple streams nest like @for@ loops. The result is a cross product of the+-- streams. However, the ordering of the results of the cross product is such+-- that each stream gets consumed equally. In other words, inner iterations of+-- a nested loop get the same priority as the outer iterations. Inner+-- iterations do not finish completely before the outer iterations start.+--+-- >>> :{+-- un $ do+--     StreamK.fairConcatFor (mk [1,2,3]) $ \x ->+--      StreamK.fairConcatFor (mk [4,5,6]) $ \y ->+--       StreamK.fromPure (x, y)+-- :}+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+--+-- == Nesting Infinite Streams+--+-- Example with infinite streams. Print all pairs in the cross product with sum+-- less than a specified number.+--+-- >>> :{+-- Stream.toList+--  $ Stream.takeWhile (\(x,y) -> x + y < 6)+--  $ StreamK.toStream+--  $ StreamK.fairConcatFor (mk [1..]) $ \x ->+--     StreamK.fairConcatFor (mk [1..]) $ \y ->+--      StreamK.fromPure (x, y)+-- :}+-- [(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]+--+-- == How the nesting works?+--+-- If we look at the cross product of [1,2,3], [4,5,6], the streams being+-- combined using 'fairConcatFor' are the following sequential loop iterations:+--+-- @+-- (1,4) (1,5) (1,6) -- first iteration of the outer loop+-- (2,4) (2,5) (2,6) -- second iteration of the outer loop+-- (3,4) (3,5) (3,6) -- third iteration of the outer loop+-- @+--+-- The result is a triangular or diagonal traversal of these iterations:+--+-- @+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+-- @+--+-- == Non-Termination Cases+--+-- If one of the two interleaved streams does not produce an output at all and+-- continues forever then the other stream will never get scheduled. This is+-- because a stream is unscheduled only after it produces an output. This can+-- lead to non-terminating programs, an example is provided below.+--+-- >>> :{+-- oddsIf x = mk (if x then [1,3..] else [2,4..])+-- filterEven x = if even x then StreamK.fromPure x else StreamK.nil+-- :}+--+-- >>> :{+-- evens =+--     StreamK.fairConcatFor (mk [True,False]) $ \r ->+--      StreamK.concatFor (oddsIf r) filterEven+-- :}+--+-- The @evens@ function does not terminate because, when r is True, the nested+-- 'concatFor' is a non-productive infinite loop, therefore, the outer loop+-- never gets a chance to generate the @False@ value.+--+-- But the following refactoring of the above code works as expected:+--+-- >>> :{+-- mixed =+--      StreamK.fairConcatFor (mk [True,False]) $ \r ->+--          StreamK.concatFor (oddsIf r) StreamK.fromPure+-- :}+--+-- >>> evens = StreamK.fairConcatFor mixed filterEven+-- >>> Stream.toList $ Stream.take 3 $ StreamK.toStream evens+-- [2,4,6]+--+-- This works because in @mixed@ both the streams being interleaved are+-- productive.+--+-- Care should be taken how you write your program, keep in mind the scheduling+-- implications. To avoid such scheduling problems in serial interleaving, you+-- can use concurrent interleaving instead i.e. parFairConcatFor. Due to+-- concurrent threads the other branch will make progress even if one is an+-- infinite loop producing nothing.+--+-- == Logic Programming+--+-- Streamly provides all operations for logic programming. It provides+-- functionality equivalent to 'LogicT' type from the 'logict' package.+-- The @MonadLogic@ operations can be implemented using the available stream+-- operations. For example, 'uncons' is @msplit@, 'interleave' corresponds to+-- the @interleave@ operation of MonadLogic, 'fairConcatFor' is the+-- fair bind (@>>-@) operation.+--+-- == Related Operations+--+-- 'concatForWith' 'interleave' is another way to interleave two serial+-- streams. In this case, the inner loop iterations get exponentially more+-- priority over the outer iterations of the nested loop. This is biased+-- towards the inner loops - this is exactly how the logic-t and list-t+-- implementation of fair bind works.+--+{-# INLINE fairConcatFor #-}+fairConcatFor :: StreamK m a -> (a -> StreamK m b) -> StreamK m b+fairConcatFor = flip fairConcatMap++-- | Like 'fairConcatFor' but maps a monadic function.+{-# INLINE fairConcatForM #-}+fairConcatForM :: Monad m => StreamK m a -> (a -> m (StreamK m b)) -> StreamK m b+fairConcatForM s f = fairConcatMap (concatEffect . f) s++{-+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 id) (const Stream.nil)+-- >>> input = StreamK.fromEffect (Left <$> Path.fromString ".")+-- >>> 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 id) (const Stream.nil)+-- >>> input = StreamK.fromEffect (Left <$> Path.fromString ".")+-- >>> 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.++-- XXX rename to concateIterateAccum? Like mapMAccum++-- | 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.fromEffect (Left <$> Path.fromString ".")+-- >>> ls = StreamK.concatIterateLeftsWith StreamK.append (StreamK.fromStream . Dir.readEither id) 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`++-- We can have a variant of interleave where 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.+--+-- TBD; give an example to show second stream is half consumed.+--+-- a1,a2,a3,a4,a5,a6,a7,a8+-- b1,b2,b3,b4,b5,b6,b7,b8+-- c1,c2,c3,c4,c5,c6,c7,c8+-- d1,d2,d3,d4,d5,d6,d7,d8+-- e1,e2,e3,e4,e5,e6,e7,e8+-- f1,f2,f3,f4,f5,f6,f7,f8+-- g1,g2,g3,g4,g5,g6,g7,g8+-- h1,h2,h3,h4,h5,h6,h7,h8+--+-- Produces: (..)+--++-- | Interleave two streams fairly, yielding one item from each in a+-- round-robin fashion:+--+-- >>> un $ StreamK.interleave (mk [1,3,5]) (mk [2,4,6])+-- [1,2,3,4,5,6]+-- >>> un $ StreamK.interleave (mk [1,3]) (mk [2,4,6])+-- [1,2,3,4,6]+-- >>> un $ StreamK.interleave (mk []) (mk [2,4,6])+-- [2,4,6]+--+-- 'interleave' is right associative when used as an infix operator.+--+-- >>> un $ mk [1,2,3] `StreamK.interleave` mk [4,5,6] `StreamK.interleave` mk [7,8,9]+-- [1,4,2,7,3,5,8,6,9]+--+-- Because of right association, the first stream yields as many items as the+-- next two streams combined.+--+-- Be careful when refactoring code involving a chain of three or more+-- 'interleave' operations as it is not associative i.e. right associated code+-- may not produce the same result as left associated. This is a direct+-- consequence of the disbalance of scheduling in the previous example. If left+-- associated the above example would produce:+--+-- >>> un $ (mk [1,2,3] `StreamK.interleave` mk [4,5,6]) `StreamK.interleave` mk [7,8,9]+-- [1,7,4,8,2,9,5,3,6]+--+-- Note: Use concatMap based interleaving instead of the binary operator to+-- interleave more than two streams to avoid associativity issues.+--+-- 'concatMapWith' 'interleave' flattens a stream of streams using 'interleave'+-- in a right associative manner. Given a stream of three streams:+--+-- @+-- 1. [1,2,3]+-- 2. [4,5,6]+-- 3. [7,8,9]+-- @+--+-- The resulting sequence is @[1,4,2,7,3,5,8,6,9]@.+--+-- For this reason, the right associated flattening with 'interleave' can work+-- with infinite number of streams without opening too many streams at the same+-- time. Each stream is consumed twice as much as the next one; if we are+-- combining an infinite number of streams of size @n@ then at most @log n@+-- streams will be opened at any given time, because the first stream will+-- finish by the time the stream after @log n@ th stream is opened.+--+-- Compare with 'bfsConcatMap' and 'mergeMapWith' 'interleave'.+--+-- For interleaving many streams, the best way is to use 'bfsConcatMap'.+--+-- See also the fused version 'Streamly.Data.Stream.interleave'.+{-# 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++-- Examples:+--+-- >>> fromList = StreamK.fromStream . Stream.fromList+-- >>> toList = Stream.toList . StreamK.toStream+-- >>> f x y = toList $ StreamK.interleaveSepBy (fromList x) (fromList y)+--+-- -- This is broken.+-- >> f "..." "abc"+-- "a.b.c"++-- >>> f ".." "abc"+-- "a.b.c"+-- >>> f "." "abc"+-- "a.bc"+--+{-# INLINE interleaveSepBy #-}+interleaveSepBy :: StreamK m a -> StreamK m a -> StreamK m a+interleaveSepBy m2 m1 = 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 `interleaveFst`++{-# DEPRECATED interleaveFst "Please use flip interleaveSepBy instead." #-}+{-# INLINE interleaveFst #-}+interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a+interleaveFst = flip interleaveSepBy++-- |+--+-- Examples:+--+-- >>> fromList = StreamK.fromStream . Stream.fromList+-- >>> toList = Stream.toList . StreamK.toStream+-- >>> f x y = toList $ StreamK.interleaveEndBy' (fromList x) (fromList y)+-- >>> f "..." "abc"+-- "a.b.c."+-- >>> f "..." "ab"+-- "a.b."+--+-- Currently broken, generates an additional element at the end::+--+-- >> f ".." "abc"+-- "a.b."+--+{-# INLINE interleaveEndBy' #-}+interleaveEndBy' :: StreamK m a -> StreamK m a -> StreamK m a+interleaveEndBy' m2 m1 = 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 (interleaveEndBy' nil m2)+        yieldk a r = yld a (interleaveEndBy' r m2)+    foldStream st yieldk single stop m1++infixr 6 `interleaveMin`++{-# DEPRECATED interleaveMin "Please use flip interleaveEndBy' instead." #-}+{-# INLINE interleaveMin #-}+interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a+interleaveMin = flip interleaveEndBy'++-------------------------------------------------------------------------------+-- 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.+--+-- >>> repeat x = let xs = StreamK.cons x xs in xs+--+-- /Pre-release/+{-# INLINE repeat #-}+repeat :: a -> StreamK m a+repeat x = let xs = cons x xs in xs++-- | 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))++-- | head for non-empty streams, fails for empty stream case.+--+{-# INLINE headNonEmpty #-}+headNonEmpty :: Monad m => StreamK m a -> m a+headNonEmpty = foldrM (\x _ -> return x) (error "headNonEmpty: empty stream")++-- | init for non-empty streams, fails for empty stream case.+--+-- See also 'init' for a non-partial version of this function..+{-# INLINE initNonEmpty #-}+initNonEmpty :: Stream m a -> Stream m a+initNonEmpty = go0++    where++    go0 m = mkStream $ \st yld sng stp ->+        let stop = error "initNonEmpty: Empty Stream."+            single _ = stp+            yieldk a r = foldStream st yld sng stp (go1 a r)+         in foldStream st yieldk single stop m++    go1 a r = mkStream $ \st yld sng stp ->+        let stop = stp+            single _ = sng a+            yieldk a1 r1 = yld a (go1 a1 r1)+         in foldStream st yieldk single stop r++-- | tail for non-empty streams, fails for empty stream case.+--+-- See also 'tail' for a non-partial version of this function..+--+-- Note: this is same as "drop 1" with error on empty stream.+{-# INLINE tailNonEmpty #-}+tailNonEmpty :: StreamK m a -> StreamK m a+tailNonEmpty m = mkStream $ \st yld sng stp ->+    let stop      = error "tailNonEmpty: empty stream"+        single _  = stp+        yieldk _ r = foldStream st yld sng stp r+    in foldStream st yieldk single stop m++-- | We can define cyclic structures using @let@:+--+-- >>> :set -fno-warn-unrecognised-warning-flags+-- >>> :set -fno-warn-x-partial+-- >>> 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.unNested $ do+--         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act+--         x <- StreamK.Nested $ StreamK.fromStream $ Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action]+--         y <- StreamK.Nested $ 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 . headNonEmpty)++    -- now fix the tail recursively+    ys = mfix (tailNonEmpty . 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++{-# INLINE fromList #-}+fromList :: [a] -> StreamK m a+fromList = fromFoldable++-------------------------------------------------------------------------------+-- 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++-- Note that this is not a StreamK -> StreamK because then we cannot handle the+-- empty stream case without making this a partial function.+--+-- See tailNonEmpty as well above.++-- | Same as:+--+-- >>> tail = fmap (fmap snd) . StreamK.uncons+--+{-# 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++-- Note that this is not a StreamK -> StreamK because then we cannot handle the+-- empty stream case without making this a partial function.+--+-- XXX How do we implement unsnoc? Make StreamK a monad and return the+-- remaining stream as a result value in the monad?++-- | Extract all but the last element of the stream, if any. This will end up+-- evaluating the last element as well to find out that it is last.+--+-- /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++-- XXX Rename to "impure" (opposite of pure) or "purely".+{-# 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+------------------------------------------------------------------------------++-- XXX add Alternative, MonadPlus - should we use interleave as the Semigroup+-- append operation in FairNested?++-- | 'Nested' is a list-transformer monad, it serves the same purpose as the+-- @ListT@ type from the @list-t@ package. It is similar to the standard+-- Haskell lists' monad instance. 'Nested' monad behaves like nested @for@ loops+-- implementing a computation based on a cross product over multiple streams.+--+-- >>> mk = StreamK.Nested . StreamK.fromStream . Stream.fromList+-- >>> un = Stream.toList . StreamK.toStream . StreamK.unNested+--+-- == Looping+--+-- In the following code the variable @x@ assumes values of the elements of the+-- stream one at a time and runs the code that follows; using that value. It is+-- equivalent to a @for@ loop:+--+-- >>> :{+-- un $ do+--     x <- mk [1,2,3] -- for each element in the stream+--     return x+-- :}+-- [1,2,3]+--+-- == Nested Looping+--+-- Multiple streams can be nested like nested @for@ loops. The result is a+-- cross product of the streams.+--+-- >>> :{+-- un $ do+--     x <- mk [1,2,3] -- outer loop, for each element in the stream+--     y <- mk [4,5,6] -- inner loop, for each element in the stream+--     return (x, y)+-- :}+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+-- Note that an infinite stream in an inner loop will block the outer streams+-- from moving to the next iteration.+--+-- == How it works?+--+-- The bind operation of the monad is flipped 'concatMapWith' 'append'. The+-- concatMap operation maps the lines involving y as a function of x over the+-- stream [1,2,3]. The streams generated so are combined using the 'append'+-- operation. If we desugar the above monad code using bind explicitly, it+-- becomes clear how it works:+--+-- >>> import Streamly.Internal.Data.StreamK (Nested(..))+-- >>> (Nested m) >>= f = Nested $ StreamK.concatMapWith StreamK.append (unNested . f) m+-- >>> un (mk [1,2,3] >>= (\x -> (mk [4,5,6] >>= \y -> return (x,y))))+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+-- You can achieve the looping and nested looping by directly using concatMap+-- but the monad and the \"do notation\" gives you better ergonomics.+--+-- == Interleaving of loop iterations+--+-- If we look at the cross product of [1,2,3], [4,5,6], the streams being+-- combined using 'append' are the @for@ loop iterations as follows:+--+-- @+-- (1,4) (1,5) (1,6) -- first iteration of the outer loop+-- (2,4) (2,5) (2,6) -- second iteration of the outer loop+-- (3,4) (3,5) (3,6) -- third iteration of the outer loop+-- @+--+-- The result is equivalent to sequentially appending all the iterations of the+-- nested @for@ loop:+--+-- @+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+-- @+--+-- == Logic Programming+--+-- 'Nested' also serves the purpose of 'LogicT' type from the 'logict' package.+-- The @MonadLogic@ operations can be implemented using the available stream+-- operations. For example, 'uncons' is @msplit@, 'interleave' corresponds to+-- the @interleave@ operation of MonadLogic, 'fairConcatFor' is the+-- fair bind (@>>-@) operation. The 'FairNested' type provides a monad with fair+-- bind.+--+-- == Related Functionality+--+-- A custom type can be created using 'bfsConcatMap' as the monad bind+-- operation then the nested loops would get inverted - the innermost loop+-- becomes the outermost and vice versa.+--+-- See 'FairNested' if you want all the streams to get equal chance to execute+-- even if they are infinite.+newtype Nested m a = Nested {unNested :: StreamK m a}+        deriving (Functor, Semigroup, Monoid, Foldable)++{-# DEPRECATED CrossStreamK "Use Nested instead." #-}+type CrossStreamK = Nested++{-# DEPRECATED mkCross "Use Nested instead." #-}+-- | Wrap the 'StreamK' type in a 'Nested' 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 -> Nested m a+mkCross = Nested++-- | 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 = unNested++-- Pure (Identity monad) stream instances+deriving instance Traversable (Nested Identity)+deriving instance IsList (Nested Identity a)+deriving instance (a ~ Char) => IsString (Nested Identity a)+-- deriving instance Eq a => Eq (Nested Identity a)+-- deriving instance Ord a => Ord (Nested Identity a)++-- Do not use automatic derivation for this to show as "fromList" rather than+-- "fromList Identity".+instance Show a => Show (Nested Identity a) where+    {-# INLINE show #-}+    show (Nested xs) = show xs++instance Read a => Read (Nested Identity a) where+    {-# INLINE readPrec #-}+    readPrec = fmap Nested readPrec++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++-- Note: we need to define all the typeclass operations because we want to+-- INLINE them.+instance Monad m => Applicative (Nested m) where+    {-# INLINE pure #-}+    pure x = Nested (fromPure x)++    {-# INLINE (<*>) #-}+    (Nested s1) <*> (Nested s2) =+        Nested (crossApply s1 s2)++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (Nested s1) *> (Nested s2) =+        Nested (crossApplySnd s1 s2)++    {-# INLINE (<*) #-}+    (Nested s1) <* (Nested s2) =+        Nested (crossApplyFst s1 s2)++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++instance Monad m => Monad (Nested m) where+    return = pure++    -- Benchmarks better with CPS bind and pure:+    -- Prime sieve (25x)+    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)+    --+    {-# INLINE (>>=) #-}+    (>>=) (Nested m) f =+        Nested (bindWith append m (unNested . f))++    {-# INLINE (>>) #-}+    (>>) = (*>)++------------------------------------------------------------------------------+-- Alternative and MonadPlus+------------------------------------------------------------------------------++instance (Monad m) => Fail.MonadFail (Nested m) where+  fail _ = inline mempty++instance (Monad m, Functor m) => Alternative (Nested m) where+  empty = inline mempty+  (<|>) = inline mappend++instance (Monad m) => MonadPlus (Nested m) where+  mzero = inline mempty+  mplus = inline mappend++------------------------------------------------------------------------------+-- Transformers+------------------------------------------------------------------------------++instance (MonadIO m) => MonadIO (Nested m) where+    liftIO x = Nested (fromEffect $ liftIO x)++instance MonadTrans Nested where+    {-# INLINE lift #-}+    lift x = Nested (fromEffect x)++instance (MonadThrow m) => MonadThrow (Nested m) where+    throwM = lift . throwM++------------------------------------------------------------------------------+-- Stream with a fair cross product style monad instance+------------------------------------------------------------------------------++-- XXX We can fix the termination issues by adding a "skip" continuation in the+-- stream. Adding a "block" continuation can allow for blocking IO. Both of+-- these together will provide a co-operative scheduling. However, adding skip+-- will regress performance in heavy filtering cases. If that's important we+-- can create another type StreamK' for skip continuation. That type can use+-- conversion from Stream type for everything except append and concatMap.++-- | 'FairNested' is like the 'Nested' type but explores the depth and breadth of+-- the cross product grid equally, so that each of the stream being crossed is+-- consumed equally. It can be used to nest infinite streams without starving+-- one due to the other.+--+-- >>> mk = StreamK.FairNested . StreamK.fromStream . Stream.fromList+-- >>> un = Stream.toList . StreamK.toStream . StreamK.unFairNested+--+-- == Looping+--+-- A single stream case is equivalent to 'Nested', it is a simple @for@ loop+-- over the stream:+--+-- >>> :{+-- un $ do+--     x <- mk [1,2] -- for each element in the stream+--     return x+-- :}+-- [1,2]+--+-- == Fair Nested Looping+--+-- Multiple streams nest like @for@ loops. The result is a cross product of the+-- streams. However, the ordering of the results of the cross product is such+-- that each stream gets consumed equally. In other words, inner iterations of+-- a nested loop get the same priority as the outer iterations. Inner+-- iterations do not finish completely before the outer iterations start.+--+-- >>> :{+-- un $ do+--     x <- mk [1,2,3] -- outer, for each element in the stream+--     y <- mk [4,5,6] -- inner, for each element in the stream+--     -- Perform the following actions for each x, for each y+--     return (x, y)+-- :}+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+--+-- == Nesting Infinite Streams+--+-- Example with infinite streams. Print all pairs in the cross product with sum+-- less than a specified number.+--+-- >>> :{+-- Stream.toList+--  $ Stream.takeWhile (\(x,y) -> x + y < 6)+--  $ StreamK.toStream $ StreamK.unFairNested+--  $ do+--     x <- mk [1..] -- infinite stream+--     y <- mk [1..] -- infinite stream+--     return (x, y)+-- :}+-- [(1,1),(1,2),(2,1),(1,3),(2,2),(3,1),(1,4),(2,3),(3,2),(4,1)]+--+-- == How it works?+--+-- 'FairNested' uses 'fairConcatFor' as the monad bind operation.+-- If we look at the cross product of [1,2,3], [4,5,6], the streams being+-- combined using 'concatMapDigaonal' are the sequential loop iterations:+--+-- @+-- (1,4) (1,5) (1,6) -- first iteration of the outer loop+-- (2,4) (2,5) (2,6) -- second iteration of the outer loop+-- (3,4) (3,5) (3,6) -- third iteration of the outer loop+-- @+--+-- The result is a triangular or diagonal traversal of these iterations:+--+-- @+-- [(1,4),(1,5),(2,4),(1,6),(2,5),(3,4),(2,6),(3,5),(3,6)]+-- @+--+-- == Associativity Issues+--+-- WARNING! The FairNested monad breaks the associativity law intentionally for+-- usefulness, it is associative only up to permutation equivalence. In this+-- monad the association order of statements might make a difference to the+-- ordering of the results because of changing the way in which streams are+-- scheduled. The same issues arise when you use the 'interleave' operation+-- directly, association order matters - however, here it can be more subtle as+-- the programmer may not see it directly.+--+-- >>> un (mk [1,2] >>= (\x -> mk [x, x + 1] >>= (\y -> mk [y, y + 2])))+-- [1,3,2,2,4,4,3,5]+-- >>> un ((mk [1,2] >>= (\x -> mk [x, x + 1])) >>= (\y -> mk [y, y + 2]))+-- [1,3,2,4,2,4,3,5]+--+-- This type is designed to be used for use cases where ordering of results+-- does not matter, we want to explore different streams to find specific+-- results, but the order in which we find or present the results may not be+-- important. Re-association of statements in this monad may change how different+-- branches are scheduled, which may change the scheduling priority of some+-- streams over others, this may end up starving some branches - in the worst+-- case some branches may be fully starved by some infinite branches producing+-- nothing - resulting in a non-terminating program.+--+-- == Non-Termination Cases+--+-- If an infinite stream that does not produce a value at all is interleaved+-- with another stream then the entire computation gets stuck forever because+-- the interleave operation schedules the second stream only after the first+-- stream yields a value. This can lead to non-terminating programs, an example+-- is provided below.+--+-- >>> :{+-- toS = StreamK.toStream . StreamK.unFairNested+-- odds x = mk (if x then [1,3..] else [2,4..])+-- filterEven x = if even x then pure x else StreamK.FairNested StreamK.nil+-- :}+--+-- When writing code with do notation, keep in mind that when we bind a+-- variable to a monadic value, all the following code that depends on this+-- variable is associated together and connected to it via a monad bind.+-- Consider the following code:+--+-- >>> :{+-- evens = toS $ do+--     r <- mk [True,False]+--     -- The next two statements depending on the variable r are associated+--     -- together and bound to the previous line using a monad bind.+--     x <- odds r+--     filterEven x+-- :}+--+-- This code does not terminate because, when r is True, @odds@ and+-- @filterEven@ together constitute an infinite inner loop, coninuously working+-- but not yielding any value at all, this stream is interleaved with the outer+-- loop, therefore, the outer loop does not get a chance to move to the next+-- iteration.+--+-- But the following code works as expected:+--+-- >>> :{+-- evens = toS $ do+--     x <- mk [True,False] >>= odds+--     filterEven x+-- :}+--+-- >>> Stream.toList $ Stream.take 3 $ evens+-- [2,4,6]+--+-- This works because both the lists being interleaved continue to produce+-- values in the outer loop and the inner loop keeps filtering them.+--+-- Care should be taken how you write your program, keep in mind the scheduling+-- implications. To avoid such scheduling problems in the serial FairNested type+-- use the concurrent version i.e. FairParallel described in+-- 'Streamly.Data.Stream.MkType' module. Due to concurrent evaluation each+-- branch will make progress even if one is an infinite loop producing nothing.+--+-- == Related Operations+--+-- We can create a custom type with 'concatMapWith' 'interleave' as the monad+-- bind operation then the inner loop iterations get exponentially more+-- priority over the outer iterations of the nested loop. This is not fully+-- fair, it is biased - this is exactly how the logic-t and list-t+-- implementation of fair bind works.++newtype FairNested m a = FairNested {unFairNested :: StreamK m a}+        deriving (Functor, Foldable)++-- Pure (Identity monad) stream instances+deriving instance Traversable (FairNested Identity)+deriving instance IsList (FairNested Identity a)+deriving instance (a ~ Char) => IsString (FairNested Identity a)+-- deriving instance Eq a => Eq (FairNested Identity a)+-- deriving instance Ord a => Ord (FairNested Identity a)++-- Do not use automatic derivation for this to show as "fromList" rather than+-- "fromList Identity".+instance Show a => Show (FairNested Identity a) where+    {-# INLINE show #-}+    show (FairNested xs) = show xs++instance Read a => Read (FairNested Identity a) where+    {-# INLINE readPrec #-}+    readPrec = fmap FairNested readPrec++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++-- Note: we need to define all the typeclass operations because we want to+-- INLINE them.+instance Monad m => Applicative (FairNested m) where+    {-# INLINE pure #-}+    pure x = FairNested (fromPure x)++    -- XXX implement more efficient version of these+    (<*>) = ap+    {-+    {-# INLINE (<*>) #-}+    (FairNested s1) <*> (FairNested s2) =+        FairNested (crossApply s1 s2)++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (FairNested s1) *> (FairNested s2) =+        FairNested (crossApplySnd s1 s2)++    {-# INLINE (<*) #-}+    (FairNested s1) <* (FairNested s2) =+        FairNested (crossApplyFst s1 s2)+    -}++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++instance Monad m => Monad (FairNested m) where+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) (FairNested m) f = FairNested (fairConcatMap (unFairNested . f) m)++    -- {-# INLINE (>>) #-}+    -- (>>) = (*>)++------------------------------------------------------------------------------+-- Transformers+------------------------------------------------------------------------------++instance (MonadIO m) => MonadIO (FairNested m) where+    liftIO x = FairNested (fromEffect $ liftIO x)++instance MonadTrans FairNested where+    {-# INLINE lift #-}+    lift x = FairNested (fromEffect x)++instance (MonadThrow m) => MonadThrow (FairNested m) where     throwM = lift . throwM
src/Streamly/Internal/Data/Time/Clock.hs view
@@ -33,7 +33,7 @@     (MicroSecond64(..), fromAbsTime, addToAbsTime, toRelTime) import Streamly.Internal.Control.ForkIO (forkIOManaged) -import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed+import qualified Streamly.Internal.Data.IORef as Unboxed  import Streamly.Internal.Data.Time.Clock.Type
src/Streamly/Internal/Data/Time/Clock/Type.hsc view
@@ -228,7 +228,7 @@ #elif HS_CLOCK_OSX  -- XXX perform error checks inside c implementation-foreign import ccall+foreign import ccall unsafe     clock_gettime_darwin :: #{type clock_id_t} -> Ptr TimeSpec -> IO ()  {-# INLINABLE getTime #-}@@ -238,10 +238,10 @@ #elif HS_CLOCK_WINDOWS  -- XXX perform error checks inside c implementation-foreign import ccall clock_gettime_win32_monotonic :: Ptr TimeSpec -> IO ()-foreign import ccall clock_gettime_win32_realtime :: Ptr TimeSpec -> IO ()-foreign import ccall clock_gettime_win32_processtime :: Ptr TimeSpec -> IO ()-foreign import ccall clock_gettime_win32_threadtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe clock_gettime_win32_monotonic :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe clock_gettime_win32_realtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe clock_gettime_win32_processtime :: Ptr TimeSpec -> IO ()+foreign import ccall unsafe clock_gettime_win32_threadtime :: Ptr TimeSpec -> IO ()  {-# INLINABLE getTime #-} getTime :: Clock -> IO AbsTime
src/Streamly/Internal/Data/Time/Units.hs view
@@ -1,7 +1,3 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE UnboxedTuples #-}- -- | -- Module      : Streamly.Internal.Data.Time.Units -- Copyright   : (c) 2019 Composewell Technologies
src/Streamly/Internal/Data/Unbox.hs view
@@ -1,7 +1,11 @@ {-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE TypeFamilies #-}+-- Must come after TypeFamilies, otherwise it is re-enabled.+-- MonoLocalBinds enabled by TypeFamilies causes perf regressions in general.+{-# LANGUAGE NoMonoLocalBinds #-} {-# LANGUAGE UnboxedTuples #-} {-# LANGUAGE UndecidableInstances #-}+{- HLINT ignore -}  -- | -- Module      : Streamly.Internal.Data.Unbox@@ -38,6 +42,7 @@     ) where  #include "MachDeps.h"+#include "HsBaseConfig.h" #include "ArrayMacros.h"  import Control.Monad (void, when)@@ -47,6 +52,7 @@ import Data.Functor.Identity (Identity(..)) import Data.Kind (Type) import Data.Proxy (Proxy (..))+import Foreign.C.Types (CChar(..), CWchar(..)) import Foreign.Ptr (IntPtr(..), WordPtr(..)) import GHC.Base (IO(..)) import GHC.Fingerprint.Type (Fingerprint(..))@@ -68,7 +74,7 @@  import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..)) #ifdef DEBUG-import Streamly.Internal.Data.MutByteArray.Type (sizeOfMutableByteArray)+import qualified Streamly.Internal.Data.MutByteArray.Type as MutByteArray #endif  --------------------------------------------------------------------------------@@ -236,7 +242,7 @@     sizeOf = genericSizeOf      -- | @peekAt byte-offset array@ reads an element of type @a@ from the-    -- the given the byte offset in the array.+    -- given 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.@@ -251,7 +257,7 @@     peekByteIndex = peekAt      -- | @pokeAt byte-offset array@ writes an element of type @a@ to the-    -- the given the byte offset in the array.+    -- given 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.@@ -273,7 +279,7 @@ checkBounds :: String -> Int -> MutByteArray -> IO () checkBounds _label _size _arr = do #ifdef DEBUG-    sz <- sizeOfMutableByteArray _arr+    sz <- MutByteArray.length _arr     if (_size > sz)     then error         $ _label@@ -441,6 +447,11 @@ DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a) #endif DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)++-- XXX Add more CTypes+DERIVE_WRAPPED_UNBOX(,CChar,CChar,HTYPE_CHAR)+DERIVE_WRAPPED_UNBOX(,CWchar,CWchar,HTYPE_WCHAR_T)+ 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)@@ -459,6 +470,7 @@     sizeOf _ = 1  #if MIN_VERSION_base(4,15,0)+ instance Unbox IoSubSystem where      {-# INLINE peekAt #-}@@ -501,6 +513,8 @@  -- Utilities to build or parse a type safely and easily. +-- XXX Use Array instead.+ -- | 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 =@@ -579,6 +593,8 @@ -- Poke utilities -------------------------------------------------------------------------------- +-- XXX Use MutArray instead of BoundedPtr.+ -- 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@@ -794,7 +810,7 @@ genericPokeByteIndex arr index x = do     -- XXX Should we use unsafe poke? #ifdef DEBUG-    end <- sizeOfMutableByteArray arr+    end <- MutByteArray.length arr     genericPokeObj x (BoundedPtr arr index end) #else     genericPokeObj x (BoundedPtr arr index undefined)@@ -900,7 +916,7 @@ genericPeekByteIndex arr index = do     -- XXX Should we use unsafe peek? #ifdef DEBUG-    end <- sizeOfMutableByteArray arr+    end <- MutByteArray.length arr     genericPeekBoundedPtr (BoundedPtr arr index end) #else     genericPeekBoundedPtr (BoundedPtr arr index undefined)
src/Streamly/Internal/Data/Unbox/TH.hs view
@@ -21,9 +21,10 @@ -- Imports -------------------------------------------------------------------------------- -import Data.Word (Word16, Word32, Word64, Word8)-import Data.Proxy (Proxy(..))+import Data.Bifunctor (second) import Data.List (elemIndex)+import Data.Proxy (Proxy(..))+import Data.Word (Word16, Word32, Word64, Word8)  import Language.Haskell.TH import Language.Haskell.TH.Syntax@@ -62,7 +63,7 @@ -- | Extract the type variable name from a 'TyVarBndr', ignoring the -- kind signature if one exists. tvName :: TyVarBndr_ flag -> Name-tvName = elimTV id (\n _ -> n)+tvName = elimTV id const  -- | Get the 'Name' of a 'TyVarBndr' tyVarBndrName :: TyVarBndr_ flag -> Name@@ -191,7 +192,7 @@                        [|$(litE (IntegerL (fromIntegral tagSize))) +                          $(varE _initialOffset)|])                   [])-             (map mkOffsetExpr (zip [1 ..] fields)))+             (fmap mkOffsetExpr (zip [1 ..] fields)))      where @@ -271,7 +272,7 @@                 , noBindS                       (caseE                            (sigE (varE _tag) (conT tagType))-                           (map peekMatch (zip [0 ..] cons) ++ [peekErr]))+                           (fmap peekMatch (zip [0 ..] cons) ++ [peekErr]))                 ]      where@@ -303,7 +304,7 @@         [|pokeAt               $(varE _initialOffset)               $(varE _arr)-              $((sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType)))|]+              $(sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType))|]  mkPokeExprFields :: Int -> [Field] -> Q Exp mkPokeExprFields tagSize fields = do@@ -326,7 +327,7 @@ mkPokeMatch :: Name -> Int -> Q Exp -> Q Match mkPokeMatch cname numFields exp0 =     match-        (conP cname (map varP (map mkFieldName [0 .. (numFields - 1)])))+        (conP cname (map (varP . mkFieldName) [0 .. (numFields - 1)]))         (normalB exp0)         [] @@ -339,15 +340,15 @@                    $(lift (pprint headTy)) ++ ")")|]         -- XXX We don't gaurentee encoded equivalilty for Unbox. Does it still         -- make sense to encode a default value for unit constructor?-        [(DataCon _ _ _ [])] -> [|pure ()|] -- mkPokeExprTag ''Word8 0-        [(DataCon cname _ _ fields)] ->+        [DataCon _ _ _ []] -> [|pure ()|] -- mkPokeExprTag ''Word8 0+        [DataCon cname _ _ fields] ->             caseE                 (varE _val)                 [mkPokeMatch cname (length fields) (mkPokeExprFields 0 fields)]         _ ->             caseE                 (varE _val)-                (map (\(tagVal, (DataCon cname _ _ fields)) ->+                (fmap (\(tagVal, DataCon cname _ _ fields) ->                           mkPokeMatch                               cname                               (length fields)@@ -466,7 +467,7 @@     mapType f v = f v      modifyConVariables f con =-        con { dcFields = map (\(a, b) -> (a, mapType f b)) (dcFields con) }+        con { dcFields = map (second (mapType f)) (dcFields con) }      mkInst mo preds headTyWC methods =         pure [InstanceD mo preds headTyWC methods]
src/Streamly/Internal/Data/Unfold.hs view
@@ -29,6 +29,7 @@     -- ** Generators     -- | Generate a monadic stream from a seed.     , repeatM+    , repeat     , replicateM     , fromIndicesM     , iterateM@@ -58,15 +59,11 @@     -- * Folding     , fold -    -- XXX Add "WithInput" versions of all these, map2, postscan2, takeWhile2,-    -- filter2 etc.  Alternatively, we can use the default operations with-    -- input, but that might make the common case more inconvenient.-     -- ** Mapping on Output     , postscanlM'     , postscan-    , scan-    , scanMany+    , scanl+    , scanlMany     , foldMany     -- pipe @@ -82,8 +79,11 @@     , dropWhileM      -- ** Cross product-    , joinInnerGeneric+    , innerJoin +    -- ** Zip+    , zipRepeat+     -- ** Resource Management     -- | 'bracket' is the most general resource management operation, all other     -- operations can be expressed using it. These functions have IO suffix@@ -107,6 +107,10 @@     -- stream of arrays before flattening it to a stream of chars.     , onException     , handle++    -- ** Deprecated+    , scan+    , scanMany     ) where @@ -118,6 +122,7 @@ import Data.Functor (($>)) import GHC.Types (SPEC(..)) import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Scanl.Type (Scanl(..)) import Streamly.Internal.Data.IOFinalizer     (newIOFinalizer, runIOFinalizer, clearingIOFinalizer) import Streamly.Internal.Data.Stream.Type (Stream(..))@@ -134,7 +139,7 @@ import Streamly.Internal.Data.Unfold.Type import Prelude        hiding (map, mapM, takeWhile, take, filter, const, zipWith-              , drop, dropWhile, either)+              , drop, dropWhile, either, scanl, repeat) import Control.Monad.IO.Class (MonadIO (liftIO)) import Foreign (Storable, peek, sizeOf) import Foreign.Ptr@@ -347,8 +352,8 @@ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone  {-# 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 final) (Unfold stepU injectU) =+scanWith :: Monad m => Bool -> Scanl m b c -> Unfold m a b -> Unfold m a c+scanWith restart (Scanl fstep initial extract final) (Unfold stepU injectU) =     Unfold step inject      where@@ -379,28 +384,40 @@ -- | Scan the output of an 'Unfold' to change it in a stateful manner. -- Once fold is done it will restart from its initial state. ----- >>> u = Unfold.scanMany (Fold.take 2 Fold.sum) Unfold.fromList+-- >>> u = Unfold.scanlMany (Scanl.take 2 Scanl.sum) Unfold.fromList -- >>> Unfold.fold Fold.toList u [1,2,3,4,5] -- [0,1,3,0,3,7,0,5] -- -- /Pre-release/+{-# INLINE_NORMAL scanlMany #-}+scanlMany :: Monad m => Scanl m b c -> Unfold m a b -> Unfold m a c+scanlMany = scanWith True++-- When we remove extract from Fold this function should be removed.+{-# DEPRECATED scanMany "Please use scanlMany instead" #-} {-# INLINE_NORMAL scanMany #-} scanMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-scanMany = scanWith True+scanMany (Fold s i e f) = scanWith True (Scanl s i e f)  -- scan2 :: Monad m => Refold m a b c -> Unfold m a b -> Unfold m a c  -- | Scan the output of an 'Unfold' to change it in a stateful manner. -- Once fold is done it will stop. ----- >>> u = Unfold.scan (Fold.take 2 Fold.sum) Unfold.fromList+-- >>> u = Unfold.scanl (Scanl.take 2 Scanl.sum) Unfold.fromList -- >>> Unfold.fold Fold.toList u [1,2,3,4,5] -- [0,1,3] -- -- /Pre-release/+{-# INLINE_NORMAL scanl #-}+scanl :: Monad m => Scanl m b c -> Unfold m a b -> Unfold m a c+scanl = scanWith False++-- When we remove extract from Fold this function should be removed.+{-# DEPRECATED scan "Please use scanl instead" #-} {-# INLINE_NORMAL scan #-} scan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-scan = scanWith False+scan (Fold s i e f) = scanWith False (Scanl s i e f)  -- | Scan the output of an 'Unfold' to change it in a stateful manner. --@@ -519,7 +536,7 @@      where -    inject seed = pure seed+    inject = pure      {-# INLINE_LATE step #-}     step (i, action) =@@ -538,6 +555,32 @@     {-# INLINE_LATE step #-}     step action = (`Yield` action) <$> action +{-# INLINE repeat #-}+repeat :: Applicative m => Unfold m a a+repeat = lmap pure repeatM++-- | Takes a tuple whose first element is repeated and the second element is+-- passed through the supplied unfold.+--+-- >>> zipRepeat = fmap (\(x,y) -> (fst x, y)) . Unfold.carry . Unfold.lmap snd+-- >>> zipRepeat = Unfold.zipArrowWith (,) Unfold.repeat+--+{-# INLINE_NORMAL zipRepeat #-}+zipRepeat :: Functor m => Unfold m a b -> Unfold m (c,a) (c,b)+-- zipRepeat = zipArrowWith (,) repeat+zipRepeat (Unfold ustep uinject) = Unfold step (\(c,a) -> (c,) <$> uinject a)++    where++    func a r =+        case r of+            Yield x s -> Yield (a, x) (a, s)+            Skip s    -> Skip (a, s)+            Stop      -> Stop++    {-# INLINE_LATE step #-}+    step (a, st) = fmap (func a) (ustep st)+ -- | Generates an infinite stream starting with the given seed and applying the -- given function repeatedly. --@@ -677,10 +720,12 @@ dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b dropWhile f = dropWhileM (return . f) -{-# INLINE_NORMAL joinInnerGeneric #-}-joinInnerGeneric :: Monad m =>+-- | Cross intersection of two unfolds. See+-- 'Streamly.Internal.Data.Stream.innerJoin' for more details.+{-# INLINE_NORMAL innerJoin #-}+innerJoin :: Monad m =>     (b -> c -> Bool) -> Unfold m a b -> Unfold m a c -> Unfold m a (b, c)-joinInnerGeneric eq s1 s2 = filter (\(a, b) -> a `eq` b) $ cross s1 s2+innerJoin eq s1 s2 = filter (\(a, b) -> a `eq` b) $ cross s1 s2  ------------------------------------------------------------------------------ -- Exceptions
src/Streamly/Internal/Data/Unfold/Type.hs view
@@ -26,7 +26,7 @@ -- much less efficient when compared to combinators using 'Unfold'.  For -- example, the 'Streamly.Data.Stream.concatMap' combinator which uses @a -> t m b@ -- (where @t@ is a stream type) to generate streams is much less efficient--- compared to 'Streamly.Data.Stream.unfoldMany'.+-- compared to 'Streamly.Data.Stream.unfoldEach'. -- -- On the other hand, transformation operations on stream types are as -- efficient as transformations on 'Unfold'.@@ -62,34 +62,36 @@      -- * From Containers     , fromList+    , fromTuple      -- * Transformations     , lmap     , lmapM     , map-    , map2     , mapM-    , mapM2     , both+    , supply     , first     , second+    , carry      -- * Trimming-    , takeWhileMWithInput     , takeWhileM     , takeWhile      -- * Nesting+    , interleave     , ConcatState (..)-    , many-    , many2-    , manyInterleave-    -- , manyInterleave2+    , unfoldEach+    , unfoldEachInterleave      -- Applicative     , crossApplySnd     , crossApplyFst     , crossWithM+    , fairCrossWithM+    , fairCrossWith+    , fairCross     , crossWith     , cross     , crossApply@@ -99,11 +101,22 @@     , concatMap     , bind +    , zipArrowWithM+    , zipArrowWith     , zipWithM     , zipWith++    -- * Deprecated+    , many+    , many2+    , manyInterleave+    , map2+    , mapM2+    , takeWhileMWithInput     ) where +#include "deprecation.h" #include "inline.hs"  -- import Control.Arrow (Arrow(..))@@ -111,7 +124,6 @@ import Control.Monad ((>=>)) import Data.Void (Void) import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) import Streamly.Internal.Data.Stream.Step (Step(..))  import Prelude hiding (map, mapM, concatMap, zipWith, takeWhile)@@ -146,13 +158,13 @@ -- -- This allows an important optimization to occur in several cases, making the -- 'Unfold' a more efficient abstraction. Consider the 'concatMap' and--- 'unfoldMany' operations, the latter is more efficient.  'concatMap'+-- 'unfoldEach' operations, the latter is more efficient.  'concatMap' -- generates a new stream object from each element in the stream by applying -- the supplied function to the element, the stream object includes the "step" -- function as well as the initial "state" of the stream.  Since the stream is -- generated dynamically the compiler does not know the step function or the -- state type statically at compile time, therefore, it cannot inline it. On--- the other hand in case of 'unfoldMany' the compiler has visibility into+-- the other hand in case of 'unfoldEach' the compiler has visibility into -- the unfold's state generation function, therefore, the compiler knows all -- the types statically and it can inline the inject as well as the step -- functions, generating efficient code. Essentially, the stream is not opaque@@ -217,6 +229,8 @@ -- Basic constructors ------------------------------------------------------------------------------ +-- XXX unfoldWith?+ -- | Make an unfold from @step@ and @inject@ functions. -- -- /Pre-release/@@ -275,32 +289,35 @@ -- >>> Unfold.fold Fold.toList u [1..5] -- [2,3,4,5,6] ----- @--- lmap f = Unfold.many (Unfold.function f)--- @+-- Definition: --+-- >>> lmap f = Unfold.unfoldEach (Unfold.function f)+-- {-# INLINE_NORMAL lmap #-} lmap :: (a -> c) -> Unfold m c b -> Unfold m a b lmap f (Unfold ustep uinject) = Unfold ustep (uinject Prelude.. f)  -- | Map an action on the input argument of the 'Unfold'. ----- @--- lmapM f = Unfold.many (Unfold.functionM f)--- @+-- Definition: --+-- lmapM f = Unfold.unfoldEach (Unfold.functionM f)+-- {-# INLINE_NORMAL lmapM #-} lmapM :: Monad m => (a -> m c) -> Unfold m c b -> Unfold m a b lmapM f (Unfold ustep uinject) = Unfold ustep (f >=> uinject)  -- | Supply the seed to an unfold closing the input end of the unfold. ----- @--- both a = Unfold.lmap (Prelude.const a)--- @+-- >>> supply a = Unfold.lmap (Prelude.const a) -- -- /Pre-release/ --+{-# INLINE_NORMAL supply #-}+supply :: a -> Unfold m a b -> Unfold m () b+supply a = lmap (Prelude.const a)++{-# DEPRECATED both "Use supply instead." #-} {-# INLINE_NORMAL both #-} both :: a -> Unfold m a b -> Unfold m Void b both a = lmap (Prelude.const a)@@ -337,9 +354,13 @@ -- Filter input ------------------------------------------------------------------------------ +-- |+-- >>> takeWhileMWithInput f u = Unfold.map snd $ Unfold.takeWhileM (\(a,b) -> f a b) (Unfold.carry u) {-# INLINE_NORMAL takeWhileMWithInput #-} takeWhileMWithInput :: Monad m =>     (a -> b -> m Bool) -> Unfold m a b -> Unfold m a b+takeWhileMWithInput f u = map snd $ takeWhileM (\(a,b) -> f a b) (carry u)+{- takeWhileMWithInput f (Unfold step1 inject1) = Unfold step inject      where@@ -357,6 +378,7 @@                 return $ if b then Yield x (Tuple' a s) else Stop             Skip s -> return $ Skip (Tuple' a s)             Stop   -> return Stop+-}  -- | Same as 'takeWhile' but with a monadic predicate. --@@ -389,8 +411,11 @@ -- Functor ------------------------------------------------------------------------------ +{-# DEPRECATED mapM2 "Use carry with mapM instead." #-} {-# INLINE_NORMAL mapM2 #-} mapM2 :: Monad m => (a -> b -> m c) -> Unfold m a b -> Unfold m a c+mapM2 f = mapM (uncurry f) . carry+{- mapM2 f (Unfold ustep uinject) = Unfold step inject     where     inject a = do@@ -404,12 +429,11 @@             Yield x s -> f inp x >>= \a -> return $ Yield a (inp, s)             Skip s    -> return $ Skip (inp, s)             Stop      -> return Stop+-}  -- | Apply a monadic function to each element of the stream and replace it -- with the output of the resulting action. ----- >>> mapM f = Unfold.mapM2 (const f)--- {-# INLINE_NORMAL mapM #-} mapM :: Monad m => (b -> m c) -> Unfold m a b -> Unfold m a c -- mapM f = mapM2 (const f)@@ -423,37 +447,37 @@             Skip s    -> return $ Skip s             Stop      -> return Stop --- XXX We can also introduce a withInput combinator which will output the input--- seed along with the output as a tuple.---- |+-- | Carry the input along with the output as the first element of the output+-- tuple. ----- >>> map2 f = Unfold.mapM2 (\a b -> pure (f a b))+-- carry = Unfold.lmap (\x -> (x,x)) . Unfold.zipRepeat ----- Note that the seed may mutate (e.g. if the seed is a Handle or IORef) as--- stream is generated from it, so we need to be careful when reusing the seed--- while the stream is being generated from it.+-- Note that the input seed may mutate (e.g. if the seed is a Handle or IORef)+-- as stream is generated from it, so we need to be careful when reusing the+-- seed while the stream is being generated from it. ---{-# INLINE_NORMAL map2 #-}-map2 :: Functor m => (a -> b -> c) -> Unfold m a b -> Unfold m a c--- map2 f = mapM2 (\a b -> pure (f a b))-map2 f (Unfold ustep uinject) = Unfold step (\a -> (a,) <$> uinject a)+{-# INLINE_NORMAL carry #-}+carry :: Functor m => Unfold m a b -> Unfold m a (a,b)+carry (Unfold ustep uinject) = Unfold step (\a -> (a,) <$> uinject a)      where      func a r =         case r of-            Yield x s -> Yield (f a x) (a, s)+            Yield x s -> Yield (a, x) (a, s)             Skip s    -> Skip (a, s)             Stop      -> Stop      {-# INLINE_LATE step #-}     step (a, st) = fmap (func a) (ustep st) +{-# DEPRECATED map2 "Use carry with map instead." #-}+{-# INLINE_NORMAL map2 #-}+map2 :: Functor m => (a -> b -> c) -> Unfold m a b -> Unfold m a c+map2 f = map (uncurry f) . carry+ -- | Map a function on the output of the unfold (the type @b@). ----- >>> map f = Unfold.map2 (const f)--- -- /Pre-release/ {-# INLINE_NORMAL map #-} map :: Functor m => (b -> c) -> Unfold m a b -> Unfold m a c@@ -499,9 +523,25 @@ -- > fromPure = fromEffect . pure -- -- /Pre-release/+{-# INLINE fromPure #-} fromPure :: Applicative m => b -> Unfold m a b fromPure = fromEffect Prelude.. pure +data TupleState a = TupleBoth a a | TupleOne a | TupleNone++-- | Convert a tuple to a 'Stream'.+--+{-# INLINE_LATE fromTuple #-}+fromTuple :: Applicative m => Unfold m (a,a) a+fromTuple = Unfold step (\(x,y) -> pure $ TupleBoth x y)++    where++    {-# INLINE_LATE step #-}+    step (TupleBoth x y) = pure $ Yield x (TupleOne y)+    step (TupleOne y) = pure $ Yield y TupleNone+    step TupleNone = pure Stop+ -- XXX Check if "unfold (fromList [1..10])" fuses, if it doesn't we can use -- rewrite rules to rewrite list enumerations to unfold enumerations. @@ -535,12 +575,18 @@     Unfold m a b -> Unfold m a c -> Unfold m a b crossApplyFst (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined +{- {-# ANN type Many2State Fuse #-} data Many2State x s1 s2 = Many2Outer x s1 | Many2Inner x s1 s2+-} +{-# DEPRECATED many2 "Use carry with unfoldEach instead." #-} {-# INLINE_NORMAL many2 #-}-many2 :: Monad m => Unfold m (a, b) c -> Unfold m a b -> Unfold m a c-many2 (Unfold step2 inject2) (Unfold step1 inject1) = Unfold step inject+many2 :: Monad m =>+    Unfold m (a, b) c -> Unfold m a b -> Unfold m a c+many2 u1 u2 = unfoldEach u1 (carry u2)+{-+unfoldEach2 (Unfold step2 inject2) (Unfold step1 inject1) = Unfold step inject      where @@ -564,15 +610,16 @@             Yield x s -> Yield x (Many2Inner a ost s)             Skip s    -> Skip (Many2Inner a ost s)             Stop      -> Skip (Many2Outer a ost)+-}  data Cross a s1 b s2 = CrossOuter a s1 | CrossInner a s1 b s2 +-- >> f1 f u = Unfold.mapM (\((_, c), b) -> f b c) Unfold.carry (Unfold.lmap fst u))+-- >> crossWithM f u = Unfold.unfoldEach2 (f1 f u)+ -- | Create a cross product (vector product or cartesian product) of the -- output streams of two unfolds using a monadic combining function. ----- >>> f1 f u = Unfold.mapM2 (\(_, c) b -> f b c) (Unfold.lmap fst u)--- >>> crossWithM f u = Unfold.many2 (f1 f u)--- -- /Pre-release/ {-# INLINE_NORMAL crossWithM #-} crossWithM :: Monad m =>@@ -603,6 +650,59 @@             Skip s    -> return $ Skip (CrossInner a s1 b s)             Stop      -> return $ Skip (CrossOuter a s1) +data FairUnfoldState a o i =+      FairUnfoldInit a o ([i] -> [i])+    | FairUnfoldNext a o ([i] -> [i]) [i]+    | FairUnfoldDrain ([i] -> [i]) [i]++{-# INLINE_NORMAL fairCrossWithM #-}+fairCrossWithM :: Monad m =>+    (b -> c -> m d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+fairCrossWithM f (Unfold step1 inject1) (Unfold step2 inject2) =+    Unfold step inject++    where++    inject a = do+        s1 <- inject1 a+        return $ FairUnfoldInit a s1 id++    {-# INLINE_LATE step #-}+    step (FairUnfoldInit a o ls) = do+        r <- step1 o+        case r of+            Yield b o' -> do+                i <- inject2 a+                i `seq` return (Skip (FairUnfoldNext a o' id (ls [(b,i)])))+            Skip o' -> return $ Skip (FairUnfoldInit a o' ls)+            Stop -> return $ Skip (FairUnfoldDrain id (ls []))++    step (FairUnfoldNext a o ys []) =+            return $ Skip (FairUnfoldInit a o ys)++    step (FairUnfoldNext a o ys ((b,st):ls)) = do+        r <- step2 st+        case r of+            Yield c s ->+                f b c >>= \x ->+                    return $ Yield x (FairUnfoldNext a o (ys . ((b, s) :)) ls)+            Skip s    -> return $ Skip (FairUnfoldNext a o ys ((b,s) : ls))+            Stop      -> return $ Skip (FairUnfoldNext a o ys ls)++    step (FairUnfoldDrain ys []) =+        case ys [] of+            [] -> return Stop+            xs -> return $ Skip (FairUnfoldDrain id xs)++    step (FairUnfoldDrain ys ((b,st):ls)) = do+        r <- step2 st+        case r of+            Yield c s ->+                f b c >>= \x ->+                    return $ Yield x (FairUnfoldDrain (ys . ((b,s) :)) ls)+            Skip s    -> return $ Skip (FairUnfoldDrain ys ((b,s) : ls))+            Stop      -> return $ Skip (FairUnfoldDrain ys ls)+ -- | Like 'crossWithM' but uses a pure combining function. -- -- > crossWith f = crossWithM (\b c -> return $ f b c)@@ -618,6 +718,11 @@     (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d crossWith f = crossWithM (\b c -> return $ f b c) +{-# INLINE fairCrossWith #-}+fairCrossWith :: Monad m =>+    (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+fairCrossWith f = fairCrossWithM (\b c -> return $ f b c)+ -- | See 'crossWith'. -- -- Definition:@@ -637,6 +742,11 @@ cross :: Monad m => Unfold m a b -> Unfold m a c -> Unfold m a (b, c) cross = crossWith (,) +{-# INLINE_NORMAL fairCross #-}+fairCross :: Monad m => Unfold m a b -> Unfold m a c -> Unfold m a (b, c)+fairCross = fairCrossWith (,)++{-# INLINE crossApply #-} crossApply :: Monad m => Unfold m a (b -> c) -> Unfold m a b -> Unfold m a c crossApply u1 u2 = fmap (\(a, b) -> a b) (cross u1 u2) @@ -792,12 +902,10 @@ -- | Apply the first unfold to each output element of the second unfold and -- flatten the output in a single stream. ----- >>> many u = Unfold.many2 (Unfold.lmap snd u)----{-# INLINE_NORMAL many #-}-many :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c+{-# INLINE_NORMAL unfoldEach #-}+unfoldEach, many :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c -- many u1 = many2 (lmap snd u1)-many (Unfold step2 inject2) (Unfold step1 inject1) = Unfold step inject+unfoldEach (Unfold step2 inject2) (Unfold step1 inject1) = Unfold step inject      where @@ -822,6 +930,8 @@             Skip s    -> Skip (ConcatInner ost s)             Stop      -> Skip (ConcatOuter ost) +RENAME(many,unfoldEach)+ {- -- XXX There are multiple possible ways to combine the unfolds, "many" appends -- them, we could also have other variants of "many" e.g. manyInterleave.@@ -840,15 +950,52 @@ -- Zipping ------------------------------------------------------------------------------- +-- XXX call the original zipWith as distribute and this one as zip? or this+-- could be called divide.+--+{-# INLINE_NORMAL zipArrowWithM #-}+zipArrowWithM :: Monad m+    => (b -> c -> m d) -> Unfold m a1 b -> Unfold m a2 c -> Unfold m (a1,a2) d+zipArrowWithM f (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject++    where++    inject (x,y) = do+        s1 <- inject1 x+        s2 <- inject2 y+        return (s1, s2, Nothing)++    {-# INLINE_LATE step #-}+    step (s1, s2, Nothing) = do+        r <- step1 s1+        return $+          case r of+            Yield x s -> Skip (s, s2, Just x)+            Skip s    -> Skip (s, s2, Nothing)+            Stop      -> Stop++    step (s1, s2, Just x) = do+        r <- step2 s2+        case r of+            Yield y s -> do+                z <- f x y+                return $ Yield z (s1, s, Nothing)+            Skip s -> return $ Skip (s1, s, Just x)+            Stop   -> return Stop+ -- | Distribute the input to two unfolds and then zip the outputs to a single -- stream using a monadic zip function. --+-- >>> zipWithM f u1 u2 = Unfold.lmap (\x -> (x,x)) (Unfold.zipArrowWithM f u1 u2)+-- -- Stops as soon as any of the unfolds stops. -- -- /Pre-release/ {-# INLINE_NORMAL zipWithM #-} zipWithM :: Monad m     => (b -> c -> m d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+zipWithM f u1 u2 = lmap (\x -> (x,x)) (zipArrowWithM f u1 u2)+{- zipWithM f (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject      where@@ -875,6 +1022,7 @@                 return $ Yield z (s1, s, Nothing)             Skip s -> return $ Skip (s1, s, Just x)             Stop   -> return Stop+-}  -- | Like 'zipWithM' but with a pure zip function. --@@ -891,6 +1039,11 @@     => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d zipWith f = zipWithM (\a b -> return (f a b)) +{-# INLINE zipArrowWith #-}+zipArrowWith :: Monad m+    => (b -> c -> d) -> Unfold m a1 b -> Unfold m a2 c -> Unfold m (a1,a2) d+zipArrowWith f = zipArrowWithM (\a b -> return (f a b))+ ------------------------------------------------------------------------------- -- Arrow -------------------------------------------------------------------------------@@ -931,25 +1084,69 @@ -- -- Similarly we can also have other binary combining ops like append, mergeBy. -- We already have zipWith.--- +data InterleaveState s1 s2 =+      InterleaveFirst s1 s2+    | InterleaveSecond s1 s2+    | InterleaveSecondOnly s2+    | InterleaveFirstOnly s1++-- | Interleave the streams generated by two unfolds.+{-# INLINE_NORMAL interleave #-}+interleave :: Monad m => Unfold m a c -> Unfold m b c -> Unfold m (a,b) c+interleave (Unfold step1 inject1) (Unfold step2 inject2) =+    Unfold step inject++    where++    inject (a,b) = do+        s1 <- inject1 a+        s2 <- inject2 b+        return (InterleaveFirst s1 s2)++    {-# INLINE_LATE step #-}+    step (InterleaveFirst st1 st2) = do+        r <- step1 st1+        return $ case r of+            Yield a s -> Yield a (InterleaveSecond s st2)+            Skip s -> Skip (InterleaveFirst s st2)+            Stop -> Skip (InterleaveSecondOnly st2)++    step (InterleaveSecond st1 st2) = do+        r <- step2 st2+        return $ case r of+            Yield a s -> Yield a (InterleaveFirst st1 s)+            Skip s -> Skip (InterleaveSecond st1 s)+            Stop -> Skip (InterleaveFirstOnly st1)++    step (InterleaveFirstOnly st1) = do+        r <- step1 st1+        return $ case r of+            Yield a s -> Yield a (InterleaveFirstOnly s)+            Skip s -> Skip (InterleaveFirstOnly s)+            Stop -> Stop++    step (InterleaveSecondOnly st2) = do+        r <- step2 st2+        return $ case r of+            Yield a s -> Yield a (InterleaveSecondOnly s)+            Skip s -> Skip (InterleaveSecondOnly s)+            Stop -> Stop+ data ManyInterleaveState o i =       ManyInterleaveOuter o [i]     | ManyInterleaveInner o [i]     | ManyInterleaveInnerL [i] [i]     | ManyInterleaveInnerR [i] [i] --- | 'Streamly.Internal.Data.Stream.unfoldManyInterleave' for+-- | See 'Streamly.Internal.Data.Stream.unfoldEachInterleave' for -- documentation and notes. ----- This is almost identical to unfoldManyInterleave in StreamD module.------ The 'many' combinator is in fact 'manyAppend' to be more explicit in naming.--- -- /Internal/-{-# INLINE_NORMAL manyInterleave #-}-manyInterleave :: Monad m => Unfold m a b -> Unfold m c a -> Unfold m c b-manyInterleave (Unfold istep iinject) (Unfold ostep oinject) =+{-# INLINE_NORMAL unfoldEachInterleave #-}+unfoldEachInterleave, manyInterleave :: Monad m =>+    Unfold m a b -> Unfold m c a -> Unfold m c b+unfoldEachInterleave (Unfold istep iinject) (Unfold ostep oinject) =     Unfold step inject      where@@ -997,3 +1194,5 @@             Yield x s -> Yield x (ManyInterleaveInnerR (s:ls) rs)             Skip s    -> Skip (ManyInterleaveInnerR ls (s:rs))             Stop      -> Skip (ManyInterleaveInnerR ls rs)++RENAME(manyInterleave,unfoldEachInterleave)
src/Streamly/Internal/FileSystem/Dir.hs view
@@ -9,6 +9,7 @@ -- Portability : GHC  module Streamly.Internal.FileSystem.Dir+{-# DEPRECATED "Please use \"Streamly.Internal.FileSystem.DirIO\" instead." #-}     (     -- * Streams       read@@ -85,194 +86,47 @@ 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, bracketIO) import qualified Streamly.Data.Stream as S-import qualified System.Directory as Dir -import Prelude hiding (read)--{--{-# INLINABLE readArrayUpto #-}-readArrayUpto :: Int -> Handle -> IO (Array Word8)-readArrayUpto size h = do-    ptr <- mallocPlainForeignPtrBytes size-    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    withForeignPtr ptr $ \p -> do-        n <- hGetBufSome h p size-        let v = Array-                { aStart = ptr-                , arrEnd   = p `plusPtr` n-                , arrBound = p `plusPtr` size-                }-        -- XXX shrink only if the diff is significant-        shrinkToFit v------------------------------------------------------------------------------------ Stream of Arrays IO------------------------------------------------------------------------------------ | @toChunksWithBufferOf size h@ reads a stream of arrays from file handle @h@.--- The maximum size of a single array is specified by @size@. The actual size--- read may be less than or equal to @size@.-{-# INLINE _toChunksWithBufferOf #-}-_toChunksWithBufferOf :: MonadIO m => Int -> Handle -> Stream m (Array Word8)-_toChunksWithBufferOf size h = go-  where-    -- XXX use cons/nil instead-    go = mkStream $ \_ yld _ stp -> do-        arr <- liftIO $ readArrayUpto size h-        if A.length arr == 0-        then stp-        else yld arr go---- | @toChunksWithBufferOf size handle@ reads a stream of arrays from the file--- handle @handle@.  The maximum size of a single array is limited to @size@.--- The actual size read may be less than or equal to @size@.------ @since 0.7.0-{-# INLINE_NORMAL toChunksWithBufferOf #-}-toChunksWithBufferOf :: MonadIO m => Int -> Handle -> Stream m (Array Word8)-toChunksWithBufferOf size h = D.fromStreamD (D.Stream step ())-  where-    {-# INLINE_LATE step #-}-    step _ _ = do-        arr <- liftIO $ readArrayUpto size h-        return $-            case A.length arr of-                0 -> D.Stop-                _ -> D.Yield arr ()---- | Unfold the tuple @(bufsize, handle)@ into a stream of 'Word8' arrays.--- Read requests to the IO device are performed using a buffer of size--- @bufsize@.  The size of an array in the resulting stream is always less than--- or equal to @bufsize@.------ @since 0.7.0-{-# INLINE_NORMAL readChunksWithBufferOf #-}-readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)-readChunksWithBufferOf = Unfold step return-    where-    {-# INLINE_LATE step #-}-    step (size, h) = do-        arr <- liftIO $ readArrayUpto size h-        return $-            case A.length arr of-                0 -> D.Stop-                _ -> D.Yield arr (size, h)---- XXX read 'Array a' instead of Word8------ | @toChunks handle@ reads a stream of arrays from the specified file--- handle.  The maximum size of a single array is limited to--- @defaultChunkSize@. The actual size read may be less than or equal to--- @defaultChunkSize@.------ > toChunks = toChunksWithBufferOf defaultChunkSize------ @since 0.7.0-{-# INLINE toChunks #-}-toChunks :: MonadIO m => Handle -> Stream m (Array Word8)-toChunks = toChunksWithBufferOf defaultChunkSize---- | Unfolds a handle into a stream of 'Word8' arrays. Requests to the IO--- device are performed using a buffer of size--- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. The--- size of arrays in the resulting stream are therefore less than or equal to--- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.------ @since 0.7.0-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Handle (Array Word8)-readChunks = UF.first readChunksWithBufferOf defaultChunkSize------------------------------------------------------------------------------------ Read a Directory to Stream------------------------------------------------------------------------------------ TODO for concurrent streams implement readahead IO. We can send multiple--- read requests at the same time. For serial case we can use async IO. We can--- also control the read throughput in mbps or IOPS.---- | Unfolds the tuple @(bufsize, handle)@ into a byte stream, read requests--- to the IO device are performed using buffers of @bufsize@.------ @since 0.7.0-{-# INLINE readWithBufferOf #-}-readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8-readWithBufferOf = UF.many readChunksWithBufferOf A.read---- | @toStreamWithBufferOf bufsize handle@ reads a byte stream from a file--- handle, reads are performed in chunks of up to @bufsize@.------ /Pre-release/-{-# INLINE toStreamWithBufferOf #-}-toStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8-toStreamWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h--}---- read child node names from a dir filtering out . and ..------ . and .. are an implementation artifact, and should probably not be used in--- user level abstractions.------ . does not seem to have any useful purpose. If we have the path of the dir--- then we will resolve it to get the inode of the dir so the . entry would be--- redundant. If we have the inode of the dir to read the dir then it is--- redundant. Is this for cross check when doing fsck?------ For .. we have the readAncestors API, we should not have this in the--- readChildren API.---- XXX exception handling+import Streamly.Internal.FileSystem.Path (Path) -#if (defined linux_HOST_OS) || (defined darwin_HOST_OS)-{-# INLINE streamReader #-}-streamReader :: MonadIO m => Unfold m DirStream FilePath-streamReader = Unfold step return+import qualified Streamly.Internal.FileSystem.Path as Path+import qualified Streamly.Internal.FileSystem.DirIO as DirIO+import qualified Streamly.Internal.Data.Unfold as Unfold -    where+import Prelude hiding (read) -    step strm = do-        -- XXX Use readDirStreamMaybe-        file <- liftIO $ readDirStream strm-        case file of-            [] -> return Stop-            _ -> return $ Yield file strm+--------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------- -#elif defined(mingw32_HOST_OS)-openDirStream :: String -> IO (Win32.HANDLE, Win32.FindData)-openDirStream = Win32.findFirstFile+{-# INLINE ePathMap #-}+ePathMap :: Either Path Path -> Either FilePath FilePath+ePathMap (Left a) = Left (Path.toString a)+ePathMap (Right a) = Right (Path.toString a) -closeDirStream :: (Win32.HANDLE, Win32.FindData) -> IO ()-closeDirStream (h, _) = Win32.findClose h+{-# INLINE pMapUnfold #-}+pMapUnfold :: MonadCatch m => Unfold m Path Path -> Unfold m FilePath FilePath+pMapUnfold = fmap Path.toString . Unfold.lmapM Path.fromString -{-# INLINE streamReader #-}-streamReader :: MonadIO m => Unfold m (Win32.HANDLE, Win32.FindData) FilePath-streamReader = Unfold step return+{-# INLINE pMapUnfoldE #-}+pMapUnfoldE+    :: MonadCatch m+    => Unfold m Path (Either Path Path)+    -> Unfold m FilePath (Either FilePath FilePath)+pMapUnfoldE = fmap ePathMap . Unfold.lmapM Path.fromString -    where+--------------------------------------------------------------------------------+-- Functions+-------------------------------------------------------------------------------- -    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+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+#define CONF id+#else+#define CONF (DirIO.followSymlinks True) #endif  --  | Read a directory emitting a stream with names of the children. Filter out@@ -282,18 +136,7 @@ -- {-# INLINE reader #-} reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath-reader =--- 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--- can then use that info to do a general filtering. "find" like filters can be--- created.+reader = fmap Path.toString $ Unfold.lmapM Path.fromString DirIO.reader  -- | Read directories as Left and files as Right. Filter out "." and ".." -- entries.@@ -302,18 +145,12 @@ -- {-# INLINE eitherReader #-} eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)-eitherReader = UF.mapM2 classify reader+eitherReader = pMapUnfoldE (DirIO.eitherReader CONF) -    where -    classify dir x = do-        r <- liftIO $ Dir.doesDirectoryExist (dir ++ "/" ++ x)-        return $ if r then Left x else Right x- {-# INLINE eitherReaderPaths #-} eitherReaderPaths ::(MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)-eitherReaderPaths =-    UF.mapM2 (\dir -> return . bimap (dir </>) (dir </>)) eitherReader+eitherReaderPaths = pMapUnfoldE (DirIO.eitherReaderPaths CONF)  -- -- | Read files only.@@ -322,7 +159,7 @@ -- {-# INLINE fileReader #-} fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath-fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader+fileReader = pMapUnfold (DirIO.fileReader CONF)  -- | Read directories only. Filter out "." and ".." entries. --@@ -330,7 +167,7 @@ -- {-# INLINE dirReader #-} dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath-dirReader = fmap (fromLeft undefined) $ UF.filter isLeft eitherReader+dirReader = pMapUnfold (DirIO.dirReader CONF)  -- | Raw read of a directory. --@@ -388,123 +225,3 @@ {-# INLINE toDirs #-} toDirs :: (MonadIO m, MonadCatch m) => String -> Stream m String toDirs = readDirs--{------------------------------------------------------------------------------------ Writing-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Array IO (output)------------------------------------------------------------------------------------ | Write an 'Array' to a file handle.------ @since 0.7.0-{-# INLINABLE writeArray #-}-writeArray :: Storable a => Handle -> Array a -> IO ()-writeArray _ arr | A.length arr == 0 = return ()-writeArray h Array{..} = withForeignPtr aStart $ \p -> hPutBuf h p aLen-    where-    aLen =-        let p = unsafeForeignPtrToPtr aStart-        in arrEnd `minusPtr` p------------------------------------------------------------------------------------ Stream of Arrays IO-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Writing------------------------------------------------------------------------------------ | Write a stream of arrays to a handle.------ @since 0.7.0-{-# INLINE fromChunks #-}-fromChunks :: (MonadIO m, Storable a)-    => Handle -> Stream m (Array a) -> m ()-fromChunks h m = S.mapM_ (liftIO . writeArray h) m---- | @fromChunksWithBufferOf bufsize handle stream@ writes a stream of arrays--- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@.--- The chunk size is only a maximum and the actual writes could be smaller as--- we do not split the arrays to fit exactly to the specified size.------ @since 0.7.0-{-# INLINE fromChunksWithBufferOf #-}-fromChunksWithBufferOf :: (MonadIO m, Storable a)-    => Int -> Handle -> Stream m (Array a) -> m ()-fromChunksWithBufferOf n h xs = fromChunks h $ AS.compact n xs---- | @fromStreamWithBufferOf 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.------ @since 0.7.0-{-# INLINE fromStreamWithBufferOf #-}-fromStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8 -> 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------ | Write a byte stream to a file handle. Accumulates the input in chunks of--- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing.------ NOTE: This may perform better than the 'write' fold, you can try this if you--- need some extra perf boost.------ @since 0.7.0-{-# INLINE fromStream #-}-fromStream :: MonadIO m => Handle -> Stream m Word8 -> m ()-fromStream = fromStreamWithBufferOf defaultChunkSize---- | Write a stream of arrays to a handle. Each array in the stream is written--- to the device as a separate IO request.------ @since 0.7.0-{-# INLINE writeChunks #-}-writeChunks :: (MonadIO m, Storable a) => Handle -> Fold m (Array a) ()-writeChunks h = FL.drainBy (liftIO . writeArray h)---- | @writeChunksWithBufferOf bufsize handle@ writes a stream of arrays--- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@.--- We never split an array, if a single array is bigger than the specified size--- it emitted as it is. Multiple arrays are coalesed as long as the total size--- remains below the specified size.------ @since 0.7.0-{-# INLINE writeChunksWithBufferOf #-}-writeChunksWithBufferOf :: (MonadIO m, Storable a)-    => Int -> Handle -> Fold m (Array a) ()-writeChunksWithBufferOf n h = lpackArraysChunksOf n (writeChunks h)---- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes.------ XXX test this--- Note that if you use a chunk size less than 8K (GHC's default buffer--- size) then you are advised to use 'NOBuffering' mode on the 'Handle' in case you--- do not want buffering to occur at GHC level as well. Same thing applies to--- writes as well.---- | @writeWithBufferOf reqSize handle@ writes the input stream to @handle@.--- Bytes in the input stream are collected into a buffer until we have a chunk--- of @reqSize@ and then written to the IO device.------ @since 0.7.0-{-# INLINE writeWithBufferOf #-}-writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWithBufferOf n h = FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks h)---- > write = 'writeWithBufferOf' A.defaultChunkSize------ | Write a byte stream to a file handle. Accumulates the input in chunks of--- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing--- to the IO device.------ @since 0.7.0-{-# INLINE write #-}-write :: MonadIO m => Handle -> Fold m Word8 ()-write = writeWithBufferOf defaultChunkSize--}
+ src/Streamly/Internal/FileSystem/DirIO.hs view
@@ -0,0 +1,532 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.FileSystem.DirIO+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+--  API Design notes:+--+-- The paths returned by "read" can be absolute (/usr/bin/ls), relative to+-- current directory (./bin/ls) or path segments relative to current dir+-- (bin/ls). To accomodate all the cases we can provide a prefix to attach+-- to the paths being generated. Alternatively, we could take the approach+-- of the higher layer doing that, but it is more efficient to allocate the+-- path buffer once rather than modifying it later. We can do this by+-- passing a fold to transform the output.+--+-- Also it may be more efficient to apply a filter to the paths right here+-- instead of applying it in a layer above. Cut the output at the source+-- rather than generate and then discard it later. We can do this by+-- passing a fold to filter the input.+--+-- When reading a symlink directory we can resolve the symlink and read the+-- destination directory or we can just emit the file it is pointing to and+-- the read can happen next at the higher level, in the traversal logic+-- (concatIterate). Not sure if one approach has any significant perf impact+-- over the other. Similar thinking applies to a mount point as well. Also, if+-- we resolve the symlinks in concatIterate, then each resolution will be+-- counted as depth level increment whereas if we resolve that at lower level+-- then it won't. We can do this by passing an option to modify the behavior.+--+-- When resolving cyclic directory symlinks one way to curtail it is ELOOP+-- which gives up if it encounters too many level. Another way is to use+-- the inode information to check if we are traversing an already traversed+-- inode, this is in general helpful in a graph traversal. We can ignore+-- ELOOP by passing an option but it may be inefficient because we may+-- encounter the loop from any node in the cycle.+--+-- If we encounter an error reading a directory because of permission+-- issues should we ignore it in this low level API or catch it in the+-- higher level traversal functionality? Similarly, if there are broken+-- symlinks, where to handle the error? Need to check performance when+-- handling it in ListDir. Suppressing the error at the lower level may be+-- more efficient than propagating it up and then handling it there. We can+-- do this by passing an option.+--+-- Returning the metadata:+--+-- Specific scans can be used to return the metadata in the output stream if+-- needed. However, we may need three different APIs:+-- one with fast metadata, and+-- another with full metadata. In the two cases the fold input would be+-- different.+--+-- * readMinimal: read only the path names, no metadata+-- * readStandard: read the path and minimal metadata+-- * readFull: read full metadata+--+-- NOTE: Full metadata can be read by mapping a stat call to a stream of paths+-- rather than via readdir API. Does it help the performance to do it in the+-- readdir API?++-- Design pattern:+--+-- By passing a scan we can process the output right at the source and produce+-- a cooked output. Otherwise we may have to produce a stream of intermediate+-- structures which may have more per item overhead and that overhead may not+-- get eliminated by fusion. For example, a fold can directly write the CString+-- from readdir to the output buffer whereas if we output the Path then we will+-- incur an overhead of intermediate structure.++module Streamly.Internal.FileSystem.DirIO+    (+    -- XXX Create a Metadata or Meta module for stat, access, getxattr, chmod,+    -- chown, utime, rename operations.+    --+    -- * Metadata+    -- getMetadata GetMetadata (followSymlinks, noAutoMount - see fstatat)++    -- * Configuration+      module Streamly.Internal.FileSystem.DirOptions++    -- * Streams+    , read++    -- Is there a benefit in providing a low level recursive read or+    -- concatIterate is good enough? Could be more efficient for non-concurrent+    -- reads by using a local loop. Or during concurrent reads use+    -- non-concurrent reads as we go deeper down in the tree.+    -- , readAttrsRecursive++    , readFiles+    , readDirs+    , readEither+    , readEitherPaths+    , readEitherChunks++    -- We can implement this in terms of readAttrsRecursive without losing+    -- perf.+    -- , readEitherRecursive -- Options: acyclic, follow symlinks+    -- , readAncestors -- read the parent chain using the .. entry.+    -- , readAncestorsAttrs++    -- * Unfolds+    -- | Use the more convenient stream APIs instead of unfolds where possible.+    , reader+    , fileReader+    , dirReader+    , eitherReader+    , eitherReaderPaths++      {-+    , toStreamWithBufferOf++    , readChunks+    , readChunksWithBufferOf++    , toChunksWithBufferOf+    , toChunks++    , write+    , writeWithBufferOf++    -- Byte stream write (Streams)+    , fromStream+    , fromStreamWithBufferOf++    -- -- * Array Write+    , writeArray+    , writeChunks+    , writeChunksWithBufferOf++    -- -- * Array stream Write+    , fromChunks+    , fromChunksWithBufferOf+    -}+    )+where++import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Bifunctor (bimap)+import Data.Either (isRight, isLeft, fromLeft, fromRight)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.FileSystem.Path (Path)+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+import qualified Streamly.Internal.Data.Fold as Fold+import Streamly.Internal.FileSystem.Windows.ReadDir (eitherReader, reader)+#else+import Streamly.Internal.FileSystem.Posix.ReadDir+    ( readEitherChunks, eitherReader, reader)+#endif+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Data.Unfold as UF+import qualified Streamly.Internal.FileSystem.Path as Path++import Streamly.Internal.FileSystem.DirOptions+import Prelude hiding (read)++{-+{-# INLINABLE readArrayUpto #-}+readArrayUpto :: Int -> Handle -> IO (Array Word8)+readArrayUpto size h = do+    ptr <- mallocPlainForeignPtrBytes size+    -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))+    withForeignPtr ptr $ \p -> do+        n <- hGetBufSome h p size+        let v = Array+                { aStart = ptr+                , arrEnd   = p `plusPtr` n+                , arrBound = p `plusPtr` size+                }+        -- XXX shrink only if the diff is significant+        shrinkToFit v++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++-- | @toChunksWithBufferOf size h@ reads a stream of arrays from file handle @h@.+-- The maximum size of a single array is specified by @size@. The actual size+-- read may be less than or equal to @size@.+{-# INLINE _toChunksWithBufferOf #-}+_toChunksWithBufferOf :: MonadIO m => Int -> Handle -> Stream m (Array Word8)+_toChunksWithBufferOf size h = go+  where+    -- XXX use cons/nil instead+    go = mkStream $ \_ yld _ stp -> do+        arr <- liftIO $ readArrayUpto size h+        if A.length arr == 0+        then stp+        else yld arr go++-- | @toChunksWithBufferOf size handle@ reads a stream of arrays from the file+-- handle @handle@.  The maximum size of a single array is limited to @size@.+-- The actual size read may be less than or equal to @size@.+--+-- @since 0.7.0+{-# INLINE_NORMAL toChunksWithBufferOf #-}+toChunksWithBufferOf :: MonadIO m => Int -> Handle -> Stream m (Array Word8)+toChunksWithBufferOf size h = D.fromStreamD (D.Stream step ())+  where+    {-# INLINE_LATE step #-}+    step _ _ = do+        arr <- liftIO $ readArrayUpto size h+        return $+            case A.length arr of+                0 -> D.Stop+                _ -> D.Yield arr ()++-- | Unfold the tuple @(bufsize, handle)@ into a stream of 'Word8' arrays.+-- Read requests to the IO device are performed using a buffer of size+-- @bufsize@.  The size of an array in the resulting stream is always less than+-- or equal to @bufsize@.+--+-- @since 0.7.0+{-# INLINE_NORMAL readChunksWithBufferOf #-}+readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)+readChunksWithBufferOf = Unfold step return+    where+    {-# INLINE_LATE step #-}+    step (size, h) = do+        arr <- liftIO $ readArrayUpto size h+        return $+            case A.length arr of+                0 -> D.Stop+                _ -> D.Yield arr (size, h)++-- XXX read 'Array a' instead of Word8++-- | @toChunks handle@ reads a stream of arrays from the specified file+-- handle.  The maximum size of a single array is limited to+-- @defaultChunkSize@. The actual size read may be less than or equal to+-- @defaultChunkSize@.+--+-- > toChunks = toChunksWithBufferOf defaultChunkSize+--+-- @since 0.7.0+{-# INLINE toChunks #-}+toChunks :: MonadIO m => Handle -> Stream m (Array Word8)+toChunks = toChunksWithBufferOf defaultChunkSize++-- | Unfolds a handle into a stream of 'Word8' arrays. Requests to the IO+-- device are performed using a buffer of size+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. The+-- size of arrays in the resulting stream are therefore less than or equal to+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.+--+-- @since 0.7.0+{-# INLINE readChunks #-}+readChunks :: MonadIO m => Unfold m Handle (Array Word8)+readChunks = UF.first readChunksWithBufferOf defaultChunkSize++-------------------------------------------------------------------------------+-- Read a Directory to Stream+-------------------------------------------------------------------------------++-- TODO for concurrent streams implement readahead IO. We can send multiple+-- read requests at the same time. For serial case we can use async IO. We can+-- also control the read throughput in mbps or IOPS.++-- | Unfolds the tuple @(bufsize, handle)@ into a byte stream, read requests+-- to the IO device are performed using buffers of @bufsize@.+--+-- @since 0.7.0+{-# INLINE readWithBufferOf #-}+readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8+readWithBufferOf = UF.many readChunksWithBufferOf A.read++-- | @toStreamWithBufferOf bufsize handle@ reads a byte stream from a file+-- handle, reads are performed in chunks of up to @bufsize@.+--+-- /Pre-release/+{-# INLINE toStreamWithBufferOf #-}+toStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8+toStreamWithBufferOf chunkSize h = AS.concat $ toChunksWithBufferOf chunkSize h+-}++-- read child node names from a dir filtering out . and ..+--+-- . and .. are an implementation artifact, and should probably not be used in+-- user level abstractions.+--+-- . does not seem to have any useful purpose. If we have the path of the dir+-- then we will resolve it to get the inode of the dir so the . entry would be+-- redundant. If we have the inode of the dir to read the dir then it is+-- redundant. Is this for cross check when doing fsck?+--+-- For .. we have the readAncestors API, we should not have this in the+-- readChildren API.++-- XXX exception handling++-- 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+-- can then use that info to do a general filtering. "find" like filters can be+-- created.++{-# INLINE eitherReaderPaths #-}+eitherReaderPaths ::(MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Unfold m Path (Either Path Path)+eitherReaderPaths f =+    let (</>) = Path.join+     in fmap (\(dir, x) -> bimap (dir </>) (dir </>) x)+            $ UF.carry (eitherReader f)++--+-- | Read files only.+--+--  /Internal/+--+{-# INLINE fileReader #-}+fileReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Unfold m Path Path+fileReader f = fmap (fromRight undefined) $ UF.filter isRight (eitherReader f)++-- | Read directories only. Filter out "." and ".." entries.+--+--  /Internal/+--+{-# INLINE dirReader #-}+dirReader :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Unfold m Path Path+dirReader f = fmap (fromLeft undefined) $ UF.filter isLeft (eitherReader f)++-- | Raw read of a directory.+--+-- /Pre-release/+{-# INLINE read #-}+read :: (MonadIO m, MonadCatch m) =>+    Path -> Stream m Path+read = S.unfold reader++-- | Read directories as Left and files as Right. Filter out "." and ".."+-- entries. The output contains the names of the directories and files.+--+-- /Pre-release/+{-# INLINE readEither #-}+readEither :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Path -> Stream m (Either Path Path)+readEither f = S.unfold (eitherReader f)++-- | Like 'readEither' but prefix the names of the files and directories with+-- the supplied directory path.+{-# INLINE readEitherPaths #-}+readEitherPaths :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Path -> Stream m (Either Path Path)+readEitherPaths f dir =+    let (</>) = Path.join+     in fmap (bimap (dir </>) (dir </>)) $ readEither f dir++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+-- XXX Implement a custom version of readEitherChunks (like for Posix) for+-- windows as well. Also implement readEitherByteChunks.+--+-- XXX For a fast custom implementation of traversal, the Right could be the+-- final array chunk including all files and dirs to be written to IO. The Left+-- could be list of dirs to be traversed.+--+-- This is a generic (but slower?) version of readEitherChunks using+-- eitherReaderPaths.+{-# INLINE readEitherChunks #-}+readEitherChunks :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    [Path] -> Stream m (Either [Path] [Path])+readEitherChunks f dirs =+    -- XXX Need to use a take to limit the group size. There will be separate+    -- limits for dir and files groups.+     S.groupsWhile grouper collector+        $ S.unfoldEach (eitherReaderPaths f)+        $ S.fromList dirs++    where++    -- XXX We can use a refold "Either dirs files" and yield the one that fills+    -- and pass the remainder to the next Refold.+    grouper first next =+        case first of+            Left _ -> isLeft next+            Right _ -> isRight next++    collector = Fold.foldl' step (Right [])++    step b x =+        case x of+            Left x1 ->+                case b of+                    Right _ -> Left [x1] -- initial+                    _ -> either (\xs -> Left (x1:xs)) Right b+            Right x1 -> fmap (x1:) b+#endif++-- | Read files only.+--+--  /Internal/+--+{-# INLINE readFiles #-}+readFiles :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Path -> Stream m Path+readFiles f = S.unfold (fileReader f)++-- | Read directories only.+--+--  /Internal/+--+{-# INLINE readDirs #-}+readDirs :: (MonadIO m, MonadCatch m) => (ReadOptions -> ReadOptions) ->+    Path -> Stream m Path+readDirs f = S.unfold (dirReader f)++{-+-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Array IO (output)+-------------------------------------------------------------------------------++-- | Write an 'Array' to a file handle.+--+-- @since 0.7.0+{-# INLINABLE writeArray #-}+writeArray :: Storable a => Handle -> Array a -> IO ()+writeArray _ arr | A.length arr == 0 = return ()+writeArray h Array{..} = withForeignPtr aStart $ \p -> hPutBuf h p aLen+    where+    aLen =+        let p = unsafeForeignPtrToPtr aStart+        in arrEnd `minusPtr` p++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++-- | Write a stream of arrays to a handle.+--+-- @since 0.7.0+{-# INLINE fromChunks #-}+fromChunks :: (MonadIO m, Storable a)+    => Handle -> Stream m (Array a) -> m ()+fromChunks h m = S.mapM_ (liftIO . writeArray h) m++-- | @fromChunksWithBufferOf bufsize handle stream@ writes a stream of arrays+-- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@.+-- The chunk size is only a maximum and the actual writes could be smaller as+-- we do not split the arrays to fit exactly to the specified size.+--+-- @since 0.7.0+{-# INLINE fromChunksWithBufferOf #-}+fromChunksWithBufferOf :: (MonadIO m, Storable a)+    => Int -> Handle -> Stream m (Array a) -> m ()+fromChunksWithBufferOf n h xs = fromChunks h $ AS.compact n xs++-- | @fromStreamWithBufferOf 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.+--+-- @since 0.7.0+{-# INLINE fromStreamWithBufferOf #-}+fromStreamWithBufferOf :: MonadIO m => Int -> Handle -> Stream m Word8 -> 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+--+-- | Write a byte stream to a file handle. Accumulates the input in chunks of+-- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing.+--+-- NOTE: This may perform better than the 'write' fold, you can try this if you+-- need some extra perf boost.+--+-- @since 0.7.0+{-# INLINE fromStream #-}+fromStream :: MonadIO m => Handle -> Stream m Word8 -> m ()+fromStream = fromStreamWithBufferOf defaultChunkSize++-- | Write a stream of arrays to a handle. Each array in the stream is written+-- to the device as a separate IO request.+--+-- @since 0.7.0+{-# INLINE writeChunks #-}+writeChunks :: (MonadIO m, Storable a) => Handle -> Fold m (Array a) ()+writeChunks h = FL.drainBy (liftIO . writeArray h)++-- | @writeChunksWithBufferOf bufsize handle@ writes a stream of arrays+-- to @handle@ after coalescing the adjacent arrays in chunks of @bufsize@.+-- We never split an array, if a single array is bigger than the specified size+-- it emitted as it is. Multiple arrays are coalesed as long as the total size+-- remains below the specified size.+--+-- @since 0.7.0+{-# INLINE writeChunksWithBufferOf #-}+writeChunksWithBufferOf :: (MonadIO m, Storable a)+    => Int -> Handle -> Fold m (Array a) ()+writeChunksWithBufferOf n h = lpackArraysChunksOf n (writeChunks h)++-- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes.+--+-- XXX test this+-- Note that if you use a chunk size less than 8K (GHC's default buffer+-- size) then you are advised to use 'NOBuffering' mode on the 'Handle' in case you+-- do not want buffering to occur at GHC level as well. Same thing applies to+-- writes as well.++-- | @writeWithBufferOf reqSize handle@ writes the input stream to @handle@.+-- Bytes in the input stream are collected into a buffer until we have a chunk+-- of @reqSize@ and then written to the IO device.+--+-- @since 0.7.0+{-# INLINE writeWithBufferOf #-}+writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()+writeWithBufferOf n h = FL.groupsOf n (pinnedWriteNUnsafe n) (writeChunks h)++-- > write = 'writeWithBufferOf' A.defaultChunkSize+--+-- | Write a byte stream to a file handle. Accumulates the input in chunks of+-- up to 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing+-- to the IO device.+--+-- @since 0.7.0+{-# INLINE write #-}+write :: MonadIO m => Handle -> Fold m Word8 ()+write = writeWithBufferOf defaultChunkSize+-}
+ src/Streamly/Internal/FileSystem/DirOptions.hs view
@@ -0,0 +1,125 @@+-- |+-- Module      : Streamly.Internal.FileSystem.DirOptions+-- Copyright   : (c) 2024 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++module Streamly.Internal.FileSystem.DirOptions+    (+      ReadOptions (..)+    , followSymlinks+    , ignoreMissing+    , ignoreSymlinkLoops+    , ignoreInaccessible+    , defaultReadOptions+    )+where++-- NOTE: If we are following symlinks, then we want to determine the type of+-- the link destination not the link itself, so we need to use stat instead of+-- lstat for resolving the symlink.+--+-- For recursive traversal, instead of classifying the dirents using stat, we+-- can leave them unclassified, and deal with ENOTDIR when doing an opendir. We+-- can just ignore that error if it is not a dir. This way we do not need to do+-- stat at all. Or we can basically say don't try to determine the type of+-- symlinks and always try to read symlinks as dirs. We can have an option for+-- classifying symlinks or DT_UNKNOWN as potential dirs.++-- When resolving a symlink we may encounter errors only if the directory entry+-- is a symlink. If the directory entry is not a symlink then stat on it will+-- have permissions, it will not give ELOOP or ENOENT unless the file was+-- deleted or recreated after we read the dirent.++-- | Options controlling the behavior of directory read.+data ReadOptions =+    ReadOptions+    { _followSymlinks :: Bool+    , _ignoreELOOP :: Bool+    , _ignoreENOENT :: Bool+    , _ignoreEACCESS :: Bool+    }++-- | Control how symbolic links are handled when determining the type+-- of a directory entry.+--+-- * If set to 'True', symbolic links are resolved before classification.+--   This means a symlink pointing to a directory will be treated as a+--   directory, and a symlink pointing to a file will be treated as a+--   non-directory.+--+-- * If set to 'False', all symbolic links are classified as non-directories,+--   without attempting to resolve their targets.+--+-- Enabling resolution may cause additional errors to occur due to+-- insufficient permissions, broken links, or symlink loops. Such errors+-- can be ignored or handled using the appropriate options.+--+-- The default is 'False'.+--+-- On Windows this option has no effect as of now, symlinks are not followed to+-- determine the type.+followSymlinks :: Bool -> ReadOptions -> ReadOptions+followSymlinks x opts = opts {_followSymlinks = x}++-- | When the 'followSymlinks' option is enabled and a directory entry is a+-- symbolic link, we resolve it to determine the type of the symlink target.+-- This option controls the behavior when encountering symlink loop errors+-- during resolution.+--+-- When set to 'True', symlink loop errors are ignored, and the type of the+-- entry is reported as not a directory. When set to 'False', the directory+-- read operation fails with an error.+--+-- The default is 'True'.+--+-- On Windows this option has no effect as of now, symlinks are not followed to+-- determine the type.+ignoreSymlinkLoops :: Bool -> ReadOptions -> ReadOptions+ignoreSymlinkLoops x opts = opts {_ignoreELOOP = x}++-- | When the 'followSymlinks' option is enabled and a directory entry is a+-- symbolic link, we resolve it to determine the type of the symlink target.+-- This option controls the behavior when encountering broken symlink errors+-- during resolution.+--+-- When set to 'True', broken symlink errors are ignored, and the type of the+-- entry is reported as not a directory. When set to 'False', the directory+-- read operation fails with an error.+--+-- The default is 'True'.+--+-- On Windows this option has no effect as of now, symlinks are not followed to+-- determine the type.+ignoreMissing :: Bool -> ReadOptions -> ReadOptions+ignoreMissing x opts = opts {_ignoreENOENT = x}++-- | When the 'followSymlinks' option is enabled and a directory entry is a+-- symbolic link, we resolve it to determine the type of the symlink target.+-- This option controls the behavior when encountering permission errors+-- during resolution.+--+-- When set to 'True', any permission errors are ignored, and the type of the+-- entry is reported as not a directory. When set to 'False', the directory+-- read operation fails with an error.+--+-- The default is 'True'.+--+-- On Windows this option has no effect as of now, symlinks are not followed to+-- determine the type.+ignoreInaccessible :: Bool -> ReadOptions -> ReadOptions+ignoreInaccessible x opts = opts {_ignoreEACCESS = x}++-- XXX find ignores errors when following symlinks, by default.+-- NOTE: The defaultReadOptions emulates the behaviour of "find".+--+defaultReadOptions :: ReadOptions+defaultReadOptions =+    ReadOptions+    { _followSymlinks = False+    , _ignoreELOOP = True+    , _ignoreENOENT = True+    , _ignoreEACCESS = True+    }
src/Streamly/Internal/FileSystem/File.hs view
@@ -20,6 +20,7 @@ --  module Streamly.Internal.FileSystem.File+{-# DEPRECATED "Please use \"Streamly.Internal.FileSystem.FileIO\" instead." #-}     (     -- * Streaming IO     -- | Stream data to or from a file or device sequentially.  When reading,@@ -95,8 +96,10 @@  import Control.Monad.Catch (MonadCatch) import Control.Monad.IO.Class (MonadIO(..))+import Data.Kind (Type) import Data.Word (Word8)-import System.IO (Handle, openFile, IOMode(..), hClose)+import System.IO+    (Handle, IOMode(..), openFile, hClose, hSetBuffering, BufferMode(..)) import Prelude hiding (read)  import qualified Control.Monad.Catch as MC@@ -113,7 +116,7 @@ import qualified Streamly.Internal.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.Array.Type as IA (chunksOf') import qualified Streamly.Internal.Data.Unfold as UF (bracketIO) import qualified Streamly.Internal.Data.Fold.Type as FL     (Step(..), snoc, reduce)@@ -148,8 +151,15 @@ {-# INLINE withFile #-} withFile :: (MonadIO m, MonadCatch m)     => FilePath -> IOMode -> (Handle -> Stream m a) -> Stream m a-withFile file mode = S.bracketIO (openFile file mode) hClose+withFile file mode = S.bracketIO open hClose +    where++    open = do+        h <- openFile file mode+        hSetBuffering h NoBuffering+        return h+ -- | Transform an 'Unfold' from a 'Handle' to an unfold from a 'FilePath'.  The -- resulting unfold opens a handle in 'ReadMode', uses it using the supplied -- unfold and then makes sure that the handle is closed on normal termination@@ -161,8 +171,16 @@ {-# INLINE usingFile #-} usingFile :: (MonadIO m, MonadCatch m)     => Unfold m Handle a -> Unfold m FilePath a-usingFile = UF.bracketIO (`openFile` ReadMode) hClose+usingFile = UF.bracketIO open hClose +    where++    open file = do+        h <- openFile file ReadMode+        hSetBuffering h NoBuffering+        return h++ {-# INLINE usingFile2 #-} usingFile2 :: (MonadIO m, MonadCatch m)     => Unfold m (x, Handle) a -> Unfold m (x, FilePath) a@@ -172,6 +190,7 @@      before (x, file) =  do         h <- openFile file ReadMode+        hSetBuffering h NoBuffering         return (x, h)      after (_, h) = hClose h@@ -185,6 +204,7 @@      before (x, y, z, file) =  do         h <- openFile file ReadMode+        hSetBuffering h NoBuffering         return (x, y, z, h)      after (_, _, _, h) = hClose h@@ -204,7 +224,7 @@ -- /Pre-release/ -- {-# INLINABLE putChunk #-}-putChunk :: FilePath -> Array a -> IO ()+putChunk :: forall (a :: Type). FilePath -> Array a -> IO () putChunk file arr = SIO.withFile file WriteMode (`FH.putChunk` arr)  -- | append an array to a file.@@ -212,7 +232,7 @@ -- /Pre-release/ -- {-# INLINABLE writeAppendArray #-}-writeAppendArray :: FilePath -> Array a -> IO ()+writeAppendArray :: forall (a :: Type). FilePath -> Array a -> IO () writeAppendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)  -------------------------------------------------------------------------------@@ -336,7 +356,7 @@ -- /Pre-release/ {-# INLINE reader #-} reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath Word8-reader = UF.many A.reader (usingFile FH.chunkReader)+reader = UF.unfoldEach A.reader (usingFile FH.chunkReader)  -- | Generate a stream of bytes from a file specified by path. The stream ends -- when EOF is encountered. File is locked using multiple reader and single@@ -369,7 +389,7 @@ -------------------------------------------------------------------------------  {-# INLINE fromChunksMode #-}-fromChunksMode :: (MonadIO m, MonadCatch m)+fromChunksMode :: forall m (a :: Type). (MonadIO m, MonadCatch m)     => IOMode -> FilePath -> Stream m (Array a) -> m () fromChunksMode mode file xs = S.fold drain $     withFile file mode (\h -> S.mapM (FH.putChunk h) xs)@@ -379,7 +399,7 @@ -- /Pre-release/ -- {-# INLINE fromChunks #-}-fromChunks :: (MonadIO m, MonadCatch m)+fromChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)     => FilePath -> Stream m (Array a) -> m () fromChunks = fromChunksMode WriteMode @@ -400,7 +420,7 @@ {-# INLINE fromBytesWith #-} fromBytesWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Stream m Word8 -> m ()-fromBytesWith n file xs = fromChunks file $ IA.pinnedChunksOf n xs+fromBytesWith n file xs = fromChunks file $ IA.chunksOf' n xs  {-# DEPRECATED fromBytesWithBufferOf "Please use 'fromBytesWith' instead"  #-} {-# INLINE fromBytesWithBufferOf #-}@@ -431,12 +451,13 @@ -- -- /Pre-release/ {-# INLINE writeChunks #-}-writeChunks :: (MonadIO m, MonadCatch m)+writeChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)     => FilePath -> Fold m (Array a) () writeChunks path = Fold step initial extract final     where     initial = do         h <- liftIO (openFile path WriteMode)+        liftIO $ hSetBuffering h NoBuffering         fld <- FL.reduce (FH.writeChunks h)                 `MC.onException` liftIO (hClose h)         return $ FL.Partial (fld, h)@@ -462,7 +483,7 @@ writeWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Fold m Word8 () writeWith n path =-    groupsOf n (A.unsafePinnedCreateOf n) (writeChunks path)+    groupsOf n (A.unsafeCreateOf' n) (writeChunks path)  {-# DEPRECATED writeWithBufferOf "Please use 'writeWith' instead"  #-} {-# INLINE writeWithBufferOf #-}@@ -487,7 +508,7 @@ -- /Pre-release/ -- {-# INLINE writeAppendChunks #-}-writeAppendChunks :: (MonadIO m, MonadCatch m)+writeAppendChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)     => FilePath -> Stream m (Array a) -> m () writeAppendChunks = fromChunksMode AppendMode @@ -501,7 +522,7 @@ writeAppendWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Stream m Word8 -> m () writeAppendWith n file xs =-    writeAppendChunks file $ IA.pinnedChunksOf n xs+    writeAppendChunks file $ IA.chunksOf' 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
+ src/Streamly/Internal/FileSystem/File/Common.hs view
@@ -0,0 +1,97 @@+module Streamly.Internal.FileSystem.File.Common+    ( withFile+    , openFile+    ) where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import Control.Exception (mask, onException, try)+import Control.Monad (when)+import GHC.IO (catchException)+import GHC.IO.Exception (IOException(..))+import GHC.IO.Handle.Internals (handleFinalizer)+import Streamly.Internal.FileSystem.Path (Path)+import System.IO (IOMode(..), Handle, hSetBinaryMode, hClose)++import qualified Streamly.Internal.FileSystem.Path as Path++#if MIN_VERSION_base(4,16,0)+import GHC.IO.Handle.Internals (addHandleFinalizer)+#else+import Control.Concurrent.MVar (MVar, addMVarFinalizer)+import GHC.IO.Handle.Types (Handle__, Handle(..))+#endif++-------------------------------------------------------------------------------+-- Utils+-------------------------------------------------------------------------------++#if !(MIN_VERSION_base(4,16,0))+type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()++-- | Add a finalizer to a 'Handle'. Specifically, the finalizer+-- will be added to the 'MVar' of a file handle or the write-side+-- 'MVar' of a duplex handle. See Handle Finalizers for details.+addHandleFinalizer :: Handle -> HandleFinalizer -> IO ()+addHandleFinalizer handle finalizer = do+  addMVarFinalizer mv (finalizer filepath mv)+  where+    !(filepath, !mv) = case handle of+      FileHandle fp m -> (fp, m)+      DuplexHandle fp _ write_m -> (fp, write_m)+#endif++{-# INLINE withOpenFile #-}+withOpenFile+    :: Bool+    -> Bool+    -> (Path -> IOMode -> IO Handle)+    -> Path+    -> IOMode+    -> (Handle -> IO r)+    -> IO r+withOpenFile binary close_finally f fp iomode action =+    mask $ \restore -> do+        h <- f fp iomode+        -- XXX In case of withFile it will be closed anyway, so do we even need+        -- this?+        addHandleFinalizer h handleFinalizer+        when binary $ hSetBinaryMode h True+        r <- restore (action h) `onException` hClose h+        when close_finally $ hClose h+        pure r++addFilePathToIOError :: String -> Path -> IOException -> IOException+addFilePathToIOError fun fp ioe =+  let !str = Path.toString fp+   in ioe+        { ioe_location = fun+        , ioe_filename = Just str+        }++{-# INLINE catchWith #-}+catchWith :: String -> Path -> IO a -> IO a+catchWith str path io =+    catchException io (ioError . addFilePathToIOError str path)++{-# INLINE withFile #-}+withFile ::+    Bool+    -> (Path -> IOMode -> IO Handle)+    -> Path+    -> IOMode+    -> (Handle -> IO r)+    -> IO r+withFile binary f path iomode act =+     catchWith "withFile" path+        (withOpenFile binary True f path iomode (try . act))+      >>= either ioError pure++{-# INLINE openFile #-}+openFile ::+    Bool -> (Path -> IOMode -> IO Handle) -> Path -> IOMode -> IO Handle+openFile binary f path iomode =+    catchWith "openFile" path+        $ withOpenFile binary False f path iomode pure
+ src/Streamly/Internal/FileSystem/FileIO.hs view
@@ -0,0 +1,643 @@+-- |+-- Module      : Streamly.Internal.FileSystem.FileIO+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--++module Streamly.Internal.FileSystem.FileIO+    (+    -- * Streaming IO+    -- | Stream data to or from a file or device sequentially.  When reading,+    -- the stream is lazy and generated on-demand as the consumer consumes it.+    -- Read IO requests to the IO device are performed in chunks limited to a+    -- maximum size of 32KiB, this is referred to as @defaultChunkSize@ in the+    -- documentation. One IO request may or may not read the full+    -- chunk. If the whole stream is not consumed, it is possible that we may+    -- read slightly more from the IO device than what the consumer needed.+    -- Unless specified otherwise in the API, writes are collected into chunks+    -- of @defaultChunkSize@ before they are written to the IO device.++    -- Streaming APIs work for all kind of devices, seekable or non-seekable;+    -- including disks, files, memory devices, terminals, pipes, sockets and+    -- fifos. While random access APIs work only for files or devices that have+    -- random access or seek capability for example disks, memory devices.+    -- Devices like terminals, pipes, sockets and fifos do not have random+    -- access capability.++    -- ** File IO Using Handle+      withFile++    -- ** Streams+    , read+    , readChunksWith+    , readChunks++    -- ** Unfolds+    , readerWith+    , reader+    -- , readShared+    -- , readUtf8+    -- , readLines+    -- , readFrames+    , chunkReaderWith+    , chunkReaderFromToWith+    , chunkReader++    -- ** Write To File+    , putChunk -- writeChunk?++    -- ** Folds+    , write+    -- , writeUtf8+    -- , writeUtf8ByLines+    -- , writeByFrames+    , writeWith+    , writeChunks++    -- ** Writing Streams+    , fromBytes -- XXX putBytes?+    , fromBytesWith -- putBytesWith+    , fromChunks -- putChunks?++    -- ** Append To File+    , writeAppend+    , writeAppendWith+    -- , appendShared+    , writeAppendArray+    , writeAppendChunks+    )+where++import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Word (Word8)+import System.IO (Handle, IOMode(..), hClose, hSetBuffering, BufferMode(..))+import Prelude hiding (read)++import qualified Control.Monad.Catch as MC++import Streamly.Data.Fold (groupsOf, drain)+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+-- import Streamly.String (encodeUtf8, decodeUtf8, foldLines)+import Streamly.Internal.System.IO (defaultChunkSize)+import Streamly.Internal.FileSystem.Path (Path)++import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Data.Stream as S+import qualified Streamly.Data.Unfold as UF+import qualified Streamly.Internal.Data.Unfold as UF (bracketIO)+import qualified Streamly.Internal.Data.Fold.Type as FL+    (Step(..), snoc, reduce)+import qualified Streamly.Internal.FileSystem.Handle as FH+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import qualified Streamly.Internal.FileSystem.Posix.File as File+#else+import qualified Streamly.Internal.FileSystem.Windows.File as File+#endif++#include "inline.hs"++-------------------------------------------------------------------------------+-- References+-------------------------------------------------------------------------------+--+-- The following references may be useful to build an understanding about the+-- file API design:+--+-- http://www.linux-mag.com/id/308/ for blocking/non-blocking IO on linux.+-- https://lwn.net/Articles/612483/ Non-blocking buffered file read operations+-- https://en.wikipedia.org/wiki/C_file_input/output for C APIs.+-- https://docs.oracle.com/javase/tutorial/essential/io/file.html for Java API.+-- https://www.w3.org/TR/FileAPI/ for http file API.++-------------------------------------------------------------------------------+-- Safe file reading+-------------------------------------------------------------------------------++-- | @'withFile' name mode act@ opens a file and passes the resulting handle to+-- the computation @act@. The handle is closed on exit from 'withFile', whether+-- by normal termination or by raising an exception.  If closing the handle+-- raises an exception, then that exception is raised by 'withFile' rather than+-- any exception raised by 'act'.+--+-- The file is opened in binary mode as encoding, decoding, and newline+-- translation can be handled explicitly by the streaming APIs.+--+-- The file is opened without buffering as buffering can be controlled+-- explicitly by the streaming APIs.+--+-- /Pre-release/+--+{-# INLINE withFile #-}+withFile :: (MonadIO m, MonadCatch m)+    => Path -> IOMode -> (Handle -> Stream m a) -> Stream m a+withFile file mode = S.bracketIO open hClose++    where++    open = do+        h <- File.openBinaryFile file mode+        hSetBuffering h NoBuffering+        return h++-- | Transform an 'Unfold' that takes 'Handle' as input to an unfold that takes+-- a 'Path' as input.  The resulting unfold opens the file in 'ReadMode',+-- passes it to the supplied unfold and then makes sure that the handle is+-- closed on normal termination or in case of an exception.  If closing the+-- handle raises an exception, then this exception will be raised by+-- 'usingFile'.+--+-- The file is opened in binary mode as encoding, decoding, and newline+-- translation can be handled explicitly by the streaming APIs.+--+-- The file is opened without buffering as buffering can be controlled+-- explicitly by the streaming APIs.+--+-- /Pre-release/+--+{-# INLINE usingFile #-}+usingFile :: (MonadIO m, MonadCatch m)+    => Unfold m Handle a -> Unfold m Path a+usingFile = UF.bracketIO open hClose++    where++    open file = do+        h <- File.openBinaryFile file ReadMode+        hSetBuffering h NoBuffering+        return h++{-# INLINE usingFile2 #-}+usingFile2 :: (MonadIO m, MonadCatch m)+    => Unfold m (x, Handle) a -> Unfold m (x, Path) a+usingFile2 = UF.bracketIO before after++    where++    before (x, file) =  do+        h <- File.openBinaryFile file ReadMode+        hSetBuffering h NoBuffering+        return (x, h)++    after (_, h) = hClose h++{-# INLINE usingFile3 #-}+usingFile3 :: (MonadIO m, MonadCatch m)+    => Unfold m (x, y, z, Handle) a -> Unfold m (x, y, z, Path) a+usingFile3 = UF.bracketIO before after++    where++    before (x, y, z, file) =  do+        h <- File.openBinaryFile file ReadMode+        hSetBuffering h NoBuffering+        return (x, y, z, h)++    after (_, _, _, h) = hClose h++-------------------------------------------------------------------------------+-- Array IO (Input)+-------------------------------------------------------------------------------++-- TODO readArrayOf++-------------------------------------------------------------------------------+-- Array IO (output)+-------------------------------------------------------------------------------++-- | Write an array to a file. Overwrites the file if it exists.+--+-- /Pre-release/+--+{-# INLINABLE putChunk #-}+putChunk :: Path -> Array a -> IO ()+putChunk file arr = File.withFile file WriteMode (`FH.putChunk` arr)++-- | Append an array to a file.+--+-- /Pre-release/+--+{-# INLINABLE writeAppendArray #-}+writeAppendArray :: Path -> Array a -> IO ()+writeAppendArray file arr = File.withFile file AppendMode (`FH.putChunk` arr)++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++-- | @readChunksWith size file@ reads a stream of arrays from file @file@.+-- The maximum size of a single array is specified by @size@. The actual size+-- read may be less than or equal to @size@.+--+-- /Pre-release/+--+{-# INLINE readChunksWith #-}+readChunksWith :: (MonadIO m, MonadCatch m)+    => Int -> Path -> Stream m (Array Word8)+readChunksWith size file =+    withFile file ReadMode (FH.readChunksWith size)++-- XXX read 'Array a' instead of Word8+--+-- | @readChunks file@ reads a stream of arrays from file @file@.+-- The maximum size of a single array is limited to @defaultChunkSize@. The+-- actual size read may be less than @defaultChunkSize@.+--+-- > readChunks = readChunksWith defaultChunkSize+--+-- /Pre-release/+--+{-# INLINE readChunks #-}+readChunks :: (MonadIO m, MonadCatch m)+    => Path -> Stream m (Array Word8)+readChunks = readChunksWith defaultChunkSize++-------------------------------------------------------------------------------+-- Read File to Stream+-------------------------------------------------------------------------------++-- TODO for concurrent streams implement readahead IO. We can send multiple+-- read requests at the same time. For serial case we can use async IO. We can+-- also control the read throughput in mbps or IOPS.++-- | Unfold the tuple @(bufsize, filepath)@ into a stream of 'Word8' arrays.+-- Read requests to the IO device are performed using a buffer of size+-- @bufsize@. The size of an array in the resulting stream is always less than+-- or equal to @bufsize@.+--+-- /Pre-release/+--+{-# INLINE chunkReaderWith #-}+chunkReaderWith :: (MonadIO m, MonadCatch m)+    => Unfold m (Int, Path) (Array Word8)+chunkReaderWith = usingFile2 FH.chunkReaderWith++-- | Unfold the tuple @(from, to, bufsize, filepath)@ into a stream+-- of 'Word8' arrays.+-- Read requests to the IO device are performed using a buffer of size+-- @bufsize@ starting from absolute offset of @from@ till the absolute+-- position of @to@. The size of an array in the resulting stream is always+-- less than or equal to @bufsize@.+--+-- /Pre-release/+{-# INLINE chunkReaderFromToWith #-}+chunkReaderFromToWith :: (MonadIO m, MonadCatch m) =>+    Unfold m (Int, Int, Int, Path) (Array Word8)+chunkReaderFromToWith = usingFile3 FH.chunkReaderFromToWith++-- | Unfolds a 'Path' into a stream of 'Word8' arrays. Requests to the IO+-- device are performed using a buffer of size+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. The+-- size of arrays in the resulting stream are therefore less than or equal to+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.+--+-- /Pre-release/+{-# INLINE chunkReader #-}+chunkReader :: (MonadIO m, MonadCatch m) => Unfold m Path (Array Word8)+chunkReader = usingFile FH.chunkReader++-- | Unfolds the tuple @(bufsize, filepath)@ into a byte stream, read requests+-- to the IO device are performed using buffers of @bufsize@.+--+-- /Pre-release/+{-# INLINE readerWith #-}+readerWith :: (MonadIO m, MonadCatch m) => Unfold m (Int, Path) Word8+readerWith = usingFile2 FH.readerWith++-- | Unfolds a file path into a byte stream. IO requests to the device are+-- performed in sizes of+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'.+--+-- /Pre-release/+{-# INLINE reader #-}+reader :: (MonadIO m, MonadCatch m) => Unfold m Path Word8+reader = UF.unfoldEach A.reader (usingFile FH.chunkReader)++-- | Generate a stream of bytes from a file specified by path. The stream ends+-- when EOF is encountered. File is locked using multiple reader and single+-- writer locking mode.+--+-- /Pre-release/+--+{-# INLINE read #-}+read :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8+read file = A.concat $ withFile file ReadMode FH.readChunks++{-+-- | Generate a stream of elements of the given type from a file 'Handle'. The+-- stream ends when EOF is encountered. File is not locked for exclusive reads,+-- writers can keep writing to the file.+--+-- @since 0.7.0+{-# INLINE readShared #-}+readShared :: MonadIO m => Handle -> Stream m Word8+readShared = undefined+-}++-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++{-# INLINE fromChunksMode #-}+fromChunksMode :: (MonadIO m, MonadCatch m)+    => IOMode -> Path -> Stream m (Array a) -> m ()+fromChunksMode mode file xs = S.fold drain $+    withFile file mode (\h -> S.mapM (FH.putChunk h) xs)++-- | Write a stream of arrays to a file. Overwrites the file if it exists.+--+-- /Pre-release/+--+{-# INLINE fromChunks #-}+fromChunks :: (MonadIO m, MonadCatch m)+    => Path -> Stream m (Array a) -> m ()+fromChunks = fromChunksMode WriteMode++-- GHC buffer size dEFAULT_FD_BUFFER_SIZE=8192 bytes.+--+-- XXX test this+-- Note that if you use a chunk size less than 8K (GHC's default buffer+-- size) then you are advised to use 'NOBuffering' mode on the 'Handle' in case you+-- do not want buffering to occur at GHC level as well. Same thing applies to+-- writes as well.++-- | Like 'write' but provides control over the write buffer. Output will+-- be written to the IO device as soon as we collect the specified number of+-- input elements.+--+-- /Pre-release/+--+{-# INLINE fromBytesWith #-}+fromBytesWith :: (MonadIO m, MonadCatch m)+    => Int -> Path -> Stream m Word8 -> m ()+fromBytesWith n file xs = fromChunks file $ A.chunksOf' n xs++-- > write = 'writeWith' defaultChunkSize+--+-- | Write a byte stream to a file. Combines the bytes in chunks of size+-- up to 'A.defaultChunkSize' before writing. If the file exists it is+-- truncated to zero size before writing. If the file does not exist it is+-- created. File is locked using single writer locking mode.+--+-- /Pre-release/+{-# INLINE fromBytes #-}+fromBytes :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8 -> m ()+fromBytes = fromBytesWith defaultChunkSize++{-+{-# INLINE write #-}+write :: (MonadIO m, Storable a) => Handle -> Stream m a -> m ()+write = toHandleWith A.defaultChunkSize+-}++-- | Write a stream of chunks to a file. Each chunk in the stream is written+-- immediately to the device as a separate IO request, without coalescing or+-- buffering.+--+{-# INLINE writeChunks #-}+writeChunks :: (MonadIO m, MonadCatch m)+    => Path -> Fold m (Array a) ()+writeChunks path = Fold step initial extract final+    where+    initial = do+        h <- liftIO (File.openBinaryFile path WriteMode)+        liftIO $ hSetBuffering h NoBuffering+        fld <- FL.reduce (FH.writeChunks h)+                `MC.onException` liftIO (hClose h)+        return $ FL.Partial (fld, h)+    step (fld, h) x = do+        r <- FL.snoc fld x `MC.onException` liftIO (hClose h)+        return $ FL.Partial (r, h)++    extract _ = return ()++    final (Fold _ initial1 _ final1, h) = do+        liftIO $ hClose h+        res <- initial1+        case res of+            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+-- of size @chunkSize@ and then written to the IO device.+--+-- /Pre-release/+{-# INLINE writeWith #-}+writeWith :: (MonadIO m, MonadCatch m)+    => Int -> Path -> Fold m Word8 ()+writeWith n path =+    groupsOf n (A.unsafeCreateOf' n) (writeChunks path)++-- > write = 'writeWith' A.defaultChunkSize+--+-- | Write a byte stream to a file. Accumulates the input in chunks of up to+-- 'Streamly.Internal.Data.Array.Type.defaultChunkSize' before writing to+-- the IO device.+--+-- /Pre-release/+--+{-# INLINE write #-}+write :: (MonadIO m, MonadCatch m) => Path -> Fold m Word8 ()+write = writeWith defaultChunkSize++-- | Append a stream of arrays to a file.+--+-- /Pre-release/+--+{-# INLINE writeAppendChunks #-}+writeAppendChunks :: (MonadIO m, MonadCatch m)+    => Path -> Stream m (Array a) -> m ()+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+-- input elements.+--+-- /Pre-release/+--+{-# INLINE writeAppendWith #-}+writeAppendWith :: (MonadIO m, MonadCatch m)+    => Int -> Path -> Stream m Word8 -> m ()+writeAppendWith n file xs =+    writeAppendChunks file $ A.chunksOf' 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+-- is appended to the file.  If the file does not exist it is created. File is+-- locked using single writer locking mode.+--+-- /Pre-release/+--+{-# INLINE writeAppend #-}+writeAppend :: (MonadIO m, MonadCatch m) => Path -> Stream m Word8 -> m ()+writeAppend = writeAppendWith defaultChunkSize++{-+-- | Like 'append' but the file is not locked for exclusive writes.+--+-- @since 0.7.0+{-# INLINE appendShared #-}+appendShared :: MonadIO m => Handle -> Stream m Word8 -> m ()+appendShared = undefined+-}++-------------------------------------------------------------------------------+-- IO with encoding/decoding Unicode characters+-------------------------------------------------------------------------------++{-+-- |+-- > readUtf8 = decodeUtf8 . read+--+-- Read a UTF8 encoded stream of unicode characters from a file handle.+--+-- @since 0.7.0+{-# INLINE readUtf8 #-}+readUtf8 :: MonadIO m => Handle -> Stream m Char+readUtf8 = decodeUtf8 . read++-- |+-- > writeUtf8 h s = write h $ encodeUtf8 s+--+-- Encode a stream of unicode characters to UTF8 and write it to the given file+-- handle. Default block buffering applies to the writes.+--+-- @since 0.7.0+{-# INLINE writeUtf8 #-}+writeUtf8 :: MonadIO m => Handle -> Stream m Char -> m ()+writeUtf8 h s = write h $ encodeUtf8 s++-- | Write a stream of unicode characters after encoding to UTF-8 in chunks+-- separated by a linefeed character @'\n'@. If the size of the buffer exceeds+-- @defaultChunkSize@ and a linefeed is not yet found, the buffer is written+-- anyway.  This is similar to writing to a 'Handle' with the 'LineBuffering'+-- option.+--+-- @since 0.7.0+{-# INLINE writeUtf8ByLines #-}+writeUtf8ByLines :: MonadIO m => Handle -> Stream m Char -> m ()+writeUtf8ByLines = undefined++-- | Read UTF-8 lines from a file handle and apply the specified fold to each+-- line. This is similar to reading a 'Handle' with the 'LineBuffering' option.+--+-- @since 0.7.0+{-# INLINE readLines #-}+readLines :: MonadIO m => Handle -> Fold m Char b -> Stream m b+readLines h f = foldLines (readUtf8 h) f++-------------------------------------------------------------------------------+-- Framing on a sequence+-------------------------------------------------------------------------------++-- | Read a stream from a file handle and split it into frames delimited by+-- the specified sequence of elements. The supplied fold is applied on each+-- frame.+--+-- @since 0.7.0+{-# INLINE readFrames #-}+readFrames :: (MonadIO m, Storable a)+    => Array a -> Handle -> Fold m a b -> Stream m b+readFrames = undefined -- foldFrames . read++-- | Write a stream to the given file handle buffering up to frames separated+-- by the given sequence or up to a maximum of @defaultChunkSize@.+--+-- @since 0.7.0+{-# INLINE writeByFrames #-}+writeByFrames :: (MonadIO m, Storable a)+    => Array a -> Handle -> Stream m a -> m ()+writeByFrames = undefined++-------------------------------------------------------------------------------+-- Random Access IO (Seek)+-------------------------------------------------------------------------------++-- XXX handles could be shared, so we may not want to use the handle state at+-- all for these APIs. we can use pread and pwrite instead. On windows we will+-- need to use readFile/writeFile with an offset argument.++-------------------------------------------------------------------------------++-- | Read the element at the given index treating the file as an array.+--+-- @since 0.7.0+{-# INLINE readIndex #-}+readIndex :: Storable a => Handle -> Int -> Maybe a+readIndex arr i = undefined++-- NOTE: To represent a range to read we have chosen (start, size) instead of+-- (start, end). This helps in removing the ambiguity of whether "end" is+-- included in the range or not.+--+-- We could avoid specifying the range to be read and instead use "take size"+-- on the stream, but it may end up reading more and then consume it partially.++-- | @readSliceWith chunkSize handle pos len@ reads up to @len@ bytes+-- from @handle@ starting at the offset @pos@ from the beginning of the file.+--+-- Reads are performed in chunks of size @chunkSize@.  For block devices, to+-- avoid reading partial blocks @chunkSize@ must align with the block size of+-- the underlying device. If the underlying block size is unknown, it is a good+-- idea to keep it a multiple 4KiB. This API ensures that the start of each+-- chunk is aligned with @chunkSize@ from second chunk onwards.+--+{-# INLINE readSliceWith #-}+readSliceWith :: (MonadIO m, Storable a)+    => Int -> Handle -> Int -> Int -> Stream m a+readSliceWith chunkSize h pos len = undefined++-- | @readSlice h i count@ streams a slice from the file handle @h@ starting+-- at index @i@ and reading up to @count@ elements in the forward direction+-- ending at the index @i + count - 1@.+--+-- @since 0.7.0+{-# INLINE readSlice #-}+readSlice :: (MonadIO m, Storable a)+    => Handle -> Int -> Int -> Stream m a+readSlice = readSliceWith defaultChunkSize++-- | @readSliceRev h i count@ streams a slice from the file handle @h@ starting+-- at index @i@ and reading up to @count@ elements in the reverse direction+-- ending at the index @i - count + 1@.+--+-- @since 0.7.0+{-# INLINE readSliceRev #-}+readSliceRev :: (MonadIO m, Storable a)+    => Handle -> Int -> Int -> Stream m a+readSliceRev h i count = undefined++-- | Write the given element at the given index in the file.+--+-- @since 0.7.0+{-# INLINE writeIndex #-}+writeIndex :: (MonadIO m, Storable a) => Handle -> Int -> a -> m ()+writeIndex h i a = undefined++-- | @writeSlice h i count stream@ writes a stream to the file handle @h@+-- starting at index @i@ and writing up to @count@ elements in the forward+-- direction ending at the index @i + count - 1@.+--+-- @since 0.7.0+{-# INLINE writeSlice #-}+writeSlice :: (Monad m, Storable a)+    => Handle -> Int -> Int -> Stream m a -> m ()+writeSlice h i len s = undefined++-- | @writeSliceRev h i count stream@ writes a stream to the file handle @h@+-- starting at index @i@ and writing up to @count@ elements in the reverse+-- direction ending at the index @i - count + 1@.+--+-- @since 0.7.0+{-# INLINE writeSliceRev #-}+writeSliceRev :: (Monad m, Storable a)+    => Handle -> Int -> Int -> Stream m a -> m ()+writeSliceRev arr i len s = undefined+-}
src/Streamly/Internal/FileSystem/Handle.hs view
@@ -121,6 +121,7 @@ import Control.Exception (assert) import Control.Monad.IO.Class (MonadIO(..)) import Data.Function ((&))+import Data.Kind (Type) import Data.Maybe (isNothing, fromJust) import Data.Word (Word8) import Streamly.Internal.Data.Unbox (Unbox)@@ -177,15 +178,10 @@ {-# INLINABLE getChunk #-} getChunk :: MonadIO m => Int -> Handle -> m (Array Word8) getChunk size h = liftIO $ do-    arr :: MArray.MutArray Word8 <- MArray.pinnedEmptyOf size     -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    -- Since the array is pinned (pinnedEmptyOf) we can safely use unsafeAsPtr-    MArray.unsafeAsPtr arr $ \p -> do-        n <- hGetBufSome h p size-        -- XXX shrink only if the diff is significant-        return $-            unsafeFreezeWithShrink $-            arr { MArray.arrEnd = n, MArray.arrBound = size }+    arr <- MArray.unsafeCreateWithPtr' size $ \p -> hGetBufSome h p size+    -- XXX shrink only if the diff is significant+    pure $ unsafeFreezeWithShrink arr  -- This could be useful in implementing the "reverse" read APIs or if you want -- to read arrays of exact size instead of compacting them later. Compacting@@ -325,11 +321,11 @@ -- | Unfolds the tuple @(bufsize, handle)@ into a byte stream, read requests -- to the IO device are performed using buffers of @bufsize@. ----- >>> readerWith = Unfold.many Array.reader Handle.chunkReaderWith+-- >>> readerWith = Unfold.unfoldEach Array.reader Handle.chunkReaderWith -- {-# INLINE readerWith #-} readerWith :: MonadIO m => Unfold m (Int, Handle) Word8-readerWith = UF.many A.reader chunkReaderWith+readerWith = UF.unfoldEach A.reader chunkReaderWith  -- | Same as 'readerWith' --@@ -341,7 +337,7 @@ -- | @readWith bufsize handle@ reads a byte stream from a file -- handle, reads are performed in chunks of up to @bufsize@. ----- >>> readWith size h = Stream.unfoldMany Array.reader $ Handle.readChunksWith size h+-- >>> readWith size h = Stream.unfoldEach Array.reader $ Handle.readChunksWith size h -- -- /Pre-release/ {-# INLINE readWith #-}@@ -352,15 +348,15 @@ -- performed in sizes of -- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. ----- >>> reader = Unfold.many Array.reader Handle.chunkReader+-- >>> reader = Unfold.unfoldEach Array.reader Handle.chunkReader -- {-# INLINE reader #-} reader :: MonadIO m => Unfold m Handle Word8-reader = UF.many A.reader chunkReader+reader = UF.unfoldEach A.reader chunkReader  -- | Generate a byte stream from a file 'Handle'. ----- >>> read h = Stream.unfoldMany Array.reader $ Handle.readChunks h+-- >>> read h = Stream.unfoldEach Array.reader $ Handle.readChunks h -- -- /Pre-release/ {-# INLINE read #-}@@ -378,15 +374,10 @@ -- | Write an 'Array' to a file handle. -- {-# INLINABLE putChunk #-}-putChunk :: MonadIO m => Handle -> Array a -> m ()+putChunk :: forall m (a :: Type). MonadIO m => Handle -> Array a -> m () putChunk _ arr | byteLength arr == 0 = return ()-putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr ->-    liftIO $ hPutBuf h ptr aLen--    where--    -- XXX We should have the length passed by unsafePinnedAsPtr itself.-    aLen = A.byteLength arr+putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr byteLen ->+    liftIO $ hPutBuf h ptr byteLen  ------------------------------------------------------------------------------- -- Stream of Arrays IO@@ -402,7 +393,8 @@ -- >>> putChunks h = Stream.fold (Fold.drainBy (Handle.putChunk h)) -- {-# INLINE putChunks #-}-putChunks :: MonadIO m => Handle -> Stream m (Array a) -> m ()+putChunks :: forall m (a :: Type). MonadIO m =>+    Handle -> Stream m (Array a) -> m () putChunks h = S.fold (FL.drainMapM (putChunk h))  -- XXX AS.compact can be written idiomatically in terms of foldMany, just like@@ -417,7 +409,7 @@ {-# INLINE putChunksWith #-} putChunksWith :: (MonadIO m, Unbox a)     => Int -> Handle -> Stream m (Array a) -> m ()-putChunksWith n h xs = putChunks h $ A.compactLE n xs+putChunksWith n h xs = putChunks h $ A.compactMax n xs  -- > putBytesWith n h m = Handle.putChunks h $ A.pinnedChunksOf n m @@ -427,7 +419,7 @@ -- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()-putBytesWith n h m = putChunks h $ A.pinnedChunksOf n m+putBytesWith n h m = putChunks h $ A.chunksOf' 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.@@ -447,14 +439,14 @@ -- writeChunks h = Fold.drainBy (Handle.putChunk h) -- {-# INLINE writeChunks #-}-writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()+writeChunks :: forall m (a :: Type). MonadIO m => Handle -> Fold m (Array a) () writeChunks h = FL.drainMapM (putChunk h)  -- | Like writeChunks but uses the experimental 'Refold' API. -- -- /Internal/ {-# INLINE chunkWriter #-}-chunkWriter :: MonadIO m => Refold m Handle (Array a) ()+chunkWriter :: forall m (a :: Type). MonadIO m => Refold m Handle (Array a) () chunkWriter = Refold.drainBy putChunk  -- | @writeChunksWith bufsize handle@ writes a stream of arrays@@ -466,7 +458,10 @@ {-# INLINE writeChunksWith #-} writeChunksWith :: (MonadIO m, Unbox a)     => Int -> Handle -> Fold m (Array a) ()-writeChunksWith n h = A.lCompactGE n (writeChunks h)+-- writeChunksWith n h = A.lCompactGE n (writeChunks h)+writeChunksWith n h =+   FL.postscanl (A.scanCompactMin n)+    $ FL.catMaybes (writeChunks h)  -- | Same as 'writeChunksWith' --@@ -484,7 +479,7 @@ -- do not want buffering to occur at GHC level as well. Same thing applies to -- writes as well. --- XXX Maybe we should have a Fold.chunksOf like we have Stream.chunksOf+-- XXX Maybe we should have a Fold.chunksOf like we have Array.chunksOf  -- | @writeWith reqSize handle@ writes the input stream to @handle@. -- Bytes in the input stream are collected into a buffer until we have a chunk@@ -494,7 +489,7 @@ -- {-# INLINE writeWith #-} writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWith n h = FL.groupsOf n (A.unsafePinnedCreateOf n) (writeChunks h)+writeWith n h = FL.groupsOf n (A.unsafeCreateOf' n) (writeChunks h)  -- | Same as 'writeWith' --@@ -512,7 +507,7 @@ writeMaybesWith :: (MonadIO m )     => Int -> Handle -> Fold m (Maybe Word8) () writeMaybesWith n h =-    let writeNJusts = FL.lmap fromJust $ A.pinnedCreateOf n+    let writeNJusts = FL.lmap fromJust $ A.createOf' n         writeOnNothing = FL.takeEndBy_ isNothing writeNJusts     in FL.many writeOnNothing (writeChunks h) @@ -522,7 +517,7 @@ {-# INLINE writerWith #-} writerWith :: MonadIO m => Int -> Refold m Handle Word8 () writerWith n =-    FL.refoldMany (FL.take n $ A.unsafePinnedCreateOf n) chunkWriter+    FL.refoldMany (FL.take n $ A.unsafeCreateOf' 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/FileSystem/Path.hs view
@@ -1,5 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}-+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.FileSystem.Path -- Copyright   : (c) 2023 Composewell Technologies@@ -7,509 +6,124 @@ -- Maintainer  : streamly@composewell.com -- Portability : GHC ----- Well typed and flexible file systems paths, preserving the OS and filesystem--- encoding.+-- == References ----- You can choose the level of type safety you want. 'Path' is the basic path--- type which can represent a file, directory, absolute or relative path with--- no restrictions. Depending on how much type safety you want you can choose--- appropriate type wrappers to wrap 'Path'. @File Path@ mandates the path to--- be a file whereas @Abs (File Path)@ mandates it to be an absolute path--- representing a file.+--  * https://en.wikipedia.org/wiki/Path_(computing)+--  * https://learn.microsoft.com/en-us/windows/win32/fileio/naming-a-file+--  * https://learn.microsoft.com/en-us/openspecs/windows_protocols/ms-dtyp/62e862f4-2a51-452e-8eeb-dc4ff5ee33cc ----- You can upgrade or downgrade the safety. Whenever a less restrictive path--- type is converted to a more restrctive path type the conversion involves--- checks and it may fail. However, a more restrictive path type can be freely--- converted to a less restrictive one.+-- == Windows and Posix Paths ----- See the @streamly-filepath@ package for interworking with the 'OsPath' type.--- The 'Path' type can be  converted to and from 'OsPath' type at zero cost--- since the underlying representation of both is the same.---- Conventions: A trailing separator on a path indicates that it is a directory.--- However, the absence of a trailing separator does not convey any--- information, it could either be a directory or a file.---- You may also find the 'str' quasiquoter from "Streamly.Unicode.String" to be--- useful in creating paths.+-- We should be able to manipulate windows paths on posix and posix paths on+-- windows as well. Therefore, we have WindowsPath and PosixPath types which+-- are supported on both platforms. However, the Path module aliases Path to+-- WindowsPath on Windows and PosixPath on Posix. ---module Streamly.Internal.FileSystem.Path-    (-    -- * Path Types-      Path (..)-    , File-    , Dir-    , Abs-    , Rel--    -- * Conversions-    , IsPath (..)-    , adaptPath--    -- * Construction-    , fromChunk-    , fromChunkUnsafe-    , fromString-    , fromChars--    -- * Statically Verified Literals-    -- quasiquoters-    , path-    , abs-    , rel-    , dir-    , file-    , absdir-    , reldir-    , absfile-    , relfile--    -- * Statically Verified Strings-    -- TH macros-    , mkPath-    , mkAbs-    , mkRel-    , mkDir-    , mkFile-    , mkAbsDir-    , mkRelDir-    , mkAbsFile-    , mkRelFile--    -- * Elimination-    , toChunk-    , toString-    , toChars--    -- * Operations-    -- Do we need to export the separator functions? They are not essential if-    -- operations to split and combine paths are provided. If someone wants to-    -- work on paths at low level then they know what they are.-    , primarySeparator-    , isSeparator-    , extendPath-    , extendDir-    )-where--import Control.Exception (Exception)-import Control.Monad.Catch (MonadThrow(..))-import Data.Char (chr)-import Data.Functor.Identity (Identity(..))-import Data.Word (Word8)-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-import Data.Word (Word16)-#endif-import Language.Haskell.TH (Q, Exp)-import Language.Haskell.TH.Quote (QuasiQuoter)-import Streamly.Internal.Data.Array (Array)-import Streamly.Internal.Data.Stream (Stream)-import System.IO.Unsafe (unsafePerformIO)--import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.MutArray as MutArray-import qualified Streamly.Internal.Data.Stream as Stream-import qualified Streamly.Internal.Unicode.Stream as Unicode--import Prelude hiding (abs)--#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-#define WORD_TYPE Word16-#define SEPARATOR 92-#else-#define WORD_TYPE Word8-#define SEPARATOR 47-#endif----------------------------------------------------------------------------------- Exceptions----------------------------------------------------------------------------------- | Exceptions thrown by path operations.-data PathException =-    InvalidPath String-  | InvalidAbsPath String-  | InvalidRelPath String-  | InvalidFilePath String-  | InvalidDirPath String-    deriving (Show,Eq)--instance Exception PathException---- XXX Path must not contain null char on Posix. System calls consider the path--- as null terminated.--- XXX Maintain the Array with null termination because Unix system calls--- require a null terminated string, also they return null terminated strings--- as paths. Implementation of path append will have to handle the null--- termination. Or we can choose to always copy the array when using it in--- system calls.---- XXX The eq instance needs to make sure that the paths are equivalent. If we--- normalize the paths we can do a byte comparison. However, on windows paths--- are case insensitive but the case is preserved, therefore, we cannot--- normalize and need to do case insensitive comparison.----------------------------------------------------------------------------------- Types----------------------------------------------------------------------------------- | A type representing file system paths for directories or files.-newtype Path = Path (Array WORD_TYPE) -- deriving Eq---- Show instance prints raw bytes without any decoding for rountdtripping.--- Should we print this as a string instead, may be useful for ascii chars but--- utf8 encoded chars may be unprintable. Better use toString if you want to--- pretty print the path.-{--instance Show Path where-    show (Path x) = show x--}---- XXX Do we need a type for file or dir Name as names cannot have the--- separator char and there may be other restrictions on names? For example,--- length restriction.  A file name cannot be "." or "..". We can use the types--- "File Name" and "Dir Name" to represent names. Also, file systems may put--- limits on names. Can have an IsName type class with members Name, (File--- Name), (Dir Name).---- | A type representing a file path.-newtype File a = File a---- | A type representing a directory path.-newtype Dir a = Dir a---- | A type representing absolute paths.-newtype Abs a = Abs a---- | A type representing relative paths.-newtype Rel a = Rel a----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- | A member of 'IsPath' knows how to convert to and from the 'Path' type.-class IsPath a where-    -- | Like 'fromPath' but does not check the properties of 'Path'. Provides-    -- performance and simplicity when we know that the properties of the path-    -- are already verified, for example, when we get the path from the file-    -- system or the OS APIs.-    fromPathUnsafe :: Path -> a--    -- | Convert a raw 'Path' to other forms of well-typed paths. It may fail-    -- if the path does not satisfy the properties of the target type.-    ---    -- Path components may have limits.-    -- Total path length may have a limit.-    fromPath :: MonadThrow m => Path -> m a--    -- | Convert a well-typed path to a raw 'Path'. Never fails.-    toPath :: a -> Path--instance IsPath Path where-    fromPathUnsafe = id-    fromPath = pure-    toPath = id--instance IsPath (File Path) where-    fromPathUnsafe p = File p-    fromPath p = pure (File p)-    toPath (File p) = p--instance IsPath (Dir Path) where-    fromPathUnsafe p = Dir p-    fromPath p = pure (Dir p)-    toPath (Dir p) = p--instance IsPath (Abs Path) where-    fromPathUnsafe p = Abs p-    fromPath p = pure (Abs p)-    toPath (Abs p) = p--instance IsPath (Rel Path) where-    fromPathUnsafe p = Rel p-    fromPath p = pure (Rel p)-    toPath (Rel p) = p--instance IsPath (Abs (File Path)) where-    fromPathUnsafe p = Abs (File p)-    fromPath p = pure (Abs (File p))-    toPath (Abs (File p)) = p--instance IsPath (Abs (Dir Path)) where-    fromPathUnsafe p = Abs (Dir p)-    fromPath p = pure (Abs (Dir p))-    toPath (Abs (Dir p)) = p--instance IsPath (Rel (File Path)) where-    fromPathUnsafe p = Rel (File p)-    fromPath p = pure (Rel (File p))-    toPath (Rel (File p)) = p--instance IsPath (Rel (Dir Path)) where-    fromPathUnsafe p = Rel (Dir p)-    fromPath p = pure (Rel (Dir p))-    toPath (Rel (Dir p)) = p---- XXX Use rewrite rules to eliminate intermediate conversions for better--- efficiency.---- | Convert a path type to another path type. This operation may fail with a--- 'PathException' when converting a less restrictive path type to a more--- restrictive one.-adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b-adaptPath p = fromPath $ toPath p----------------------------------------------------------------------------------- Construction----------------------------------------------------------------------------------- A chunk is essentially an untyped Array i.e. Array Word8.  We can either use--- the term ByteArray for that or just Chunk. The latter is shorter and we have--- been using it consistently in streamly.---- | /Unsafe/: On Posix, a path cannot contain null characters. On Windows, the--- array passed must be a multiple of 2 bytes as the underlying representation--- uses 'Word16'.-{-# INLINE fromChunkUnsafe #-}-fromChunkUnsafe :: Array Word8 -> Path-fromChunkUnsafe arr = Path (Array.castUnsafe arr)---- | On Posix it may fail if the byte array contains null characters. On--- Windows the array passed must be a multiple of 2 bytes as the underlying--- representation uses 'Word16'.+-- == File System as Tree vs Graph ----- Throws 'InvalidPath'.-fromChunk :: MonadThrow m => Array Word8 -> m Path-fromChunk arr =-    case Array.cast arr of-        Nothing ->-            -- XXX Windows only message.-            throwM-                $ InvalidPath-                $ "Encoded path length " ++ show (Array.byteLength arr)-                    ++ " is not a multiple of 16-bit."-        Just x -> pure (Path x)---- | Convert 'Path' to an array of bytes.-toChunk :: Path -> Array Word8-toChunk (Path arr) = Array.asBytes arr---- | Encode a Unicode char stream to 'Path' using strict UTF-8 encoding on--- Posix. On Posix it may fail if the stream contains null characters.--- TBD: Use UTF16LE on Windows.-fromChars :: MonadThrow m => Stream Identity Char -> m Path-fromChars s =-    let n = runIdentity $ Stream.fold Fold.length s-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-     in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf16le' s))-#else-     in pure $ Path (Array.fromPureStreamN n (Unicode.encodeUtf8' s))-#endif---- | Decode the path to a stream of Unicode chars using strict UTF-8 decoding--- on Posix.--- TBD: Use UTF16LE on Windows.-toChars :: Monad m => Path -> Stream m Char-toChars (Path arr) =-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)-    Unicode.decodeUtf16le' $ Array.read arr-#else-    Unicode.decodeUtf8' $ Array.read arr-#endif---- | Encode a Unicode string to 'Path' using strict UTF-8 encoding on Posix.--- On Posix it may fail if the stream contains null characters.--- TBD: Use UTF16LE on Windows.-fromString :: MonadThrow m => [Char] -> m Path-fromString = fromChars . Stream.fromList---- | Decode the path to a Unicode string using strict UTF-8 decoding on Posix.--- TBD: Use UTF16LE on Windows.-toString :: Path -> [Char]-toString = runIdentity . Stream.toList . toChars----------------------------------------------------------------------------------- Statically Verified Literals----------------------------------------------------------------------------------- XXX Build these on top of the str quasiquoter so that we get the--- interpolation for free.---- | Generates a 'Path' type from an interpolated string literal.+-- A file system is a tree when there are no hard links or symbolic links. But+-- in the presence of symlinks it could be a DAG or a graph, because directory+-- symlinks can create cycles. ----- /Unimplemented/-path :: QuasiQuoter-path = undefined---- | Generates an @Abs Path@ type from an interpolated string literal.+-- == Rooted and Branch paths ----- /Unimplemented/-abs :: QuasiQuoter-abs = undefined---- | Generates an @Rel Path@ type from an interpolated string literal.+-- We make two distinctions for paths, a path may a specific filesystem root+-- attached to it or it may be a free branch without a root attached. ----- /Unimplemented/-rel :: QuasiQuoter-rel = undefined---- | Generates an @Dir Path@ type from an interpolated string literal.+-- A path that has a root attached to it is called a rooted path e.g. /usr is a+-- rooted path, . is a rooted path, ./bin is a rooted path. A rooted path could+-- be absolute e.g. /usr or it could be relative e.g. ./bin . A rooted path+-- always has two components, a specific "root" which could be explicit or+-- implicit, and a path segment relative to the root. A rooted path with a+-- fixed root is known as an absolute path whereas a rooted path with an+-- implicit root e.g. "./bin" is known as a relative path. ----- /Unimplemented/-dir :: QuasiQuoter-dir = undefined---- | Generates an @File Path@ type from an interpolated string literal.+-- A path that does not have a root attached but defines steps to go from some+-- place to another is a path branch. For example, "local/bin" is a path branch+-- whereas "./local/bin" is a rooted path. ----- /Unimplemented/-file :: QuasiQuoter-file = undefined---- | Generates an @Abs (Dir Path)@ type from an interpolated string literal.+-- Rooted paths can never be appended to any other path whereas a branch can be+-- appended. ----- /Unimplemented/-absdir :: QuasiQuoter-absdir = undefined---- | Generates an @Rel (Dir Path)@ type from an interpolated string literal.+-- == Comparing Paths ----- /Unimplemented/-reldir :: QuasiQuoter-reldir = undefined---- | Generates an @Abs (File Path)@ type from an interpolated string literal.+-- We can compare two absolute rooted paths or path branches but we cannot+-- compare two relative rooted paths. If each component of the path is the same+-- then the paths are considered to be equal. ----- /Unimplemented/-absfile :: QuasiQuoter-absfile = undefined---- | Generates an @Rel (File Path)@ type from an interpolated string literal.+-- == Implicit Roots (.) ----- /Unimplemented/-relfile :: QuasiQuoter-relfile = undefined----------------------------------------------------------------------------------- Statically Verified Strings----------------------------------------------------------------------------------- | Generates a 'Path' type.+-- On Posix and Windows "." implicitly refers to the current directory. On+-- Windows a path like @/Users/@ has the drive reference implicit. Such+-- references are contextual and may have different meanings at different+-- times. ----- /Unimplemented/-mkPath :: String -> Q Exp-mkPath = undefined---- | Generates an @Abs Path@ type.+-- @./bin@ may refer to a different location depending on what "." is+-- referring to. Thus we should not allow @./bin@ to be appended to another+-- path, @bin@ can be appended though. Similarly, we cannot compare @./bin@+-- with @./bin@ and say that they are equal because they may be referring to+-- different locations depending on in what context the paths were created. ----- /Unimplemented/-mkAbs :: String -> Q Exp-mkAbs = undefined---- | Generates an @Rel Path@ type.+-- The same arguments apply to paths with implicit drive on Windows. ----- /Unimplemented/-mkRel :: String -> Q Exp-mkRel = undefined---- | Generates an @Dir Path@ type.+-- We can treat @.\/bin\/ls@ as an absolute path with "." as an implicit root.+-- The relative path is "bin/ls" which represents steps from somewhere to+-- somewhere else rather than a particular location. We can also call @./bin@+-- as a "rooted path" as it starts from particular location rather than+-- defining "steps" to go from one place to another. If we want to append such+-- paths we need to first make them explicitly relative by dropping the+-- implicit root. Or we can use unsafeAppend to force it anyway or unsafeCast+-- to convert absolute to relative. ----- /Unimplemented/-mkDir :: String -> Q Exp-mkDir = undefined---- | Generates an @File Path@ type.+-- On these absolute (Rooted) paths if we use takeRoot, it should return+-- RootCurDir, RootCurDrive and @Root Path@ to distinguish @./@, @/@, @C:/@. We+-- could represent them by different types but that would make the types even+-- more complicated. So runtime checks are are a good balance. ----- /Unimplemented/-mkFile :: String -> Q Exp-mkFile = undefined---- | Generates an @Abs (Dir Path)@ type.+-- Path comparison should return EqTrue, EqFalse or EqUnknown. If we compare+-- these absolute/located paths having implicit roots then result should be+-- EqUnknown or maybe we can just return False?. @./bin@ and @./bin@ should be+-- treated as paths with different roots/drives but same relative path. The+-- programmer can explicitly drop the root and compare the relative paths if+-- they want to check literal equality. ----- /Unimplemented/-mkAbsDir :: String -> Q Exp-mkAbsDir = undefined---- | Generates an @Rel (Dir Path)@ type.+-- Note that a trailing . or a . in the middle of a path is different as it+-- refers to a known name. ----- /Unimplemented/-mkRelDir :: String -> Q Exp-mkRelDir = undefined---- | Generates an @Abs (File Path)@ type.+-- == Ambiguous References (..) ----- /Unimplemented/-mkAbsFile :: String -> Q Exp-mkAbsFile = undefined---- | Generates an @Rel (File Path)@ type.+-- ".." in a path refers to the parent directory relative to the current path.+-- For an absolute root directory ".." refers to the root itself because you+-- cannot go further up. ----- /Unimplemented/-mkRelFile :: String -> Q Exp-mkRelFile = undefined----------------------------------------------------------------------------------- Operations---------------------------------------------------------------------------------separatorWord :: WORD_TYPE-separatorWord = SEPARATOR---- Portable definition for exporting.+-- When resolving ".." it always resolves to the parent of a directory as+-- stored in the directory entry. So if we landed in a directory via a symlink,+-- ".." can take us back to a different directory and not to the symlink+-- itself. Thus @a\/b/..@ may not be the same as @a/@. Shells like bash keep+-- track of the old paths explicitly, so you may not see this behavior when+-- using a shell.+--+-- For this reason we cannot process ".." in the path statically. However, if+-- the components of two paths are exactly the same then they will always+-- resolve to the same target. But two paths with different components could+-- also point to the same target. So if there are ".." in the path we cannot+-- definitively say if they are the same without resolving them.+--+-- == Exception Handling+--+-- Path creation routines use MonadThrow which can be interpreted as an Either+-- type. It is rare to actually handle exceptions in path creation functions,+-- we would rather fix the issue, so partial functions should also be fine. But+-- there may be some cases where we are parsing paths from external inputs,+-- reading from a file etc where we may want to handle exceptions. We can+-- always create partial wrappers from these if that is convenient to use.+-- --- | Primary path separator character, @/@ on Posix and @\\@ on Windows.--- Windows supports @/@ too as a separator. Please use 'isSeparator' for--- testing if a char is a separator char.-primarySeparator :: Char-primarySeparator = chr (SEPARATOR)+#define IS_PORTABLE --- | On Posix only @/@ is a path separator but in windows it could be either--- @/@ or @\\@.-isSeparator :: Char -> Bool #if defined(mingw32_HOST_OS) || defined(__MINGW32__)-isSeparator c = (c == '/') || (c == '\\')+#define IS_WINDOWS+#include "Streamly/Internal/FileSystem/WindowsPath.hs" #else-isSeparator = (== '/')+#include "Streamly/Internal/FileSystem/PosixPath.hs" #endif---- If we append an absolute path it may fail with an error if the 'Path'--- implementation stores absolute path information (a leading separator char).--- However, the implementation may choose to store the path as a list of--- components in which case we cannot distinguish an absolute path from--- relative.---- | Like 'extendDir' but for the less restrictive 'Path' type which will always--- create a syntactically valid 'Path' type but it may not be semantically valid--- because we may append an absolute path or we may append to a file path.--- The onus lies on the user to ensure that the first path is not a file and--- the second path is not absolute.-extendPath :: Path -> Path -> Path-extendPath (Path a) (Path b) =-    let len = Array.byteLength a + 1 + Array.byteLength b-        -- XXX Check the leading separator or drive identifier. However,-        -- checking the drive letter may add an additional overhead (can it be-        -- arbitrarily long?), if it is significant we may want to have a-        -- separate combinePathChecked API for that.-        ---        -- Also, do not add a separator char if the first path has a trailing-        -- separator.-        newArr = unsafePerformIO $ do-            arr <- MutArray.new len-            arr1 <- MutArray.spliceUnsafe arr (Array.unsafeThaw a)-            arr2 <- MutArray.snocUnsafe arr1 separatorWord-            arr3 <- MutArray.spliceUnsafe arr2 (Array.unsafeThaw b)-            return (Array.unsafeFreeze arr3)-        in Path newArr---- The only safety we need for paths is: (1) The first path can only be a Dir--- type path, and (2) second path can only be a Rel path.--- Can this be coerced to create unsafe versions?---- | Extend a directory path by appending a relative path to it. This is the--- equivalent to the @</>@ operator from the @filepath@ package.-{-# INLINE extendDir #-}-extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) =>-    (a (Dir Path)) -> Rel b -> a b-extendDir a (Rel b) =-    fromPathUnsafe $ extendPath (toPath a) (toPath b)
+ src/Streamly/Internal/FileSystem/Path/Common.hs view
@@ -0,0 +1,1561 @@+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module      : Streamly.Internal.FileSystem.Path.Common+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+module Streamly.Internal.FileSystem.Path.Common+    (+    -- * Types+      OS (..)++    -- * Validation+    , validatePath+    , validatePath'+    , validateFile++    -- * Construction+    , fromArray+    , unsafeFromArray+    , fromChars+    , unsafeFromChars++    -- * Quasiquoters+    , mkQ++    -- * Elimination+    , toString+    , toChars++    -- * Separators+    , primarySeparator+    , isSeparator+    , isSeparatorWord+    , dropTrailingSeparators+    , dropTrailingBy+    , hasTrailingSeparator+    , hasLeadingSeparator++    -- * Tests+    , isBranch+    , isRooted+    , isAbsolute+ -- , isRelative -- not isAbsolute+    , isRootRelative -- XXX hasRelativeRoot+    , isRelativeWithDrive -- XXX hasRelativeDriveRoot+    , hasDrive++    -- * Joining+    , append+    , append'+    , unsafeAppend+    , appendCString+    , appendCString'+    , unsafeJoinPaths+ -- , joinRoot -- XXX append should be enough++    -- * Splitting++    -- Note: splitting the search path does not belong here, it is shell aware+    -- operation. search path is separated by : and : is allowed in paths on+    -- posix. Shell would escape it which needs to be handled.++    , splitRoot+ -- , dropRoot+ -- , dropRelRoot -- if relative then dropRoot+    , splitHead+    , splitTail+    , splitPath+    , splitPath_++    -- * Dir and File+    , splitFile+    , splitDir++    -- * Extensions+    , extensionWord+    , splitExtension+    , splitExtensionBy+ -- , addExtension++    -- * Equality+ -- , processParentRefs+    , normalizeSeparators+ -- , normalize -- separators and /./ components (split/combine)+    , eqPathBytes+    , EqCfg(..)+    , eqPath+ -- , commonPrefix -- common prefix of two paths+ -- , eqPrefix -- common prefix is equal to first path+ -- , dropPrefix++    -- * Utilities+    , wordToChar+    , charToWord+    , unsafeIndexChar++    -- * Internal+    , unsafeSplitTopLevel+    , unsafeSplitDrive+    , unsafeSplitUNC+    , splitCompact+    , splitWithFilter+    )+where++#include "assert.hs"++import Control.Monad (when)+import Control.Monad.Catch (MonadThrow(..))+import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (chr, ord, isAlpha, toUpper)+import Data.Function ((&))+import Data.Functor.Identity (Identity(..))+import Data.Word (Word8, Word16)+import Foreign (castPtr)+import Foreign.C (CString, CSize(..))+import GHC.Base (unsafeChr, Addr#)+import GHC.Ptr (Ptr(..))+import Language.Haskell.TH (Q, Exp)+import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Internal.Data.MutArray (MutArray)+import Streamly.Internal.Data.MutByteArray (Unbox(..))+import Streamly.Internal.Data.Path (PathException(..))+import Streamly.Internal.Data.Stream (Stream)+import System.IO.Unsafe (unsafePerformIO)++import qualified Data.List as List+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Fold as Fold+import qualified Streamly.Internal.Data.MutArray as MutArray+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Unicode.Stream as Unicode++{- $setup+>>> :m++>>> import Data.Functor.Identity (runIdentity)+>>> import System.IO.Unsafe (unsafePerformIO)+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Unicode.Stream as Unicode+>>> import qualified Streamly.Internal.Data.Array as Array+>>> import qualified Streamly.Internal.FileSystem.Path.Common as Common+>>> import qualified Streamly.Internal.Unicode.Stream as Unicode+>>> import Streamly.Internal.FileSystem.Path (ignoreTrailingSeparators, allowRelativeEquality, ignoreCase)++>>> packPosix = unsafePerformIO . Stream.fold Array.create . Unicode.encodeUtf8' . Stream.fromList+>>> unpackPosix = runIdentity . Stream.toList . Unicode.decodeUtf8' . Array.read++>>> packWindows = unsafePerformIO . Stream.fold Array.create . Unicode.encodeUtf16le' . Stream.fromList+>>> unpackWindows = runIdentity . Stream.toList . Unicode.decodeUtf16le' . Array.read+-}++data OS = Windows | Posix deriving Eq++------------------------------------------------------------------------------+-- Parsing Operations+------------------------------------------------------------------------------++-- XXX We can use Enum type class to include the Char type as well so that the+-- functions can work on Array Word8/Word16/Char but that may be slow.++-- XXX Windows is supported only on little endian machines so generally we do+-- not need covnersion from LE to BE format unless we want to manipulate+-- windows paths on big-endian machines.++-- | Unsafe, may tructate to shorter word types, can only be used safely for+-- characters that fit in the given word size.+charToWord :: Integral a => Char -> a+charToWord c =+    let n = ord c+     in assert (n <= 255) (fromIntegral n)++-- | Unsafe, should be a valid character.+wordToChar :: Integral a => a -> Char+wordToChar = unsafeChr . fromIntegral++------------------------------------------------------------------------------+-- Array utils+------------------------------------------------------------------------------++-- | Index a word in an array and convert it to Char.+unsafeIndexChar :: (Unbox a, Integral a) => Int -> Array a -> Char+unsafeIndexChar i a = wordToChar (Array.unsafeGetIndex i a)++-- XXX put this in array module, we can have Array.fold and Array.foldM+foldArr :: Unbox a => Fold.Fold Identity a b -> Array a -> b+foldArr f arr = runIdentity $ Array.foldM f arr++{-# INLINE countLeadingBy #-}+countLeadingBy :: Unbox a => (a -> Bool) -> Array a -> Int+countLeadingBy p = foldArr (Fold.takeEndBy_ (not . p) Fold.length)++countTrailingBy :: Unbox a => (a -> Bool) -> Array a -> Int+countTrailingBy p = Array.foldRev (Fold.takeEndBy_ (not . p) Fold.length)++------------------------------------------------------------------------------+-- Separator parsing+------------------------------------------------------------------------------++extensionWord :: Integral a => a+extensionWord = charToWord '.'++posixSeparator :: Char+posixSeparator = '/'++windowsSeparator :: Char+windowsSeparator = '\\'++-- | Primary path separator character, @/@ on Posix and @\\@ on Windows.+-- Windows supports @/@ too as a separator. Please use 'isSeparator' for+-- testing if a char is a separator char.+{-# INLINE primarySeparator #-}+primarySeparator :: OS -> Char+primarySeparator Posix = posixSeparator+primarySeparator Windows = windowsSeparator++-- | On Posix only @/@ is a path separator but in windows it could be either+-- @/@ or @\\@.+{-# INLINE isSeparator #-}+isSeparator :: OS -> Char -> Bool+isSeparator Posix c = c == posixSeparator+isSeparator Windows c = (c == windowsSeparator) || (c == posixSeparator)++{-# INLINE isSeparatorWord #-}+isSeparatorWord :: Integral a => OS -> a -> Bool+isSeparatorWord os = isSeparator os . wordToChar++------------------------------------------------------------------------------+-- Separator normalization+------------------------------------------------------------------------------++-- | If the path is @//@ the result is @/@. If it is @a//@ then the result is+-- @a@. On Windows "c:" and "c:/" are different paths, therefore, we do not+-- drop the trailing separator from "c:/" or for that matter a separator+-- preceded by a ':'.+--+-- Can't use any arbitrary predicate "p", the logic in this depends on assuming+-- that it is a path separator.+{-# INLINE dropTrailingBy #-}+dropTrailingBy :: (Unbox a, Integral a) =>+    OS -> (a -> Bool) -> Array a -> Array a+dropTrailingBy os p arr =+    let len = Array.length arr+        n = countTrailingBy p arr+        arr1 = fst $ Array.unsafeBreakAt (len - n) arr+     in if n == 0+        then arr+        else if n == len -- "////"+        then+            -- Even though "//" is not allowed as a valid path.+            -- We still handle that case in this low level function.+            if os == Windows+                && n >= 2+                && Array.unsafeGetIndex 0 arr == Array.unsafeGetIndex 1 arr+            then fst $ Array.unsafeBreakAt 2 arr -- make it "//" share name+            else fst $ Array.unsafeBreakAt 1 arr+        -- "c:////" - keep one "/" after colon in ".*:///" otherwise it will+        -- change the meaning. "c:/" may also appear, in the middle e.g.+        -- in UNC paths.+        else if (os == Windows)+                && (Array.unsafeGetIndex (len - n - 1) arr == charToWord ':')+        then fst $ Array.unsafeBreakAt (len - n + 1) arr+        else arr1++-- XXX we cannot compact "//" to "/" on windows+{-# INLINE compactTrailingBy #-}+compactTrailingBy :: Unbox a => (a -> Bool) -> Array a -> Array a+compactTrailingBy p arr =+    let len = Array.length arr+        n = countTrailingBy p arr+     in if n <= 1+        then arr+        else fst $ Array.unsafeBreakAt (len - n + 1) arr++{-# INLINE dropTrailingSeparators #-}+dropTrailingSeparators :: (Unbox a, Integral a) => OS -> Array a -> Array a+dropTrailingSeparators os =+    dropTrailingBy os (isSeparator os . wordToChar)++-- | A path starting with a separator.+hasLeadingSeparator :: (Unbox a, Integral a) => OS -> Array a -> Bool+hasLeadingSeparator os a+    | Array.null a = False -- empty path should not occur+    | isSeparatorWord os (Array.unsafeGetIndex 0 a) = True+    | otherwise = False++{-# INLINE hasTrailingSeparator #-}+hasTrailingSeparator :: (Integral a, Unbox a) => OS -> Array a -> Bool+hasTrailingSeparator os path =+    let e = Array.getIndexRev 0 path+     in case e of+            Nothing -> False+            Just x -> isSeparatorWord os x++{-# INLINE toDefaultSeparator #-}+toDefaultSeparator :: Integral a => a -> a+toDefaultSeparator x =+    if isSeparatorWord Windows x+    then charToWord (primarySeparator Windows)+    else x++-- | Change all separators in the path to default separator on windows.+{-# INLINE normalizeSeparators #-}+normalizeSeparators :: (Integral a, Unbox a) => Array a -> Array a+normalizeSeparators a =+    -- XXX We can check and return the original array if no change is needed.+    Array.fromPureStreamN (Array.length a)+        $ fmap toDefaultSeparator+        $ Array.read a++------------------------------------------------------------------------------+-- Windows drive parsing+------------------------------------------------------------------------------++-- | @C:...@, does not check array length.+{-# INLINE unsafeHasDrive #-}+unsafeHasDrive :: (Unbox a, Integral a) => Array a -> Bool+unsafeHasDrive a+    -- Check colon first for quicker return+    | unsafeIndexChar 1 a /= ':' = False+    -- XXX If we found a colon anyway this cannot be a valid path unless it has+    -- a drive prefix. colon is not a valid path character.+    -- XXX check isAlpha perf+    | not (isAlpha (unsafeIndexChar 0 a)) = False+    | otherwise = True++-- | A path that starts with a alphabet followed by a colon e.g. @C:...@.+hasDrive :: (Unbox a, Integral a) => Array a -> Bool+hasDrive a = Array.length a >= 2 && unsafeHasDrive a++-- | A path that contains only an alphabet followed by a colon e.g. @C:@.+isDrive :: (Unbox a, Integral a) => Array a -> Bool+isDrive a = Array.length a == 2 && unsafeHasDrive a++------------------------------------------------------------------------------+-- Relative or Absolute+------------------------------------------------------------------------------++-- | A path relative to cur dir it is either @.@ or starts with @./@.+isRelativeCurDir :: (Unbox a, Integral a) => OS -> Array a -> Bool+isRelativeCurDir os a+    | len == 0 = False -- empty path should not occur+    | wordToChar (Array.unsafeGetIndex 0 a) /= '.' = False+    | len < 2 = True+    | otherwise = isSeparatorWord os (Array.unsafeGetIndex 1 a)++    where++    len = Array.length a++-- | A non-UNC path starting with a separator.+-- Note that "\\/share/x" is treated as "C:/share/x".+isRelativeCurDriveRoot :: (Unbox a, Integral a) => Array a -> Bool+isRelativeCurDriveRoot a+    | len == 0 = False -- empty path should not occur+    | len == 1 && sep0 = True+    | sep0 && c0 /= c1 = True -- "\\/share/x" is treated as "C:/share/x".+    | otherwise = False++    where++    len = Array.length a+    c0 = Array.unsafeGetIndex 0 a+    c1 = Array.unsafeGetIndex 1 a+    sep0 = isSeparatorWord Windows c0++-- | @C:@ or @C:a...@.+isRelativeWithDrive :: (Unbox a, Integral a) => Array a -> Bool+isRelativeWithDrive a =+    hasDrive a+        && (  Array.length a < 3+           || not (isSeparator Windows (unsafeIndexChar 2 a))+           )++isRootRelative :: (Unbox a, Integral a) => OS -> Array a -> Bool+isRootRelative Posix a = isRelativeCurDir Posix a+isRootRelative Windows a =+    isRelativeCurDir Windows a+        || isRelativeCurDriveRoot a+        || isRelativeWithDrive a++-- | @C:\...@. Note that "C:" or "C:a" is not absolute.+isAbsoluteWithDrive :: (Unbox a, Integral a) => Array a -> Bool+isAbsoluteWithDrive a =+    Array.length a >= 3+        && unsafeHasDrive a+        && isSeparator Windows (unsafeIndexChar 2 a)++-- | @\\\\...@ or @//...@+isAbsoluteUNC :: (Unbox a, Integral a) => Array a -> Bool+isAbsoluteUNC a+    | Array.length a < 2 = False+    | isSeparatorWord Windows c0 && c0 == c1 = True+    | otherwise = False++    where++    c0 = Array.unsafeGetIndex 0 a+    c1 = Array.unsafeGetIndex 1 a++-- XXX rename to isRootAbsolute++-- | Note that on Windows a path starting with a separator is relative to+-- current drive while on Posix this is absolute path as there is only one+-- drive.+isAbsolute :: (Unbox a, Integral a) => OS -> Array a -> Bool+isAbsolute Posix arr =+    hasLeadingSeparator Posix arr+isAbsolute Windows arr =+    isAbsoluteWithDrive arr || isAbsoluteUNC arr++------------------------------------------------------------------------------+-- Location or Segment+------------------------------------------------------------------------------++-- XXX API for static processing of .. (normalizeParentRefs)+--+-- Note: paths starting with . or .. are ambiguous and can be considered+-- segments or rooted. We consider a path starting with "." as rooted, when+-- someone uses "./x" they explicitly mean x in the current directory whereas+-- just "x" can be taken to mean a path segment without any specific root.+-- However, in typed paths the programmer can convey the meaning whether they+-- mean it as a segment or a rooted path. So even "./x" can potentially be used+-- as a segment which can just mean "x".+--+-- XXX For the untyped Path we can allow appending "./x" to other paths. We can+-- leave this to the programmer. In typed paths we can allow "./x" in segments.+-- XXX Empty path can be taken to mean "." except in case of UNC paths++isRooted :: (Unbox a, Integral a) => OS -> Array a -> Bool+isRooted Posix a =+    hasLeadingSeparator Posix a+        || isRelativeCurDir Posix a+isRooted Windows a =+    hasLeadingSeparator Windows a+        || isRelativeCurDir Windows a+        || hasDrive a -- curdir-in-drive relative, drive absolute++isBranch :: (Unbox a, Integral a) => OS -> Array a -> Bool+isBranch os = not . isRooted os++------------------------------------------------------------------------------+-- Split root+------------------------------------------------------------------------------++unsafeSplitPrefix :: (Unbox a, Integral a) =>+    OS -> Int -> Array a -> (Array a, Array a)+unsafeSplitPrefix os prefixLen arr =+    Array.unsafeBreakAt cnt arr++    where++    afterDrive = snd $ Array.unsafeBreakAt prefixLen arr+    n = countLeadingBy (isSeparatorWord os) afterDrive+    cnt = prefixLen + n++-- Note: We can have normalized splitting functions to normalize as we split+-- for efficiency. But then we will have to allocate new arrays instead of+-- slicing which can make it inefficient.++-- | Split a path prefixed with a separator into (drive, path) tuple.+--+-- >>> toListPosix (a,b) = (unpackPosix a, unpackPosix b)+-- >>> splitPosix = toListPosix . Common.unsafeSplitTopLevel Common.Posix . packPosix+--+-- >>> toListWin (a,b) = (unpackWindows a, unpackWindows b)+-- >>> splitWin = toListWin . Common.unsafeSplitTopLevel Common.Windows . packWindows+--+-- >>> splitPosix "/"+-- ("/","")+--+-- >>> splitPosix "//"+-- ("//","")+--+-- >>> splitPosix "/home"+-- ("/","home")+--+-- >>> splitPosix "/home/user"+-- ("/","home/user")+--+-- >>> splitWin "\\"+-- ("\\","")+--+-- >>> splitWin "\\home"+-- ("\\","home")+unsafeSplitTopLevel :: (Unbox a, Integral a) =>+    OS -> Array a -> (Array a, Array a)+-- Note on Windows we should be here only when the path starts with exactly one+-- separator, otherwise it would be UNC path. But on posix multiple separators+-- are valid.+unsafeSplitTopLevel os = unsafeSplitPrefix os 1++-- In some cases there is no valid drive component e.g. "\\a\\b", though if we+-- consider relative roots then we could use "\\" as the root in this case. In+-- other cases there is no valid path component e.g. "C:" or "\\share\\" though+-- the latter is not a valid path and in the former case we can use "." as the+-- path component.++-- | Split a path prefixed with drive into (drive, path) tuple.+--+-- >>> toList (a,b) = (unpackPosix a, unpackPosix b)+-- >>> split = toList . Common.unsafeSplitDrive . packPosix+--+-- >>> split "C:"+-- ("C:","")+--+-- >>> split "C:a"+-- ("C:","a")+--+-- >>> split "C:\\"+-- ("C:\\","")+--+-- >>> split "C:\\\\" -- this is invalid path+-- ("C:\\\\","")+--+-- >>> split "C:\\\\a" -- this is invalid path+-- ("C:\\\\","a")+--+-- >>> split "C:\\/a/b" -- is this valid path?+-- ("C:\\/","a/b")+unsafeSplitDrive :: (Unbox a, Integral a) => Array a -> (Array a, Array a)+unsafeSplitDrive = unsafeSplitPrefix Windows 2++-- | Skip separators and then parse the next path segment.+-- Return (segment offset, segment length).+parseSegment :: (Unbox a, Integral a) => Array a -> Int -> (Int, Int)+parseSegment arr sepOff = (segOff, segCnt)++    where++    arr1 = snd $ Array.unsafeBreakAt sepOff arr+    sepCnt = countLeadingBy (isSeparatorWord Windows) arr1+    segOff = sepOff + sepCnt++    arr2 = snd $ Array.unsafeBreakAt segOff arr+    segCnt = countLeadingBy (not . isSeparatorWord Windows) arr2++-- XXX We can split a path as "root, . , rest" or "root, /, rest".+-- XXX We can remove the redundant path separator after the root. With that+-- joining root vs other paths will become similar. But there are some special+-- cases e.g. (1) "C:a" does not have a separator, can we make this "C:.\\a"?+-- (2) In case of "/home" we have "/" as root - while joining root and path we+-- should not add another separator between root and path - thus joining root+-- and path in this case is anyway special.++-- | Split a path prefixed with "\\" into (drive, path) tuple.+--+-- >>> toList (a,b) = (unpackPosix a, unpackPosix b)+-- >>> split = toList . Common.unsafeSplitUNC . packPosix+--+-- >> split ""+-- ("","")+--+-- >>> split "\\\\"+-- ("\\\\","")+--+-- >>> split "\\\\server"+-- ("\\\\server","")+--+-- >>> split "\\\\server\\"+-- ("\\\\server\\","")+--+-- >>> split "\\\\server\\home"+-- ("\\\\server\\","home")+--+-- >>> split "\\\\?\\c:"+-- ("\\\\?\\c:","")+--+-- >>> split "\\\\?\\c:/"+-- ("\\\\?\\c:/","")+--+-- >>> split "\\\\?\\c:\\home"+-- ("\\\\?\\c:\\","home")+--+-- >>> split "\\\\?\\UNC/"+-- ("\\\\?\\UNC/","")+--+-- >>> split "\\\\?\\UNC\\server"+-- ("\\\\?\\UNC\\server","")+--+-- >>> split "\\\\?\\UNC/server\\home"+-- ("\\\\?\\UNC/server\\","home")+--+unsafeSplitUNC :: (Unbox a, Integral a) => Array a -> (Array a, Array a)+unsafeSplitUNC arr =+    if cnt1 == 1 && unsafeIndexChar 2 arr == '?'+    then do+        if uncLen == 3+                && unsafeIndexChar uncOff arr == 'U'+                && unsafeIndexChar (uncOff + 1) arr == 'N'+                && unsafeIndexChar (uncOff + 2) arr == 'C'+        then unsafeSplitPrefix Windows (serverOff + serverLen) arr+        else unsafeSplitPrefix Windows sepOff1 arr+    else unsafeSplitPrefix Windows sepOff arr++    where++    arr1 = snd $ Array.unsafeBreakAt 2 arr+    cnt1 = countLeadingBy (not . isSeparatorWord Windows) arr1+    sepOff = 2 + cnt1++    -- XXX there should be only one separator in a valid path?+    -- XXX it should either be UNC or two letter drive in a valid path+    (uncOff, uncLen) = parseSegment arr sepOff+    sepOff1 = uncOff + uncLen+    (serverOff, serverLen) = parseSegment arr sepOff1++-- XXX should we make the root Maybe? Both components will have to be Maybe to+-- avoid an empty path.+-- XXX Should we keep the trailing separator in the directory components?++{-# INLINE splitRoot #-}+splitRoot :: (Unbox a, Integral a) => OS -> Array a -> (Array a, Array a)+-- NOTE: validatePath depends on splitRoot splitting the path without removing+-- any redundant chars etc. It should just split and do nothing else.+-- XXX We can put an assert here "arrLen == rootLen + stemLen".+-- XXX assert (isValidPath path == isValidPath root)+--+-- NOTE: we cannot drop the trailing "/" on the root even if we want to -+-- because "c:/" will become "c:" and the two are not equivalent.+splitRoot Posix arr+    | isRooted Posix arr+        = unsafeSplitTopLevel Posix arr+    | otherwise = (Array.empty, arr)+splitRoot Windows arr+    | isRelativeCurDriveRoot arr || isRelativeCurDir Windows arr+        = unsafeSplitTopLevel Windows arr+    | hasDrive arr = unsafeSplitDrive arr+    | isAbsoluteUNC arr = unsafeSplitUNC arr+    | otherwise = (Array.empty, arr)++------------------------------------------------------------------------------+-- Split path+------------------------------------------------------------------------------++-- | Raw split an array on path separartor word using a filter to filter out+-- some splits.+{-# INLINE splitWithFilter #-}+splitWithFilter+    :: (Unbox a, Integral a, Monad m)+    => ((Int, Int) -> Bool)+    -> Bool+    -> OS+    -> Array a+    -> Stream m (Array a)+splitWithFilter filt withSep os arr =+      f (isSeparatorWord os) (Array.read arr)+    & Stream.filter filt+    & fmap (\(i, len) -> Array.unsafeSliceOffLen i len arr)++    where++    f = if withSep then Stream.indexEndBy else Stream.indexEndBy_++-- | Split a path on separator chars and compact contiguous separators and+-- remove /./ components. Note this does not treat the path root in a special+-- way.+{-# INLINE splitCompact #-}+splitCompact+    :: (Unbox a, Integral a, Monad m)+    => Bool+    -> OS+    -> Array a+    -> Stream m (Array a)+splitCompact withSep os arr =+    splitWithFilter (not . shouldFilterOut) withSep os arr++    where++    sepFilter (off, len) =+        ( len == 1+        && isSeparator os (unsafeIndexChar off arr)+        )+        ||+        -- Note, last component may have len == 2 but second char may not+        -- be slash, so we need to check for slash explicitly.+        --+        ( len == 2+        && unsafeIndexChar off arr == '.'+        && isSeparator os (unsafeIndexChar (off + 1) arr)+        )++    {-# INLINE shouldFilterOut #-}+    shouldFilterOut (off, len) =+        len == 0+            -- Note this is needed even when withSep is true - for the last+            -- component case.+            || (len == 1 && unsafeIndexChar off arr == '.')+            -- XXX Ensure that these are statically removed by GHC when withSep+            -- is False.+            || (withSep && sepFilter (off, len))++-- Split a path into its components.+--+-- Usage:+-- @+-- splitPathUsing withSep ignoreLeading os arr+-- @+--+-- if withSep == True then keep the trailing separators.+--+-- if ignoreLeading == True we drop all leading separators and relative paths.+-- Example behaviour (psuedo-code):+-- @+-- > f = splitPathUsing (withSep = False) (ignoreLeading = True)+-- > f "./a/b/c" == ["a","b","c"]+-- > f "./a/./b/c" == ["a","b","c"]+-- > f "/a/./b/c" == ["a","b","c"]+-- > f "/./a/./b/c" == ["a","b","c"]+-- > f "././a/./b/c" == ["a","b","c"]+-- > f "a/./b/c" == ["a","b","c"]+-- @+--+-- We can safely set @ignoreLeading = True@ if we splitRoot prior and only pass+-- the stem of the path to this function.+{-# INLINE splitPathUsing #-}+splitPathUsing+    :: (Unbox a, Integral a, Monad m)+    => Bool+    -> Bool+    -> OS+    -> Array a+    -> Stream m (Array a)+splitPathUsing withSep ignoreLeading os arr =+    let stream = splitCompact withSep os rest+    in if ignoreLeading || Array.null root+       then stream+       else Stream.cons root1 stream++    where++    -- We should not filter out a leading '.' on Posix or Windows.+    -- We should not filter out a '.' in the middle of a UNC root on windows.+    -- Therefore, we split the root and treat it in a special way.+    (root, rest) = splitRoot os arr+    root1 =+        if withSep+        then compactTrailingBy (isSeparator os . wordToChar) root+        else dropTrailingSeparators os root++{-# INLINE splitPath_ #-}+splitPath_+    :: (Unbox a, Integral a, Monad m)+    => OS -> Array a -> Stream m (Array a)+splitPath_ = splitPathUsing False False++{-# INLINE splitPath #-}+splitPath+    :: (Unbox a, Integral a, Monad m)+    => OS -> Array a -> Stream m (Array a)+splitPath = splitPathUsing True False++-- | Split the first non-empty path component.+--+-- /Unimplemented/+{-# INLINE splitHead #-}+splitHead :: -- (Unbox a, Integral a) =>+    OS -> Array a -> (Array a, Maybe (Array a))+splitHead _os _arr = undefined++-- | Split the last non-empty path component.+--+-- /Unimplemented/+{-# INLINE splitTail #-}+splitTail :: -- (Unbox a, Integral a) =>+    OS -> Array a -> (Maybe (Array a), Array a)+splitTail _os _arr = undefined++------------------------------------------------------------------------------+-- File or Dir+------------------------------------------------------------------------------++-- | Returns () if the path can be a valid file, otherwise throws an+-- exception.+validateFile :: (MonadThrow m, Unbox a, Integral a) => OS -> Array a -> m ()+validateFile os arr = do+    s1 <-+            Stream.toList+                $ Stream.take 3+                $ Stream.takeWhile (not . isSeparator os)+                $ fmap wordToChar+                $ Array.readRev arr+    -- XXX On posix we just need to check last 3 bytes of the array+    -- XXX Display the path in the exception messages.+    case s1 of+        [] -> throwM $ InvalidPath "A file name cannot have a trailing separator"+        '.' : xs ->+            case xs of+                [] -> throwM $ InvalidPath "A file name cannot have a trailing \".\""+                '.' : [] ->+                    throwM $ InvalidPath "A file name cannot have a trailing \"..\""+                _ -> pure ()+        _ -> pure ()++    case os of+        Windows ->+            -- XXX We can exclude a UNC root as well but just the UNC root is+            -- not even a valid path.+            when (isDrive arr)+                $ throwM $ InvalidPath "A drive root is not a valid file name"+        Posix -> pure ()++{-# INLINE splitFile #-}+splitFile :: (Unbox a, Integral a) =>+    OS -> Array a -> Maybe (Maybe (Array a), Array a)+splitFile os arr =+    let p x =+            if os == Windows+            then x == charToWord ':' || isSeparatorWord os x+            else isSeparatorWord os x+        -- XXX Use Array.revBreakEndBy?+        fileLen = runIdentity+                $ Stream.fold (Fold.takeEndBy_ p Fold.length)+                $ Array.readRev arr+        arrLen = Array.length arr+        baseLen = arrLen - fileLen+        (base, file) = Array.unsafeBreakAt baseLen arr+        fileFirst = Array.unsafeGetIndex 0 file+        fileSecond = Array.unsafeGetIndex 1 file+     in+        if fileLen > 0+            -- exclude the file == '.' case+            && not (fileLen == 1 && fileFirst == charToWord '.')+            -- exclude the file == '..' case+            && not (fileLen == 2+                && fileFirst == charToWord '.'+                && fileSecond == charToWord '.')+        then+            if baseLen <= 0+            then Just (Nothing, arr)+            else Just (Just $ Array.unsafeSliceOffLen 0 baseLen base, file) -- "/"+        else Nothing++-- | Split a multi-component path into (dir, last component). If the path has a+-- single component and it is a root then return (path, "") otherwise return+-- ("", path).+--+-- Split a single component into (dir, "") if it can be a dir i.e. it is either+-- a path root, "." or ".." or has a trailing separator.+--+-- The only difference between splitFile and splitDir:+--+-- >> splitFile "a/b/"+-- ("a/b/", "")+-- >> splitDir "a/b/"+-- ("a/", "b/")+--+-- This is equivalent to splitPath and keeping the last component but is usually+-- faster.+--+-- >>> toList (a,b) = (unpackPosix a, unpackPosix b)+-- >>> splitPosix = toList . Common.splitDir Common.Posix . packPosix+--+-- >> splitPosix "/"+-- ("/","")+--+-- >> splitPosix "."+-- (".","")+--+-- >> splitPosix "/."+-- ("/.","")+--+-- >> splitPosix "/x"+-- ("/","x")+--+-- >> splitPosix "/x/"+-- ("/","x/")+--+-- >> splitPosix "//"+-- ("//","")+--+-- >> splitPosix "./x"+-- ("./","x")+--+-- >> splitPosix "x"+-- ("","x")+--+-- >> splitPosix "x/"+-- ("x/","")+--+-- >> splitPosix "x/y"+-- ("x/","y")+--+-- >> splitPosix "x/y/"+-- ("x/","y/")+--+-- >> splitPosix "x/y//"+-- ("x/","y//")+--+-- >> splitPosix "x//y"+-- ("x//","y")+--+-- >> splitPosix "x/./y"+-- ("x/./","y")+--+-- /Unimplemented/+{-# INLINE splitDir #-}+splitDir :: -- (Unbox a, Integral a) =>+    OS -> Array a -> (Array a, Array a)+splitDir _os _arr = undefined++------------------------------------------------------------------------------+-- Split extensions+------------------------------------------------------------------------------++-- | Like split extension but we can specify the extension char to be used.+{-# INLINE splitExtensionBy #-}+splitExtensionBy :: (Unbox a, Integral a) =>+    a -> OS -> Array a -> Maybe (Array a, Array a)+splitExtensionBy c os arr =+    let p x = x == c || isSeparatorWord os x+        -- XXX Use Array.revBreakEndBy_+        extLen = runIdentity+                $ Stream.fold (Fold.takeEndBy p Fold.length)+                $ Array.readRev arr+        arrLen = Array.length arr+        baseLen = arrLen - extLen+        -- XXX We can use reverse split operation on the array+        res@(base, ext) = Array.unsafeBreakAt baseLen arr+        baseLast = Array.unsafeGetIndexRev 0 base+        extFirst = Array.unsafeGetIndex 0 ext+     in+        -- For an extension to be present the path must be at least 3 chars.+        -- non-empty base followed by extension char followed by non-empty+        -- extension.+        if arrLen > 2+            -- If ext is empty, then there is no extension and we should not+            -- strip an extension char if any at the end of base.+            && extLen > 1+            && extFirst == c+            -- baseLast is always either base name char or '/' unless empty+            -- if baseLen is 0 then we have not found an extension.+            && baseLen > 0+            -- If baseLast is '/' then base name is empty which means it is a+            -- dot file and there is no extension.+            && not (isSeparatorWord os baseLast)+            -- On Windows if base is 'c:.' or a UNC path ending in '/c:.' then+            -- it is a dot file, no extension.+            && not (os == Windows && baseLast == charToWord ':')+        then Just res+        else Nothing++{-# INLINE splitExtension #-}+splitExtension :: (Unbox a, Integral a) => OS -> Array a -> Maybe (Array a, Array a)+splitExtension = splitExtensionBy extensionWord++{-+-- Instead of this keep calling splitExtension until there is no more extension+-- returned.+{-# INLINE splitAllExtensionsBy #-}+splitAllExtensionsBy :: (Unbox a, Integral a) =>+    Bool -> a -> OS -> Array a -> (Array a, Array a)+-- If the isFileName arg is true, it means that the path supplied does not have+-- any separator chars, so we can do it more efficiently.+splitAllExtensionsBy isFileName extChar os arr =+    let file =+            if isFileName+            then arr+            else snd $ splitFile os arr+        fileLen = Array.length file+        arrLen = Array.length arr+        baseLen = foldArr (Fold.takeEndBy_ (== extChar) Fold.length) file+        extLen = fileLen - baseLen+     in+        -- XXX unsafeBreakAt itself should use Array.empty in case of no split+        if fileLen > 0 && extLen > 1 && extLen /= fileLen+        then (Array.unsafeBreakAt (arrLen - extLen) arr)+        else (arr, Array.empty)++-- |+--+-- TODO: This function needs to be consistent with splitExtension. It should+-- strip all valid extensions by that definition.+--+-- splitAllExtensions "x/y.tar.gz" gives ("x/y", ".tar.gz")+--+-- >>> toList (a,b) = (unpackPosix a, unpackPosix b)+-- >>> splitPosix = toList . Common.splitAllExtensions Common.Posix . packPosix+--+-- >>> toListWin (a,b) = (unpackWindows a, unpackWindows b)+-- >>> splitWin = toListWin . Common.splitAllExtensions Common.Windows . packWindows+--+-- >>> splitPosix "/"+-- ("/","")+--+-- >>> splitPosix "."+-- (".","")+--+-- >>> splitPosix "x"+-- ("x","")+--+-- >>> splitPosix "/x"+-- ("/x","")+--+-- >>> splitPosix "x/"+-- ("x/","")+--+-- >>> splitPosix "./x"+-- ("./x","")+--+-- >>> splitPosix "x/."+-- ("x/.","")+--+-- >>> splitPosix "x/y."+-- ("x/y.","")+--+-- >>> splitPosix "/x.y"+-- ("/x",".y")+--+-- >>> splitPosix "x/.y"+-- ("x/.y","")+--+-- >>> splitPosix ".x"+-- (".x","")+--+-- >>> splitPosix "x."+-- ("x.","")+--+-- >>> splitPosix ".x.y"+-- (".x",".y")+--+-- >>> splitPosix "x/y.z"+-- ("x/y",".z")+--+-- >>> splitPosix "x.y.z"+-- ("x",".y.z")+--+-- >>> splitPosix "x..y" -- ??+-- ("x.",".y")+--+-- >>> splitPosix ".."+-- ("..","")+--+-- >>> splitPosix "..."+-- ("...","")+--+-- >>> splitPosix "...x"+-- ("...x","")+--+-- >>> splitPosix "x/y.z/"+-- ("x/y.z/","")+--+-- >>> splitPosix "x/y"+-- ("x/y","")+--+-- >>> splitWin "x:y"+-- ("x:y","")+--+-- >>> splitWin "x:.y"+-- ("x:.y","")+--+{-# INLINE splitAllExtensions #-}+splitAllExtensions :: (Unbox a, Integral a) =>+    OS -> Array a -> (Array a, Array a)+splitAllExtensions = splitAllExtensionsBy False extensionWord+-}++------------------------------------------------------------------------------+-- Construction+------------------------------------------------------------------------------++{-# INLINE isInvalidPathChar #-}+isInvalidPathChar :: Integral a => OS -> a -> Bool+isInvalidPathChar Posix x = x == 0+isInvalidPathChar Windows x =+    -- case should be faster than list search+    case x of+        34 -> True -- '"'+        42 -> True -- '*'+        58 -> True -- ':'+        60 -> True -- '<'+        62 -> True -- '>'+        63 -> True -- '?'+        124 -> True -- '|'+        _ -> x <= charToWord '\US'++countLeadingValid :: (Unbox a, Integral a) => OS -> Array a -> Int+countLeadingValid os path =+    let f = Fold.takeEndBy_ (isInvalidPathChar os) Fold.length+     in foldArr f path++-- XXX Supply it an array for checking and use a more efficient prefix matching+-- check.++-- | Only for windows.+isInvalidPathComponent :: Integral a => [[a]]+isInvalidPathComponent = fmap (fmap charToWord)+    [ "CON","PRN","AUX","NUL","CLOCK$"+    , "COM1","COM2","COM3","COM4","COM5","COM6","COM7","COM8","COM9"+    , "LPT1","LPT2","LPT3","LPT4","LPT5","LPT6","LPT7","LPT8","LPT9"+    ]++{- HLINT ignore "Use when" -}+validatePathWith :: (MonadThrow m, Integral a, Unbox a) =>+    Bool -> OS -> Array a -> m ()+validatePathWith _ Posix path =+    let pathLen = Array.length path+        validLen = countLeadingValid Posix path+     in if pathLen == 0+        then throwM $ InvalidPath "Empty path"+        else if pathLen /= validLen+        then throwM $ InvalidPath+            $ "Null char found after " ++ show validLen ++ " characters."+        else pure ()+validatePathWith allowRoot Windows path+  | Array.null path = throwM $ InvalidPath "Empty path"+  | otherwise = do+        if hasDrive path && postDriveSep > 1 -- "C://"+        then throwM $ InvalidPath+            "More than one separators between drive root and the path"+        else if isAbsoluteUNC path+        then+            if postDriveSep > 1 -- "///x"+            then throwM $ InvalidPath+                "Path starts with more than two separators"+            else if invalidRootComponent -- "//prn/x"+            then throwM $ InvalidPath+                -- XXX print the invalid component name+                "Special filename component found in share root"+            else if rootEndSeps /= 1 -- "//share//x"+            then throwM $ InvalidPath+                $ "Share name is needed and exactly one separator is needed "+                ++ "after the share root"+            else if not allowRoot && Array.null stem -- "//share/"+            then throwM $ InvalidPath+                "the share root must be followed by a non-empty path"+            else pure ()+        else pure ()++        if stemLen /= validStemLen -- "x/x>y"+        then throwM $ InvalidPath+            $ "Disallowed char found after "+            ++ show (rootLen + validStemLen)+            ++ " characters. The invalid char is: "+            ++ show (chr (fromIntegral invalidVal))+            ++ " [" ++ show invalidVal ++ "]"+        else if invalidComponent -- "x/prn/y"+        -- XXX print the invalid component name+        then throwM $ InvalidPath "Disallowed Windows filename in path"+        else pure ()++    where++    postDrive = snd $ Array.unsafeBreakAt 2 path+    postDriveSep = countLeadingBy (isSeparatorWord Windows) postDrive++    -- XXX check invalid chars in the path root as well - except . and '?'?+    (root, stem) = splitRoot Windows path+    rootLen = Array.length root+    stemLen = Array.length stem+    validStemLen = countLeadingValid Windows stem+    invalidVal = fromIntegral (Array.unsafeGetIndex validStemLen stem) :: Word16++    rootEndSeps  = countTrailingBy (isSeparatorWord Windows) root++    -- TBD: We are not currently validating the sharenames against disallowed+    -- file names. Apparently windows does not allow even sharenames with those+    -- names. To match against sharenames we will have to strip the separators+    -- and drive etc from the root. Or we can use the parsing routines+    -- themselves to validate.+    toUp w16 =+        if w16 < 256+        then charToWord $ toUpper (wordToChar w16)+        else w16++    -- Should we strip all space chars as in Data.Char.isSpace?+    isSpace x = x == charToWord ' '++    -- XXX instead of using a list based check, pass the array to the checker.+    -- We do not need to upcase the array, it can be done in the checker. Thus+    -- we do not need to create a new array, the original slice can be checked.+    getBaseName x =+          runIdentity+        $ Stream.toList+        $ fmap toUp+        $ Array.read+        $ Array.dropAround isSpace+        $ fst $ Array.breakEndBy_ (== extensionWord) x++    components =+          runIdentity+        . Stream.toList+        . fmap getBaseName+        . splitCompact False Windows++    invalidRootComponent =+        List.any (`List.elem` isInvalidPathComponent) (components root)+    invalidComponent =+        List.any (`List.elem` isInvalidPathComponent) (components stem)++-- | A valid root, share root or a valid path.+{-# INLINE validatePath #-}+validatePath :: (MonadThrow m, Integral a, Unbox a) => OS -> Array a -> m ()+validatePath = validatePathWith True++{-# INLINE validatePath' #-}+validatePath' :: (MonadThrow m, Integral a, Unbox a) => OS -> Array a -> m ()+validatePath' = validatePathWith False++{-# INLINE unsafeFromArray #-}+unsafeFromArray :: Array a -> Array a+unsafeFromArray = id++{-# INLINE fromArray #-}+fromArray :: forall m a. (MonadThrow m, Unbox a, Integral a) =>+    OS -> Array a -> m (Array a)+fromArray os arr = validatePath os arr >> pure arr+{-+    let arr1 = Array.unsafeCast arr :: Array a+     in validatePath os arr1 >> pure arr1+fromArray Windows arr =+    case Array.cast arr of+        Nothing ->+            throwM+                $ InvalidPath+                $ "Encoded path length " ++ show (Array.byteLength arr)+                    ++ " is not a multiple of 16-bit."+        Just x -> validatePath Windows x >> pure x+-}++{-# INLINE unsafeFromChars #-}+unsafeFromChars :: (Unbox a) =>+       (Stream Identity Char -> Stream Identity a)+    -> Stream Identity Char+    -> Array a+unsafeFromChars encode s =+    let n = runIdentity $ Stream.fold Fold.length s+     in Array.fromPureStreamN n (encode s)++-- XXX Writing a custom fold for parsing a Posix path may be better for+-- efficient bulk parsing when needed. We need the same code to validate a+-- Chunk where we do not need to create an array.+{-# INLINE fromChars #-}+fromChars :: (MonadThrow m, Unbox a, Integral a) =>+       OS+    -> (Stream Identity Char -> Stream Identity a)+    -> Stream Identity Char+    -> m (Array a)+fromChars os encode s =+    let arr = unsafeFromChars encode s+     in fromArray os (Array.unsafeCast arr)++{-# INLINE toChars #-}+toChars :: (Monad m, Unbox a) =>+    (Stream m a -> Stream m Char) -> Array a -> Stream m Char+toChars decode arr = decode $ Array.read arr++{-# INLINE toString #-}+toString :: Unbox a =>+    (Stream Identity a -> Stream Identity Char) -> Array a -> [Char]+toString decode = runIdentity . Stream.toList . toChars decode++------------------------------------------------------------------------------+-- Statically Verified Literals+------------------------------------------------------------------------------++-- XXX pass the quote name for errors?+mkQ :: (String -> Q Exp) -> QuasiQuoter+mkQ f =+  QuasiQuoter+  { quoteExp  = f+  , quotePat  = err "pattern"+  , quoteType = err "type"+  , quoteDec  = err "declaration"+  }++  where++  err x _ = fail $ "QuasiQuote used as a " ++ x+    ++ ", can be used only as an expression"++------------------------------------------------------------------------------+-- Operations of Path+------------------------------------------------------------------------------++-- See also cstringLength# in GHC.CString in ghc-prim+foreign import ccall unsafe "string.h strlen" c_strlen_pinned+    :: Addr# -> IO CSize++{-# INLINE appendCStringWith #-}+appendCStringWith ::+       (Int -> IO (MutArray Word8))+    -> OS+    -> Array Word8+    -> CString+    -> IO (Array Word8)+appendCStringWith create os a b@(Ptr addrB#) = do+    let lenA = Array.length a+    lenB <- fmap fromIntegral $ c_strlen_pinned addrB#+    assertM(lenA /= 0 && lenB /= 0)+    let len = lenA + 1 + lenB+    arr <- create len+    arr1 <- MutArray.unsafeSplice arr (Array.unsafeThaw a)+    arr2 <- MutArray.unsafeSnoc arr1 (charToWord (primarySeparator os))+    arr3 :: MutArray.MutArray Word8 <-+        MutArray.unsafeAppendPtrN arr2 (castPtr b) lenB+    return (Array.unsafeFreeze arr3)++{-# INLINE appendCString #-}+appendCString :: OS -> Array Word8 -> CString -> IO (Array Word8)+appendCString = appendCStringWith MutArray.emptyOf++{-# INLINE appendCString' #-}+appendCString' :: OS -> Array Word8 -> CString -> IO (Array Word8)+appendCString' = appendCStringWith MutArray.emptyOf'++{-# INLINE doAppend #-}+doAppend :: (Unbox a, Integral a) => OS -> Array a -> Array a -> Array a+doAppend os a b = unsafePerformIO $ do+    let lenA = Array.length a+        lenB = Array.length b+    assertM(lenA /= 0 && lenB /= 0)+    let lastA = Array.unsafeGetIndexRev 0 a+        sepA = isSeparatorWord os lastA+        sepB = isSeparatorWord os (Array.unsafeGetIndex 0 b)+    let len = lenA + 1 + lenB+    arr <- MutArray.emptyOf len+    arr1 <- MutArray.unsafeSplice arr (Array.unsafeThaw a)+    arr2 <-+            if     lenA /= 0+                && lenB /= 0+                && not sepA+                && not sepB+                && not (os == Windows && lastA == charToWord ':')+            then MutArray.unsafeSnoc arr1 (charToWord (primarySeparator os))+            else pure arr1+    -- Note: if the last char on the first array is ":" and first char on the+    -- second array is "/" then we cannot drop the "/". We drop only if both+    -- are separators excluding ":".+    let arrB =+            if sepA && sepB+            then snd $ Array.unsafeBreakAt 1 b+            else b+    arr3 <- MutArray.unsafeSplice arr2 (Array.unsafeThaw arrB)+    return (Array.unsafeFreeze arr3)++{-# INLINE withAppendCheck #-}+withAppendCheck :: (Unbox b, Integral b) =>+    OS -> (Array b -> String) -> Array b -> a -> a+withAppendCheck os toStr arr f =+    if isRooted os arr+    then error $ "append: cannot append a rooted path " ++ toStr arr+    else f++{-# INLINE unsafeAppend #-}+unsafeAppend :: (Unbox a, Integral a) =>+    OS -> (Array a -> String) -> Array a -> Array a -> Array a+unsafeAppend os _toStr = doAppend os++{-# INLINE append #-}+append :: (Unbox a, Integral a) =>+    OS -> (Array a -> String) -> Array a -> Array a -> Array a+append os toStr a b = withAppendCheck os toStr b (doAppend os a b)++{-# INLINE append' #-}+append' :: (Unbox a, Integral a) =>+    OS -> (Array a -> String) -> Array a -> Array a -> Array a+append' os toStr a b =+    let hasSep = countTrailingBy (isSeparatorWord os) a > 0+        hasColon =+               os == Windows+            && Array.getIndexRev 0 a == Just (charToWord ':')+     in if hasSep || hasColon+        then withAppendCheck os toStr b (doAppend os a b)+        else error+                $ "append': first path must be dir like i.e. must have a "+                ++ "trailing separator or colon on windows: " ++ toStr a++-- XXX MonadIO?++-- | Join paths by path separator. Does not check if the paths being appended+-- are rooted or path segments. Note that splitting and joining may not give+-- exactly the original path but an equivalent, normalized path.+{-# INLINE unsafeJoinPaths #-}+unsafeJoinPaths+    :: (Unbox a, Integral a, MonadIO m)+    => OS -> Stream m (Array a) -> m (Array a)+unsafeJoinPaths os =+    -- XXX This can be implemented more efficiently using an Array intersperse+    -- operation. Which can be implemented by directly copying arrays rather+    -- than converting them to stream first. Also fromStreamN would be more+    -- efficient if we have to use streams.+    -- XXX We can remove leading and trailing separators first, if any, except+    -- the leading separator from the first path. But it is not necessary.+    -- Instead we can avoid adding a separator if it is already present.+    Array.fromStream . Array.concatSepBy (charToWord $ primarySeparator os)++------------------------------------------------------------------------------+-- Equality+------------------------------------------------------------------------------++eqPathBytes :: Array a -> Array a -> Bool+eqPathBytes = Array.byteEq++-- On posix macOs can have case insensitive comparison. On Windows also+-- case sensitive behavior may depend on the file system being used.++-- Use eq prefix?++-- | Options for path comparison operation. By default path comparison uses a+-- strict criteria for equality. The following options are provided to+-- control the strictness.+--+-- The default configuration is as follows:+--+-- >>> :{+-- defaultMod = ignoreTrailingSeparators False+--            . ignoreCase False+--            . allowRelativeEquality False+-- :}+--+data EqCfg =+    EqCfg+    { _ignoreTrailingSeparators :: Bool -- ^ Allows "x\/" == "x"+    , _ignoreCase :: Bool               -- ^ Allows "x" == \"X\"+    , _allowRelativeEquality :: Bool+    -- ^ A leading dot is ignored, thus ".\/x" == ".\/x" and ".\/x" == "x".+    -- On Windows allows "\/x" == \/x" and "C:x == C:x"++    -- , resolveParentReferences -- "x\/..\/y" == "y"+    -- , noIgnoreRedundantSeparators -- "x\/\/y" \/= "x\/y"+    -- , noIgnoreRedundantDot -- "x\/.\/" \/= "x"+    }++data PosixRoot = PosixRootAbs | PosixRootRel deriving Eq++data WindowsRoot =+      WindowsRootPosix -- /x or ./x+    | WindowsRootNonPosix -- C:... or \\...+    deriving Eq++-- | Change to upper case and replace separators by primary separator+{-# INLINE normalizeCaseAndSeparators #-}+normalizeCaseAndSeparators :: Monad m => Array Word16 -> Stream m Char+normalizeCaseAndSeparators =+      fmap toUpper+    . Unicode.decodeUtf16le'+    . fmap toDefaultSeparator+    . Array.read++{-# INLINE normalizeCaseWith #-}+normalizeCaseWith :: (Monad m, Unbox a) =>+    (Stream m a -> Stream m Char) -> Array a -> Stream m Char+normalizeCaseWith decoder =+      fmap toUpper+    . decoder+    . Array.read++eqWindowsRootStrict :: (Unbox a, Integral a) =>+    Bool -> Array a -> Array a -> Bool+eqWindowsRootStrict ignCase a b =+    let f = normalizeCaseAndSeparators+     in if ignCase+        then+            -- XXX We probably do not want to equate UNC with UnC etc.+            runIdentity+                $ Stream.eqBy (==)+                    (f $ Array.unsafeCast a) (f $ Array.unsafeCast b)+        else+            runIdentity+                $ Stream.eqBy (==)+                    (fmap toDefaultSeparator $ Array.read a)+                    (fmap toDefaultSeparator $ Array.read b)++{-# INLINE eqRootStrict #-}+eqRootStrict :: (Unbox a, Integral a) =>+    Bool -> OS -> Array a -> Array a -> Bool+eqRootStrict _ Posix a b =+    -- a can be "/" and b can be "//"+    -- We call this only when the roots are either absolute or null.+    Array.null a == Array.null b+eqRootStrict ignCase Windows a b = eqWindowsRootStrict ignCase a b++-- | Compare Posix roots or Windows roots without a drive or share name.+{-# INLINE eqPosixRootLax #-}+eqPosixRootLax :: (Unbox a, Integral a) => Array a -> Array a -> Bool+eqPosixRootLax a b = getRoot a == getRoot b++    where++    -- Can only be either "", '.', './' or '/' (or Windows separators)+    getRoot arr =+        if Array.null arr || unsafeIndexChar 0 arr == '.'+        then PosixRootRel+        else PosixRootAbs++{-# INLINABLE eqRootLax #-}+eqRootLax :: (Unbox a, Integral a) => Bool -> OS -> Array a -> Array a -> Bool+eqRootLax _ Posix a b = eqPosixRootLax a b+eqRootLax ignCase Windows a b =+    let aType = getRootType a+        bType = getRootType b+     in aType == bType+        && (+            (aType == WindowsRootPosix && eqPosixRootLax a b)+            || eqWindowsRootStrict ignCase a b+           )++    where++    getRootType arr =+        if isAbsoluteUNC arr || hasDrive arr+        then WindowsRootNonPosix+        else WindowsRootPosix++{-# INLINE eqComponentsWith #-}+eqComponentsWith :: (Unbox a, Integral a) =>+       EqCfg+    -> (Stream Identity a -> Stream Identity Char)+    -> OS+    -> Array a+    -> Array a+    -> Bool+eqComponentsWith EqCfg{..} decoder os a b =+    if _ignoreCase+    then+        let streamEq x y = runIdentity $ Stream.eqBy (==) x y+            toComponents = fmap (normalizeCaseWith decoder) . splitter os+        -- XXX check perf/fusion+         in runIdentity+                $ Stream.eqBy streamEq (toComponents a) (toComponents b)+    else+        runIdentity+            $ Stream.eqBy+                Array.byteEq (splitter os a) (splitter os b)+    where+    splitter = splitPathUsing False _allowRelativeEquality++-- XXX can we do something like SpecConstr for such functions e.g. without+-- inlining the function we can use two copies one for _allowRelativeEquality+-- True and other for False and so on for other values of PathEq.++{-# INLINE eqPath #-}+eqPath :: (Unbox a, Integral a) =>+    (Stream Identity a -> Stream Identity Char)+    -> OS -> EqCfg -> Array a -> Array a -> Bool+eqPath decoder os eqCfg@(EqCfg{..}) a b =+    let (rootA, stemA) = splitRoot os a+        (rootB, stemB) = splitRoot os b++        eqRelative =+               if _allowRelativeEquality+               then eqRootLax _ignoreCase os rootA rootB+               else (not (isRootRelative os rootA)+                    && not (isRootRelative os rootB))+                    && eqRootStrict _ignoreCase os rootA rootB++        -- XXX If one ends in a "." and the other ends in ./ (and same for ".."+        -- and "../") then they can be equal. We can append a slash in these two+        -- cases before comparing.+        eqTrailingSep =+            _ignoreTrailingSeparators+                || hasTrailingSeparator os a == hasTrailingSeparator os b++     in+           eqRelative+        && eqTrailingSep+        && eqComponentsWith eqCfg decoder os stemA stemB
+ src/Streamly/Internal/FileSystem/Path/Node.hs view
@@ -0,0 +1,20 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Path.Node+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+#define OS_PATH WindowsPath+#else+#define OS_PATH PosixPath+#endif++module Streamly.Internal.FileSystem.Path.Node+    (+      module Streamly.Internal.FileSystem.OS_PATH.Node+    )+where++import Streamly.Internal.FileSystem.OS_PATH.Node
+ src/Streamly/Internal/FileSystem/Path/Seg.hs view
@@ -0,0 +1,20 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Path.Seg+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+#define OS_PATH WindowsPath+#else+#define OS_PATH PosixPath+#endif++module Streamly.Internal.FileSystem.Path.Seg+    (+      module Streamly.Internal.FileSystem.OS_PATH.Seg+    )+where++import Streamly.Internal.FileSystem.OS_PATH.Seg
+ src/Streamly/Internal/FileSystem/Path/SegNode.hs view
@@ -0,0 +1,20 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Path.SegNode+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+#define OS_PATH WindowsPath+#else+#define OS_PATH PosixPath+#endif++module Streamly.Internal.FileSystem.Path.SegNode+    (+      module Streamly.Internal.FileSystem.OS_PATH.SegNode+    )+where++import Streamly.Internal.FileSystem.OS_PATH.SegNode
+ src/Streamly/Internal/FileSystem/Posix/Errno.hs view
@@ -0,0 +1,60 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Posix.Errno+-- Copyright   : (c) 2024 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++module Streamly.Internal.FileSystem.Posix.Errno+    (+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+      throwErrnoPath+    , throwErrnoPathIfRetry+    , throwErrnoPathIfNullRetry+    , throwErrnoPathIfMinus1Retry+#endif+    )+where++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Foreign (Ptr, nullPtr)+import Foreign.C (getErrno, eINTR)+import Foreign.C.Error (errnoToIOError)+import Streamly.Internal.FileSystem.PosixPath (PosixPath(..))++import qualified Streamly.Internal.FileSystem.PosixPath as Path++-------------------------------------------------------------------------------+-- From unix+-------------------------------------------------------------------------------++-- | Same as 'throwErrno', but exceptions include the given path when+-- appropriate.+--+throwErrnoPath :: String -> PosixPath -> IO a+throwErrnoPath loc path =+  do+    errno <- getErrno+    -- XXX toString uses strict decoding, may fail+    ioError (errnoToIOError loc errno Nothing (Just (Path.toString path)))++throwErrnoPathIfRetry :: (a -> Bool) -> String -> PosixPath -> IO a -> IO a+throwErrnoPathIfRetry pr loc rpath f =+  do+    res <- f+    if pr res+      then do+        err <- getErrno+        if err == eINTR+          then throwErrnoPathIfRetry pr loc rpath f+          else throwErrnoPath loc rpath+      else return res++throwErrnoPathIfNullRetry :: String -> PosixPath -> IO (Ptr a) -> IO (Ptr a)+throwErrnoPathIfNullRetry = throwErrnoPathIfRetry (== nullPtr)++throwErrnoPathIfMinus1Retry :: (Eq a, Num a) =>+    String -> PosixPath -> IO a -> IO a+throwErrnoPathIfMinus1Retry = throwErrnoPathIfRetry (== -1)+#endif
+ src/Streamly/Internal/FileSystem/Posix/File.hsc view
@@ -0,0 +1,316 @@+module Streamly.Internal.FileSystem.Posix.File+    (+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)++    -- * File open flags+      OpenFlags (..)+    , defaultOpenFlags++    -- * File status flags+    , setAppend+    , setNonBlock+    , setSync++    -- * File creation flags+    , setCloExec+    , setDirectory+    , setExcl+    , setNoCtty+    , setNoFollow+    -- setTmpFile+    , setTrunc++    -- * File create mode+    , defaultCreateMode++    -- ** User Permissions+    , setUr+    , setUw+    , setUx++    , clrUr+    , clrUw+    , clrUx++    -- ** Group Permissions+    , setGr+    , setGw+    , setGx++    , clrGr+    , clrGw+    , clrGx++    -- ** Other Permissions+    , setOr+    , setOw+    , setOx++    , clrOr+    , clrOw+    , clrOx++    -- ** Status bits+    , setSuid+    , setSgid+    , setSticky++    , clrSuid+    , clrSgid+    , clrSticky++    -- * Fd based Low Level+    , openAt+    , close++    -- * Handle based+    , openFile+    , withFile+    , openBinaryFile+    , withBinaryFile++    -- Re-exported+    , Fd+#endif+    ) where++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import Data.Bits ((.|.), (.&.), complement)+import Foreign.C.Error (throwErrnoIfMinus1_)+import Foreign.C.String (CString)+import Foreign.C.Types (CInt(..))+import GHC.IO.Handle.FD (fdToHandle)+import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfMinus1Retry)+import Streamly.Internal.FileSystem.PosixPath (PosixPath)+import System.IO (IOMode(..), Handle)+import System.Posix.Types (Fd(..), CMode(..))++import qualified Streamly.Internal.FileSystem.File.Common as File+import qualified Streamly.Internal.FileSystem.PosixPath as Path++-- We want to remain close to the Posix C API. A function based API to set and+-- clear the modes is simple, type safe and directly mirrors the C API. It does+-- not require explicit mapping from Haskell ADT to C types, we can dirctly+-- manipulate the C type.++#include <fcntl.h>++-------------------------------------------------------------------------------+-- Create mode+-------------------------------------------------------------------------------++-- | Open flags, see posix open system call man page.+newtype FileMode = FileMode CMode++##define MK_MODE_API(name1,name2,x) \+{-# INLINE name1 #-}; \+name1 :: FileMode -> FileMode; \+name1 (FileMode mode) = FileMode (x .|. mode); \+{-# INLINE name2 #-}; \+name2 :: FileMode -> FileMode; \+name2 (FileMode mode) = FileMode (x .&. complement mode)++{-+#define S_ISUID  0004000+#define S_ISGID  0002000+#define S_ISVTX  0001000++#define S_IRWXU 00700+#define S_IRUSR 00400+#define S_IWUSR 00200+#define S_IXUSR 00100++#define S_IRWXG 00070+#define S_IRGRP 00040+#define S_IWGRP 00020+#define S_IXGRP 00010++#define S_IRWXO 00007+#define S_IROTH 00004+#define S_IWOTH 00002+#define S_IXOTH 00001++#define AT_FDCWD (-100)+-}++MK_MODE_API(setSuid,clrSuid,S_ISUID)+MK_MODE_API(setSgid,clrSgid,S_ISGID)+MK_MODE_API(setSticky,clrSticky,S_ISVTX)++-- MK_MODE_API(setUrwx,clrUrwx,S_IRWXU)+MK_MODE_API(setUr,clrUr,S_IRUSR)+MK_MODE_API(setUw,clrUw,S_IWUSR)+MK_MODE_API(setUx,clrUx,S_IXUSR)++-- MK_MODE_API(setGrwx,clrGrwx,S_IRWXU)+MK_MODE_API(setGr,clrGr,S_IRUSR)+MK_MODE_API(setGw,clrGw,S_IWUSR)+MK_MODE_API(setGx,clrGx,S_IXUSR)++-- MK_MODE_API(setOrwx,clrOrwx,S_IRWXU)+MK_MODE_API(setOr,clrOr,S_IRUSR)+MK_MODE_API(setOw,clrOw,S_IWUSR)+MK_MODE_API(setOx,clrOx,S_IXUSR)++-- Uses the same default mode as openFileWith in base+defaultCreateMode :: FileMode+defaultCreateMode = FileMode 0o666++-------------------------------------------------------------------------------+-- Open Flags+-------------------------------------------------------------------------------++-- | Open flags, see posix open system call man page.+newtype OpenFlags = OpenFlags CInt++##define MK_FLAG_API(name,x) \+{-# INLINE name #-}; \+name :: OpenFlags -> OpenFlags; \+name (OpenFlags flags) = OpenFlags (flags .|. x)++-- foreign import ccall unsafe "HsBase.h __hscore_o_rdonly" o_RDONLY :: CInt+-- These affect the first two bits in flags.+MK_FLAG_API(setReadOnly,#{const O_RDONLY})+MK_FLAG_API(setWriteOnly,#{const O_WRONLY})+MK_FLAG_API(setReadWrite,#{const O_RDWR})++##define MK_BOOL_FLAG_API(name,x) \+{-# INLINE name #-}; \+name :: Bool -> OpenFlags -> OpenFlags; \+name True (OpenFlags flags) = OpenFlags (flags .|. x); \+name False (OpenFlags flags) = OpenFlags (flags .&. complement x)++-- setCreat is internal only, do not export this. This is automatically set+-- when create mode is passed, otherwise cleared.+MK_BOOL_FLAG_API(setCreat,#{const O_CREAT})++MK_BOOL_FLAG_API(setExcl,#{const O_EXCL})+MK_BOOL_FLAG_API(setNoCtty,#{const O_NOCTTY})+MK_BOOL_FLAG_API(setTrunc,#{const O_TRUNC})+MK_BOOL_FLAG_API(setAppend,#{const O_APPEND})+MK_BOOL_FLAG_API(setNonBlock,#{const O_NONBLOCK})+MK_BOOL_FLAG_API(setDirectory,#{const O_DIRECTORY})+MK_BOOL_FLAG_API(setNoFollow,#{const O_NOFOLLOW})+MK_BOOL_FLAG_API(setCloExec,#{const O_CLOEXEC})+MK_BOOL_FLAG_API(setSync,#{const O_SYNC})++-- | Default values for the 'OpenFlags'.+--+-- By default a 0 value is used, no flag is set. See the open system call man+-- page.+defaultOpenFlags :: OpenFlags+defaultOpenFlags = OpenFlags 0++-------------------------------------------------------------------------------+-- Low level (fd returning) file opening APIs+-------------------------------------------------------------------------------++-- XXX Should we use interruptible open as in base openFile?+foreign import capi unsafe "fcntl.h openat"+   c_openat :: CInt -> CString -> CInt -> CMode -> IO CInt++-- | Open and optionally create (when create mode is specified) a file relative+-- to an optional directory file descriptor. If directory fd is not specified+-- then opens relative to the current directory.+-- {-# INLINE openAtCString #-}+openAtCString ::+       Maybe Fd -- ^ Optional directory file descriptor+    -> CString -- ^ Pathname to open+    -> OpenFlags -- ^ Append, exclusive, etc.+    -> Maybe FileMode -- ^ Create mode+    -> IO Fd+openAtCString fdMay path flags cmode =+    Fd <$> c_openat c_fd path flags1 mode++    where++    c_fd = maybe (#{const AT_FDCWD}) (\ (Fd fd) -> fd) fdMay+    FileMode mode = maybe defaultCreateMode id cmode+    OpenFlags flags1 = maybe flags (\_ -> setCreat True flags) cmode++-- | Open a file relative to an optional directory file descriptor.+--+-- Note: In Haskell, using an fd directly for IO may be problematic as blocking+-- file system operations on the file might block the capability and GC for+-- "unsafe" calls. "safe" calls may be more expensive. Also, you may have to+-- synchronize concurrent access via multiple threads.+--+{-# INLINE openAt #-}+openAt ::+       Maybe Fd -- ^ Optional directory file descriptor+    -> PosixPath -- ^ Pathname to open+    -> OpenFlags -- ^ Append, exclusive, truncate, etc.+    -> Maybe FileMode -- ^ Create mode+    -> IO Fd+openAt fdMay path flags cmode =+   Path.asCString path $ \cstr -> do+     throwErrnoPathIfMinus1Retry "openAt" path+        $ openAtCString fdMay cstr flags cmode+++-- | Open a regular file, return an Fd.+--+-- Sets O_NOCTTY, O_NONBLOCK flags to be compatible with the base openFile+-- behavior. O_NOCTTY affects opening of terminal special files and O_NONBLOCK+-- affects fifo special files, and mandatory locking.+--+openFileFdWith :: OpenFlags -> PosixPath -> IOMode -> IO Fd+openFileFdWith oflags path iomode = do+    case iomode of+        ReadMode -> open1 (setReadOnly oflags1) Nothing+        WriteMode ->+            open1 (setWriteOnly oflags1) (Just defaultCreateMode)+        AppendMode ->+            open1+                ((setAppend True . setWriteOnly) oflags1)+                (Just defaultCreateMode)+        ReadWriteMode ->+            open1 (setReadWrite oflags) (Just defaultCreateMode)++    where++    oflags1 = setNoCtty True $ setNonBlock True oflags+    open1 = openAt Nothing path++openFileFd :: PosixPath -> IOMode -> IO Fd+openFileFd = openFileFdWith defaultOpenFlags++foreign import ccall unsafe "unistd.h close"+   c_close :: CInt -> IO CInt++close :: Fd -> IO ()+close (Fd fd) = throwErrnoIfMinus1_ ("close " ++ show fd) (c_close fd)++-------------------------------------------------------------------------------+-- base openFile compatible, Handle returning, APIs+-------------------------------------------------------------------------------++-- | Open a regular file, return a Handle. The file is locked, the Handle is+-- NOT set up to close the file on garbage collection.+{-# INLINE openFileHandle #-}+openFileHandle :: PosixPath -> IOMode -> IO Handle+openFileHandle p x = openFileFd p x >>= fdToHandle . fromIntegral++-- | Like openFile in base package but using Path instead of FilePath.+-- Use hSetBinaryMode on the handle if you want to use binary mode.+openFile :: PosixPath -> IOMode -> IO Handle+openFile = File.openFile False openFileHandle++-- | Like withFile in base package but using Path instead of FilePath.+-- Use hSetBinaryMode on the handle if you want to use binary mode.+withFile :: PosixPath -> IOMode -> (Handle -> IO r) -> IO r+withFile = File.withFile False openFileHandle++-- | Like openBinaryFile in base package but using Path instead of FilePath.+openBinaryFile :: PosixPath -> IOMode -> IO Handle+openBinaryFile = File.openFile True openFileHandle++-- | Like withBinaryFile in base package but using Path instead of FilePath.+withBinaryFile :: PosixPath -> IOMode -> (Handle -> IO r) -> IO r+withBinaryFile = File.withFile True openFileHandle+#endif
+ src/Streamly/Internal/FileSystem/Posix/ReadDir.hsc view
@@ -0,0 +1,931 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Posix.ReadDir+-- Copyright   : (c) 2024 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++module Streamly.Internal.FileSystem.Posix.ReadDir+    (+#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+      readScanWith_+    , readScanWith+    , readPlusScanWith++    , DirStream (..)+    , openDirStream+    , openDirStreamCString+    , closeDirStream+    , readDirStreamEither+    , readEitherChunks+    , readEitherByteChunks+    , readEitherByteChunksAt+    , eitherReader+    , reader+#endif+    )+where++#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__)+import Control.Monad (unless)+import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (ord)+import Foreign+    ( Ptr, Word8, nullPtr, peek, peekByteOff, castPtr, plusPtr, (.&.)+    , allocaBytes+    )+import Foreign.C+    ( resetErrno, throwErrno, throwErrnoIfMinus1Retry_, throwErrnoIfNullRetry+    , Errno(..), getErrno, eINTR, eNOENT, eACCES, eLOOP+    , CInt(..), CString, CChar, CSize(..)+    )+import Foreign.Storable (poke)+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Internal.Data.MutByteArray (MutByteArray)+import Streamly.Internal.Data.Scanl (Scanl)+import Streamly.Internal.Data.Stream (Stream(..), Step(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.FileSystem.Path (Path)+import Streamly.Internal.FileSystem.Posix.Errno (throwErrnoPathIfNullRetry)+import Streamly.Internal.FileSystem.Posix.File+    (defaultOpenFlags, openAt, close)+import Streamly.Internal.FileSystem.PosixPath (PosixPath(..))+import System.Posix.Types (Fd(..), CMode)++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.MutByteArray as MutByteArray+import qualified Streamly.Internal.Data.Unfold as UF (bracketIO)+import qualified Streamly.Internal.FileSystem.Path.Common as PathC+import qualified Streamly.Internal.FileSystem.PosixPath as Path++import Streamly.Internal.FileSystem.DirOptions++#include <dirent.h>+#include <sys/stat.h>++-------------------------------------------------------------------------------++data {-# CTYPE "DIR" #-} CDir+data {-# CTYPE "struct dirent" #-} CDirent+data {-# CTYPE "struct stat" #-} CStat++newtype DirStream = DirStream (Ptr CDir)++-- | Minimal read without any metadata.+{-# INLINE readScanWith_ #-}+readScanWith_ :: -- (MonadIO m, MonadCatch m) =>+       Scanl m (Path, CString) a+    -> (ReadOptions -> ReadOptions)+    -> Path+    -> Stream m a+readScanWith_ = undefined++-- | Read with essential metadata. The scan takes the parent dir, the child+-- name, the child metadata and produces an output. The scan can do filtering,+-- formatting of the output, colorizing the output etc.+--+-- The options are to ignore errors encountered when reading a path, turn the+-- errors into a nil stream instead.+{-# INLINE readScanWith #-}+readScanWith :: -- (MonadIO m, MonadCatch m) =>+       Scanl m (Path, CString, Ptr CDirent) a+    -> (ReadOptions -> ReadOptions)+    -> Path+    -> Stream m a+readScanWith = undefined++-- NOTE: See  https://www.manpagez.com/man/2/getattrlistbulk/ for BSD/macOS.++-- | Read with full metadata.+{-# INLINE readPlusScanWith #-}+readPlusScanWith :: -- (MonadIO m, MonadCatch m) =>+       Scanl m (Path, CString, Ptr CStat) a+    -> (ReadOptions -> ReadOptions)+    -> Path+    -> Stream m a+readPlusScanWith = undefined++-------------------------------------------------------------------------------+-- readdir operations+-------------------------------------------------------------------------------++-- XXX Marking the calls "safe" has significant perf impact because it runs on+-- a separate OS thread. "unsafe" is faster but can block the GC if the system+-- call blocks. The effect could be signifcant if the file system is on NFS. Is+-- it possible to have a faster safe - where we know the function is safe but+-- we run it on the current thread, and if it blocks for longer we can snatch+-- the capability and enable GC?+--+-- IMPORTANT NOTE: Use capi FFI for all readdir APIs. This is required at+-- least on macOS for correctness. We saw random directory entries when ccall+-- was used on macOS 15.3. Looks like it was picking the wrong version of+-- dirent structure. Did not see the problem in CIs on macOS 14.7.2 though.+foreign import capi unsafe "closedir"+   c_closedir :: Ptr CDir -> IO CInt++foreign import capi unsafe "dirent.h opendir"+    c_opendir :: CString  -> IO (Ptr CDir)++foreign import capi unsafe "dirent.h fdopendir"+    c_fdopendir :: CInt  -> IO (Ptr CDir)++-- XXX The "unix" package uses a wrapper over readdir __hscore_readdir (see+-- cbits/HsUnix.c in unix package) which uses readdir_r in some cases where+-- readdir is not known to be re-entrant. We are not doing that here. We are+-- assuming that readdir is re-entrant which may not be the case on some old+-- unix systems.+foreign import capi unsafe "dirent.h readdir"+    c_readdir  :: Ptr CDir -> IO (Ptr CDirent)++--------------------------------------------------------------------------------+-- Stat+--------------------------------------------------------------------------------++foreign import ccall unsafe "stat.h lstat"+    c_lstat :: CString -> Ptr CStat -> IO CInt++foreign import ccall unsafe "stat.h stat"+    c_stat :: CString -> Ptr CStat -> IO CInt++s_IFMT :: CMode+s_IFMT  = #{const S_IFMT}++s_IFDIR :: CMode+s_IFDIR = #{const S_IFDIR}++{-+s_IFREG :: CMode+s_IFREG = #{const S_IFREG}++s_IFLNK :: CMode+s_IFLNK = #{const S_IFLNK}+-}++-- NOTE: Using fstatat with a dirfd and relative path would be faster.+stat :: Bool -> CString -> IO (Either Errno CMode)+stat followSym cstr =+    allocaBytes #{size struct stat} $ \p_stat -> do+        resetErrno+        result <-+            if followSym+            then c_stat cstr p_stat+            else c_lstat cstr p_stat+        if result /= 0+        then do+            errno <- getErrno+            if errno == eINTR+            then stat followSym cstr+            else pure $ Left errno+        else do+            mode <- #{peek struct stat, st_mode} p_stat+            pure $ Right (mode .&. s_IFMT)++--------------------------------------------------------------------------------+-- Functions+--------------------------------------------------------------------------------++-- | The CString must be pinned.+{-# INLINE openDirStreamCString #-}+openDirStreamCString :: CString -> IO DirStream+openDirStreamCString s = do+    -- XXX we do not decode the path here, just print it as cstring+    -- XXX pass lazy concat of "openDirStream: " ++ s+    dirp <- throwErrnoIfNullRetry "openDirStream" $ c_opendir s+    return (DirStream dirp)++-- XXX Path is not null terminated therefore we need to make a copy even if the+-- array is pinned.+-- {-# INLINE openDirStream #-}+openDirStream :: PosixPath -> IO DirStream+openDirStream p =+    Array.asCStringUnsafe (Path.toArray p) $ \s -> do+        -- openDirStreamCString s+        dirp <- throwErrnoPathIfNullRetry "openDirStream" p $ c_opendir s+        return (DirStream dirp)++-- | Note that the supplied Fd is used by DirStream and when we close the+-- DirStream the fd will be closed.+openDirStreamAt :: Fd -> PosixPath -> IO DirStream+openDirStreamAt fd p = do+    -- XXX can pass O_DIRECTORY here, is O_NONBLOCK useful for dirs?+    -- Note this fd is not automatically closed, we have to take care of+    -- exceptions and closing the fd.+    fd1 <- openAt (Just fd) p defaultOpenFlags Nothing+    -- liftIO $ putStrLn $ "opened: " ++ show fd1+    dirp <- throwErrnoPathIfNullRetry "openDirStreamAt" p+        $ c_fdopendir (fromIntegral fd1)+    -- XXX can we somehow clone fd1 instead of opening again?+    return (DirStream dirp)++-- | @closeDirStream dp@ calls @closedir@ to close+--   the directory stream @dp@.+closeDirStream :: DirStream -> IO ()+closeDirStream (DirStream dirp) = do+  throwErrnoIfMinus1Retry_ "closeDirStream" (c_closedir dirp)++-------------------------------------------------------------------------------+-- determining filetype+-------------------------------------------------------------------------------++isMetaDir :: Ptr CChar -> IO Bool+isMetaDir dname = do+    -- XXX Assuming an encoding that maps "." to ".", this is true for+    -- UTF8.+    -- Load as soon as possible to optimize memory accesses+    c1 <- peek dname+    c2 :: Word8 <- peekByteOff dname 1+    if (c1 /= fromIntegral (ord '.'))+    then return False+    else do+        if (c2 == 0)+        then return True+        else do+            if (c2 /= fromIntegral (ord '.'))+            then return False+            else do+                c3 :: Word8 <- peekByteOff dname 2+                if (c3 == 0)+                then return True+                else return False++data EntryType = EntryIsDir | EntryIsNotDir | EntryIgnored++{-# NOINLINE statEntryType #-}+statEntryType+    :: ReadOptions -> PosixPath -> Ptr CChar -> IO EntryType+statEntryType conf parent dname = do+    -- XXX We can create a pinned array right here since the next call pins+    -- it anyway.+    path <- appendCString parent dname+    Array.asCStringUnsafe (Path.toArray path) $ \cStr -> do+        res <- stat (_followSymlinks conf) cStr+        case res of+            Right mode -> pure $+                if (mode == s_IFDIR)+                then EntryIsDir+                else EntryIsNotDir+            Left errno -> do+                if errno == eNOENT+                then unless (_ignoreENOENT conf) $+                         throwErrno (errMsg path)+                else if errno == eACCES+                then unless (_ignoreEACCESS conf) $+                         throwErrno (errMsg path)+                else if errno == eLOOP+                then unless (_ignoreELOOP conf) $+                         throwErrno (errMsg path)+                else throwErrno (errMsg path)+                pure $ EntryIgnored+    where++    errMsg path =+        let pathStr = Path.toString_ path+         in "statEntryType: " ++ pathStr++-- | Checks if dname is a directory, not dir or should be ignored.+{-# INLINE getEntryType #-}+getEntryType+    :: ReadOptions+    -> PosixPath -> Ptr CChar -> #{type unsigned char} -> IO EntryType+getEntryType conf parent dname dtype = do+    let needStat =+#ifdef FORCE_LSTAT_READDIR+            True+#else+            (dtype == (#const DT_LNK) && _followSymlinks conf)+                || dtype == #const DT_UNKNOWN+#endif++    if dtype /= (#const DT_DIR) && not needStat+    then pure EntryIsNotDir+    else do+        isMeta <- liftIO $ isMetaDir dname+        if isMeta+        then pure EntryIgnored+        else if dtype == (#const DT_DIR)+        then pure EntryIsDir+        else statEntryType conf parent dname++-------------------------------------------------------------------------------+-- streaming reads+-------------------------------------------------------------------------------++-- XXX We can use getdents64 directly so that we can use array slices from the+-- same buffer that we passed to the OS. That way we can also avoid any+-- overhead of bracket.+-- XXX Make this as Unfold to avoid returning Maybe+-- XXX Or NOINLINE some parts and inline the rest to fuse it+-- {-# INLINE readDirStreamEither #-}+readDirStreamEither ::+    -- DirStream -> IO (Either (Rel (Dir Path)) (Rel (File Path)))+    (ReadOptions -> ReadOptions) ->+    (PosixPath, DirStream) -> IO (Maybe (Either PosixPath PosixPath))+readDirStreamEither confMod (curdir, (DirStream dirp)) = loop++  where++  conf = confMod defaultReadOptions++  -- mkPath :: IsPath (Rel (a Path)) => Array Word8 -> Rel (a Path)+  -- {-# INLINE mkPath #-}+  mkPath :: Array Word8 -> PosixPath+  mkPath = Path.unsafeFromArray++  loop = do+    resetErrno+    ptr <- c_readdir dirp+    if (ptr /= nullPtr)+    then do+        let dname = #{ptr struct dirent, d_name} ptr+        dtype :: #{type unsigned char} <- #{peek struct dirent, d_type} ptr+        -- dreclen :: #{type unsigned short} <- #{peek struct dirent, d_reclen} ptr+        -- It is possible to find the name length using dreclen and then use+        -- fromPtrN, but it is not straightforward because the reclen is+        -- padded to 8-byte boundary.+        name <- Array.fromCString (castPtr dname)+        etype <- getEntryType conf curdir dname dtype+        case etype of+            EntryIsDir -> return (Just (Left (mkPath name)))+            EntryIsNotDir -> return (Just (Right (mkPath name)))+            EntryIgnored -> loop+    else do+        errno <- getErrno+        if (errno == eINTR)+        then loop+        else do+            let (Errno n) = errno+            if (n == 0)+            -- then return (Left (mkPath (Array.fromList [46])))+            then return Nothing+            else throwErrno "readDirStreamEither"++-- XXX We can make this code common with windows, the path argument would be+-- redundant for windows case though.+{-# INLINE streamEitherReader #-}+streamEitherReader :: MonadIO m =>+    (ReadOptions -> ReadOptions) ->+    Unfold m (PosixPath, DirStream) (Either Path Path)+streamEitherReader confMod = Unfold step return+    where++    step s = do+        r <- liftIO $ readDirStreamEither confMod s+        case r of+            Nothing -> return Stop+            Just x -> return $ Yield x s++{-# INLINE streamReader #-}+streamReader :: MonadIO m => Unfold m (PosixPath, DirStream) Path+streamReader = fmap (either id id) (streamEitherReader id)++{-# INLINE before #-}+before :: PosixPath -> IO (PosixPath, DirStream)+before parent = (parent,) <$> openDirStream parent++{-# INLINE after #-}+after :: (PosixPath, DirStream) -> IO ()+after (_, dirStream) = closeDirStream dirStream++--  | Read a directory emitting a stream with names of the children. Filter out+--  "." and ".." entries.+--+--  /Internal/+--+{-# INLINE reader #-}+reader :: (MonadIO m, MonadCatch m) => Unfold m Path Path+reader =+    -- 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 before after (streamReader)++-- | Read directories as Left and files as Right. Filter out "." and ".."+-- entries.+--+--  /Internal/+--+{-# INLINE eitherReader #-}+eitherReader :: (MonadIO m, MonadCatch m) =>+    (ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)+eitherReader confMod =+    -- XXX The measured overhead of bracketIO is not noticeable, if it turns+    -- out to be a problem for small filenames we can use getdents64 to use+    -- chunked read to avoid the overhead.+    UF.bracketIO before after (streamEitherReader confMod)++{-# INLINE appendCString #-}+appendCString :: PosixPath -> CString -> IO PosixPath+appendCString (PosixPath a) b = do+    arr <- PathC.appendCString PathC.Posix a b+    pure $ PosixPath arr++{-# ANN type ChunkStreamState Fuse #-}+data ChunkStreamState =+      ChunkStreamInit [PosixPath] [PosixPath] Int [PosixPath] Int+    | ChunkStreamLoop+        PosixPath -- current dir path+        [PosixPath]  -- remaining dirs+        (Ptr CDir) -- current dir+        [PosixPath] -- dirs buffered+        Int    -- dir count+        [PosixPath] -- files buffered+        Int -- file count++-- XXX We can use a fold for collecting files and dirs.+-- A fold may be useful to translate the output to whatever format we want, we+-- can add a prefix or we can colorize it. The Right output would be the output+-- of the fold which can be any type not just a Path.++-- XXX We can write a two fold scan to buffer and yield whichever fills first+-- like foldMany, it would be foldEither.+{-# INLINE readEitherChunks #-}+readEitherChunks+    :: MonadIO m+    => (ReadOptions -> ReadOptions)+    -> [PosixPath] -> Stream m (Either [PosixPath] [PosixPath])+readEitherChunks confMod alldirs =+    Stream step (ChunkStreamInit alldirs [] 0 [] 0)++    where++    conf = confMod defaultReadOptions++    -- We want to keep the dir batching as low as possible for better+    -- concurrency esp when the number of dirs is low.+    dirMax = 4+    fileMax = 1000++    step _ (ChunkStreamInit (x:xs) dirs ndirs files nfiles) = do+        DirStream dirp <- liftIO $ openDirStream x+        return $ Skip (ChunkStreamLoop x xs dirp dirs ndirs files nfiles)++    step _ (ChunkStreamInit [] [] _ [] _) =+        return Stop++    step _ (ChunkStreamInit [] [] _ files _) =+        return $ Yield (Right files) (ChunkStreamInit [] [] 0 [] 0)++    step _ (ChunkStreamInit [] dirs _ files _) =+        return $ Yield (Left dirs) (ChunkStreamInit [] [] 0 files 0)++    step _ st@(ChunkStreamLoop curdir xs dirp dirs ndirs files nfiles) = do+        liftIO resetErrno+        dentPtr <- liftIO $ c_readdir dirp+        if (dentPtr /= nullPtr)+        then do+            let dname = #{ptr struct dirent, d_name} dentPtr+            dtype :: #{type unsigned char} <-+                liftIO $ #{peek struct dirent, d_type} dentPtr++            etype <- liftIO $ getEntryType conf curdir dname dtype+            case etype of+                EntryIsDir -> do+                     path <- liftIO $ appendCString curdir dname+                     let dirs1 = path : dirs+                         ndirs1 = ndirs + 1+                      in if ndirs1 >= dirMax+                         then return $ Yield (Left dirs1)+                            (ChunkStreamLoop curdir xs dirp [] 0 files nfiles)+                         else return $ Skip+                            (ChunkStreamLoop curdir xs dirp dirs1 ndirs1 files nfiles)+                EntryIsNotDir -> do+                 path <- liftIO $ appendCString curdir dname+                 let files1 = path : files+                     nfiles1 = nfiles + 1+                  in if nfiles1 >= fileMax+                     then return $ Yield (Right files1)+                        (ChunkStreamLoop curdir xs dirp dirs ndirs [] 0)+                     else return $ Skip+                        (ChunkStreamLoop curdir xs dirp dirs ndirs files1 nfiles1)+                EntryIgnored -> return $ Skip st+        else do+            errno <- liftIO getErrno+            if (errno == eINTR)+            then return $ Skip st+            else do+                let (Errno n) = errno+                -- XXX Exception safety+                liftIO $ closeDirStream (DirStream dirp)+                if (n == 0)+                then return $ Skip (ChunkStreamInit xs dirs ndirs files nfiles)+                else liftIO $ throwErrno "readEitherChunks"++foreign import ccall unsafe "string.h memcpy" c_memcpy+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)++-- See also cstringLength# in GHC.CString in ghc-prim+foreign import ccall unsafe "string.h strlen" c_strlen+    :: Ptr CChar -> IO CSize++-- Split a list in half.+splitHalf :: [a] -> ([a], [a])+splitHalf xxs = split xxs xxs++    where++    split (x:xs) (_:_:ys) =+        let (f, s) = split xs ys+         in (x:f, s)+    split xs _ = ([], xs)++{-# ANN type ChunkStreamByteState Fuse #-}+data ChunkStreamByteState =+      ChunkStreamByteInit+    | ChunkStreamByteStop+    | ChunkStreamByteLoop+        PosixPath -- current dir path+        [PosixPath]  -- remaining dirs+        (Ptr CDir) -- current dir stream+        MutByteArray+        Int+    | ChunkStreamReallocBuf+        (Ptr CChar) -- pending item+        PosixPath -- current dir path+        [PosixPath]  -- remaining dirs+        (Ptr CDir) -- current dir stream+        MutByteArray+        Int+    | ChunkStreamDrainBuf+        MutByteArray+        Int++-- XXX Detect cycles. ELOOP can be used to avoid cycles, but we can also detect+-- them proactively.++-- XXX Since we are separating paths by newlines, it cannot support newlines in+-- paths. Or we can return null separated paths as well. Provide a Mut array+-- API to replace the nulls with newlines in-place.+--+-- We can pass a fold to make this modular, but if we are passing readdir+-- managed memory then we will have to consume it immediately. Otherwise we can+-- use getdents64 directly and use GHC managed memory instead.+--+-- A fold may be useful to translate the output to whatever format we want, we+-- can add a prefix or we can colorize it.+--+-- XXX Use bufSize, recursive traversal, split strategy, output entries+-- separator as config options. When not using concurrently we do not need to+-- split the work at all.+--+-- XXX Currently we are quite aggressive in splitting the work because we have+-- no knowledge of whether we need to or not. But this leads to more overhead.+-- Instead, we can measure the coarse monotonic and process cpu time after+-- every n system calls or n iterations. If the cpu utilization is low then+-- yield the dirs otherwise dont. We can use an async thread for computing cpu+-- utilization periodically and all other threads can just read it from an+-- IORef. So this can be shared across all such consumers.++-- | This function may not traverse all the directories supplied and it may+-- traverse the directories recursively. Left contains those directories that+-- were not traversed by this function, these my be the directories that were+-- supplied as input as well as newly discovered directories during traversal.+-- To traverse the entire tree we have to iterate this function on the Left+-- output.+--+-- Right is a buffer containing directories and files separated by newlines.+--+{-# INLINE readEitherByteChunks #-}+readEitherByteChunks :: MonadIO m =>+    (ReadOptions -> ReadOptions) ->+    [PosixPath] -> Stream m (Either [PosixPath] (Array Word8))+readEitherByteChunks confMod alldirs =+    Stream step ChunkStreamByteInit++    where++    conf = confMod defaultReadOptions++    -- XXX A single worker may not have enough directories to list at once to+    -- fill up a large buffer. We need to change the concurrency model such+    -- that a worker should be able to pick up another dir from the queue+    -- without emitting an output until the buffer fills.+    --+    -- XXX A worker can also pick up multiple work items in one go. However, we+    -- also need to keep in mind that any kind of batching might have+    -- pathological cases where concurrency may be reduced.+    --+    -- XXX Alternatively, we can distribute the dir stream over multiple+    -- concurrent folds and return (monadic output) a stream of arrays created+    -- from the output channel, then consume that stream by using a monad bind.++    bufSize = 32000++    copyToBuf dstArr pos dirPath name = do+        nameLen <- fmap fromIntegral (liftIO $ c_strlen name)+        -- We know it is already pinned.+        MutByteArray.unsafeAsPtr dstArr (\ptr -> liftIO $ do+            -- XXX We may need to decode and encode the path if the+            -- output encoding differs from fs encoding.+            let PosixPath (Array dirArr start end) = dirPath+                dirLen = end - start+                endDir = pos + dirLen+                endPos = endDir + nameLen + 2 -- sep + newline+                sepOff = ptr `plusPtr` endDir -- separator offset+                nameOff = sepOff `plusPtr` 1  -- file name offset+                nlOff = nameOff `plusPtr` nameLen -- newline offset+                separator = 47 :: Word8+                newline = 10 :: Word8+            if (endPos < bufSize)+            then do+                -- XXX We can keep a trailing separator on the dir itself.+                MutByteArray.unsafePutSlice dirArr start dstArr pos dirLen+                poke sepOff separator+                _ <- c_memcpy nameOff (castPtr name) (fromIntegral nameLen)+                poke nlOff newline+                return (Just endPos)+            else return Nothing+            )++    step _ ChunkStreamByteInit = do+        mbarr <- liftIO $ MutByteArray.new' bufSize+        case alldirs of+            (x:xs) -> do+                DirStream dirp <- liftIO $ openDirStream x+                return $ Skip $ ChunkStreamByteLoop x xs dirp mbarr 0+            [] -> return Stop++    step _ ChunkStreamByteStop = return Stop++    step _ (ChunkStreamReallocBuf pending curdir xs dirp mbarr pos) = do+        mbarr1 <- liftIO $ MutByteArray.new' bufSize+        r1 <- copyToBuf mbarr1 0 curdir pending+        case r1 of+            Just pos2 ->+                return $ Yield (Right (Array mbarr 0 pos))+                    -- When we come in this state we have emitted dirs+                    (ChunkStreamByteLoop curdir xs dirp mbarr1 pos2)+            Nothing -> error "Dirname too big for bufSize"++    step _ (ChunkStreamDrainBuf mbarr pos) =+        if pos == 0+        then return Stop+        else return $ Yield (Right (Array mbarr 0 pos)) ChunkStreamByteStop++    step _ (ChunkStreamByteLoop icurdir ixs idirp mbarr ipos) = do+        goOuter icurdir idirp ixs ipos++        where++        -- This is recursed only when we open the next dir+        -- Encapsulates curdir and dirp as static arguments+        goOuter curdir dirp = goInner++            where++            -- This is recursed each time we find a dir+            -- Encapsulates dirs as static argument+            goInner dirs = nextEntry++                where++                {-# INLINE nextEntry #-}+                nextEntry pos = do+                    liftIO resetErrno+                    dentPtr <- liftIO $ c_readdir dirp+                    if dentPtr /= nullPtr+                    then handleDentry pos dentPtr+                    else handleErr pos++                openNextDir pos =+                    case dirs of+                        (x:xs) -> do+                            DirStream dirp1 <- liftIO $ openDirStream x+                            goOuter x dirp1 xs pos+                        [] ->+                            if pos == 0+                            then return Stop+                            else return+                                    $ Yield+                                        (Right (Array mbarr 0 pos))+                                        ChunkStreamByteStop++                handleErr pos = do+                    errno <- liftIO getErrno+                    if (errno /= eINTR)+                    then do+                        let (Errno n) = errno+                        liftIO $ closeDirStream (DirStream dirp)+                        if (n == 0)+                        then openNextDir pos+                        else liftIO $ throwErrno "readEitherByteChunks"+                    else nextEntry pos++                splitAndRealloc pos dname xs =+                    case xs of+                        [] ->+                            return $ Skip+                                (ChunkStreamReallocBuf dname curdir+                                    [] dirp mbarr pos)+                        _ -> do+                            let (h,t) = splitHalf xs+                            return $ Yield (Left t)+                                (ChunkStreamReallocBuf dname curdir+                                    h dirp mbarr pos)++                {-# INLINE handleFileEnt #-}+                handleFileEnt pos dname = do+                    r <- copyToBuf mbarr pos curdir dname+                    case r of+                        Just pos1 -> nextEntry pos1+                        Nothing -> splitAndRealloc pos dname dirs++                {-# INLINE handleDirEnt #-}+                handleDirEnt pos dname = do+                    path <- liftIO $ appendCString curdir dname+                    let dirs1 = path : dirs+                    r <- copyToBuf mbarr pos curdir dname+                    case r of+                        Just pos1 -> goInner dirs1 pos1+                        Nothing -> splitAndRealloc pos dname dirs1++                handleDentry pos dentPtr = do+                    let dname = #{ptr struct dirent, d_name} dentPtr+                    dtype :: #{type unsigned char} <-+                        liftIO $ #{peek struct dirent, d_type} dentPtr++                    etype <- liftIO $ getEntryType conf curdir dname dtype+                    case etype of+                        EntryIsNotDir -> handleFileEnt pos dname+                        EntryIsDir -> handleDirEnt pos dname+                        EntryIgnored -> nextEntry pos++{-# ANN type ByteChunksAt Fuse #-}+data ByteChunksAt =+      ByteChunksAtInit0+    | ByteChunksAtInit+        Fd+        [PosixPath] -- input dirs+        -- (Handle, [PosixPath]) -- output dirs+        -- Int -- count of output dirs+        MutByteArray -- output files and dirs+        Int -- position in MutByteArray+    | ByteChunksAtLoop+        Fd+        (Ptr CDir) -- current dir stream+        PosixPath -- current dir path+        [PosixPath]  -- remaining dirs+        [PosixPath] -- output dirs+        Int    -- output dir count+        MutByteArray+        Int+    | ByteChunksAtRealloc+        (Ptr CChar) -- pending item+        Fd+        (Ptr CDir) -- current dir stream+        PosixPath -- current dir path+        [PosixPath]  -- remaining dirs+        [PosixPath] -- output dirs+        Int    -- output dir count+        MutByteArray+        Int++-- The advantage of readEitherByteChunks over readEitherByteChunksAt is that we+-- do not need to open the dir handles and thus requires less open fd.+{-# INLINE readEitherByteChunksAt #-}+readEitherByteChunksAt :: MonadIO m => (ReadOptions -> ReadOptions) ->+       -- (parent dir path, child dir paths rel to parent)+       (PosixPath, [PosixPath])+    -> Stream m (Either (PosixPath, [PosixPath]) (Array Word8))+readEitherByteChunksAt confMod (ppath, alldirs) =+    Stream step (ByteChunksAtInit0)++    where+    conf = confMod defaultReadOptions++    bufSize = 4000++    copyToBuf dstArr pos dirPath name = do+        nameLen <- fmap fromIntegral (liftIO $ c_strlen name)+        -- XXX prepend ppath to dirPath+        let PosixPath (Array dirArr start end) = dirPath+            dirLen = end - start+            -- XXX We may need to decode and encode the path if the+            -- output encoding differs from fs encoding.+            --+            -- Account for separator and newline bytes.+            byteCount = dirLen + nameLen + 2+        if pos + byteCount <= bufSize+        then do+            -- XXX append a path separator to a dir path+            -- We know it is already pinned.+            MutByteArray.unsafeAsPtr dstArr (\ptr -> liftIO $ do+                MutByteArray.unsafePutSlice  dirArr start dstArr pos dirLen+                let ptr1 = ptr `plusPtr` (pos + dirLen)+                    separator = 47 :: Word8+                poke ptr1 separator+                let ptr2 = ptr1 `plusPtr` 1+                _ <- c_memcpy ptr2 (castPtr name) (fromIntegral nameLen)+                let ptr3 = ptr2 `plusPtr` nameLen+                    newline = 10 :: Word8+                poke ptr3 newline+                )+            return (Just (pos + byteCount))+        else return Nothing++    step _ ByteChunksAtInit0 = do+        -- Note this fd is not automatically closed, we have to take care of+        -- exceptions and closing the fd.+        pfd <- liftIO $ openAt Nothing ppath defaultOpenFlags Nothing+        mbarr <- liftIO $ MutByteArray.new' bufSize+        return $ Skip (ByteChunksAtInit pfd alldirs mbarr 0)++    step _ (ByteChunksAtInit ph (x:xs) mbarr pos) = do+        (DirStream dirp) <- liftIO $ openDirStreamAt ph x+        return $ Skip (ByteChunksAtLoop ph dirp x xs [] 0 mbarr pos)++    step _ (ByteChunksAtInit pfd [] _ 0) = do+        liftIO $ close (pfd)+        return Stop++    step _ (ByteChunksAtInit pfd [] mbarr pos) = do+        return+            $ Yield+                (Right (Array mbarr 0 pos))+                (ByteChunksAtInit pfd [] mbarr 0)++    step _ (ByteChunksAtRealloc pending pfd dirp curdir xs dirs ndirs mbarr pos) = do+        mbarr1 <- liftIO $ MutByteArray.new' bufSize+        r1 <- copyToBuf mbarr1 0 curdir pending+        case r1 of+            Just pos2 ->+                return $ Yield (Right (Array mbarr 0 pos))+                    (ByteChunksAtLoop pfd dirp curdir xs dirs ndirs mbarr1 pos2)+            Nothing -> error "Dirname too big for bufSize"++    step _ st@(ByteChunksAtLoop pfd dirp curdir xs dirs ndirs mbarr pos) = do+        liftIO resetErrno+        dentPtr <- liftIO $ c_readdir dirp+        if (dentPtr /= nullPtr)+        then do+            let dname = #{ptr struct dirent, d_name} dentPtr+            dtype :: #{type unsigned char} <-+                liftIO $ #{peek struct dirent, d_type} dentPtr++            -- Keep the file check first as it is more likely+            etype <- liftIO $ getEntryType conf curdir dname dtype+            case etype of+                EntryIsNotDir -> do+                    r <- copyToBuf mbarr pos curdir dname+                    case r of+                        Just pos1 ->+                            return $ Skip+                                (ByteChunksAtLoop+                                    pfd dirp curdir xs dirs ndirs mbarr pos1)+                        Nothing ->+                            return $ Skip+                                (ByteChunksAtRealloc+                                    dname pfd dirp curdir xs dirs ndirs mbarr pos)+                EntryIsDir -> do+                    arr <- Array.fromCString (castPtr dname)+                    let path = Path.unsafeFromArray arr+                    let dirs1 = path : dirs+                        ndirs1 = ndirs + 1+                    r <- copyToBuf mbarr pos curdir dname+                    case r of+                        Just pos1 ->+                            -- XXX When there is less parallelization at the+                            -- top of the tree, we should use smaller chunks.+                            {-+                            if ndirs > 64+                            then do+                                let fpath = Path.unsafeJoin ppath curdir+                                return $ Yield+                                    (Left (fpath, dirs1))+                                    (ByteChunksAtLoop pfd dirp curdir xs [] 0 mbarr pos1)+                            else+                            -}+                                return $ Skip+                                    (ByteChunksAtLoop+                                        pfd dirp curdir xs dirs1 ndirs1 mbarr pos1)+                        Nothing -> do+                            return $ Skip+                                (ByteChunksAtRealloc+                                    dname pfd dirp curdir xs dirs1 ndirs1 mbarr pos)+                EntryIgnored ->  return $ Skip st+        else do+            errno <- liftIO getErrno+            if (errno == eINTR)+            then return $ Skip st+            else do+                let (Errno n) = errno+                -- XXX What if an exception occurs in the code before this?+                -- Should we attach a weak IORef to close the fd on GC.+                liftIO $ closeDirStream (DirStream dirp)+                if (n == 0)+                then+                    -- XXX Yielding on each dir completion may hurt perf when+                    -- there are many small directories. However, it may also+                    -- help parallelize more in IO bound case.+                    if ndirs > 0+                    then do+                        let fpath = Path.unsafeJoin ppath curdir+                        return $ Yield+                            (Left (fpath, dirs))+                            (ByteChunksAtInit pfd xs mbarr pos)+                    else return $ Skip (ByteChunksAtInit pfd xs mbarr pos)+                else liftIO $ throwErrno "readEitherByteChunks"+#endif
+ src/Streamly/Internal/FileSystem/PosixPath.hs view
@@ -0,0 +1,1611 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE TemplateHaskell #-}++#if defined(IS_PORTABLE)+#define OS_PATH_TYPE Path+#define OS_WORD_TYPE OsWord+#define OS_CSTRING_TYPE OsCString+#define AS_OS_CSTRING asOsCString+#elif defined(IS_WINDOWS)+#define OS_PATH_TYPE WindowsPath+#define OS_WORD_TYPE Word16+#define OS_CSTRING_TYPE CWString+#define AS_OS_CSTRING asCWString+#else+#define OS_PATH_TYPE PosixPath+#define OS_WORD_TYPE Word8+#define OS_CSTRING_TYPE CString+#define AS_OS_CSTRING asCString+#endif++-- Anything other than windows (Linux/macOS/FreeBSD) is Posix+#if defined(IS_WINDOWS)+#define OS_NAME Windows+#define OS_PATH WindowsPath+#define OS_WORD Word16+#define OS_CSTRING CWString+#define UNICODE_ENCODER encodeUtf16le'+#define UNICODE_DECODER decodeUtf16le'+#define UNICODE_DECODER_LAX decodeUtf16le+#define CODEC_NAME UTF-16LE+#define SEPARATORS @/, \\@+#else+#define OS_NAME Posix+#define OS_PATH PosixPath+#define OS_WORD Word8+#define OS_CSTRING CString+#define UNICODE_ENCODER encodeUtf8'+#define UNICODE_DECODER decodeUtf8'+#define UNICODE_DECODER_LAX decodeUtf8+#define CODEC_NAME UTF-8+#define SEPARATORS @/@+#endif++-- |+-- Module      : Streamly.Internal.FileSystem.OS_PATH_TYPE+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- This module implements a OS_PATH_TYPE type representing a file system path for+-- OS_NAME operating systems. The only assumption about the encoding of the+-- path is that it maps the characters SEPARATORS and @.@ to OS_WORD_TYPE+-- representing their ASCII values. Operations are provided to encode and+-- decode using CODEC_NAME encoding.+--+-- This module has APIs that are equivalent to or can emulate all or most of+-- the filepath package APIs. It has some differences from the filepath+-- package:+--+-- * Empty paths are not allowed. Paths are validated before construction.+-- * The default Path type itself affords considerable safety regarding the+-- distinction of rooted or non-rooted paths, it also allows distinguishing+-- directory and file paths.+-- * It is designed to provide flexible typing to provide compile time safety+-- for rooted/non-rooted paths and file/dir paths. The Path type is just part+-- of that typed path ecosystem. Though the default Path type itself should be+-- enough for most cases.+-- * It leverages the streamly array module for most of the heavy lifting,+-- it is a thin wrapper on top of that, improving maintainability as well as+-- providing better performance. We can have pinned and unpinned paths, also+-- provide lower level operations for certain cases to interact more+-- efficinetly with low level code.++module Streamly.Internal.FileSystem.OS_PATH_TYPE+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Type+#if defined(IS_PORTABLE)+      OS_WORD_TYPE+    , OS_CSTRING_TYPE+    , OS_PATH_TYPE+#else+      OS_PATH_TYPE (..)+#endif+    -- * Conversions+    , IsPath (..)+    , adapt++    -- * Conversion to OsWord+    , charToWord+    , wordToChar++    -- * Validation+    , validatePath+    , isValidPath+#ifdef IS_WINDOWS+    , validatePath'+    , isValidPath'+#endif++    -- * Construction+    , fromArray+    , unsafeFromArray+    , fromChars+    , fromString+    , fromString_+    , encodeString+    , unsafeFromString+    -- , fromCString#+    -- , fromCWString#+    , readArray++    -- * Statically Verified String Literals+    -- | Quasiquoters.+    , path++    -- * Statically Verified Strings+    -- | Template Haskell expression splices.++    -- Note: We expose these even though we have quasiquoters as these TH+    -- helpers are more powerful. They are useful if we are generating strings+    -- statically using methods other than literals or if we are doing some+    -- text processing on strings before using them.+    , pathE++    -- * Elimination+    , toArray+    , toChars+    , toChars_+    , toString+    , AS_OS_CSTRING+    , toString_+    , showArray++    -- * Separators+    -- Do we need to export the separator char functions? They are not+    -- essential if operations to split and combine paths are provided. If+    -- someone wants to work on paths at low level then they know what they+    -- are. We should export the OsWord based operations to work with arrays.+    , separator+    , isSeparator+    , extSeparator++    -- * Dir or non-dir paths++    -- You do not need these, instead use eqPath with ignoreTrailingSeparators.+    , dropTrailingSeparators+    , hasTrailingSeparator+    , addTrailingSeparator++    -- * Path Segment Types+    , isRooted+    , isUnrooted++    -- * Joining+    , joinStr+ -- , concat+    , unsafeJoin+#ifndef IS_WINDOWS+    , joinCStr+    , joinCStr'+#endif+    , join+    , joinDir+    , unsafeJoinPaths++    -- * Splitting+    -- | Note: you can use 'unsafeJoin' as a replacement for the joinDrive+    -- function in the filepath package.+    , splitRoot+    , splitPath+    , splitPath_+    , splitFile++    , splitFirst+    , splitLast++    -- ** Extension+    , splitExtension+    , dropExtension+    , addExtension+    , replaceExtension++    -- ** Path View+    , takeFileName+    , takeDirectory+ -- , takeDirectory_ -- drops the trailing /+    , takeExtension+    , takeFileBase++    -- * Equality+    , EqCfg+    , ignoreTrailingSeparators+    , ignoreCase+    , allowRelativeEquality+    , eqPath+    , eqPathBytes+    , normalize+    )+where++import Control.Exception (throw)+import Control.Monad.Catch (MonadThrow(..))+import Data.Bifunctor (bimap)+import Data.Functor.Identity (Identity(..))+import Data.Maybe (fromJust, isJust)+#ifndef IS_WINDOWS+import Data.Word (Word8)+import Foreign.C (CString)+#else+import Data.Word (Word16)+import Foreign.C (CWString)+#endif+import Language.Haskell.TH.Syntax (lift)+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.FileSystem.Path.Common (mkQ, EqCfg(..))++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.FileSystem.Path.Common as Common+import qualified Streamly.Internal.Unicode.Stream as Unicode++import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Streamly.Internal.Data.Path++#if defined(IS_PORTABLE)+import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))+#endif++-- NOTES about C preprocessor use.+--+-- docspec comment lines cannot use CPP macros, docspec does not expand them+-- before running tests.+--+-- We cannot use a CPP conditional inside haddock comments because the+-- conditional line replaced by a blank line by CPP and this breaks the haddock+-- comment. Therefore if the comment is slightly different on a different+-- platform we duplicate the entire comment inside a conditional.++#ifdef IS_PORTABLE+#include "DocTestFileSystemPath.hs"+#elif defined(IS_WINDOWS)+#include "DocTestFileSystemWindowsPath.hs"+#else+#include "DocTestFileSystemPosixPath.hs"+#endif++#if defined(IS_PORTABLE)+type OS_PATH_TYPE = OS_PATH+type OS_WORD_TYPE = OS_WORD+type OS_CSTRING_TYPE = OS_CSTRING+#else+-- | A type representing file system paths on OS_NAME.+--+-- A OS_PATH_TYPE is validated before construction unless unsafe constructors are+-- used to create it. For validations performed by the safe construction+-- methods see the 'fromChars' function.+--+-- Note that in some cases the file system may perform unicode normalization on+-- paths (e.g. Apple HFS), it may cause surprising results as the path used by+-- the user may not have the same bytes as later returned by the file system.+newtype OS_PATH = OS_PATH (Array OS_WORD_TYPE)++-- XXX The Eq instance may be provided but it will require some sensible+-- defaults for comparison. For example, should we use case sensitive or+-- insensitive comparison? It depends on the underlying file system. For now+-- now we have eqPath operations for equality comparison.++instance IsPath OS_PATH OS_PATH where+    unsafeFromPath = id+    fromPath = pure+    toPath = id+#endif++-- XXX Use rewrite rules to eliminate intermediate conversions for better+-- efficiency. If the argument path is already verfied for a property, we+-- should not verify it again e.g. if we adapt (Rooted path) as (Rooted (Dir+-- path)) then we should not verify it to be Rooted again.++-- XXX castPath?++-- | Convert a path type to another path type. This operation may fail with a+-- 'PathException' when converting a less restrictive path type to a more+-- restrictive one. This can be used to upgrade or downgrade type safety.+adapt :: (MonadThrow m, IsPath OS_PATH_TYPE a, IsPath OS_PATH_TYPE b) => a -> m b+adapt p = fromPath (toPath p :: OS_PATH_TYPE)++------------------------------------------------------------------------------+-- Char to word+------------------------------------------------------------------------------++-- | Unsafe, truncates the Char to Word8 on Posix and Word16 on Windows.+charToWord :: Char -> OS_WORD_TYPE+charToWord = Common.charToWord++-- | Unsafe, should be a valid character.+wordToChar :: OS_WORD_TYPE -> Char+wordToChar = Common.wordToChar++------------------------------------------------------------------------------+-- Separators+------------------------------------------------------------------------------++-- | The primary path separator word: @/@ on POSIX and @\\@ on Windows.+-- Windows also supports @/@ as a valid separator. Use 'isSeparator' to check+-- for any valid path separator.+{-# INLINE separator #-}+separator :: OS_WORD_TYPE+separator = charToWord $ Common.primarySeparator Common.OS_NAME++-- | On POSIX, only @/@ is a path separator, whereas on Windows both @/@ and+-- @\\@ are valid separators.+{-# INLINE isSeparator #-}+isSeparator :: OS_WORD_TYPE -> Bool+isSeparator = Common.isSeparatorWord Common.OS_NAME++-- | File extension separator word.+{-# INLINE extSeparator #-}+extSeparator :: OS_WORD_TYPE+extSeparator = Common.extensionWord++------------------------------------------------------------------------------+-- Path parsing utilities+------------------------------------------------------------------------------++-- XXX We can have prime suffixed versions where it drops or adds separator+-- unconditionally. Alternatively, we can convert the path to array and use+-- array operations instead.++-- | Remove all trailing path separators from the given 'Path'.+--+-- Instead of this operation you may want to use 'eqPath' with+-- 'ignoreTrailingSeparators' option.+--+-- This operation is careful not to alter the semantic meaning of the path.+-- For example, on Windows:+--+--   * Dropping the separator from "C:/" would change the meaning of the path+--     from referring to the root of the C: drive to the current directory on C:.+--   * If a path ends with a separator immediately after a colon (e.g., "C:/"),+--     the separator will not be removed.+--+-- If the input path is invalid, the behavior is not fully guaranteed:+--+--   * The separator may still be dropped.+--   * In some cases, dropping the separator may make an invalid path valid+--     (e.g., "C:\\\\" or "C:\\/").+--+-- This operation may convert a path that implicitly refers to a directory+-- into one that does not.+--+-- Typically, if the path is @dir//@, the result is @dir@. Special cases include:+--+--   * On POSIX: dropping from @"//"@ yields @"/"@.+--   * On Windows: dropping from @"C://"@ results in @"C:/"@.+--+-- Examples:+--+-- >>> f = Path.toString . Path.dropTrailingSeparators . Path.fromString_+-- >>> f "./"+-- "."+--+-- >> f "//"  -- On POSIX+-- "/"+--+{-# INLINE dropTrailingSeparators #-}+dropTrailingSeparators :: OS_PATH_TYPE -> OS_PATH_TYPE+dropTrailingSeparators (OS_PATH arr) =+    OS_PATH (Common.dropTrailingSeparators Common.OS_NAME arr)++-- On windows a share name can also be reported to have a trailing separator,+-- but that is not a valid Path.++-- | Returns 'True' if the path ends with a trailing separator.+--+-- This typically indicates that the path is a directory, though this is not+-- guaranteed in all cases.+--+-- Example:+--+-- >>> Path.hasTrailingSeparator (Path.fromString_ "foo/")+-- True+--+-- >>> Path.hasTrailingSeparator (Path.fromString_ "foo")+-- False+{-# INLINE hasTrailingSeparator #-}+hasTrailingSeparator :: OS_PATH_TYPE -> Bool+hasTrailingSeparator (OS_PATH arr) =+    Common.hasTrailingSeparator Common.OS_NAME arr++-- | Add a trailing path separator to a path if it doesn't already have one.+--+-- Instead of this operation you may want to use 'eqPath' with+-- 'ignoreTrailingSeparators' option.+--+-- This function avoids modifying the path if doing so would change its meaning+-- or make it invalid. For example, on Windows:+--+--   * Adding a separator to "C:" would change it from referring to the current+--     directory on the C: drive to the root directory.+--   * Adding a separator to "\\" could turn it into a UNC share path, which may+--     not be intended.+--   * If the path ends with a colon (e.g., "C:"), a separator is not added.+--+-- This operation typically makes the path behave like an implicit directory path.+{-# INLINE addTrailingSeparator #-}+addTrailingSeparator :: OS_PATH_TYPE -> OS_PATH_TYPE+addTrailingSeparator p@(OS_PATH _arr) =+#ifdef IS_WINDOWS+    if Array.unsafeGetIndexRev 0 _arr == Common.charToWord ':'+    then p+    else unsafeJoin p sep+#else+    unsafeJoin p sep+#endif++    where++    sep = fromJust $ fromString [Common.primarySeparator Common.OS_NAME]++-- Path must not contain null char as system calls treat the path as a null+-- terminated C string. Also, they return null terminated strings as paths.+--+-- XXX Maintain the Array with null termination? To avoid copying the path for+-- null termination when passing to system calls. Path appends will have to+-- handle the null termination.++#ifndef IS_WINDOWS+-- | Checks whether the filepath is valid; i.e., whether the operating system+-- permits such a path for listing or creating files. These validations are+-- operating system specific and file system independent. Throws an exception+-- with a detailed explanation if the path is invalid.+--+-- >>> isValid = isJust . Path.validatePath . Path.encodeString+--+-- Validations:+--+-- >>> isValid ""+-- False+-- >>> isValid "\0"+-- False+--+-- Other than these there may be maximum path component length and maximum path+-- length restrictions enforced by the OS as well as the filesystem which we do+-- not validate.+--+#else+-- | Checks whether the filepath is valid; i.e., whether the operating system+-- permits such a path for listing or creating files. These validations are+-- operating system specific and file system independent. Throws an exception+-- with a detailed explanation if the path is invalid.+--+-- >>> isValid = isJust . Path.validatePath . Path.encodeString+--+-- General validations:+--+-- >>> isValid ""+-- False+-- >>> isValid "\0"+-- False+--+-- Windows invalid characters:+--+-- >>> isValid "c::"+-- False+-- >>> isValid "c:\\x:y"+-- False+-- >>> isValid "x*"+-- False+-- >>> isValid "x\ty" -- control characters+-- False+--+-- Windows invalid path components:+--+-- >>> isValid "pRn.txt"+-- False+-- >>> isValid " pRn .txt"+-- False+-- >>> isValid "c:\\x\\pRn"+-- False+-- >>> isValid "c:\\x\\pRn.txt"+-- False+-- >>> isValid "c:\\pRn\\x"+-- False+-- >>> isValid "c:\\ pRn \\x"+-- False+-- >>> isValid "pRn.x.txt"+-- False+--+-- Windows drive root validations:+--+-- >>> isValid "c:"+-- True+-- >>> isValid "c:a\\b"+-- True+-- >>> isValid "c:\\"+-- True+-- >>> isValid "c:\\\\"+-- False+-- >>> isValid "c:\\/"+-- False+-- >>> isValid "c:\\\\x"+-- False+-- >>> isValid "c:\\/x"+-- False+--+-- Mixing path separators:+-- >>> isValid "/x\\y"+-- True+-- >>> isValid "\\/" -- ?+-- True+-- >>> isValid "/\\" -- ?+-- True+-- >>> isValid "\\/x/y" -- ?+-- True+-- >>> isValid "/x/\\y" -- ?+-- True+-- >>> isValid "/x\\/y" -- ?+-- True+--+-- Windows share path validations:+--+-- >>> isValid "\\"+-- True+-- >>> isValid "\\\\"+-- False+-- >>> isValid "\\\\\\"+-- False+-- >>> isValid "\\\\x"+-- False+-- >>> isValid "\\\\x\\"+-- True+-- >>> isValid "\\\\x\\y"+-- True+-- >>> isValid "//x/y"+-- True+-- >>> isValid "\\\\prn\\y"+-- False+-- >>> isValid "\\\\x\\\\"+-- False+-- >>> isValid "\\\\x\\\\x"+-- False+-- >>> isValid "\\\\\\x"+-- False+--+-- Windows short UNC path validations:+--+-- >>> isValid "\\\\?\\c:"+-- False+-- >>> isValid "\\\\?\\c:\\"+-- True+-- >>> isValid "\\\\?\\c:x"+-- False+-- >>> isValid "\\\\?\\c:\\\\" -- XXX validate this+-- False+-- >>> isValid "\\\\?\\c:\\x"+-- True+-- >>> isValid "\\\\?\\c:\\\\\\"+-- False+-- >>> isValid "\\\\?\\c:\\\\x"+-- False+--+-- Windows long UNC path validations:+--+-- >>> isValid "\\\\?\\UnC\\x" -- UnC treated as share name+-- True+-- >>> isValid "\\\\?\\UNC\\x" -- XXX fix+-- False+-- >>> isValid "\\\\?\\UNC\\c:\\x"+-- True+--+-- DOS local/global device namespace+--+-- >>> isValid "\\\\.\\x"+-- True+-- >>> isValid "\\\\??\\x"+-- True+--+-- Other than these there may be maximum path component length and maximum path+-- length restrictions enforced by the OS as well as the filesystem which we do+-- not validate.+--+#endif+validatePath :: MonadThrow m => Array OS_WORD_TYPE -> m ()+validatePath = Common.validatePath Common.OS_NAME++-- | Returns 'True' if the filepath is valid:+--+-- >>> isValidPath = isJust . Path.validatePath+--+isValidPath :: Array OS_WORD_TYPE -> Bool+isValidPath = isJust . validatePath++-- Note: CPP gets confused by the prime suffix, so we have to put the CPP+-- macros on the next line to get it to work.++------------------------------------------------------------------------------+-- Construction+------------------------------------------------------------------------------++-- A chunk is essentially an untyped Array i.e. Array Word8.  We can either use+-- the term ByteArray for that or just Chunk. The latter is shorter and we have+-- been using it consistently in streamly. We use "bytes" for a stream of+-- bytes.++-- | /Unsafe/: The user is responsible to make sure that the path is valid as+-- per 'validatePath'.+--+{-# INLINE unsafeFromArray #-}+unsafeFromArray :: Array OS_WORD_TYPE -> OS_PATH_TYPE+unsafeFromArray =+#ifndef DEBUG+    OS_PATH . Common.unsafeFromArray+#else+    fromJust . fromArray+#endif++#ifndef IS_WINDOWS+-- | Convert an encoded array of OS_WORD_TYPE into a value of type+-- OS_PATH_TYPE. The path is validated using 'validatePath'.+--+-- Each OS_WORD_TYPE should be encoded such that:+--+-- * The input does not contain a NUL word.+-- * Values from 1-128 are assumed to be ASCII characters.+--+-- Apart from the above, there are no restrictions on the encoding.+--+-- To bypass path validation checks, use 'unsafeFromArray'.+--+-- Throws 'InvalidPath' if 'validatePath' fails on the resulting path.+--+#else+-- | Convert an encoded array of OS_WORD_TYPE into a value of type+-- OS_PATH_TYPE. The path is validated using 'validatePath'.+--+-- Each OS_WORD_TYPE should be encoded such that:+--+-- * The input does not contain a NUL word.+-- * The OS_WORD_TYPE is encoded with little-endian ordering.+-- * Values from 1-128 are assumed to be ASCII characters.+--+-- Apart from the above, there are no restrictions on the encoding.+--+-- To bypass path validation checks, use 'unsafeFromArray'.+--+-- Throws 'InvalidPath' if 'validatePath' fails on the resulting path.+--+#endif+fromArray :: MonadThrow m => Array OS_WORD_TYPE -> m OS_PATH_TYPE+fromArray arr = OS_PATH <$> Common.fromArray Common.OS_NAME arr++-- XXX Should be a Fold instead?++-- | Like 'fromString' but a streaming operation.+--+-- >>> fromString = Path.fromChars . Stream.fromList+--+-- We do not sanitize the path i.e. we do not remove duplicate separators,+-- redundant @.@ segments, trailing separators etc because that would require+-- unnecessary checks and modifications to the path which may not be used ever+-- for any useful purpose, it is only needed for path equality and can be done+-- during the equality check.+--+-- Unicode normalization is not done. If normalization is needed the user can+-- normalize it and then use the 'fromArray' API.+{-# INLINE fromChars #-}+fromChars :: MonadThrow m => Stream Identity Char -> m OS_PATH_TYPE+fromChars s =+    OS_PATH <$> Common.fromChars Common.OS_NAME Unicode.UNICODE_ENCODER s++-- | Create an array from a path string using strict CODEC_NAME encoding. The+-- path is not validated, therefore, it may not be valid according to+-- 'validatePath'.+--+-- Same as @toArray . unsafeFromString@.+encodeString :: [Char] -> Array OS_WORD_TYPE+encodeString =+      Common.unsafeFromChars Unicode.UNICODE_ENCODER+    . Stream.fromList++-- | Like 'fromString' but does not perform any validations mentioned under+-- 'validatePath'. Fails only if unicode encoding fails.+unsafeFromString :: [Char] -> OS_PATH_TYPE+unsafeFromString =+#ifndef DEBUG+      OS_PATH+    . encodeString+#else+    fromJust . fromString+#endif++-- | Encode a Unicode character string to OS_PATH_TYPE using strict CODEC_NAME+-- encoding. The path is validated using 'validatePath'.+--+-- * Throws 'InvalidPath' if 'validatePath' fails on the path+-- * Fails if the stream contains invalid unicode characters+--+fromString :: MonadThrow m => [Char] -> m OS_PATH_TYPE+fromString = fromChars . Stream.fromList++-- | Like fromString but a pure and partial function that throws an+-- 'InvalidPath' exception.+fromString_ :: [Char] -> OS_PATH_TYPE+fromString_ x =+        case fromString x of+            Left e -> throw e+            Right v -> v++-- | Append a separator followed by the supplied string to a path.+--+--  Throws 'InvalidPath' if the resulting path is not a valid path as per+--  'validatePath'.+--+joinStr :: OS_PATH_TYPE -> [Char] -> OS_PATH_TYPE+joinStr (OS_PATH a) b =+    OS_PATH $+        Common.append Common.OS_NAME+            (Common.toString Unicode.UNICODE_DECODER) a (encodeString b)+++------------------------------------------------------------------------------+-- Statically Verified Strings+------------------------------------------------------------------------------++-- XXX We can lift the array directly, ByteArray has a lift instance. Does that+-- work better?+--+-- XXX Make this polymorphic and reusable in other modules.++liftPath :: OS_PATH_TYPE -> Q Exp+liftPath p =+    [| unsafeFromString $(lift $ toString p) :: OS_PATH |]++-- | Generates a Haskell expression of type OS_PATH_TYPE from a String. Equivalent+-- to using 'fromString' on the string passed.+--+pathE :: String -> Q Exp+pathE = either (error . show) liftPath . fromString++------------------------------------------------------------------------------+-- Statically Verified Literals+------------------------------------------------------------------------------++-- XXX Define folds or parsers to parse the paths.+-- XXX Build these on top of the str quasiquoter so that we get interpolation+-- for free. Interpolated vars if any have to be of appropriate type depending+-- on the context so that we can splice them safely.++#ifdef IS_PORTABLE+-- | Generates a OS_PATH_TYPE type from a quoted literal. Equivalent to using+-- 'fromString' on the static literal.+--+-- >>> Path.toString ([path|/usr/bin|] :: Path)+-- "/usr/bin"+--+#endif+path :: QuasiQuoter+path = mkQ pathE++------------------------------------------------------------------------------+-- Eimination+------------------------------------------------------------------------------++-- | Convert the path to an array.+toArray :: OS_PATH_TYPE -> Array OS_WORD_TYPE+toArray (OS_PATH arr) = arr++-- | Decode the path to a stream of Unicode chars using strict CODEC_NAME decoding.+{-# INLINE toChars #-}+toChars :: Monad m => OS_PATH_TYPE -> Stream m Char+toChars (OS_PATH arr) = Common.toChars Unicode.UNICODE_DECODER arr++-- | Decode the path to a stream of Unicode chars using lax CODEC_NAME decoding.+toChars_ :: Monad m => OS_PATH_TYPE -> Stream m Char+toChars_ (OS_PATH arr) = Common.toChars Unicode.UNICODE_DECODER_LAX arr++-- XXX When showing, append a "/" to dir types?++-- | Decode the path to a Unicode string using strict CODEC_NAME decoding.+toString :: OS_PATH_TYPE -> [Char]+toString = runIdentity . Stream.toList . toChars++-- | Decode the path to a Unicode string using lax CODEC_NAME decoding.+toString_ :: OS_PATH_TYPE -> [Char]+toString_ = runIdentity . Stream.toList . toChars_++-- | Show the path as raw characters without any specific decoding.+--+-- See also: 'readArray'.+--+showArray :: OS_PATH_TYPE -> [Char]+showArray (OS_PATH arr) = show arr++#ifndef IS_WINDOWS+#ifdef IS_PORTABLE+-- | Parse a raw array of bytes as a path type.+--+-- >>> readArray = fromJust . Path.fromArray . read+--+-- >>> arr = Path.encodeString "hello"+-- >>> Path.showArray $ (Path.readArray $ show arr :: Path.Path)+-- "fromList [104,101,108,108,111]"+--+-- See also: 'showArray'.+#endif+readArray :: [Char] -> OS_PATH_TYPE+readArray = fromJust . fromArray . read+#endif++-- We cannot show decoded path in the Show instance as it may not always+-- succeed and it depends on the encoding which we may not even know. The+-- encoding may depend on the OS and the file system. Also we need Show and+-- Read to be inverses. The best we can provide is to show the bytes as+-- Hex or decimal values.+{-+instance Show OS_PATH where+    show (OS_PATH x) = show x+-}++#ifndef IS_WINDOWS+-- | Use the path as a pinned CString. Useful for using a PosixPath in+-- system calls on Posix.+{-# INLINE AS_OS_CSTRING #-}+AS_OS_CSTRING :: OS_PATH_TYPE -> (OS_CSTRING_TYPE -> IO a) -> IO a+AS_OS_CSTRING p = Array.asCStringUnsafe (toArray p)+#else+-- | Use the path as a pinned CWString. Useful for using a WindowsPath in+-- system calls on Windows.+{-# INLINE AS_OS_CSTRING #-}+AS_OS_CSTRING :: OS_PATH_TYPE -> (OS_CSTRING_TYPE -> IO a) -> IO a+AS_OS_CSTRING p = Array.asCWString (toArray p)+#endif++------------------------------------------------------------------------------+-- Operations on Path+------------------------------------------------------------------------------++#ifndef IS_WINDOWS+-- | A path that is attached to a root e.g. "\/x" or ".\/x" are rooted paths.+-- "\/" is considered an absolute root and "." as a dynamic root. ".." is not+-- considered a root, "..\/x" or "x\/y" are not rooted paths.+--+-- >>> isRooted = Path.isRooted . Path.fromString_+--+-- >>> isRooted "/"+-- True+-- >>> isRooted "/x"+-- True+-- >>> isRooted "."+-- True+-- >>> isRooted "./x"+-- True+--+isRooted :: OS_PATH_TYPE -> Bool+isRooted (OS_PATH arr) = Common.isRooted Common.OS_NAME arr+#endif++-- | A path that is not attached to a root e.g. @a\/b\/c@ or @..\/b\/c@.+--+-- >>> isUnrooted = not . Path.isRooted+--+-- >>> isUnrooted = Path.isUnrooted . Path.fromString_+--+-- >>> isUnrooted "x"+-- True+-- >>> isUnrooted "x/y"+-- True+-- >>> isUnrooted ".."+-- True+-- >>> isUnrooted "../x"+-- True+--+isUnrooted :: OS_PATH_TYPE -> Bool+isUnrooted = not . isRooted++#ifndef IS_WINDOWS+-- | Like 'join' but does not check if the second path is rooted.+--+-- >>> f a b = Path.toString $ Path.unsafeJoin (Path.fromString_ a) (Path.fromString_ b)+--+-- >>> f "x" "y"+-- "x/y"+-- >>> f "x/" "y"+-- "x/y"+-- >>> f "x" "/y"+-- "x/y"+-- >>> f "x/" "/y"+-- "x/y"+--+{-# INLINE unsafeJoin #-}+unsafeJoin :: OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+unsafeJoin (OS_PATH a) (OS_PATH b) =+    OS_PATH+        $ Common.unsafeAppend+            Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b++-- If you want to avoid runtime failure use the typesafe+-- Streamly.FileSystem.OS_PATH_TYPE.Seg module.++-- | Append a separator followed by another path to a OS_PATH_TYPE. Fails if+-- the second path is a rooted path. Use 'unsafeJoin' to avoid failure if you+-- know it is ok to append the rooted path.+--+-- >>> f a b = Path.toString $ Path.join a b+--+-- >>> f [path|/usr|] [path|bin|]+-- "/usr/bin"+-- >>> f [path|/usr/|] [path|bin|]+-- "/usr/bin"+-- >>> fails (f [path|/usr|] [path|/bin|])+-- True+--+join :: OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+join (OS_PATH a) (OS_PATH b) =+    OS_PATH+        $ Common.append+            Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b++-- | A stricter version of 'join' which requires the first path to be a+-- directory like path i.e. having a trailing separator.+--+-- >>> f a b = Path.toString $ Path.joinDir a b+--+-- >>> fails $ f [path|/usr|] [path|bin|]+-- True+--+joinDir ::+    OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+joinDir+    (OS_PATH a) (OS_PATH b) =+    OS_PATH+        $ Common.append'+            Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b+#endif++-- XXX This can be pure, like append.+-- XXX add appendCWString for Windows?++#ifndef IS_WINDOWS+-- | Append a separator and a CString to the Array. This is like 'unsafeJoin'+-- but always inserts a separator between the two paths even if the first path+-- has a trailing separator or second path has a leading separator.+--+joinCStr :: OS_PATH_TYPE -> CString -> IO OS_PATH_TYPE+joinCStr (OS_PATH a) str =+    fmap OS_PATH+        $ Common.appendCString+            Common.OS_NAME a str++-- | Like 'joinCStr' but creates a pinned path.+--+joinCStr' ::+    OS_PATH_TYPE -> CString -> IO OS_PATH_TYPE+joinCStr'+    (OS_PATH a) str =+    fmap OS_PATH+        $ Common.appendCString'+            Common.OS_NAME a str+#endif++-- See unsafeJoinPaths in the Common path module, we need to avoid MonadIo from+-- that to implement this.++-- | Join paths by path separator. Does not check if the paths being appended+-- are rooted or branches. Note that splitting and joining may not give exactly+-- the original path but an equivalent path.+--+-- /Unimplemented/+unsafeJoinPaths :: [OS_PATH_TYPE] -> OS_PATH_TYPE+unsafeJoinPaths = undefined++------------------------------------------------------------------------------+-- Splitting path+------------------------------------------------------------------------------++#ifndef IS_WINDOWS+-- | If a path is rooted then separate the root and the remaining path,+-- otherwise return 'Nothing'. The non-root+-- part is guaranteed to NOT start with a separator.+--+-- Some filepath package equivalent idioms:+--+-- >>> splitDrive = Path.splitRoot+-- >>> joinDrive = Path.unsafeJoin+-- >>> takeDrive = fmap fst . Path.splitRoot+-- >>> dropDrive x = Path.splitRoot x >>= snd+-- >>> hasDrive = isJust . Path.splitRoot+-- >>> isDrive = isNothing . dropDrive+--+-- >>> toList (a,b) = (Path.toString a, fmap Path.toString b)+-- >>> split = fmap toList . Path.splitRoot . Path.fromString_+--+-- >>> split "/"+-- Just ("/",Nothing)+--+-- >>> split "."+-- Just (".",Nothing)+--+-- >>> split "./"+-- Just ("./",Nothing)+--+-- >>> split "/home"+-- Just ("/",Just "home")+--+-- >>> split "//"+-- Just ("//",Nothing)+--+-- >>> split "./home"+-- Just ("./",Just "home")+--+-- >>> split "home"+-- Nothing+--+splitRoot :: OS_PATH_TYPE -> Maybe (OS_PATH_TYPE, Maybe OS_PATH_TYPE)+splitRoot (OS_PATH x) =+    let (a,b) = Common.splitRoot Common.OS_NAME x+     in if Array.null a+        then Nothing+        else if Array.null b+        then Just (OS_PATH a, Nothing)+        else Just (OS_PATH a, Just (OS_PATH b))++-- | Split the path components keeping separators between path components+-- attached to the dir part. Redundant separators are removed, only the first+-- one is kept. Separators are not added either e.g. "." and ".." may not have+-- trailing separators if the original path does not.+--+-- >>> split = Stream.toList . fmap Path.toString . Path.splitPath . Path.fromString_+--+-- >>> split "."+-- ["."]+--+-- >>> split "././"+-- ["./"]+--+-- >>> split "./a/b/."+-- ["./","a/","b/"]+--+-- >>> split ".."+-- [".."]+--+-- >>> split "../"+-- ["../"]+--+-- >>> split "a/.."+-- ["a/",".."]+--+-- >>> split "/"+-- ["/"]+--+-- >>> split "//"+-- ["/"]+--+-- >>> split "/x"+-- ["/","x"]+--+-- >>> split "/./x/"+-- ["/","x/"]+--+-- >>> split "/x/./y"+-- ["/","x/","y"]+--+-- >>> split "/x/../y"+-- ["/","x/","../","y"]+--+-- >>> split "/x///y"+-- ["/","x/","y"]+--+-- >>> split "/x/\\y"+-- ["/","x/","\\y"]+--+{-# INLINE splitPath #-}+splitPath :: Monad m => OS_PATH_TYPE -> Stream m OS_PATH_TYPE+splitPath (OS_PATH a) = fmap OS_PATH $ Common.splitPath Common.OS_NAME a++-- | Split a path into components separated by the path separator. "."+-- components in the path are ignored except when in the leading position.+-- Trailing separators in non-root components are dropped.+--+-- >>> split = Stream.toList . fmap Path.toString . Path.splitPath_ . Path.fromString_+--+-- >>> split "."+-- ["."]+--+-- >>> split "././"+-- ["."]+--+-- >>> split ".//"+-- ["."]+--+-- >>> split "//"+-- ["/"]+--+-- >>> split "//x/y/"+-- ["/","x","y"]+--+-- >>> split "./a"+-- [".","a"]+--+-- >>> split "a/."+-- ["a"]+--+-- >>> split "/"+-- ["/"]+--+-- >>> split "/x"+-- ["/","x"]+--+-- >>> split "/./x/"+-- ["/","x"]+--+-- >>> split "/x/./y"+-- ["/","x","y"]+--+-- >>> split "/x/../y"+-- ["/","x","..","y"]+--+-- >>> split "/x///y"+-- ["/","x","y"]+--+-- >>> split "/x/\\y"+-- ["/","x","\\y"]+--+{-# INLINE splitPath_ #-}+splitPath_ :: Monad m => OS_PATH_TYPE -> Stream m OS_PATH_TYPE+splitPath_ (OS_PATH a) = fmap OS_PATH $ Common.splitPath_ Common.OS_NAME a+#endif++-- | If the path does not look like a directory then return @Just (Maybe dir,+-- file)@ otherwise return 'Nothing'. The path is not a directory if:+--+-- * the path does not end with a separator+-- * the path does not end with a . or .. component+--+-- Splits a single component path into @Just (Nothing, path)@ if it does not+-- look like a dir.+--+-- >>> toList (a,b) = (fmap Path.toString a, Path.toString b)+-- >>> split = fmap toList . Path.splitFile . Path.fromString_+--+-- >>> split "/"+-- Nothing+--+-- >>> split "."+-- Nothing+--+-- >>> split "/."+-- Nothing+--+-- >>> split ".."+-- Nothing+--+-- >> split "//" -- Posix+-- Nothing+--+-- >>> split "/home"+-- Just (Just "/","home")+--+-- >>> split "./home"+-- Just (Just "./","home")+--+-- >>> split "home"+-- Just (Nothing,"home")+--+-- >>> split "x/"+-- Nothing+--+-- >>> split "x/y"+-- Just (Just "x/","y")+--+-- >>> split "x//y"+-- Just (Just "x//","y")+--+-- >>> split "x/./y"+-- Just (Just "x/./","y")+splitFile :: OS_PATH_TYPE -> Maybe (Maybe OS_PATH_TYPE, OS_PATH_TYPE)+splitFile (OS_PATH a) =+    fmap (bimap (fmap OS_PATH) OS_PATH) $ Common.splitFile Common.OS_NAME a++-- | Split the path into the first component and rest of the path. Treats the+-- entire root or share name, if present, as the first component.+--+-- /Unimplemented/+splitFirst :: OS_PATH_TYPE -> (OS_PATH_TYPE, Maybe OS_PATH_TYPE)+splitFirst (OS_PATH a) =+    bimap OS_PATH (fmap OS_PATH) $ Common.splitHead Common.OS_NAME a++-- | Split the path into the last component and rest of the path. Treats the+-- entire root or share name, if present, as the first component.+--+-- >>> basename = snd . Path.splitLast -- Posix basename+-- >>> dirname = fst . Path.splitLast -- Posix dirname+--+-- /Unimplemented/+splitLast :: OS_PATH_TYPE -> (Maybe OS_PATH_TYPE, OS_PATH_TYPE)+splitLast (OS_PATH a) =+    bimap (fmap OS_PATH) OS_PATH $ Common.splitTail Common.OS_NAME a++#ifndef IS_WINDOWS+-- Note: In the cases of "x.y." and "x.y.." we return no extension rather+-- than ".y." or ".y.." as extensions. That is they considered to have no+-- extension.++-- | Returns @Just(filename, extension)@ if an extension is present otherwise+-- returns 'Nothing'.+--+-- A file name is considered to have an extension if the file name can be+-- split into a non-empty filename followed by the extension separator "."+-- followed by a non-empty extension with at least one character in addition to+-- the extension separator.+-- The shortest suffix obtained by this rule, starting with the+-- extension separator, is returned as the extension and the remaining prefix+-- part as the filename.+--+-- A directory name does not have an extension.+--+-- If you want a @splitExtensions@, you can use splitExtension until the+-- extension returned is Nothing. @dropExtensions@, @isExtensionOf@ can be+-- implemented similarly.+--+-- >>> toList (a,b) = (Path.toString a, Path.toString b)+-- >>> split = fmap toList . Path.splitExtension . Path.fromString_+--+-- >>> split "/"+-- Nothing+--+-- >>> split "."+-- Nothing+--+-- >>> split ".."+-- Nothing+--+-- >>> split "x"+-- Nothing+--+-- >>> split "/x"+-- Nothing+--+-- >>> split "x/"+-- Nothing+--+-- >>> split "./x"+-- Nothing+--+-- >>> split "x/."+-- Nothing+--+-- >>> split "x/y."+-- Nothing+--+-- >>> split "/x.y"+-- Just ("/x",".y")+--+-- >>> split "/x.y."+-- Nothing+--+-- >>> split "/x.y.."+-- Nothing+--+-- >>> split "x/.y"+-- Nothing+--+-- >>> split ".x"+-- Nothing+--+-- >>> split "x."+-- Nothing+--+-- >>> split ".x.y"+-- Just (".x",".y")+--+-- >>> split "x/y.z"+-- Just ("x/y",".z")+--+-- >>> split "x.y.z"+-- Just ("x.y",".z")+--+-- >>> split "x..y"+-- Just ("x.",".y")+--+-- >>> split "..."+-- Nothing+--+-- >>> split "..x"+-- Just (".",".x")+--+-- >>> split "...x"+-- Just ("..",".x")+--+-- >>> split "x/y.z/"+-- Nothing+--+-- >>> split "x/y"+-- Nothing+--+splitExtension :: OS_PATH_TYPE -> Maybe (OS_PATH_TYPE, OS_PATH_TYPE)+splitExtension (OS_PATH a) =+    fmap (bimap OS_PATH OS_PATH) $ Common.splitExtension Common.OS_NAME a+#endif++-- | Take the extension of a file if it has one.+--+-- >>> takeExtension = fmap snd . Path.splitExtension+-- >>> hasExtension = isJust . Path.splitExtension+--+-- >>> fmap Path.toString $ Path.takeExtension [path|/home/user/file.txt|]+-- Just ".txt"+--+-- See 'splitExtension' for more examples.+takeExtension :: OS_PATH_TYPE -> Maybe OS_PATH_TYPE+takeExtension = fmap snd . splitExtension++-- | Drop the extension of a file if it has one.+--+-- >>> dropExtension p = maybe p fst $ Path.splitExtension p+--+-- >>> Path.toString $ Path.dropExtension [path|/home/user/file.txt|]+-- "/home/user/file"+--+dropExtension :: OS_PATH_TYPE -> OS_PATH_TYPE+dropExtension orig@(OS_PATH a) =+    maybe orig (OS_PATH . fst) $ Common.splitExtension Common.OS_NAME a++-- | Add an extension to a file path. If a non-empty extension does not start+-- with a leading dot then a dot is inserted, otherwise the extension is+-- concatenated with the path.+--+-- It is an error to add an extension to a path with a trailing separator.+--+-- /Unimplemented/+addExtension :: OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+addExtension (OS_PATH _a) = undefined++-- /Unimplemented/+replaceExtension :: OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+replaceExtension (OS_PATH _a) = undefined++------------------------------------------------------------------------------+-- Path View+------------------------------------------------------------------------------++-- | Extracts the file name component (with extension) from a OS_PATH_TYPE, if+-- present.+--+-- >>> takeFileName = fmap snd . Path.splitFile+-- >>> replaceDirectory p x = fmap (flip Path.join x) (takeFileName p)+--+-- >>> fmap Path.toString $ Path.takeFileName [path|/home/user/file.txt|]+-- Just "file.txt"+-- >>> fmap Path.toString $ Path.takeFileName [path|/home/user/|]+-- Nothing+--+-- See 'splitFile' for more examples.+--+takeFileName :: OS_PATH_TYPE -> Maybe OS_PATH_TYPE+takeFileName = fmap snd . splitFile++-- | Extracts the file name dropping the extension, if any, from a+-- OS_PATH_TYPE.+--+-- >>> takeFileBase = fmap Path.dropExtension . Path.takeFileName+--+-- >>> fmap Path.toString $ Path.takeFileBase [path|/home/user/file.txt|]+-- Just "file"+-- >>> fmap Path.toString $ Path.takeFileBase [path|/home/user/file|]+-- Just "file"+-- >>> fmap Path.toString $ Path.takeFileBase [path|/home/user/.txt|]+-- Just ".txt"+-- >>> fmap Path.toString $ Path.takeFileBase [path|/home/user/|]+-- Nothing+--+-- See 'splitFile' for more examples.+--+takeFileBase :: OS_PATH_TYPE -> Maybe OS_PATH_TYPE+takeFileBase = fmap dropExtension . takeFileName++-- | Returns the parent directory of the given OS_PATH_TYPE, if any.+--+-- >>> takeDirectory x = Path.splitFile x >>= fst+-- >>> replaceFileName p x = fmap (flip Path.join x) (takeDirectory p)+--+-- To get an equivalent to takeDirectory from filepath use+-- 'dropTrailingSeparators' on the result.+--+-- >>> fmap Path.toString $ Path.takeDirectory [path|/home/user/file.txt|]+-- Just "/home/user/"+-- >>> fmap Path.toString $ Path.takeDirectory [path|file.txt|]+-- Nothing+--+takeDirectory :: OS_PATH_TYPE -> Maybe OS_PATH_TYPE+takeDirectory x = splitFile x >>= fst++------------------------------------------------------------------------------+-- Path equality+------------------------------------------------------------------------------++#ifndef IS_WINDOWS+-- | Default equality check configuration.+--+-- >>> :{+-- eqCfg =+--       Path.ignoreTrailingSeparators False+--     . Path.ignoreCase False+--     . Path.allowRelativeEquality False+-- :}+--+#else+-- | Default equality check configuration.+--+-- >>> :{+-- eqCfg =+--       Path.ignoreTrailingSeparators False+--     . Path.ignoreCase True+--     . Path.allowRelativeEquality False+-- :}+--+#endif+eqCfg :: EqCfg+eqCfg = Common.EqCfg+    { _ignoreTrailingSeparators = False+    , _allowRelativeEquality = False+#ifndef IS_WINDOWS+    , _ignoreCase = False+#else+    , _ignoreCase = True+#endif+    }++-- | When set to 'False' (default):+--+-- >>> cfg = Path.ignoreTrailingSeparators False+-- >>> eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)+--+-- >>> eq "x/"  "x"+-- False+--+-- When set to 'True':+--+-- >>> cfg = Path.ignoreTrailingSeparators True+-- >>> eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)+--+-- >>> eq "x/"  "x"+-- True+--+-- /Default/: False+ignoreTrailingSeparators :: Bool -> EqCfg -> EqCfg+ignoreTrailingSeparators val conf = conf { _ignoreTrailingSeparators = val }++-- | When set to 'False', comparison is case sensitive.+--+-- /Posix Default/: False+--+-- /Windows Default/: True+ignoreCase :: Bool -> EqCfg -> EqCfg+ignoreCase val conf = conf { _ignoreCase = val }++-- Note: ignoreLeadingDot or similar names are not good because we want to+-- convey that when it is False "./x" and "./x" are not strictly equal.+-- Similarly, "treatDotRootsEqual" has a problem with the "./x" and "x"+-- comparison, there is not dor root in the second path.++-- | Allow relative paths to be treated as equal. When this is 'False' relative+-- paths will never match even if they are literally equal e.g. "./x" will not+-- match "./x" because the meaning of "." in both cases could be different+-- depending on what the user meant by current directory in each case.+--+-- When set to 'False' (default):+--+-- >>> cfg = Path.allowRelativeEquality False+-- >>> eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)+-- >>> eq "."  "."+-- False+-- >>> eq "./x"  "./x"+-- False+-- >>> eq "./x"  "x"+-- False+--+-- When set to 'False' (default):+--+-- >>> cfg = Path.allowRelativeEquality True+-- >>> eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)+-- >>> eq "."  "."+-- True+-- >>> eq "./x"  "./x"+-- True+-- >>> eq "./x"  "x"+-- True+--+-- >>> eq "./x"  "././x"+-- True+--+-- /Default/: False+allowRelativeEquality :: Bool -> EqCfg -> EqCfg+allowRelativeEquality val conf = conf { _allowRelativeEquality = val }++#ifndef IS_WINDOWS+-- | Checks whether two paths are logically equal. This function takes a+-- configuration modifier to customize the notion of equality. For using the+-- default configuration pass 'id' as the modifier. For details about the+-- defaults, see 'EqCfg'.+--+-- eqPath performs some normalizations on the paths before comparing them,+-- specifically it drops redundant path separators between path segments and+-- redundant "\/.\/" components between segments.+--+-- Default config options use strict equality, for strict equality both the+-- paths must be absolute or both must be path segments without a leading root+-- component (e.g. x\/y). Also, both must be files or both must be directories.+--+-- In addition to the default config options, the following equality semantics+-- are used:+--+-- * An absolute path and a path relative to "." may be equal depending on the+-- meaning of ".", however this routine treats them as unequal, it does not+-- resolve the "." to a concrete path.+--+-- * Two paths having ".." components may be equal after processing the ".."+-- components even if we determined them to be unequal. However, if we+-- determined them to be equal then they must be equal.+--+-- Using default config with case sensitive comparision, if eqPath returns+-- equal then the paths are definitely equal, if it returns unequal then the+-- paths may still be equal under some relaxed equality criterion.+--+-- >>> :{+--  eq a b = Path.eqPath id (Path.fromString_ a) (Path.fromString_ b)+-- :}+--+-- >>> eq "x"  "x"+-- True+-- >>> eq ".."  ".."+-- True+--+-- Non-trailing separators and non-leading "." segments are ignored:+--+-- >>> eq "/x"  "//x"+-- True+-- >>> eq "x//y"  "x/y"+-- True+-- >>> eq "x/./y"  "x/y"+-- True+-- >>> eq "x/y/."  "x/y"+-- True+--+-- Leading dot, relative paths are not equal by default:+--+-- >>> eq "."  "."+-- False+-- >>> eq "./x"  "./x"+-- False+-- >>> eq "./x"  "x"+-- False+--+-- Trailing separators are significant by default:+--+-- >>> eq "x/"  "x"+-- False+--+-- Match is case sensitive by default:+--+-- >>> eq "x"  "X"+-- False+--+eqPath :: (EqCfg -> EqCfg) -> OS_PATH_TYPE -> OS_PATH_TYPE -> Bool+eqPath cfg (OS_PATH a) (OS_PATH b) =+    Common.eqPath Unicode.UNICODE_DECODER+        Common.OS_NAME (cfg eqCfg) a b+#endif++-- | Check two paths for byte level equality. This is the most strict path+-- equality check.+--+-- >>> eqPath a b = Path.eqPathBytes (Path.fromString_ a) (Path.fromString_ b)+--+-- >>> eqPath "x//y"  "x//y"+-- True+--+-- >>> eqPath "x//y"  "x/y"+-- False+--+-- >>> eqPath "x/./y"  "x/y"+-- False+--+-- >>> eqPath "x\\y" "x/y"+-- False+--+-- >>> eqPath "./file"  "file"+-- False+--+-- >>> eqPath "file/"  "file"+-- False+--+eqPathBytes :: OS_PATH_TYPE -> OS_PATH_TYPE -> Bool+eqPathBytes (OS_PATH a) (OS_PATH b) = Common.eqPathBytes a b++-- | Convert the path to an equivalent but standard format for reliable+-- comparison. This can be implemented if required. Usually, the equality+-- operations should be enough and this may not be needed.+--+-- /Unimplemented/+normalize :: EqCfg -> OS_PATH_TYPE -> OS_PATH_TYPE+normalize _cfg (OS_PATH _a) = undefined
+ src/Streamly/Internal/FileSystem/PosixPath/Node.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE TemplateHaskell #-}+-- For constraints on "append"+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++#if defined(IS_WINDOWS)+#define OS_NAME Windows+#define OS_PATH WindowsPath+#else+#define OS_NAME Posix+#define OS_PATH PosixPath+#endif++-- |+-- Module      : Streamly.Internal.FileSystem.OS_PATH.Node+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- This module provides a type safe path append operation by distinguishing+-- paths between files and directories. Files are represented by the @File+-- OS_PATH@ type and directories are represented by the @Dir OS_PATH@ type.+--+-- This distinction provides safety against appending a path to a file. Append+-- operation allows appending to only 'Dir' types.+--+module Streamly.Internal.FileSystem.OS_PATH.Node+    (+    -- * Types+      File (..)+    , Dir (..)+    , IsNode++    -- * Statically Verified Path Literals+    -- | Quasiquoters.+    , dir+    , file++    -- * Statically Verified Path Strings+    -- | Template Haskell expression splices.+    , dirE+    , fileE++    -- * Operations+    , join+    )+where++import Control.Monad ((>=>))+import Language.Haskell.TH (Q, Exp)+import Language.Haskell.TH.Syntax (lift)+import Language.Haskell.TH.Quote (QuasiQuoter)+import Streamly.Internal.Data.Path (IsPath(..))+import Streamly.Internal.FileSystem.Path.Common (OS(..), mkQ)+import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))++import qualified Streamly.Internal.FileSystem.Path.Common as Common+import qualified Streamly.Internal.FileSystem.OS_PATH as OsPath++{- $setup+>>> :m+>>> :set -XQuasiQuotes++For APIs that have not been released yet.++>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath)+>>> import Streamly.Internal.FileSystem.PosixPath.Node (File, Dir, file, dir)+>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path+>>> import qualified Streamly.Internal.FileSystem.PosixPath.Node as Node+-}++newtype File a = File a+newtype Dir a = Dir a++-- | Constraint to check if a type uses 'File' or 'Dir' as the outermost+-- constructor.+class IsNode a++instance IsNode (File a)+instance IsNode (Dir a)++instance IsPath OS_PATH (File OS_PATH) where+    unsafeFromPath = File++    fromPath p@(OS_PATH arr) = do+        !_ <- Common.validateFile OS_NAME arr+        pure $ File p++    toPath (File p) = p++instance IsPath OS_PATH (Dir OS_PATH) where+    unsafeFromPath = Dir+    fromPath p = pure (Dir p)+    toPath (Dir p) = p++------------------------------------------------------------------------------+-- Statically Verified Strings+------------------------------------------------------------------------------++-- XXX We can lift the array directly, ByteArray has a lift instance. Does that+-- work better?++liftDir :: Dir OS_PATH -> Q Exp+liftDir (Dir p) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Dir OS_PATH |]++liftFile :: File OS_PATH -> Q Exp+liftFile (File p) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: File OS_PATH |]++-- | Generates a Haskell expression of type @Dir OS_PATH@.+--+dirE :: String -> Q Exp+dirE = either (error . show) liftDir . (OsPath.fromString >=> fromPath)++-- | Generates a Haskell expression of type @File OS_PATH@.+--+fileE :: String -> Q Exp+fileE = either (error . show) liftFile . (OsPath.fromString >=> fromPath)++------------------------------------------------------------------------------+-- Statically Verified Literals+------------------------------------------------------------------------------++-- XXX Define folds or parsers to parse the paths.+-- XXX Build these on top of the str quasiquoter so that we get interpolation+-- for free. Interpolated vars if any have to be of appropriate type depending+-- on the context so that we can splice them safely.++-- | Generates a @Dir OS_PATH@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([dir|usr|] :: Dir PosixPath))+-- "usr"+--+dir :: QuasiQuoter+dir = mkQ dirE++-- | Generates a @File OS_PATH@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([file|usr|] :: File PosixPath))+-- "usr"+--+file :: QuasiQuoter+file = mkQ fileE++-- The only safety we need for paths is: (1) The first path can only be a Dir+-- type path, and (2) second path can only be a Seg path.++-- | Append a 'Dir' or 'File' path to a 'Dir' path.+--+-- >>> Path.toString (Path.toPath (Node.join [dir|/usr|] [dir|bin|] :: Dir PosixPath))+-- "/usr/bin"+-- >>> Path.toString (Path.toPath (Node.join [dir|/usr|] [file|bin|] :: File PosixPath))+-- "/usr/bin"+--+-- Fails if the second path is a specific location and not a path segment.+--+{-# INLINE join #-}+join :: (IsPath OS_PATH (a OS_PATH), IsNode (a OS_PATH)) =>+    Dir OS_PATH -> a OS_PATH -> a OS_PATH+join (Dir a) b =+    unsafeFromPath $ OsPath.unsafeJoin (toPath a) (toPath b)
+ src/Streamly/Internal/FileSystem/PosixPath/Seg.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE TemplateHaskell #-}+-- For constraints on "append"+{-# OPTIONS_GHC -Wno-redundant-constraints #-}++#if defined(IS_WINDOWS)+#define OS_NAME Windows+#define OS_PATH WindowsPath+#else+#define OS_NAME Posix+#define OS_PATH PosixPath+#endif++-- |+-- Module      : Streamly.Internal.FileSystem.OS_PATH.Seg+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- This module provides a type safe path append operation by distinguishing+-- paths between rooted paths and branches. Rooted paths are represented by the+-- @Rooted OS_PATH@ type and branches are represented by the @Unrooted OS_PATH@+-- type. Rooted paths are paths that are attached to specific roots in the file+-- system. Rooted paths could be absolute or relative e.g. @\/usr\/bin@,+-- @.\/local\/bin@, or @.@. Unrootedes are a paths that are not attached to a+-- specific root e.g. @usr\/bin@, @local\/bin@, or @../bin@ are branches.+--+-- This distinction provides a safe path append operation which cannot fail.+-- These types do not allow appending a rooted path to any other path. Only+-- branches can be appended.+--+module Streamly.Internal.FileSystem.OS_PATH.Seg+    (+    -- * Types+      Rooted (..)+    , Unrooted (..)+    , IsSeg++    -- * Statically Verified Path Literals+    -- | Quasiquoters.+    , rt+    , ur++    -- * Statically Verified Path Strings+    -- | Template Haskell expression splices.+    , rtE+    , urE++    -- * Operations+    , join+    )+where++import Control.Monad ((>=>))+import Control.Monad.Catch (MonadThrow(..))+import Language.Haskell.TH (Q, Exp)+import Language.Haskell.TH.Syntax (lift)+import Language.Haskell.TH.Quote (QuasiQuoter)+import Streamly.Internal.Data.Path (IsPath(..), PathException(..))+import Streamly.Internal.FileSystem.Path.Common (mkQ)+import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))++import qualified Streamly.Internal.FileSystem.OS_PATH as OsPath++{- $setup+>>> :m+>>> :set -XQuasiQuotes++For APIs that have not been released yet.++>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath)+>>> import Streamly.Internal.FileSystem.PosixPath.Seg (Rooted, Unrooted, rt, ur)+>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path+>>> import qualified Streamly.Internal.FileSystem.PosixPath.Seg as Seg+-}++newtype Rooted a = Rooted a+newtype Unrooted a = Unrooted a++instance IsPath OS_PATH (Rooted OS_PATH) where+    unsafeFromPath = Rooted+    fromPath p =+        if OsPath.isRooted p+        then pure (Rooted p)+        -- XXX Add more detailed error msg with all valid examples.+        else throwM $ InvalidPath+                $ "Must be a specific location, not a path segment: "+                ++ OsPath.toString p+    toPath (Rooted p) = p++instance IsPath OS_PATH (Unrooted OS_PATH) where+    unsafeFromPath = Unrooted+    fromPath p =+        if OsPath.isUnrooted p+        then pure (Unrooted p)+        -- XXX Add more detailed error msg with all valid examples.+        else throwM $ InvalidPath+                $ "Must be a path segment, not a specific location: "+                ++ OsPath.toString p+    toPath (Unrooted p) = p++-- | Constraint to check if a type has Rooted or Unrooted annotations.+class IsSeg a++instance IsSeg (Rooted a)+instance IsSeg (Unrooted a)++------------------------------------------------------------------------------+-- Statically Verified Strings+------------------------------------------------------------------------------++liftRooted :: Rooted OS_PATH -> Q Exp+liftRooted (Rooted p) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Rooted OS_PATH |]++liftUnrooted :: Unrooted OS_PATH -> Q Exp+liftUnrooted (Unrooted p) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Unrooted OS_PATH |]++-- | Generates a Haskell expression of type @Rooted OS_PATH@.+--+rtE :: String -> Q Exp+rtE = either (error . show) liftRooted . (OsPath.fromString >=> fromPath)++-- | Generates a Haskell expression of type @Unrooted OS_PATH@.+--+urE :: String -> Q Exp+urE = either (error . show) liftUnrooted . (OsPath.fromString >=> fromPath)++------------------------------------------------------------------------------+-- Statically Verified Literals+------------------------------------------------------------------------------++-- XXX Define folds or parsers to parse the paths.+-- XXX Build these on top of the str quasiquoter so that we get interpolation+-- for free. Interpolated vars if any have to be of appropriate type depending+-- on the context so that we can splice them safely.++-- | Generates a @Rooted Path@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([rt|/usr|] :: Rooted PosixPath))+-- "/usr"+--+rt :: QuasiQuoter+rt = mkQ rtE++-- | Generates a @Unrooted Path@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([ur|usr|] :: Unrooted PosixPath))+-- "usr"+--+ur :: QuasiQuoter+ur = mkQ urE++-- The only safety we need for paths is: (1) The first path can only be a Dir+-- type path, and (2) second path can only be a Unrooted path.++-- | Append a 'Unrooted' type path to a 'Rooted' path or 'Unrooted' path.+--+-- >>> Path.toString (Path.toPath (Seg.join [rt|/usr|] [ur|bin|] :: Rooted PosixPath))+-- "/usr/bin"+-- >>> Path.toString (Path.toPath (Seg.join [ur|usr|] [ur|bin|] :: Unrooted PosixPath))+-- "usr/bin"+--+{-# INLINE join #-}+join ::+    (+      IsSeg (a OS_PATH)+    , IsPath OS_PATH (a OS_PATH)+    ) => a OS_PATH -> Unrooted OS_PATH -> a OS_PATH+join a (Unrooted c) =+    unsafeFromPath $ OsPath.unsafeJoin (toPath a) (toPath c)
+ src/Streamly/Internal/FileSystem/PosixPath/SegNode.hs view
@@ -0,0 +1,311 @@+{-# LANGUAGE TemplateHaskell #-}+-- For constraints on "join"+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-orphans #-}++#if defined(IS_WINDOWS)+#define OS_NAME Windows+#define OS_PATH WindowsPath+#else+#define OS_NAME Posix+#define OS_PATH PosixPath+#endif++-- |+-- Module      : Streamly.Internal.FileSystem.OS_PATH.SegNode+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- When @Rooted/Unrooted@ and @File/Dir@ both are present, @Rooted/Unrooted@ must be+-- outermost constructors and @File/Dir@ as inner. Thus the types File (Rooted+-- a) or Dir (Rooted a) are not allowed but Rooted (Dir a) and Rooted (File a) are+-- allowed.++module Streamly.Internal.FileSystem.OS_PATH.SegNode+    (+    -- * Statically Verified Path Literals+    -- | Quasiquoters.+      rtdir+    , urdir+    , rtfile+    , urfile++    -- * Statically Verified Path Strings+    -- | Template Haskell expression splices.+    , rtdirE+    , urdirE+    , rtfileE+    , urfileE++    -- * Operations+    , join+    )+where++import Control.Monad ((>=>))+import Language.Haskell.TH.Syntax (lift)+import Streamly.Internal.FileSystem.Path.Common (mkQ)+import Streamly.Internal.FileSystem.OS_PATH (OS_PATH(..))+import Streamly.Internal.FileSystem.OS_PATH.Seg (Rooted(..), Unrooted(..))+import Streamly.Internal.FileSystem.OS_PATH.Node (File(..), Dir(..))++import qualified Streamly.Internal.FileSystem.OS_PATH as OsPath++import Language.Haskell.TH+import Language.Haskell.TH.Quote+import Streamly.Internal.Data.Path++{- $setup+>>> :m+>>> :set -XQuasiQuotes++For APIs that have not been released yet.++>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath)+>>> import Streamly.Internal.FileSystem.PosixPath.Node (Dir, File, dir, file)+>>> import Streamly.Internal.FileSystem.PosixPath.Seg (Rooted, Unrooted, rt, ur)+>>> import Streamly.Internal.FileSystem.PosixPath.SegNode (rtdir, urdir, rtfile, urfile)+>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path+>>> import qualified Streamly.Internal.FileSystem.PosixPath.SegNode as SegNode+-}++-- Note that (Rooted a) may also be a directory if "a" is (Dir b), but it can also+-- be a file if "a" is (File b). Therefore, the constraints are put on a more+-- specific type e.g. (Rooted OS_PATH) may be a dir.++{-+-- | Constraint to check if a type represents a directory.+class HasDir a++instance HasDir (Dir a)+instance HasDir (Rooted (Dir a))+instance HasDir (Unrooted (Dir a))+-}++-- Design notes:+--+-- There are two ways in which we can lift or upgrade a lower level path to a+-- higher level one. Lift each type directly from the base path e.g. Rooted (Dir+-- PosixPath) can be created directly from PosixPath. This allows us to do dir+-- checks and loc checks at the same time in a monolithic manner. But this also+-- makes us do the Dir checks again if we are lifting from Dir to Rooted. This+-- leads to less complicated constraints, more convenient type conversions.+--+-- Another alternative is to lift one segment at a time, so we lift PosixPath+-- to Dir and then Dir to Rooted. This way the checks are serialized, we perform+-- the dir checks first and then Rooted checks, we cannot combine them together.+-- The advantage is that when lifting from Dir to Rooted we do not need to do the+-- Dir checks. The disadvantage is less convenient conversion because of+-- stronger typing, we will need two steps - fromPath . fromPath and toPath .+-- toPath to upgrade or downgrade instead of just adapt.+--+{-+instance IsPath (File OS_PATH) (Rooted (File OS_PATH)) where+    unsafeFromPath = Rooted+    fromPath (File p) = do+        _ :: Rooted OS_PATH <- fromPath p+        pure $ Rooted (File p)+    toPath (Rooted p) = p++instance IsPath (Rooted OS_PATH) (Rooted (File OS_PATH)) where+    unsafeFromPath = Rooted+    fromPath (File p) = do+        _ :: File OS_PATH <- fromPath p+        pure $ Rooted (File p)+    toPath (Rooted p) = p+-}++-- Assuming that lifting from Dir/File to Rooted/Unrooted is not common and even if it+-- is then the combined cost of doing Dir/Rooted checks would be almost the same+-- as individual checks, we take the first approach.++instance IsPath OS_PATH (Rooted (File OS_PATH)) where+    unsafeFromPath p = Rooted (File p)+    fromPath p = do+        _ :: File OS_PATH <- fromPath p+        _ :: Rooted OS_PATH <- fromPath p+        pure $ Rooted (File p)+    toPath (Rooted (File p)) = p++instance IsPath OS_PATH (Rooted (Dir OS_PATH)) where+    unsafeFromPath p = Rooted (Dir p)+    fromPath p = do+        _ :: Dir OS_PATH <- fromPath p+        _ :: Rooted OS_PATH <- fromPath p+        pure $ Rooted (Dir p)+    toPath (Rooted (Dir p)) = p++instance IsPath OS_PATH (Unrooted (File OS_PATH)) where+    unsafeFromPath p = Unrooted (File p)+    fromPath p = do+        _ :: File OS_PATH <- fromPath p+        _ :: Unrooted OS_PATH <- fromPath p+        pure $ Unrooted (File p)+    toPath (Unrooted (File p)) = p++instance IsPath OS_PATH (Unrooted (Dir OS_PATH)) where+    unsafeFromPath p = Unrooted (Dir p)+    fromPath p = do+        _ :: Dir OS_PATH <- fromPath p+        _ :: Unrooted OS_PATH <- fromPath p+        pure $ Unrooted (Dir p)+    toPath (Unrooted (Dir p)) = p++------------------------------------------------------------------------------+-- Statically Verified Strings+------------------------------------------------------------------------------++-- XXX We can lift the array directly, ByteArray has a lift instance. Does that+-- work better?++liftRootedDir :: Rooted (Dir OS_PATH) -> Q Exp+liftRootedDir (Rooted (Dir p)) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Rooted (Dir OS_PATH)|]++liftUnrootedDir :: Unrooted (Dir OS_PATH) -> Q Exp+liftUnrootedDir (Unrooted (Dir p)) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Unrooted (Dir OS_PATH) |]++liftRootedFile :: Rooted (File OS_PATH) -> Q Exp+liftRootedFile (Rooted (File p)) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Rooted (File OS_PATH)|]++liftUnrootedFile :: Unrooted (File OS_PATH) -> Q Exp+liftUnrootedFile (Unrooted (File p)) =+    [| unsafeFromPath (OsPath.unsafeFromString $(lift $ OsPath.toString $ toPath p)) :: Unrooted (File OS_PATH)|]++-- | Generates a Haskell expression of type @Rooted (Dir OS_PATH)@.+--+rtdirE :: String -> Q Exp+rtdirE = either (error . show) liftRootedDir . (OsPath.fromString >=> fromPath)++-- | Generates a Haskell expression of type @Unrooted (Dir OS_PATH)@.+--+urdirE :: String -> Q Exp+urdirE = either (error . show) liftUnrootedDir . (OsPath.fromString >=> fromPath)++-- | Generates a Haskell expression of type @Rooted (File OS_PATH)@.+--+rtfileE :: String -> Q Exp+rtfileE = either (error . show) liftRootedFile . (OsPath.fromString >=> fromPath)++-- | Generates a Haskell expression of type @Unrooted (File OS_PATH)@.+--+urfileE :: String -> Q Exp+urfileE = either (error . show) liftUnrootedFile . (OsPath.fromString >=> fromPath)++------------------------------------------------------------------------------+-- Statically Verified Literals+------------------------------------------------------------------------------++-- XXX Define folds or parsers to parse the paths.+-- XXX Build these on top of the str quasiquoter so that we get interpolation+-- for free. Interpolated vars if any have to be of appropriate type depending+-- on the context so that we can splice them safely.++-- | Generates a @Rooted (Dir OS_PATH)@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([rtdir|/usr|] :: Rooted (Dir PosixPath)))+-- "/usr"+--+rtdir :: QuasiQuoter+rtdir = mkQ rtdirE++-- | Generates a @Unrooted (Dir OS_PATH)@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([urdir|usr|] :: Unrooted (Dir PosixPath)))+-- "usr"+--+urdir :: QuasiQuoter+urdir = mkQ urdirE++-- | Generates a @Rooted (File OS_PATH)@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([rtfile|/x.txt|] :: Rooted (File PosixPath)))+-- "/x.txt"+--+rtfile :: QuasiQuoter+rtfile = mkQ rtfileE++-- | Generates a @Unrooted (File OS_PATH)@ type from a quoted literal.+--+-- >>> Path.toString (Path.toPath ([urfile|x.txt|] :: Unrooted (File PosixPath)))+-- "x.txt"+--+urfile :: QuasiQuoter+urfile = mkQ urfileE++-- The only safety we need for paths is: (1) The first path can only be a Dir+-- type path, and (2) second path can only be a Unrooted path.++{-+-- If the first path is 'Rooted' then the return type is also 'Rooted'.+--+-- If the second path does not have 'File' or 'Dir' information then the return+-- type too cannot have it.+--+-- >> Path.toString (Path.toPath (SegNode.join [rtdir|/usr|] [br|bin|] :: Rooted PosixPath))+-- "/usr/bin"+-- >> Path.toString (Path.toPath (SegNode.join [urdir|usr|] [br|bin|] :: Unrooted PosixPath))+-- "usr/bin"+--+-- >> Path.toString (Path.toPath (SegNode.join [rt|/usr|] [br|bin|] :: Rooted PosixPath))+-- "/usr/bin"+-- >> Path.toString (Path.toPath (SegNode.join [br|usr|] [br|bin|] :: Unrooted PosixPath))+-- "usr/bin"+--+-- If the second path has 'File' or 'Dir' information then the return type+-- also has it.+--+-- >> Path.toString (Path.toPath (SegNode.join [rt|/usr|] [urdir|bin|] :: Rooted (Dir PosixPath)))+-- "/usr/bin"+-- >> Path.toString (Path.toPath (SegNode.join [rt|/usr|] [urfile|bin|] :: Rooted (File PosixPath)))+-- "/usr/bin"+-- >> Path.toString (Path.toPath (SegNode.join [br|usr|] [urdir|bin|] :: Unrooted (Dir PosixPath)))+-- "usr/bin"+-- >> Path.toString (Path.toPath (SegNode.join [br|usr|] [urfile|bin|] :: Unrooted (File PosixPath)))+-- "usr/bin"+--+-- Type error cases:+--+-- >> SegNode.join [dir|/usr|] [br|bin|] -- first arg must be Rooted/Unrooted+-- >> SegNode.join [file|/usr|] [br|bin|] -- first arg must be Rooted/Unrooted+-- >> SegNode.join [rtfile|/usr|] [br|bin|] -- first arg must be a dir+-- >> SegNode.join [rt|/usr|] [rt|/bin|] -- second arg must be seg+-- >> SegNode.join [rt|/usr|] [dir|bin|] -- second arg must be seg+-- >> SegNode.join [rt|/usr|] [file|bin|] -- second arg must be seg+--+{-# INLINE join #-}+join ::+    (+      IsSeg (a b)+    , HasDir (a b)+    , IsPath OS_PATH (a b)+    , IsPath OS_PATH c+    , IsPath OS_PATH (a c)+    ) => a b -> Unrooted c -> a c+join a (Unrooted c) = unsafeFromPath $ OS_NAME.unsafeJoin (toPath a) (toPath c)+-}++-- | Append a branch type path to a directory.+--+-- >>> Path.toString (Path.toPath (SegNode.join [rtdir|/usr|] [urdir|bin|] :: Rooted (Dir PosixPath)))+-- "/usr/bin"+-- >>> Path.toString (Path.toPath (SegNode.join [rtdir|/usr|] [urfile|bin|] :: Rooted (File PosixPath)))+-- "/usr/bin"+-- >>> Path.toString (Path.toPath (SegNode.join [urdir|usr|] [urdir|bin|] :: Unrooted (Dir PosixPath)))+-- "usr/bin"+-- >>> Path.toString (Path.toPath (SegNode.join [urdir|usr|] [urfile|bin|] :: Unrooted (File PosixPath)))+-- "usr/bin"+--+{-# INLINE join #-}+join ::+    (+      IsPath OS_PATH (a (Dir OS_PATH))+    , IsPath OS_PATH (b OS_PATH)+    , IsPath OS_PATH (a (b OS_PATH))+    ) => a (Dir OS_PATH) -> Unrooted (b OS_PATH) -> a (b OS_PATH)+join p1 (Unrooted p2) =+    unsafeFromPath $ OsPath.unsafeJoin (toPath p1) (toPath p2)
+ src/Streamly/Internal/FileSystem/Windows/File.hsc view
@@ -0,0 +1,202 @@+-- XXX When introducing platform specifc API, see Posix/File.hsc and design in+-- the same consistent way.+module Streamly.Internal.FileSystem.Windows.File+    (+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+    -- * Handle based+      openFile+    , withFile+    , openBinaryFile+    , withBinaryFile+#endif+    ) where++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++import Control.Concurrent (threadDelay)+import Control.Exception (onException)+import Control.Monad (when, void)+import Streamly.Internal.FileSystem.WindowsPath (WindowsPath)+import System.IO (IOMode(..), Handle)++#if defined(__IO_MANAGER_WINIO__)+import GHC.IO.SubSystem+#else+import GHC.IO.Handle.FD (fdToHandle')+#include <fcntl.h>+#endif++import qualified Streamly.Internal.FileSystem.File.Common as File+import qualified Streamly.Internal.FileSystem.WindowsPath as Path++import Data.Bits+import Foreign.Ptr+import System.Win32 as Win32 hiding (createFile, failIfWithRetry)++#include <windows.h>++-------------------------------------------------------------------------------+-- Low level (fd returning) file opening APIs+-------------------------------------------------------------------------------++-- XXX Note for i386, stdcall is needed instead of ccall, see Win32+-- package/windows_cconv.h. We support only x86_64 for now.+foreign import ccall unsafe "windows.h CreateFileW"+  c_CreateFile :: LPCTSTR -> AccessMode -> ShareMode -> LPSECURITY_ATTRIBUTES -> CreateMode -> FileAttributeOrFlag -> HANDLE -> IO HANDLE++-- | like failIf, but retried on sharing violations. This is necessary for many+-- file operations; see+-- https://www.betaarchive.com/wiki/index.php/Microsoft_KB_Archive/316609+--+failIfWithRetry :: (a -> Bool) -> String -> IO a -> IO a+failIfWithRetry needRetry msg action = retryOrFail retries++    where++    delay = 100 * 1000 -- 100 ms++    -- KB article recommends 250/5+    retries = 20 :: Int++    -- retryOrFail :: Int -> IO a+    retryOrFail times+        | times <= 0 = errorWin msg+        | otherwise  = do+            ret <- action+            if not (needRetry ret)+            then return ret+            else do+                err_code <- getLastError+                if err_code == 32+                then do+                    threadDelay delay+                    retryOrFail (times - 1)+                else errorWin msg++createFile ::+       WindowsPath+    -> AccessMode+    -> ShareMode+    -> Maybe LPSECURITY_ATTRIBUTES+    -> CreateMode+    -> FileAttributeOrFlag+    -> Maybe Win32.HANDLE+    -> IO Win32.HANDLE+createFile name access share mb_attr mode flag mb_h =+  Path.asCWString name $ \c_name ->+      failIfWithRetry+        (== iNVALID_HANDLE_VALUE)+        (unwords ["CreateFile", Path.toString name])+        $ c_CreateFile+            c_name access share (maybePtr mb_attr) mode flag (maybePtr mb_h)++win2HsHandle :: WindowsPath -> IOMode -> Win32.HANDLE -> IO Handle+win2HsHandle _fp _iomode h = do+#if defined(__IO_MANAGER_WINIO__)+    Win32.hANDLEToHandle h+#else+    fd <- _open_osfhandle (fromIntegral (ptrToIntPtr h)) (#const _O_BINARY)+    fdToHandle' fd Nothing False (Path.toString _fp) _iomode True+#endif++fdToHandle :: WindowsPath -> IOMode -> Win32.HANDLE -> IO Handle+fdToHandle fp iomode h =+    win2HsHandle fp iomode h `onException` Win32.closeHandle h++openFileFd :: Bool -> WindowsPath -> IOMode -> IO Win32.HANDLE+openFileFd existing fp iomode = do+    h <- createFile+          fp+          accessMode+          shareMode+          Nothing+          (if existing then createModeExisting else createMode)+          fileAttr+          Nothing+    when (iomode == AppendMode )+        $ void $ Win32.setFilePointerEx h 0 Win32.fILE_END+    return h++    where++    accessMode =+        case iomode of+            ReadMode      -> Win32.gENERIC_READ+            WriteMode     -> Win32.gENERIC_WRITE+            AppendMode    -> Win32.gENERIC_WRITE .|. Win32.fILE_APPEND_DATA+            ReadWriteMode -> Win32.gENERIC_READ .|. Win32.gENERIC_WRITE++    writeShareMode :: ShareMode+    writeShareMode =+          Win32.fILE_SHARE_DELETE+      .|. Win32.fILE_SHARE_READ++    maxShareMode :: ShareMode+    maxShareMode =+          Win32.fILE_SHARE_DELETE+      .|. Win32.fILE_SHARE_READ+      .|. Win32.fILE_SHARE_WRITE++    shareMode =+        case iomode of+            ReadMode      -> Win32.fILE_SHARE_READ+            WriteMode     -> writeShareMode+            AppendMode    -> writeShareMode+            ReadWriteMode -> maxShareMode++    createMode =+        case iomode of+            ReadMode      -> Win32.oPEN_EXISTING+            WriteMode     -> Win32.cREATE_ALWAYS+            AppendMode    -> Win32.oPEN_ALWAYS+            ReadWriteMode -> Win32.oPEN_ALWAYS++    createModeExisting =+        case iomode of+            ReadMode      -> Win32.oPEN_EXISTING+            WriteMode     -> Win32.tRUNCATE_EXISTING+            AppendMode    -> Win32.oPEN_EXISTING+            ReadWriteMode -> Win32.oPEN_EXISTING++    fileAttr =+#if defined(__IO_MANAGER_WINIO__)+      (case ioSubSystem of+        IoPOSIX -> Win32.fILE_ATTRIBUTE_NORMAL+        IoNative -> Win32.fILE_ATTRIBUTE_NORMAL .|. Win32.fILE_FLAG_OVERLAPPED+      )+#else+      Win32.fILE_ATTRIBUTE_NORMAL+#endif++-------------------------------------------------------------------------------+-- base openFile compatible, Handle returning, APIs+-------------------------------------------------------------------------------++-- | Open a regular file, return a Handle. The file is locked, the Handle is+-- NOT set up to close the file on garbage collection.+{-# INLINE openFileHandle #-}+openFileHandle :: WindowsPath -> IOMode -> IO Handle+openFileHandle p x = openFileFd False p x >>= fdToHandle p x++-- | Like withFile in base package but using Path instead of FilePath.+-- Use hSetBinaryMode on the handle if you want to use binary mode.+withFile :: WindowsPath -> IOMode -> (Handle -> IO r) -> IO r+withFile = File.withFile False openFileHandle++-- | Like openFile in base package but using Path instead of FilePath.+-- Use hSetBinaryMode on the handle if you want to use binary mode.+openFile :: WindowsPath -> IOMode -> IO Handle+openFile = File.openFile False openFileHandle++-- | Like withBinaryFile in base package but using Path instead of FilePath.+withBinaryFile :: WindowsPath -> IOMode -> (Handle -> IO r) -> IO r+withBinaryFile = File.withFile True openFileHandle++-- | Like openBinaryFile in base package but using Path instead of FilePath.+openBinaryFile :: WindowsPath -> IOMode -> IO Handle+openBinaryFile = File.openFile True openFileHandle+#endif
+ src/Streamly/Internal/FileSystem/Windows/ReadDir.hsc view
@@ -0,0 +1,273 @@+-- |+-- Module      : Streamly.Internal.FileSystem.Windows.ReadDir+-- Copyright   : (c) 2024 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC++module Streamly.Internal.FileSystem.Windows.ReadDir+    (+#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+      DirStream+    , openDirStream+    , closeDirStream+    , readDirStreamEither+    , eitherReader+    , reader+#endif+    )+where++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)++import Control.Exception (throwIO)+import Control.Monad (void)+import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Char (ord, isSpace)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Foreign.C (CInt(..), CWchar(..), Errno(..), errnoToIOError, peekCWString)+import Numeric (showHex)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Stream (Step(..))+import Streamly.Internal.FileSystem.Path (Path)+import Streamly.Internal.FileSystem.WindowsPath (WindowsPath(..))+import System.IO.Error (ioeSetErrorString)++import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Unfold as UF (bracketIO)+import qualified Streamly.Internal.FileSystem.WindowsPath as Path+import qualified System.Win32 as Win32 (failWith)++import Streamly.Internal.FileSystem.DirOptions+import Foreign hiding (void)++#include <windows.h>++-- Note on A vs W suffix in APIs.+-- CreateFile vs. CreateFileW: CreateFile is a macro that expands to+-- CreateFileA or CreateFileW depending on whether Unicode support (UNICODE and+-- _UNICODE preprocessor macros) is enabled in your project. To ensure+-- consistent Unicode support, explicitly use CreateFileW.++------------------------------------------------------------------------------+-- Types+------------------------------------------------------------------------------++type BOOL = Bool+type DWORD = Word32++type UINT_PTR = Word+type ErrCode = DWORD+type LPCTSTR = Ptr CWchar+type WIN32_FIND_DATA = ()+type HANDLE = Ptr ()++------------------------------------------------------------------------------+-- Windows C APIs+------------------------------------------------------------------------------++-- XXX Note for i386, stdcall is needed instead of ccall, see Win32+-- package/windows_cconv.h. We support only x86_64 for now.+foreign import ccall unsafe "windows.h FindFirstFileW"+  c_FindFirstFileW :: LPCTSTR -> Ptr WIN32_FIND_DATA -> IO HANDLE++foreign import ccall unsafe "windows.h FindNextFileW"+  c_FindNextFileW :: HANDLE -> Ptr WIN32_FIND_DATA -> IO BOOL++foreign import ccall unsafe "windows.h FindClose"+  c_FindClose :: HANDLE -> IO BOOL++foreign import ccall unsafe "windows.h GetLastError"+  getLastError :: IO ErrCode++foreign import ccall unsafe "windows.h LocalFree"+  localFree :: Ptr a -> IO (Ptr a)++------------------------------------------------------------------------------+-- Haskell C APIs+------------------------------------------------------------------------------++foreign import ccall unsafe "maperrno_func" -- in base/cbits/Win32Utils.c+  c_maperrno_func :: ErrCode -> IO Errno++------------------------------------------------------------------------------+-- Error Handling+------------------------------------------------------------------------------++-- XXX getErrorMessage and castUINTPtrToPtr require c code, so left out for+-- now. Once we replace these we can remove dependency on Win32. We can+-- possibly implement these in Haskell by directly calling the Windows API.++foreign import ccall unsafe "getErrorMessage"+  getErrorMessage :: DWORD -> IO (Ptr CWchar)++foreign import ccall unsafe "castUINTPtrToPtr"+  castUINTPtrToPtr :: UINT_PTR -> Ptr a++failWith :: String -> ErrCode -> IO a+failWith fn_name err_code = do+  c_msg <- getErrorMessage err_code+  msg <- if c_msg == nullPtr+         then return $ "Error 0x" ++ Numeric.showHex err_code ""+         else do+             msg <- peekCWString c_msg+             -- We ignore failure of freeing c_msg, given we're already failing+             _ <- localFree c_msg+             return msg+  errno <- c_maperrno_func err_code+  let msg' = reverse $ dropWhile isSpace $ reverse msg -- drop trailing \n+      ioerror = errnoToIOError fn_name errno Nothing Nothing+                  `ioeSetErrorString` msg'+  throwIO ioerror++errorWin :: String -> IO a+errorWin fn_name = do+  err_code <- getLastError+  failWith fn_name err_code++failIf :: (a -> Bool) -> String -> IO a -> IO a+failIf p wh act = do+  v <- act+  if p v then errorWin wh else return v++iNVALID_HANDLE_VALUE :: HANDLE+iNVALID_HANDLE_VALUE = castUINTPtrToPtr maxBound++------------------------------------------------------------------------------+-- Dir stream implementation+------------------------------------------------------------------------------++-- XXX Define this as data and unpack three fields?+newtype DirStream =+    DirStream (HANDLE, IORef Bool, ForeignPtr WIN32_FIND_DATA)++openDirStream :: WindowsPath -> IO DirStream+openDirStream p = do+    let path = Path.unsafeJoin p $ Path.unsafeFromString "*"+    fp_finddata <- mallocForeignPtrBytes (# const sizeof(WIN32_FIND_DATAW) )+    withForeignPtr fp_finddata $ \dataPtr -> do+        handle <-+            Array.asCStringUnsafe (Path.toArray path) $ \pathPtr -> do+                -- XXX Use getLastError to distinguish the case when no+                -- matching file is found. See the doc of FindFirstFileW.+                failIf+                    (== iNVALID_HANDLE_VALUE)+                    ("FindFirstFileW: " ++ Path.toString path)+                    $ c_FindFirstFileW (castPtr pathPtr) dataPtr+        ref <- newIORef True+        return $ DirStream (handle, ref, fp_finddata)++closeDirStream :: DirStream -> IO ()+closeDirStream (DirStream (h, _, _)) = void (c_FindClose h)++-- XXX Keep this in sync with the isMetaDir function in Posix readdir module.+isMetaDir :: Ptr CWchar -> IO Bool+isMetaDir dname = do+    -- XXX Assuming UTF16LE encoding+    c1 <- peek dname+    if (c1 /= fromIntegral (ord '.'))+    then return False+    else do+        c2 :: Word8 <- peekByteOff dname 1+        if (c2 == 0)+        then return True+        else if (c2 /= fromIntegral (ord '.'))+        then return False+        else do+            c3 :: Word8 <- peekByteOff dname 2+            if (c3 == 0)+            then return True+            else return False++readDirStreamEither ::+    (ReadOptions -> ReadOptions) ->+    DirStream -> IO (Maybe (Either WindowsPath WindowsPath))+readDirStreamEither _ (DirStream (h, ref, fdata)) =+    withForeignPtr fdata $ \ptr -> do+        firstTime <- readIORef ref+        if firstTime+        then do+            writeIORef ref False+            processEntry ptr+        else findNext ptr++    where++    -- XXX: for a symlink the attribute may have a FILE_ATTRIBUTE_DIRECTORY if+    -- the symlink was created as a directory symlink, but it might have+    -- changed later. To find the real type of the symlink when we have+    -- followSymlinks option on we need to check if it is a+    -- FILE_ATTRIBUTE_REPARSE_POINT, we need to open the reparse point and find+    -- the type.++    processEntry ptr = do+        let dname = #{ptr WIN32_FIND_DATAW, cFileName} ptr+        dattrs :: #{type DWORD} <-+            #{peek WIN32_FIND_DATAW, dwFileAttributes} ptr+        name <- Array.fromW16CString dname+        if (dattrs .&. (#const FILE_ATTRIBUTE_DIRECTORY) /= 0)+        then do+            isMeta <- isMetaDir dname+            if isMeta+            then findNext ptr+            else return (Just (Left (Path.unsafeFromArray name)))+        else return (Just (Right (Path.unsafeFromArray name)))++    findNext ptr = do+        retval <- liftIO $ c_FindNextFileW h ptr+        if (retval)+        then processEntry ptr+        else do+            err <- getLastError+            if err == (# const ERROR_NO_MORE_FILES )+            then return Nothing+            -- XXX Print the path in the error message+            else Win32.failWith "findNextFile" err++{-# INLINE streamEitherReader #-}+streamEitherReader :: MonadIO m =>+    (ReadOptions -> ReadOptions) ->+    Unfold m DirStream (Either Path Path)+streamEitherReader f = Unfold step return+    where++    step strm = do+        r <- liftIO $ readDirStreamEither f strm+        case r of+            Nothing -> return Stop+            Just x -> return $ Yield x strm++{-# INLINE streamReader #-}+streamReader :: MonadIO m => Unfold m DirStream Path+streamReader = fmap (either id id) (streamEitherReader id)++--  | Read a directory emitting a stream with names of the children. Filter out+--  "." and ".." entries.+--+--  /Internal/++{-# INLINE reader #-}+reader :: (MonadIO m, MonadCatch m) => Unfold m Path Path+reader =+-- 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++-- | Read directories as Left and files as Right. Filter out "." and ".."+-- entries.+--+--  /Internal/+--+{-# INLINE eitherReader #-}+eitherReader :: (MonadIO m, MonadCatch m) =>+    (ReadOptions -> ReadOptions) -> Unfold m Path (Either Path Path)+eitherReader f =+    -- XXX The measured overhead of bracketIO is not noticeable, if it turns+    -- out to be a problem for small filenames we can use getdents64 to use+    -- chunked read to avoid the overhead.+      UF.bracketIO openDirStream closeDirStream (streamEitherReader f)+#endif
+ src/Streamly/Internal/FileSystem/WindowsPath.hs view
@@ -0,0 +1,366 @@+{-# LANGUAGE CPP #-}+#define IS_WINDOWS+#include "Streamly/Internal/FileSystem/PosixPath.hs"++-- XXX Move these functions to PosixPath.hs and use CPP conditionals for+-- documentation differences, definitions are identical.++-- Note: We can use powershell for testing path validity.+-- "//share/x" works in powershell.+-- But mixed forward and backward slashes do not work, it is treated as a path+-- relative to current drive e.g. "\\/share/x" is treated as "C:/share/x".+--+-- XXX Note: Windows may have case sensitive behavior depending on the file+-- system being used. Does it impact any of the case insensitive validations+-- below?+--+-- XXX ADS - alternate data stream syntax - file.txt:stream .++-- | Like 'validatePath' but more strict. The path must refer to a file system+-- object. For example, a share root itself is not a valid file system object.+-- it must be followed by a non-empty path.+--+-- >>> isValid = isJust . Path.validatePath' . Path.encodeString+--+-- >>> isValid "\\\\"+-- False+-- >>> isValid "\\\\server\\"+-- False+-- >>> isValid "\\\\server\\x"+-- True+-- >>> isValid "\\\\?\\UNC\\server"+-- False+--+validatePath' ::+    MonadThrow m => Array OS_WORD_TYPE -> m ()+validatePath' = Common.validatePath' Common.Windows++-- | Like 'isValidPath' but more strict.+--+-- >>> isValidPath' = isJust . Path.validatePath'+--+isValidPath' ::+    Array OS_WORD_TYPE -> Bool+isValidPath' = isJust . validatePath'++-- | Read a raw array of OS_WORD_TYPE as a path type.+--+-- >>> readArray = fromJust . Path.fromArray . read+--+-- >>> arr :: Array Word16 = Path.encodeString "hello"+-- >>> Path.showArray $ (Path.readArray $ show arr :: Path.WindowsPath)+-- "fromList [104,101,108,108,111]"+--+-- See also: 'showArray'.+readArray :: [Char] -> OS_PATH_TYPE+readArray = fromJust . fromArray . read++-- | A path that is attached to a root. "C:\\" is considered an absolute root+-- and "." as a dynamic root. ".." is not considered a root, "..\/x" or "x\/y"+-- are not rooted paths.+--+-- Absolute locations:+--+-- * @C:\\@ local drive+-- * @\\\\share\\@ UNC share+-- * @\\\\?\\C:\\@ Long UNC local drive+-- * @\\\\?\\UNC\\@ Long UNC remote server+-- * @\\\\.\\@ DOS local device namespace+-- * @\\\\??\\@ DOS global namespace+--+-- Relative locations:+--+-- * @\\@ relative to current drive root+-- * @.\\@ relative to current directory+-- * @C:@ current directory in drive+-- * @C:file@ relative to current directory in drive+--+-- >>> isRooted = Path.isRooted . fromJust . Path.fromString+--+-- Common to Windows and Posix:+--+-- >>> isRooted "/"+-- True+-- >>> isRooted "/x"+-- True+-- >>> isRooted "."+-- True+-- >>> isRooted "./x"+-- True+--+-- Windows specific:+--+-- >>> isRooted "c:"+-- True+-- >>> isRooted "c:x"+-- True+-- >>> isRooted "c:/"+-- True+-- >>> isRooted "//x/y"+-- True+--+isRooted :: OS_PATH_TYPE -> Bool+isRooted (OS_PATH arr) = Common.isRooted Common.OS_NAME arr++-- | Like 'join' but does not check if any of the path is empty or if the+-- second path is rooted.+--+-- >>> f a b = Path.toString $ Path.unsafeJoin (Path.fromString_ a) (Path.fromString_ b)+--+-- >>> f "x" "y"+-- "x\\y"+-- >>> f "x/" "y"+-- "x/y"+-- >>> f "x" "/y"+-- "x/y"+-- >>> f "x/" "/y"+-- "x/y"+--+-- Note "c:" and "/x" are both rooted paths, therefore, 'join' cannot be used+-- to join them. Similarly for joining "//x/" and "/y". For these cases use+-- 'unsafeJoin'. 'unsafeJoin' can be used as a replacement for the+-- joinDrive function from the filepath package.+--+-- >>> f "c:" "/x"+-- "c:/x"+-- >>> f "//x/" "/y"+-- "//x/y"+--+{-# INLINE unsafeJoin #-}+unsafeJoin :: OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+unsafeJoin (OS_PATH a) (OS_PATH b) =+    OS_PATH+        $ Common.unsafeAppend+            Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b++-- | Append a OS_PATH_TYPE to another. Fails if the second path refers to a rooted+-- path. If you want to avoid runtime failure use the typesafe+-- Streamly.FileSystem.OS_PATH_TYPE.Seg module. Use 'unsafeJoin' to avoid failure+-- if you know it is ok to append the path.+--+-- Usually, append joins two paths using a separator between the paths. On+-- Windows, joining a drive "c:" with path "x" does not add a separator between+-- the two because "c:x" is different from "c:/x".+--+-- Note "c:" and "/x" are both rooted paths, therefore, 'join' cannot be used+-- to join them. Similarly for joining "//x/" and "/y". For these cases use+-- 'unsafeJoin'.+--+-- >>> f a b = Path.toString $ Path.join a b+--+-- >>> f [path|x|] [path|y|]+-- "x\\y"+-- >>> f [path|x/|] [path|y|]+-- "x/y"+-- >>> f [path|c:|] [path|x|]+-- "c:x"+-- >>> f [path|c:/|] [path|x|]+-- "c:/x"+-- >>> f [path|//x/|] [path|y|]+-- "//x/y"+--+-- >>> fails $ f [path|c:|] [path|/|]+-- True+-- >>> fails $ f [path|c:|] [path|/x|]+-- True+-- >>> fails $ f [path|c:/|] [path|/x|]+-- True+-- >>> fails $ f [path|//x/|] [path|/y|]+-- True+join :: OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+join (OS_PATH a) (OS_PATH b) =+    OS_PATH+        $ Common.append+            Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b++-- | A stricter version of 'join' which requires the first path to be a+-- directory like path i.e. with a trailing separator.+--+-- >>> f a b = Path.toString $ Path.joinDir a b+--+-- >>> fails $ f [path|x|] [path|y|]+-- True+--+joinDir ::+    OS_PATH_TYPE -> OS_PATH_TYPE -> OS_PATH_TYPE+joinDir+    (OS_PATH a) (OS_PATH b) =+    OS_PATH+        $ Common.append'+            Common.OS_NAME (Common.toString Unicode.UNICODE_DECODER) a b++-- | See the eqPath documentation in the+-- "Streamly.Internal.FileSystem.PosixPath" module for details.+--+-- On Windows, the following is different:+--+-- * paths are normalized by replacing forward slash path separators by+-- backslashes.+-- * default configuration uses case-insensitive comparison.+--+-- >>> :{+--  eq a b = Path.eqPath id (Path.fromString_ a) (Path.fromString_ b)+-- :}+--+-- The cases that are different from Posix:+--+-- >>> eq "x\\y" "x/y"+-- True+--+-- >>> eq "x"  "X"+-- True+--+-- >>> eq "c:"  "C:"+-- False+--+-- >>> eq "c:"  "c:"+-- False+--+-- >>> eq "c:x"  "c:x"+-- False+--+-- >>> :{+--  cfg = Path.ignoreTrailingSeparators True+--      . Path.ignoreCase True+--      . Path.allowRelativeEquality True+--  eq a b = Path.eqPath cfg (Path.fromString_ a) (Path.fromString_ b)+-- :}+--+-- >>> eq "./x"  "x"+-- True+--+-- >>> eq "X/"  "x"+-- True+--+-- >>> eq "C:x"  "c:X"+-- True+--+-- >>> eq ".\\x"  "./X"+-- True+--+-- >>> eq "x//y"  "x/y"+-- True+--+-- >>> eq "x/./y"  "x/y"+-- True+--+-- >>> eq "x"  "x"+-- True+--+eqPath :: (EqCfg -> EqCfg) -> OS_PATH_TYPE -> OS_PATH_TYPE -> Bool+eqPath cfg (OS_PATH a) (OS_PATH b) =+    Common.eqPath Unicode.UNICODE_DECODER+        Common.OS_NAME (cfg eqCfg) a b++-- | If a path is rooted then separate the root and the remaining path,+-- otherwise root is returned as empty. If the path is rooted then the non-root+-- part is guaranteed to not start with a separator.+--+-- See "Streamly.Internal.FileSystem.PosixPath" module for common examples. We+-- provide some Windows specific examples here.+--+-- >>> toList (a,b) = (Path.toString a, fmap Path.toString b)+-- >>> split = fmap toList . Path.splitRoot . Path.fromString_+--+-- >>> split "c:"+-- Just ("c:",Nothing)+--+-- >>> split "c:/"+-- Just ("c:/",Nothing)+--+-- >>> split "//x/"+-- Just ("//x/",Nothing)+--+-- >>> split "//x/y"+-- Just ("//x/",Just "y")+--+splitRoot :: OS_PATH_TYPE -> Maybe (OS_PATH_TYPE, Maybe OS_PATH_TYPE)+splitRoot (OS_PATH x) =+    let (a,b) = Common.splitRoot Common.OS_NAME x+     in if Array.null a+        then Nothing+        else if Array.null b+        then Just (OS_PATH a, Nothing)+        else Just (OS_PATH a, Just (OS_PATH b))++-- | Split a path into components separated by the path separator. "."+-- components in the path are ignored except when in the leading position.+-- Trailing separators in non-root components are dropped.+--+-- >>> split = Stream.toList . fmap Path.toString . Path.splitPath_ . Path.fromString_+--+-- >>> split "c:x"+-- ["c:","x"]+--+-- >>> split "c:/" -- Note, c:/ is not the same as c:+-- ["c:/"]+--+-- >>> split "c:/x"+-- ["c:/","x"]+--+-- >>> split "//x/y/"+-- ["//x","y"]+--+-- >>> split "./a"+-- [".","a"]+--+-- >>> split "c:./a"+-- ["c:","a"]+--+-- >>> split "a/."+-- ["a"]+--+-- >>> split "/x"+-- ["/","x"]+--+-- >>> split "/x/\\y"+-- ["/","x","y"]+--+-- >>> split "\\x/\\y"+-- ["\\","x","y"]+--+{-# INLINE splitPath_ #-}+splitPath_ :: Monad m => OS_PATH_TYPE -> Stream m OS_PATH_TYPE+splitPath_ (OS_PATH a) = fmap OS_PATH $ Common.splitPath_ Common.OS_NAME a++-- | Split the path components keeping separators between path components+-- attached to the dir part. Redundant separators are removed, only the first+-- one is kept, but separators are not changed to the default on Windows.+-- Separators are not added either e.g. "." and ".." may not have trailing+-- separators if the original path does not.+--+-- >>> split = Stream.toList . fmap Path.toString . Path.splitPath . Path.fromString_+--+-- >>> split "/x"+-- ["/","x"]+--+-- >>> split "/x/\\y"+-- ["/","x/","y"]+--+-- >>> split "\\x/\\y" -- this is not valid, multiple seps after share?+-- ["\\","x/","y"]+--+{-# INLINE splitPath #-}+splitPath :: Monad m => OS_PATH_TYPE -> Stream m OS_PATH_TYPE+splitPath (OS_PATH a) = fmap OS_PATH $ Common.splitPath Common.OS_NAME a++-- | See "Streamly.Internal.FileSystem.PosixPath" module for detailed+-- documentation and examples. We provide some Windows specific examples here.+--+-- Note: On Windows we cannot create a file named "prn." or "prn..". Thus it+-- considers anything starting with and including the first "." as the+-- extension and the part before it as the filename. Our definition considers+-- "prn." as a filename without an extension.+--+-- >>> toList (a,b) = (Path.toString a, Path.toString b)+-- >>> split = fmap toList . Path.splitExtension . Path.fromString_+--+-- >>> split "x:y"+-- Nothing+--+-- >>> split "x:.y"+-- Nothing+--+splitExtension :: OS_PATH_TYPE -> Maybe (OS_PATH_TYPE, OS_PATH_TYPE)+splitExtension (OS_PATH a) =+    fmap (bimap OS_PATH OS_PATH) $ Common.splitExtension Common.OS_NAME a
+ src/Streamly/Internal/FileSystem/WindowsPath/Node.hs view
@@ -0,0 +1,2 @@+#define IS_WINDOWS+#include "Streamly/Internal/FileSystem/PosixPath/Node.hs"
+ src/Streamly/Internal/FileSystem/WindowsPath/Seg.hs view
@@ -0,0 +1,2 @@+#define IS_WINDOWS+#include "Streamly/Internal/FileSystem/PosixPath/Seg.hs"
+ src/Streamly/Internal/FileSystem/WindowsPath/SegNode.hs view
@@ -0,0 +1,2 @@+#define IS_WINDOWS+#include "Streamly/Internal/FileSystem/PosixPath/SegNode.hs"
src/Streamly/Internal/Unicode/Array.hs view
@@ -55,7 +55,7 @@ -- {-# INLINE lines #-} lines :: MonadIO m => Stream m Char -> Stream m (Array Char)-lines = S.lines A.write+lines = S.lines A.create  -- | Break a string up into a stream of strings, which were delimited -- by characters representing white space.@@ -67,7 +67,7 @@ -- {-# INLINE words #-} words :: MonadIO m => Stream m Char -> Stream m (Array Char)-words = S.words A.write+words = S.words A.create  -- | Flattens the stream of @Array Char@, after appending a terminating -- newline to each string.
src/Streamly/Internal/Unicode/Parser.hs view
@@ -70,7 +70,7 @@ import Data.Char (ord) import Data.Ratio ((%)) import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Parser (Parser(..), Initial(..),  Step(..))+import Streamly.Internal.Data.Parser (Parser(..), Initial(..), Step(..), Final(..))  import qualified Data.Char as Char import qualified Streamly.Data.Fold as Fold@@ -339,87 +339,87 @@     {-# INLINE step #-}     step SPInitial val =         case val of-          '+' -> Continue 0 (SPSign 1)-          '-' -> Continue 0 $ (SPSign (-1))+          '+' -> SContinue 1 (SPSign 1)+          '-' -> SContinue 1 (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+              then SPartial 1 $ SPAfterSign 1 (intToInteger num)+              else SError $ 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+            then SPartial 1 $ SPAfterSign multiplier (intToInteger num)+            else SError $ 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+            '.' -> SContinue 1 $ SPDot multiplier buf+            'e' -> SContinue 1 $ SPExponent multiplier buf 0+            'E' -> SContinue 1 $ SPExponent multiplier buf 0             _ ->                 let num = ord val - 48                  in if num >= 0 && num <= 9                     then-                        Partial 0+                        SPartial 1                             $ SPAfterSign multiplier (combineNum buf (intToInteger num))-                    else Done 1 $ exitSPAfterSign multiplier buf+                    else SDone 0 $ 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+            then SPartial 1 $ SPAfterDot multiplier (combineNum buf (intToInteger num)) 1+            else SDone (-1) $ 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+            'e' -> SContinue 1 $ SPExponent multiplier buf decimalPlaces+            'E' -> SContinue 1 $ SPExponent multiplier buf decimalPlaces             _ ->                 let num = ord val - 48                  in if num >= 0 && num <= 9                     then-                        Partial 0+                        SPartial 1                             $ SPAfterDot                                   multiplier                                   (combineNum buf (intToInteger num))                                   (decimalPlaces + 1)-                    else Done 1 $ exitSPAfterDot multiplier buf decimalPlaces+                    else SDone 0 $ 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))+          '+' -> SContinue 1 (SPExponentWithSign multiplier buf decimalPlaces 1)+          '-' -> SContinue 1 (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+              then SPartial 1 $ SPAfterExponent multiplier buf decimalPlaces 1 num+              else SDone (-1) $ 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+            then SPartial 1 $ SPAfterExponent mult buf decimalPlaces powerMult num+            else SDone (-2) $ 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+                SPartial 1                     $ SPAfterExponent                           mult num decimalPlaces powerMult (combineNum buf n)             else-                Done 1+                SDone 0                     $ 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 SPInitial = FError $ exitSPInitial "end of input"+    extract (SPSign _) = FError $ exitSPSign "end of input"+    extract (SPAfterSign mult num) = FDone 0 $ exitSPAfterSign mult num+    extract (SPDot mult num) = FDone (-1) $ exitSPAfterSign mult num     extract (SPAfterDot mult num decimalPlaces) =-        Done 0 $ exitSPAfterDot mult num decimalPlaces+        FDone 0 $ exitSPAfterDot mult num decimalPlaces     extract (SPExponent mult num decimalPlaces) =-        Done 1 $ exitSPAfterDot mult num decimalPlaces+        FDone (-1) $ exitSPAfterDot mult num decimalPlaces     extract (SPExponentWithSign mult num decimalPlaces _) =-        Done 2 $ exitSPAfterDot mult num decimalPlaces+        FDone (-2) $ exitSPAfterDot mult num decimalPlaces     extract (SPAfterExponent mult num decimalPlaces powerMult powerNum) =-        Done 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum+        FDone 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum  type MantissaInt = Int type OverflowPower = Int@@ -480,84 +480,84 @@     {-# INLINE step #-}     step DPInitial val =         case val of-          '+' -> Continue 0 (DPSign 1)-          '-' -> Continue 0 $ (DPSign (-1))+          '+' -> SContinue 1 (DPSign 1)+          '-' -> SContinue 1 (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+              then SPartial 1 $ DPAfterSign 1 num 0+              else SError $ 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+            then SPartial 1 $ DPAfterSign multiplier num 0+            else SError $ 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+            '.' -> SContinue 1 $ DPDot multiplier buf opower+            'e' -> SContinue 1 $ DPExponent multiplier buf opower+            'E' -> SContinue 1 $ 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+                         in SPartial 1                             $ DPAfterSign multiplier buf1 power1-                    else Done 1 $ exitDPAfterSign multiplier buf opower+                    else SDone 0 $ 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+                 in SPartial 1 $ DPAfterDot multiplier buf1 (power1 - 1)+            else SDone (-1) $ 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+            'e' -> SContinue 1 $ DPExponent multiplier buf opower+            'E' -> SContinue 1 $ 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+                         in SPartial 1 $ DPAfterDot multiplier buf1 (power1 - 1)+                    else SDone 0 $ 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))+          '+' -> SContinue 1 (DPExponentWithSign multiplier buf opower 1)+          '-' -> SContinue 1 (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+              then SPartial 1 $ DPAfterExponent multiplier buf opower 1 num+              else SDone (-1) $ 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+            then SPartial 1 $ DPAfterExponent mult buf opower powerMult num+            else SDone (-2) $ 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+                SPartial 1                     $ DPAfterExponent mult num opower powerMult (buf * 10 + n)-            else Done 1 $ exitDPAfterExponent mult num opower powerMult buf+            else SDone 0 $ 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 DPInitial = FError $ exitDPInitial "end of input"+    extract (DPSign _) = FError $ exitDPSign "end of input"+    extract (DPAfterSign mult num opow) = FDone 0 $ exitDPAfterSign mult num opow+    extract (DPDot mult num opow) = FDone (-1) $ exitDPAfterSign mult num opow     extract (DPAfterDot mult num opow) =-        Done 0 $ exitDPAfterDot mult num opow+        FDone 0 $ exitDPAfterDot mult num opow     extract (DPExponent mult num opow) =-        Done 1 $ exitDPAfterDot mult num opow+        FDone (-1) $ exitDPAfterDot mult num opow     extract (DPExponentWithSign mult num opow _) =-        Done 2 $ exitDPAfterDot mult num opow+        FDone (-2) $ exitDPAfterDot mult num opow     extract (DPAfterExponent mult num opow powerMult powerNum) =-        Done 0 $ exitDPAfterExponent mult num opow powerMult powerNum+        FDone 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.@@ -589,7 +589,7 @@ -- -- Examples: ----- >>> p = Stream.parse Unicode.double . Stream.fromList+-- >>> p = Stream.parsePos Unicode.double . Stream.fromList -- -- >>> p "-1.23e-123" -- Right (-1.23e-123)@@ -614,13 +614,13 @@ -- Error cases: -- -- >>> p ""--- Left (ParseError "number: expecting sign or decimal digit, got end of input")+-- Left (ParseErrorPos 0 "number: expecting sign or decimal digit, got end of input") -- -- >>> p ".1"--- Left (ParseError "number: expecting sign or decimal digit, got '.'")+-- Left (ParseErrorPos 1 "number: expecting sign or decimal digit, got '.'") -- -- >>> p "+"--- Left (ParseError "number: expecting decimal digit, got end of input")+-- Left (ParseErrorPos 1 "number: expecting decimal digit, got end of input") -- {-# INLINE double #-} double :: Monad m => Parser Char m Double
src/Streamly/Internal/Unicode/Stream.hs view
@@ -18,19 +18,24 @@     --     -- $setup +    -- XXX Use to/from instead of encode/decode for more compact naming.+     -- * Construction (Decoding)       decodeLatin1 -    -- ** UTF-8 Decoding+    -- ** UTF-8 Byte Stream Decoding     , CodingFailureMode(..)     , writeCharUtf8'     , parseCharUtf8With     , decodeUtf8     , decodeUtf8'     , decodeUtf8_++    -- ** UTF-16 Byte Stream Decoding     , decodeUtf16le'+    , decodeUtf16le -    -- ** Resumable UTF-8 Decoding+    -- ** Resumable UTF-8 Byte Stream Decoding     , DecodeError(..)     , DecodeState     , CodePoint@@ -41,14 +46,15 @@     , decodeUtf8Chunks     , decodeUtf8Chunks'     , decodeUtf8Chunks_+    -- , fromUtf8ChunksEndByLn      -- * Elimination (Encoding)-    -- ** Latin1 Encoding+    -- ** Latin1 Encoding to Byte Stream     , encodeLatin1     , encodeLatin1'     , encodeLatin1_ -    -- ** UTF-8 Encoding+    -- ** UTF-8 Encoding to Byte Stream     , readCharUtf8'     , readCharUtf8     , readCharUtf8_@@ -56,7 +62,21 @@     , encodeUtf8'     , encodeUtf8_     , encodeStrings++    -- ** UTF-8 Encoding to Chunk Stream+    -- , toUtf8Chunks+    -- , toUtf8Chunks'+    -- , toUtf8Chunks_+    -- , toUtf8ChunksEndByLn++    -- , toPinnedUtf8Chunks+    -- , toPinnedUtf8Chunks'+    -- , toPinnedUtf8Chunks_+    -- , toPinnedUtf8ChunksEndByLn++    -- ** UTF-16 Encoding to Byte Stream     , encodeUtf16le'+    , encodeUtf16le     {-     -- * Operations on character strings     , strip -- (dropAround isSpace)@@ -65,10 +85,10 @@      -- * Transformation     , stripHead-    , lines-    , words-    , unlines-    , unwords+    , lines -- foldLines+    , words -- foldWords+    , unlines -- unfoldLines+    , unwords -- unfoldWords      -- * StreamD UTF8 Encoding / Decoding transformations.     , decodeUtf8D@@ -83,6 +103,10 @@     -- * Decoding String Literals     , fromStr# +    -- * Word16 Utilities+    , mkEvenW8Chunks+    , swapByteOrder+     -- * Deprecations     , decodeUtf8Lax     , encodeLatin1Lax@@ -92,6 +116,10 @@  #include "inline.hs" +-- MachDeps.h includes ghcautoconf.h that defines WORDS_BIGENDIAN for big endian+-- systems.+#include "MachDeps.h"+ import Control.Monad (void) import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Bits (shiftR, shiftL, (.|.), (.&.))@@ -124,7 +152,7 @@  import qualified Streamly.Data.Fold as Fold import qualified Streamly.Data.Unfold as Unfold-import qualified Streamly.Internal.Data.Array.Type as Array+import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.Parser as Parser (Parser) import qualified Streamly.Internal.Data.Parser as ParserD import qualified Streamly.Internal.Data.Stream as Stream@@ -465,15 +493,15 @@      handleError err souldBackTrack =         case cfm of-            ErrorOnCodingFailure -> ParserD.Error err+            ErrorOnCodingFailure -> ParserD.SError err             TransliterateCodingFailure ->                 case souldBackTrack of-                    True -> ParserD.Done 1 replacementChar-                    False -> ParserD.Done 0 replacementChar+                    True -> ParserD.SDone 0 replacementChar+                    False -> ParserD.SDone 1 replacementChar             DropOnCodingFailure ->                 case souldBackTrack of-                    True -> ParserD.Continue 1 UTF8CharDecodeInit-                    False -> ParserD.Continue 0 UTF8CharDecodeInit+                    True -> ParserD.SContinue 0 UTF8CharDecodeInit+                    False -> ParserD.SContinue 1 UTF8CharDecodeInit      {-# INLINE step' #-}     step' table UTF8CharDecodeInit x =@@ -483,7 +511,7 @@         -- change with the compiler versions, we need a more reliable         -- "likely" primitive to control branch predication.         return $ case x > 0x7f of-            False -> ParserD.Done 0 $ unsafeChr $ fromIntegral x+            False -> ParserD.SDone 1 $ unsafeChr $ fromIntegral x             True ->                 let (Tuple' sv cp) = decode0 table x                  in case sv of@@ -492,12 +520,12 @@                                     ++ "Invalid first UTF8 byte" ++ show x                              in handleError msg False                         0 -> error $ prefix ++ "unreachable state"-                        _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)+                        _ -> ParserD.SContinue 1 (UTF8CharDecoding sv cp)      step' table (UTF8CharDecoding statePtr codepointPtr) x = return $         let (Tuple' sv cp) = decode1 table statePtr codepointPtr x          in case sv of-            0 -> ParserD.Done 0 $ unsafeChr cp+            0 -> ParserD.SDone 1 $ unsafeChr cp             12 ->                 let msg = prefix                         ++ "Invalid subsequent UTF8 byte"@@ -507,16 +535,16 @@                         ++ "accumulated value"                         ++ show codepointPtr                  in handleError msg True-            _ -> ParserD.Continue 0 (UTF8CharDecoding sv cp)+            _ -> ParserD.SContinue 1 (UTF8CharDecoding sv cp)      {-# INLINE extract #-}     extract UTF8CharDecodeInit =  error $ prefix ++ "Not enough input"     extract (UTF8CharDecoding _ _) =         case cfm of             ErrorOnCodingFailure ->-                return $ ParserD.Error $ prefix ++ "Not enough input"+                return $ ParserD.FError $ prefix ++ "Not enough input"             TransliterateCodingFailure ->-                return (ParserD.Done 0 replacementChar)+                return (ParserD.FDone 0 replacementChar)             -- XXX We shouldn't error out here. There is no way to represent an             -- empty parser result unless we return a "Maybe" type.             DropOnCodingFailure -> error $ prefix ++ "Not enough input"@@ -682,15 +710,184 @@ -- Decoding Utf16 ------------------------------------------------------------------------------- --- | Decode a UTF-16 little endian encoded bytestream to a stream of Unicode--- characters. The function throws an error if an invalid codepoint is+data MkEvenW8ChunksState s w8 arr+    = MECSInit s+    | MECSBuffer w8 s+    | MECSYieldAndInit arr s+    | MECSYieldAndBuffer arr w8 s++-- | Ensure chunks of even length. This can be used before casting the arrays to+-- Word16. Use this API when interacting with external data.+--+-- The chunks are split and merged accordingly to create arrays of even length.+-- If the sum of length of all the arrays in the stream is odd then the trailing+-- byte of the last array is dropped.+--+{-# INLINE_NORMAL mkEvenW8Chunks #-}+mkEvenW8Chunks :: Monad m => Stream m (Array Word8) -> Stream m (Array Word8)+mkEvenW8Chunks (D.Stream step state) = D.Stream step1 (MECSInit state)++    where++    {-# INLINE_LATE step1 #-}+    step1 gst (MECSInit st) = do+        r <- step (adaptState gst) st+        return $+            case r of+                Yield arr st1 ->+                    let len = Array.length arr+                     in if (len .&. 1) == 1+                        then let arr1 = Array.unsafeSliceOffLen 0 (len - 1) arr+                                 remElem = Array.unsafeGetIndex (len - 1) arr+                              in Yield arr1 (MECSBuffer remElem st1)+                        else Yield arr (MECSInit st1)+                Skip s -> Skip (MECSInit s)+                Stop -> Stop+    step1 gst (MECSBuffer remElem st) = do+        r <- step (adaptState gst) st+        return $+            case r of+                Yield arr st1 | Array.length arr == 0 ->+                                  Skip (MECSBuffer remElem st1)+                Yield arr st1 | Array.length arr == 1 ->+                    let fstElem = Array.unsafeGetIndex 0 arr+                        w16 = Array.fromList [remElem, fstElem]+                     in Yield w16 (MECSInit st1)+                Yield arr st1 ->+                    let len = Array.length arr+                     in if (len .&. 1) == 1+                        then let arr1 = Array.unsafeSliceOffLen 1 (len - 1) arr+                                 fstElem = Array.unsafeGetIndex 0 arr+                                 w16 = Array.fromList [remElem, fstElem]+                              in Yield w16 (MECSYieldAndInit arr1 st1)+                        else let arr1 = Array.unsafeSliceOffLen 1 (len - 2) arr+                                 fstElem = Array.unsafeGetIndex 0 arr+                                 lstElem = Array.unsafeGetIndex (len - 1) arr+                                 w16 = Array.fromList [remElem, fstElem]+                              in Yield w16+                                     (MECSYieldAndBuffer arr1 lstElem st1)+                Skip s -> Skip (MECSBuffer remElem s)+                Stop -> Stop -- Here the last Word8 is lost+    step1 _ (MECSYieldAndInit arr st) =+        pure $ Yield arr (MECSInit st)+    step1 _ (MECSYieldAndBuffer arr lastElem st) =+        pure $ Yield arr (MECSBuffer lastElem st)++-- | Swap the byte order of Word16+--+-- > swapByteOrder 0xABCD == 0xCDAB+-- > swapByteOrder . swapByteOrder == id+{-# INLINE swapByteOrder #-}+swapByteOrder :: Word16 -> Word16+swapByteOrder w = (w `shiftL` 8) .|. (w `shiftR` 8)++data DecodeUtf16WithState w c s+    = U16NoSurrogate s+    | U16HighSurrogate w s+    | U16D+    | U16YAndC c (DecodeUtf16WithState w c s)++{-# INLINE_NORMAL decodeUtf16With #-}+decodeUtf16With ::+       Monad m+    => CodingFailureMode+    -> D.Stream m Word16+    -> D.Stream m Char+decodeUtf16With cfm (D.Stream step state) =+    D.Stream step1 (U16NoSurrogate state)++    where++    prefix = "Streamly.Internal.Unicode.Stream.decodeUtf16With: "++    {-# INLINE combineSurrogates #-}+    combineSurrogates hi lo =+        let first10 = fromIntegral (hi - utf16HighSurrogate) `shiftL` 10+            second10 = fromIntegral (lo - utf16LowSurrogate)+         in unsafeChr (0x10000 + (first10 .|. second10))++    {-# INLINE transliterateOrError #-}+    transliterateOrError e s =+        case cfm of+            ErrorOnCodingFailure -> error e+            TransliterateCodingFailure -> U16YAndC replacementChar s+            DropOnCodingFailure -> s++    {-# INLINE inputUnderflow #-}+    inputUnderflow =+        case cfm of+            ErrorOnCodingFailure -> error $ prefix ++ "Input Underflow"+            TransliterateCodingFailure -> U16YAndC replacementChar U16D+            DropOnCodingFailure -> U16D++    {-# INLINE_LATE step1 #-}+    step1 gst (U16NoSurrogate st) = do+        r <- step (adaptState gst) st+        pure $+            case r of+                Yield x st1+                    | x < 0xD800 || x > 0xDFFF ->+                        Yield (unsafeChr (fromIntegral x)) (U16NoSurrogate st1)+                    | x >= 0xD800 && x <= 0xDBFF ->+                        Skip (U16HighSurrogate x st1)+                    | otherwise ->+                          let msg = prefix+                                 ++ "Invalid first UTF16 word " ++ show x+                           in Skip $+                              transliterateOrError msg (U16NoSurrogate st1)+                Skip st1 -> Skip (U16NoSurrogate st1)+                Stop -> Stop+    step1 gst (U16HighSurrogate hi st) = do+        r <- step (adaptState gst) st+        pure $+            case r of+                Yield x st1+                    | x >= 0xDC00 && x <= 0xDFFF ->+                          Yield (combineSurrogates hi x) (U16NoSurrogate st1)+                    | otherwise ->+                          let msg = prefix+                                 ++ "Invalid subsequent UTF16 word " ++ show x+                                 ++ " in state " ++ show hi+                           in Skip $+                              transliterateOrError msg (U16NoSurrogate st1)+                Skip st1 -> Skip (U16HighSurrogate hi st1)+                Stop -> Skip inputUnderflow+    step1 _ (U16YAndC x st) = pure $ Yield x st+    step1 _ U16D = pure Stop++{-# INLINE decodeUtf16' #-}+decodeUtf16' :: Monad m => Stream m Word16 -> Stream m Char+decodeUtf16' = decodeUtf16With ErrorOnCodingFailure++{-# INLINE decodeUtf16 #-}+decodeUtf16 :: Monad m => Stream m Word16 -> Stream m Char+decodeUtf16 = decodeUtf16With TransliterateCodingFailure++-- | Similar to 'decodeUtf16le' but throws an error if an invalid codepoint is -- encountered. ----- /Unimplemented/ {-# INLINE decodeUtf16le' #-}-decodeUtf16le' :: Stream m Word16 -> Stream m Char-decodeUtf16le' = undefined+decodeUtf16le' :: Monad m => Stream m Word16 -> Stream m Char+decodeUtf16le' =+    decodeUtf16'+#ifdef WORDS_BIGENDIAN+        . fmap swapByteOrder+#endif +-- | Decode a UTF-16 encoded stream to a stream of Unicode characters. Any+-- invalid codepoint encountered is replaced with the unicode replacement+-- character.+--+-- The Word16s are expected to be in the little-endian byte order.+--+{-# INLINE decodeUtf16le #-}+decodeUtf16le :: Monad m => Stream m Word16 -> Stream m Char+decodeUtf16le =+    decodeUtf16+#ifdef WORDS_BIGENDIAN+        . fmap swapByteOrder+#endif+ ------------------------------------------------------------------------------- -- Decoding Array Streams -------------------------------------------------------------------------------@@ -850,12 +1047,12 @@ -- Encoding Unicode (UTF-8) Characters ------------------------------------------------------------------------------- -data WList = WCons !Word8 !WList | WNil+data WList a = WCons !a !(WList a) | WNil  -- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.  {-# INLINE ord2 #-}-ord2 :: Char -> WList+ord2 :: Char -> (WList Word8) ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))   where     n = ord c@@ -863,7 +1060,7 @@     x2 = fromIntegral $ (n .&. 0x3F) + 0x80  {-# INLINE ord3 #-}-ord3 :: Char -> WList+ord3 :: Char -> (WList Word8) ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))   where     n = ord c@@ -872,7 +1069,7 @@     x3 = fromIntegral $ (n .&. 0x3F) + 0x80  {-# INLINE ord4 #-}-ord4 :: Char -> WList+ord4 :: Char -> (WList Word8) ord4 c = assert (n >= 0x10000)  (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))   where     n = ord c@@ -882,7 +1079,7 @@     x4 = fromIntegral $ (n .&. 0x3F) + 0x80  {-# INLINE_NORMAL readCharUtf8With #-}-readCharUtf8With :: Monad m => WList -> Unfold m Char Word8+readCharUtf8With :: Monad m => (WList Word8) -> Unfold m Char Word8 readCharUtf8With surr = Unfold step inject      where@@ -910,7 +1107,7 @@ -- paths (slow path). {-# INLINE_NORMAL encodeUtf8D' #-} encodeUtf8D' :: Monad m => D.Stream m Char -> D.Stream m Word8-encodeUtf8D' = D.unfoldMany readCharUtf8'+encodeUtf8D' = D.unfoldEach readCharUtf8'  -- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. When -- any invalid character (U+D800-U+D8FF) is encountered in the input stream the@@ -929,7 +1126,7 @@ -- {-# INLINE_NORMAL encodeUtf8D #-} encodeUtf8D :: Monad m => D.Stream m Char -> D.Stream m Word8-encodeUtf8D = D.unfoldMany readCharUtf8+encodeUtf8D = D.unfoldEach readCharUtf8  -- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any -- Invalid characters (U+D800-U+D8FF) in the input stream are replaced by the@@ -945,7 +1142,7 @@  {-# INLINE_NORMAL encodeUtf8D_ #-} encodeUtf8D_ :: Monad m => D.Stream m Char -> D.Stream m Word8-encodeUtf8D_ = D.unfoldMany readCharUtf8_+encodeUtf8D_ = D.unfoldEach readCharUtf8_  -- | Encode a stream of Unicode characters to a UTF-8 encoded bytestream. Any -- Invalid characters (U+D800-U+D8FF) in the input stream are dropped.@@ -965,18 +1162,81 @@ -- Encoding to Utf16 ------------------------------------------------------------------------------- --- | Encode a stream of Unicode characters to a UTF-16 little endian encoded--- bytestream.+{-# INLINE utf16LowSurrogate #-}+utf16LowSurrogate :: Word16+utf16LowSurrogate = 0xDC00++{-# INLINE utf16HighSurrogate #-}+utf16HighSurrogate :: Word16+utf16HighSurrogate = 0xD800++{-# INLINE_NORMAL readCharUtf16With #-}+readCharUtf16With :: Monad m => WList Word16 -> Unfold m Char Word16+readCharUtf16With invalidReplacement = Unfold step inject++    where++    inject c =+        return $ case ord c of+            x | x < 0xD800 -> fromIntegral x `WCons` WNil+              | x > 0xDFFF && x <= 0xFFFF -> fromIntegral x `WCons` WNil+              | x >= 0x10000 && x <= 0x10FFFF ->+                    let u = x - 0x10000                         -- 20 bits+                        h = utf16HighSurrogate+                                + fromIntegral (u `shiftR` 10)  -- 10 bits+                        l = utf16LowSurrogate+                                + fromIntegral (u .&. 0x3FF)    -- 10 bits+                    in WCons h $ WCons l WNil+              | otherwise -> invalidReplacement++    {-# INLINE_LATE step #-}+    step WNil = return Stop+    step (WCons x xs) = return $ Yield x xs++{-# INLINE encodeUtf16' #-}+encodeUtf16' :: Monad m => Stream m Char -> Stream m Word16+encodeUtf16' = D.unfoldEach (readCharUtf16With errString)+    where+    errString =+        error+            $ "Streamly.Internal.Unicode.encodeUtf16': Encountered an \+               invalid character"++{-# INLINE encodeUtf16 #-}+encodeUtf16 :: Monad m => Stream m Char -> Stream m Word16+encodeUtf16 = D.unfoldEach (readCharUtf16With WNil)++-- | Similar to 'encodeUtf16le' but throws an error if any invalid character is+-- encountered. ----- /Unimplemented/ {-# INLINE encodeUtf16le' #-}-encodeUtf16le' :: Stream m Char -> Stream m Word16-encodeUtf16le' = undefined+encodeUtf16le' :: Monad m => Stream m Char -> Stream m Word16+encodeUtf16le' =+#ifdef WORDS_BIGENDIAN+    fmap swapByteOrder .+#endif+        encodeUtf16' +-- | Encode a stream of Unicode characters to a UTF-16 encoded stream. Any+-- invalid characters in the input stream are replaced by the Unicode+-- replacement character U+FFFD.+--+-- The resulting Word16s are encoded in little-endian byte order.+--+{-# INLINE encodeUtf16le #-}+encodeUtf16le :: Monad m => Stream m Char -> Stream m Word16+encodeUtf16le =+#ifdef WORDS_BIGENDIAN+    fmap swapByteOrder .+#endif+        encodeUtf16+ ------------------------------------------------------------------------------- -- Decoding string literals ------------------------------------------------------------------------------- +-- XXX decodeCString#+ -- | Read UTF-8 encoded bytes as chars from an 'Addr#' until a 0 byte is -- encountered, the 0 byte is not included in the stream. --@@ -990,7 +1250,7 @@ -- {-# INLINE fromStr# #-} fromStr# :: MonadIO m => Addr# -> Stream m Char-fromStr# addr = decodeUtf8 $ Stream.fromByteStr# addr+fromStr# addr = decodeUtf8 $ Stream.fromCString# addr  ------------------------------------------------------------------------------- -- Encode streams of containers@@ -1006,7 +1266,7 @@     -> Unfold m a Char     -> a     -> m (Array Word8)-encodeObject encode u = Stream.fold Array.write . encode . Stream.unfold u+encodeObject encode u = Stream.fold Array.create . encode . Stream.unfold u  -- | Encode a stream of container objects using the supplied encoding scheme. -- Each object is encoded as an @Array Word8@.@@ -1044,7 +1304,7 @@  -- | Remove leading whitespace from a string. ----- > stripHead = Stream.dropWhile isSpace+-- >>> stripHead = Stream.dropWhile Char.isSpace -- -- /Pre-release/ {-# INLINE stripHead #-}@@ -1054,11 +1314,15 @@ -- | Fold each line of the stream using the supplied 'Fold' -- and stream the result. ----- >>> Stream.fold Fold.toList $ Unicode.lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")--- ["lines","this","string","",""]+-- Definition: ----- > lines = Stream.splitOnSuffix (== '\n')+-- >>> lines f = Stream.foldMany (Fold.takeEndBy_ (== '\n') f) --+-- Usage:+--+-- >>> Stream.toList $ Unicode.lines Fold.toList (Stream.fromList "line1\nline2\nline3\n\n\n")+-- ["line1","line2","line3","",""]+-- -- /Pre-release/ {-# INLINE lines #-} lines :: Monad m => Fold m Char b -> Stream m Char -> Stream m b@@ -1082,14 +1346,17 @@   where     uc = fromIntegral (ord c) :: Word --- | Fold each word of the stream using the supplied 'Fold'--- and stream the result.+-- | Fold each word of the stream using the supplied 'Fold'. ----- >>>  Stream.fold Fold.toList $ Unicode.words Fold.toList (Stream.fromList "fold these     words")--- ["fold","these","words"]+-- Definition: ----- > words = Stream.wordsBy isSpace+-- >>> words = Stream.wordsBy Char.isSpace --+-- Usage:+--+-- >>> Stream.toList $ Unicode.words Fold.toList (Stream.fromList " ab  cd   ef ")+-- ["ab","cd","ef"]+-- -- /Pre-release/ {-# INLINE words #-} words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b@@ -1098,26 +1365,24 @@ -- | Unfold a stream to character streams using the supplied 'Unfold' -- and concat the results suffixing a newline character @\\n@ to each stream. ----- @--- unlines = Stream.interposeSuffix '\n'--- unlines = Stream.intercalateSuffix Unfold.fromList "\n"--- @+-- Definition: --+-- >>> unlines = Stream.unfoldEachEndBy '\n'+-- >>> unlines = Stream.unfoldEachEndBySeq "\n" Unfold.fromList+-- -- /Pre-release/ {-# INLINE unlines #-} unlines :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char-unlines = Stream.interposeSuffix '\n'+unlines = Stream.unfoldEachEndBy '\n'  -- | Unfold the elements of a stream to character streams using the supplied -- 'Unfold' and concat the results with a whitespace character infixed between -- the streams. ----- @--- unwords = Stream.interpose ' '--- unwords = Stream.intercalate Unfold.fromList " "--- @+-- >>> unwords = Stream.unfoldEachSepBy ' '+-- >>> unwords = Stream.unfoldEachSepBySeq " " Unfold.fromList -- -- /Pre-release/ {-# INLINE unwords #-} unwords :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char-unwords = Stream.interpose ' '+unwords = Stream.unfoldEachSepBy ' '
src/Streamly/Internal/Unicode/String.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.String@@ -39,14 +39,14 @@     --     -- $setup -    str+      str     ) where   import Control.Applicative (Alternative(..)) import Control.Exception (displayException) import Data.Functor.Identity (runIdentity)-import Streamly.Internal.Data.Parser (Parser)+import Streamly.Internal.Data.Parser (Parser, ParseError)  import Language.Haskell.TH import Language.Haskell.TH.Quote@@ -106,9 +106,12 @@ strExp :: [StrSegment] -> Q Exp strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs +parseStr :: String -> Either ParseError [StrSegment]+parseStr = runIdentity . Stream.parse strParser . Stream.fromList+ expandVars :: String -> Q Exp-expandVars ln =-    case runIdentity $ Stream.parse strParser (Stream.fromList ln) of+expandVars input =+    case parseStr input of         Left e ->             fail $ "str QuasiQuoter parse error: " ++ displayException e         Right x ->@@ -140,9 +143,6 @@ -- world!|] -- :} -- "hello world!"------ Bugs: because of a bug in parsers, a lone # at the end of input gets--- removed. -- str :: QuasiQuoter str =
src/Streamly/Unicode/Stream.hs view
@@ -80,6 +80,8 @@       decodeLatin1     , decodeUtf8     , decodeUtf8'+    , decodeUtf16le+    , decodeUtf16le'     , decodeUtf8Chunks      -- * Elimination (Encoding)@@ -87,6 +89,8 @@     , encodeLatin1'     , encodeUtf8     , encodeUtf8'+    , encodeUtf16le+    , encodeUtf16le'     , encodeStrings     {-     -- * Operations on character strings
+ src/deprecation.h view
@@ -0,0 +1,9 @@+#define RENAME(_old, _new)                          \+{-# DEPRECATED _old "Please use _new instead." #-}; \+{-# INLINE _old #-}; \+_old = _new++#define RENAME_PRIME(_old, _new)                       \+{-# DEPRECATED _old "Please use _new' instead." #-}; \+{-# INLINE _old #-}; \+_old = _new'
+ src/doctest/DocTestControlException.hs view
@@ -0,0 +1,13 @@+{- $setup++>>> :m+>>> import Control.Monad (when)+>>> import Control.Concurrent (threadDelay)+>>> import Data.Function ((&))+>>> import System.IO (hClose, IOMode(..), openFile)++>>> import Streamly.Data.Stream (Stream)+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Control.Exception as Exception+-}
+ src/doctest/DocTestDataArray.hs view
@@ -0,0 +1,22 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> :set -XMagicHash+>>> import Data.Function ((&))+>>> import Data.Functor.Identity (Identity(..))+>>> import System.IO.Unsafe (unsafePerformIO)++>>> import Streamly.Data.Array (Array)+>>> import Streamly.Data.Stream (Stream)++>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.ParserK as ParserK+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Array as Array+>>> import qualified Streamly.Internal.Data.Stream as Stream+-}
+ src/doctest/DocTestDataFold.hs view
@@ -0,0 +1,33 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> import Control.Monad (void)+>>> import qualified Data.Foldable as Foldable+>>> import Data.Bifunctor(bimap)+>>> import Data.Function ((&))+>>> import Data.Functor.Identity (Identity, runIdentity)+>>> import Data.IORef (newIORef, readIORef, writeIORef)+>>> import Data.Maybe (fromJust, isJust)+>>> import Data.Monoid (Endo(..), Last(..), Sum(..))++>>> import Streamly.Data.Array (Array)+>>> import Streamly.Data.Fold (Fold, Tee(..))+>>> import Streamly.Data.Stream (Stream)++>>> import qualified Data.Map as Map+>>> import qualified Data.Set as Set+>>> import qualified Data.IntSet as IntSet+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.MutArray as MutArray+>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK+>>> import qualified Streamly.Data.Unfold as Unfold++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Scanl as Scanl+>>> import qualified Streamly.Internal.Data.Stream as Stream+-}
+ src/doctest/DocTestDataMutArray.hs view
@@ -0,0 +1,11 @@+{- $setup+>>> :m+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.MutArray as MutArray+>>> import qualified Streamly.Data.Stream as Stream++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.MutArray as MutArray+-}
+ src/doctest/DocTestDataMutArrayGeneric.hs view
@@ -0,0 +1,10 @@+{- $setup+>>> :m+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.MutArray.Generic as MutArray+>>> import qualified Streamly.Data.Stream as Stream++For APIs that have not been released yet.++>>> import Streamly.Internal.Data.MutArray.Generic as MutArray+-}
+ src/doctest/DocTestDataParser.hs view
@@ -0,0 +1,20 @@+{- $setup+>>> :m+>>> import Control.Applicative ((<|>))+>>> import Data.Bifunctor (second)+>>> import Data.Char (isSpace)+>>> import qualified Data.Foldable as Foldable+>>> import qualified Data.Maybe as Maybe++>>> import Streamly.Data.Fold (Fold)+>>> 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++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Parser as Parser+-}
+ src/doctest/DocTestDataParserK.hs view
@@ -0,0 +1,18 @@+{- $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+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK+>>> import qualified Streamly.Unicode.Parser as Parser++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.ParserK as ParserK+-}
+ src/doctest/DocTestDataScanl.hs view
@@ -0,0 +1,36 @@+{- $setup+>>> :m+>>> :set -XFlexibleContexts+>>> import Control.Monad (void)+>>> import qualified Data.Foldable as Foldable+>>> import Data.Bifunctor(bimap)+>>> import Data.Function ((&))+>>> import Data.Functor.Identity (Identity, runIdentity)+>>> import Data.IORef (newIORef, readIORef, writeIORef)+>>> import Data.Maybe (fromJust, isJust)+>>> import Data.Monoid (Endo(..), Last(..), Sum(..))+>>> import Prelude hiding (length, sum, minimum, maximum)++>>> import Streamly.Data.Array (Array)+>>> import Streamly.Data.Fold (Fold, Tee(..))+>>> import Streamly.Data.Stream (Stream)++>>> import qualified Data.Map as Map+>>> import qualified Data.Set as Set+>>> import qualified Data.IntSet as IntSet+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.MutArray as MutArray+>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Data.Scanl as Scanl+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK+>>> import qualified Streamly.Data.Unfold as Unfold++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.RingArray as RingArray+>>> import qualified Streamly.Internal.Data.Scanl as Scanl+>>> import qualified Streamly.Internal.Data.Stream as Stream+-}
+ src/doctest/DocTestDataStream.hs view
@@ -0,0 +1,45 @@+{- $setup++>>> :m+>>> import Control.Concurrent (threadDelay)+>>> import Control.Monad (void, when)+>>> import Control.Monad.IO.Class (MonadIO (liftIO))+>>> import Control.Monad.Trans.Class (lift)+>>> import Control.Monad.Trans.Identity (runIdentityT)+>>> import Data.Char (isSpace)+>>> import Data.Either (fromLeft, fromRight, isLeft, isRight, either)+>>> import Data.Maybe (fromJust, isJust)+>>> import Data.Function (fix, (&))+>>> import Data.Functor.Identity (runIdentity)+>>> import Data.IORef+>>> import Data.Semigroup (cycle1)+>>> import Data.Word (Word8, Word16)+>>> import GHC.Exts (Ptr (Ptr))+>>> import System.IO (stdout, hClose, hSetBuffering, openFile, BufferMode(LineBuffering), IOMode(..))++>>> hSetBuffering stdout LineBuffering+>>> effect n = print n >> return n++>>> import Streamly.Data.Stream (Stream)+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Scanl as Scanl+>>> 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.DirIO as Dir++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.Control.Exception as Exception+>>> import qualified Streamly.Internal.FileSystem.Path as Path+>>> import qualified Streamly.Internal.Data.Scanr as Scanr+>>> import qualified Streamly.Internal.Data.Scanl as Scanl+>>> import qualified Streamly.Internal.Data.Fold as Fold+>>> import qualified Streamly.Internal.Data.Parser as Parser+>>> import qualified Streamly.Internal.Data.Stream as Stream+>>> import qualified Streamly.Internal.Data.StreamK as StreamK+>>> import qualified Streamly.Internal.Data.Unfold as Unfold+>>> import qualified Streamly.Internal.FileSystem.DirIO as Dir+-}
+ src/doctest/DocTestDataStreamK.hs view
@@ -0,0 +1,24 @@+{- $setup++>>> :m+>>> import Control.Concurrent (threadDelay)+>>> import Data.Function (fix, (&))+>>> import Data.Semigroup (cycle1)++>>> import Streamly.Data.StreamK (StreamK)+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Parser as Parser+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Data.StreamK as StreamK+>>> import qualified Streamly.FileSystem.DirIO as Dir++>>> mk = StreamK.fromStream . Stream.fromList+>>> un = Stream.toList . StreamK.toStream+>>> effect n = print n >> return n++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.FileSystem.Path as Path+>>> import qualified Streamly.Internal.Data.StreamK as StreamK+>>> import qualified Streamly.Internal.FileSystem.DirIO as Dir+-}
+ src/doctest/DocTestDataUnfold.hs view
@@ -0,0 +1,13 @@+{- $setup++>>> :m+>>> import Streamly.Data.Unfold (Unfold)+>>> import qualified Streamly.Data.Fold as Fold+>>> import qualified Streamly.Data.Scanl as Scanl+>>> 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.Unfold as Unfold+-}
+ src/doctest/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 (unsafeCreateOf)+>>> 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/doctest/DocTestFileSystemPath.hs view
@@ -0,0 +1,20 @@+{- $setup+>>> :m+>>> :set -XQuasiQuotes+>>> import Control.Exception (SomeException, evaluate, try)+>>> import Data.Either (Either, isLeft)+>>> import Data.Maybe (fromJust, isJust, isNothing)+>>> import Streamly.FileSystem.Path (Path, path)+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.FileSystem.Path as Path+>>> import qualified Streamly.Unicode.Stream as Unicode++For APIs that have not been released yet.++>>> import qualified Streamly.Internal.FileSystem.Path as Path++Utilities:++>>> fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))+-}
+ src/doctest/DocTestFileSystemPosixPath.hs view
@@ -0,0 +1,19 @@+{- $setup+>>> :m+>>> :set -XQuasiQuotes+>>> import Control.Exception (SomeException, evaluate, try)+>>> import Data.Either (Either, isLeft)+>>> import Data.Maybe (isNothing, isJust)+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Unicode.Stream as Unicode++For APIs that have not been released yet.++>>> import Streamly.Internal.FileSystem.PosixPath (PosixPath, path)+>>> import qualified Streamly.Internal.FileSystem.PosixPath as Path++Utilities:++>>> fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))+-}
+ src/doctest/DocTestFileSystemWindowsPath.hs view
@@ -0,0 +1,21 @@+{- $setup+>>> :m+>>> :set -XQuasiQuotes+>>> import Control.Exception (SomeException, evaluate, try)+>>> import Data.Either (Either, isLeft)+>>> import Data.Maybe (fromJust, isNothing, isJust)+>>> import Data.Word (Word16)+>>> import Streamly.Data.Array (Array)+>>> import qualified Streamly.Data.Array as Array+>>> import qualified Streamly.Data.Stream as Stream+>>> import qualified Streamly.Unicode.Stream as Unicode++For APIs that have not been released yet.++>>> import Streamly.Internal.FileSystem.WindowsPath (WindowsPath, path)+>>> import qualified Streamly.Internal.FileSystem.WindowsPath as Path++Utilities:++>>> fails x = isLeft <$> (try (evaluate x) :: IO (Either SomeException String))+-}
+ src/doctest/DocTestUnicodeParser.hs view
@@ -0,0 +1,10 @@+{- $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.Data.Stream as Stream (parsePos)+>>> import qualified Streamly.Internal.Unicode.Parser as Unicode (number, mkDouble)+-}
+ src/doctest/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/doctest/DocTestUnicodeString.hs view
@@ -0,0 +1,5 @@+{- $setup+>>> :m+>>> :set -XQuasiQuotes+>>> import Streamly.Internal.Unicode.String+-}
streamly-core.cabal view
@@ -1,61 +1,52 @@-cabal-version:      2.2+cabal-version:      2.4 name:               streamly-core-version:            0.2.3+version:            0.3.0 synopsis:           Streaming, parsers, arrays, serialization 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 is a standard library for Haskell that focuses on C-like-  performance, modular combinators, and streaming data flow model.-  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-  note below), while-  <https://hackage.haskell.org/package/streamly streamly> provides-  higher-level features like concurrency, time, lifted exceptions,-  and networking. For documentation, visit the-  <https://streamly.composewell.com Streamly website>.+  Streamly is a high-performance, beginner-friendly standard library+  for Haskell. It unifies streaming with list transformers and logic+  programming; unifies streaming with concurrency and reactive+  programming; unifies arrays with ring arrays, text, bytestring+  and vector use cases; unifies arrays with builders and binary+  serialization; generalizes parsers to any input type and unifies+  attoparsec, parsec use cases with better performance; provides+  streaming fileIO — all with a clean, consistent, well-integrated and+  streaming enabled API.   .-  The streamly-core package provides the following functionality:+  Streams are designed to have a list like interface — no steep+  learning curve, no complex types. Streamly is designed to build+  general purpose applications in a truly functional manner, from+  simple hello-world to advanced high-performance systems. The design+  emphasizes simplicity, modularity, and code reuse with minimal+  building blocks. Performance is on par with C, tuning is easy, and+  it’s hard to get it wrong.   .-  * Streams as composable producers of a sequence of values.-  * Streams provide all the functionality provided by Haskell lists but-  in an effectful, streaming fashion with better performance.-  * Streams provide ListT and logic programming functionality as well.-  * Folds as composable stream consumers that reduce the streams to a-  single value or reduce segments of streams to transform the stream.-  * Parsers as more powerful, composable stream consumers supporting-  standard parser combinators with backtracking but in a streaming-  fashion.-  * Arrays with streaming interfaces providing high performance,-  modularity, and concise interface as all streaming operations can be-  performed on arrays.-  * Arrays can be immutable or mutable, unboxed or boxed, pinned or-  unpinned.-  * Arrays generalize the functionality provided by @bytestring@ and-  @text@ packages.-  * Interoperability with @bytestring@ and @text@ is-  provided via separate packages.-  * Arrays and folds provide natural builder functionality so there are no-  separate builder modules.-  * High performance binary serialization with configurable JSON like features.-  * Streaming combinators for unicode text processing, providing-  functionality equivalent to the @text@ package.-  * String interpolation for convenient construction of strings.-  * Streaming console IO (stdin/stdout) operations.-  * Streaming file and directory IO operations.+  Streamly is serial by default, with seamless declarative concurrency+  that scales automatically when needed. It provides prompt and safe+  resource management, works well with other streaming libraries as well+  as core libraries like bytestring and text, and is backed by solid+  documentation.   .-  This package covers some or all of the functionality covered-  by @streaming, pipes, conduit, list-t, logic-t, foldl, attoparsec,-  array, primitive, vector, vector-algorithms, binary, cereal, store,-  bytestring, text, stringsearch, interpolate@. Streamly provides a-  consistent, concise, modular and performant interface for all this-  functionality.+  @streamly-core@ is a Haskell standard library built on top of @base@+  and GHC boot libraries only. Stream processing abstractions include+  streams, scans, folds, parsers; and console I/O, file I/O; text+  processing.  Array abstractions include pinned, unpinned, mutable,+  immutable, boxed and unboxed arrays, and ring arrays.  Builders,+  binary serialization, and deserialization are built-in features of+  arrays.   .-  Note: The dependencies "heaps" and "monad-control" are included in-  the package solely for backward compatibility, and will be removed in-  future versions.+  This package provides a high-performance, unified and ergonomic+  alternative to many disparate packages, such as @streaming, pipes,+  conduit, list-t, logict, foldl, attoparsec, array, primitive,+  vector, vector-algorithms, binary, cereal, store, bytestring, text,+  stringsearch, interpolate, filepath, and path@.+  .+  Performant. Unified. Modular. Powerful. Simple.+  .+  Learn more at <https://streamly.composewell.com the streamly website>.  homepage:            https://streamly.composewell.com bug-reports:         https://github.com/composewell/streamly/issues@@ -85,24 +76,14 @@     configure.ac     -- doctest include files-    src/DocTestDataArray.hs-    src/DocTestDataFold.hs-    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+    src/doctest/*.hs      -- This is duplicated     src/Streamly/Internal/Data/Array/ArrayMacros.h+    src/Streamly/Internal/Data/ParserDrivers.h     src/assert.hs     src/inline.hs+    src/deprecation.h      src/Streamly/Internal/Data/Time/Clock/config-clock.h     src/config.h.in@@ -116,10 +97,7 @@ extra-doc-files:     Changelog.md     docs/*.md-    docs/ApiChangelogs/0.1.0.txt-    docs/ApiChangelogs/0.1.0-0.2.0.txt-    docs/ApiChangelogs/0.2.0-0.2.2.txt-    docs/ApiChangelogs/0.2.2-0.2.3.txt+    docs/ApiChangelogs/*.txt  source-repository head     type: git@@ -130,8 +108,8 @@   manual: True   default: False -flag dev-  description: Development build+flag internal-dev+  description: DO NOT USE, ONLY FOR INTERNAL USE.   manual: True   default: False @@ -150,8 +128,8 @@   manual: True   default: False -flag use-unliftio-  description: Use unliftio-core instead of monad-control+flag internal-use-unliftio+  description: DO NOT USE, ONLY FOR INTERNAL USE.   manual: True   default: False @@ -165,14 +143,20 @@   manual: True   default: False +flag force-lstat-readdir+  description: Use lstat instead of checking for dtype in ReadDir+  manual: True+  default: False+ ------------------------------------------------------------------------------- -- Common stanzas -------------------------------------------------------------------------------  common compile-options-    default-language: Haskell2010+    if flag(force-lstat-readdir)+      cpp-options:    -DFORCE_LSTAT_READDIR -    if flag(dev)+    if flag(internal-dev)       cpp-options:    -DDEVBUILD      if flag(use-unfolds)@@ -205,24 +189,44 @@       ghc-options:         -Wno-missing-role-annotations +    if impl(ghc >= 9.10)+      ghc-options:+        -Wno-missing-poly-kind-signatures+     if flag(has-llvm)       ghc-options: -fllvm -    if flag(dev)+    if flag(internal-dev)       ghc-options:    -Wmissed-specialisations                       -Wall-missed-specialisations      if flag(limit-build-mem)         ghc-options: +RTS -M1000M -RTS -    if flag(use-unliftio)+    if flag(internal-use-unliftio)       cpp-options: -DUSE_UNLIFTIO  common default-extensions+    default-language: Haskell2010++    -- GHC2024 may include more extensions than we are actually using, see the+    -- full list below. We enable this to ensure that we are able to compile+    -- with this i.e. there is no interference by other extensions.++    -- Don't enforce GHC2024 and GHC2021 but We can support the build with them.++    -- if impl(ghc >= 9.10)+    --   default-language: GHC2024++    -- if impl(ghc >= 9.2) && impl(ghc < 9.10)+    --   default-language: GHC2021++    if impl(ghc >= 8.10)+      default-extensions: StandaloneKindSignatures++    -- In GHC 2024     default-extensions:         BangPatterns-        CApiFFI-        CPP         ConstraintKinds         DeriveDataTypeable         DeriveGeneric@@ -234,27 +238,42 @@         InstanceSigs         KindSignatures         LambdaCase-        MagicHash         MultiParamTypeClasses-        PatternSynonyms         RankNTypes-        RecordWildCards         ScopedTypeVariables         StandaloneDeriving         TupleSections         TypeApplications-        TypeFamilies         TypeOperators-        ViewPatterns -        -- MonoLocalBinds, enabled by TypeFamilies, causes performance-        -- regressions. Disable it. This must come after TypeFamilies,+        -- Not in GHC2024+        CApiFFI+        CPP+        DefaultSignatures+        MagicHash+        RecordWildCards++        -- TypeFamilies is required by IsList, IsMap type classes and+        -- Unbox generic deriving code.+        -- TypeFamilies++        -- MonoLocalBinds, enabled by TypeFamilies and GHC2024, was+        -- once found to cause runtime performance regressions which+        -- does not seem to be the case anymore, but need more testing+        -- to confirm.  It is confirmed that it requires more memory+        -- for compilation at least in some cases (Data.Fold.Window+        -- benchmark on GHC-9.10.1 macOS).  It also causes some+        -- code to not compile, so has been disabled in specific+        -- modules. Disabling this must come after TypeFamilies,         -- otherwise TypeFamilies will enable it again.-        NoMonoLocalBinds+        -- NoMonoLocalBinds          -- UndecidableInstances -- Does not show any perf impact         -- UnboxedTuples        -- interferes with (#.) +    if impl(ghc >= 8.6)+      default-extensions: QuantifiedConstraints+ common optimization-options   if flag(opt)     ghc-options: -O2@@ -263,7 +282,7 @@                  -fmax-worker-args=16    -- For this to be effective it must come after the -O2 option-  if flag(dev) || flag(debug) || !flag(opt)+  if flag(internal-dev) || flag(debug) || !flag(opt)     cpp-options: -DDEBUG     ghc-options: -fno-ignore-asserts @@ -287,18 +306,19 @@ library     import: lib-options -    if impl(ghc >= 8.6)-      default-extensions: QuantifiedConstraints-     js-sources: jsbits/clock.js      include-dirs:           src+        , src/doctest+        , src/Streamly/Internal/Data         , src/Streamly/Internal/Data/Array         , src/Streamly/Internal/Data/Stream      c-sources: src/Streamly/Internal/Data/MutArray/Lib.c +    -- Prefer OS conditionals inside the source files rather than here,+    -- conditionals here do not work well with cabal2nix.     if os(windows)       c-sources:     src/Streamly/Internal/Data/Time/Clock/Windows.c @@ -331,6 +351,7 @@                      , Streamly.Internal.Data.Time.TimeSpec                      , Streamly.Internal.Data.Time.Units                      , Streamly.Internal.Data.Time.Clock+                     , Streamly.Internal.Data.Path                       -- streamly-core-stream-types                      , Streamly.Internal.Data.SVar.Type@@ -339,6 +360,7 @@                       -- streamly-core-array-types                      , Streamly.Internal.Data.MutByteArray+                     , Streamly.Internal.Data.CString                       -- streaming and parsing Haskell types to/from bytes                      , Streamly.Internal.Data.Binary.Parser@@ -351,26 +373,27 @@                      -- streamly-core-streams                      , Streamly.Internal.Data.StreamK                      -- StreamD depends on streamly-array-types-                     , Streamly.Internal.Data.Stream.StreamD                      , Streamly.Internal.Data.Stream                       -- streamly-core-data                      , Streamly.Internal.Data.Builder                      , Streamly.Internal.Data.Unfold-                     , Streamly.Internal.Data.Fold.Chunked                      , Streamly.Internal.Data.Parser                      , Streamly.Internal.Data.ParserK                      , Streamly.Internal.Data.Pipe+                     , Streamly.Internal.Data.Scanr                       -- streamly-containers (non-base)                      , Streamly.Internal.Data.Fold+                     , Streamly.Internal.Data.Scanl                       -- streamly-core-data-arrays                      , Streamly.Internal.Data.Array.Generic                      , Streamly.Internal.Data.Array-                     , Streamly.Internal.Data.MutArray.Stream-                     , Streamly.Internal.Data.Array.Stream +                     -- Unboxed IORef+                     , Streamly.Internal.Data.IORef+                     -- streamly-unicode-core                      , Streamly.Internal.Unicode.Stream                      , Streamly.Internal.Unicode.String@@ -378,35 +401,47 @@                      , Streamly.Internal.Unicode.Array                       -- Filesystem/IO+                      , Streamly.Internal.FileSystem.Path+                     , Streamly.Internal.FileSystem.Path.Seg+                     , Streamly.Internal.FileSystem.Path.Node+                     , Streamly.Internal.FileSystem.Path.SegNode++                     , Streamly.Internal.FileSystem.PosixPath+                     , Streamly.Internal.FileSystem.PosixPath.Seg+                     , Streamly.Internal.FileSystem.PosixPath.Node+                     , Streamly.Internal.FileSystem.PosixPath.SegNode++                     , Streamly.Internal.FileSystem.WindowsPath+                     , Streamly.Internal.FileSystem.WindowsPath.Seg+                     , Streamly.Internal.FileSystem.WindowsPath.Node+                     , Streamly.Internal.FileSystem.WindowsPath.SegNode+                      , Streamly.Internal.FileSystem.Handle-                     , Streamly.Internal.FileSystem.File-                     , Streamly.Internal.FileSystem.Dir+                     , Streamly.Internal.FileSystem.File.Common+                     , Streamly.Internal.FileSystem.Posix.Errno+                     , Streamly.Internal.FileSystem.Posix.File+                     , Streamly.Internal.FileSystem.Posix.ReadDir+                     , Streamly.Internal.FileSystem.Windows.ReadDir+                     , Streamly.Internal.FileSystem.Windows.File+                     , Streamly.Internal.FileSystem.FileIO+                     , Streamly.Internal.FileSystem.DirIO -                    -- Ring Arrays-                     , Streamly.Internal.Data.Ring-                     , Streamly.Internal.Data.Ring.Generic+                    -- RingArray Arrays+                     , Streamly.Internal.Data.RingArray+                     , Streamly.Internal.Data.RingArray.Generic                       -- streamly-console                      , Streamly.Internal.Console.Stdio                       -- To be implemented                      -- , Streamly.Data.Refold-                     -- , Streamly.Data.Binary.Encode -- Stream types                       -- Pre-release modules-                     -- , Streamly.Data.Fold.Window                      -- , Streamly.Data.Pipe-                     -- , Streamly.Data.Array.Stream-                     -- , Streamly.Data.Array.Fold-                     -- , Streamly.Data.Array.Mut.Stream-                     -- , Streamly.Data.Ring-                     -- , Streamly.Data.Ring.Unboxed-                     -- , Streamly.Data.IORef.Unboxed+                     -- , Streamly.Data.RingArray.Generic+                     -- , Streamly.Data.IORef                      -- , Streamly.Data.List-                     -- , Streamly.Data.Binary.Decode-                     -- , Streamly.FileSystem.File-                     -- , Streamly.FileSystem.Dir                      -- , Streamly.Data.Time.Units                      -- , Streamly.Data.Time.Clock                      -- , Streamly.Data.Tuple.Strict@@ -414,36 +449,65 @@                      -- , Streamly.Data.Either.Strict                       -- streamly-core released modules in alphabetic order-                     -- NOTE: these must be added to streamly.cabal as well                      , Streamly.Console.Stdio-                     , Streamly.Data.MutByteArray+                     , Streamly.Control.Exception                      , Streamly.Data.Array                      , Streamly.Data.Array.Generic+                     , Streamly.Data.Fold                      , Streamly.Data.MutArray                      , Streamly.Data.MutArray.Generic-                     , Streamly.Data.Fold+                     , Streamly.Data.MutByteArray                      , Streamly.Data.Parser                      , Streamly.Data.ParserK+                     , Streamly.Data.RingArray+                     , Streamly.Data.Scanl                      , Streamly.Data.Stream                      , Streamly.Data.StreamK                      , Streamly.Data.Unfold-                     , Streamly.FileSystem.Dir-                     , Streamly.FileSystem.File+                     , Streamly.FileSystem.DirIO+                     , Streamly.FileSystem.FileIO                      , Streamly.FileSystem.Handle+                     , Streamly.FileSystem.Path                      , Streamly.Unicode.Parser                      , Streamly.Unicode.Stream                      , Streamly.Unicode.String++                    -- Deprecated in 0.3.0+                     , Streamly.Internal.FileSystem.File+                     , Streamly.Internal.FileSystem.Dir+                     , Streamly.FileSystem.Dir+                     , Streamly.FileSystem.File++                    -- Deprecated in 0.2.0+                     , Streamly.Internal.Data.MutArray.Stream+                     , Streamly.Internal.Data.Array.Stream+                     , Streamly.Internal.Data.Stream.StreamD+                     , Streamly.Internal.Data.Fold.Chunked++    -- Only those modules should be here which are fully re-exported via some+    -- other module.     other-modules:-                      Streamly.Internal.Data.Fold.Step+                      Streamly.FileSystem.Path.Seg+                    , Streamly.FileSystem.Path.Node+                    , Streamly.FileSystem.Path.SegNode++                    , Streamly.Internal.Data.Fold.Step                     , Streamly.Internal.Data.Fold.Type                     , Streamly.Internal.Data.Fold.Combinators                     , Streamly.Internal.Data.Fold.Container+                    , Streamly.Internal.Data.Fold.Exception                     , Streamly.Internal.Data.Fold.Tee                     , Streamly.Internal.Data.Fold.Window +                    , Streamly.Internal.Data.Scanl.Type+                    , Streamly.Internal.Data.Scanl.Window+                    , Streamly.Internal.Data.Scanl.Combinators+                    , Streamly.Internal.Data.Scanl.Container+                     , Streamly.Internal.Data.Parser.Type                     , Streamly.Internal.Data.Parser.Tee                     , Streamly.Internal.Data.ParserK.Type+                    , Streamly.Internal.Data.ParserDrivers                      , Streamly.Internal.Data.Stream.Container                     , Streamly.Internal.Data.Stream.Eliminate@@ -468,9 +532,7 @@                     , Streamly.Internal.Data.MutArray.Type                      , Streamly.Internal.Data.Array.Type--                    -- Unboxed IORef-                    , Streamly.Internal.Data.IORef.Unboxed+                    , Streamly.Internal.Data.Array.Generic.Type                      , Streamly.Internal.Data.MutByteArray.Type                     , Streamly.Internal.Data.Unbox@@ -485,8 +547,10 @@                     , Streamly.Internal.Data.Producer.Source                      , Streamly.Internal.Data.Time.Clock.Type+                    , Streamly.Internal.FileSystem.Path.Common+                    , Streamly.Internal.FileSystem.DirOptions -    if flag(dev)+    if flag(internal-dev)       exposed-modules:                         Streamly.Internal.Data.StreamK.Alt                         -- XXX Compilation needs to be fixed@@ -509,15 +573,12 @@                      , base              >= 4.12  && < 4.22                      , exceptions        >= 0.8.0 && < 0.11                      , transformers      >= 0.5.5 && < 0.7-                     , filepath          >= 1.4.2 && < 1.6                      -- streamly-unicode-core                      , template-haskell  >= 2.14  && < 2.24 -                     -- streamly-filesystem-core-                     , directory         >= 1.3.3 && < 1.4-                      -- XXX to be removed+                     , filepath          >= 1.4.2 && < 1.6                      , containers        >= 0.6.0 && < 0.8                      , heaps             >= 0.3   && < 0.5 @@ -526,11 +587,8 @@     else       build-depends:  integer-gmp >= 1.0 && < 1.2 -    if !flag(use-unliftio)+    if !flag(internal-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