packages feed

streamly-core 0.1.0 → 0.3.1

raw patch · 216 files changed

Files

Changelog.md view
@@ -1,8 +1,140 @@ # Changelog +## 0.3.1 (May 2026)++* Fixed `Path.fromString` truncation when unicode chars are present.+* Fixed `DirIO.followSymlinks` option not working correctly on macOS.++## 0.3.0 (Sep 2025)++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)++* Add fixities `infixr 5` for `cons` and `consM` functions.+* Fix a bug in Array `Eq` instance when the type is a sum type with+  differently sized constructors.+* lpackArraysChunksOf, compact, writeChunksWith, putChunksWith now take the+  buffer size in number of array elements instead of bytes.++## 0.2.1 (Dec 2023)++* Make the serialization of the unit constructor deterministic.+* Expose `pinnedSerialize` & `deserialize` via `Streamly.Data.Array`.++## 0.2.0 (Nov 2023)++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of API changes in this release. Only a few significant+changes are mentioned here.++### Breaking Changes++* `ParserK` in `Streamly.Data.ParserK` is not implicitly specialized+  to arrays anymore. To adapt to the new code, change `ParserK a m+  b` to `ParserK (Array a) m b` where the `Array` type comes from+  `Streamly.Data.Array`. This change also affected the signatures of+  `parseChunks` and `parseBreakChunks`.+* Changed the signature of 'Streamly.Data.Stream.handle' to make the+  exception handler monadic.+* Behavior change: Exceptions are now rethrown promptly in `bracketIO`.++### Enhancements++* __Serialization__: Added a `Streamly.Data.MutByteArray` module with a+  `Serialize` type class for fast binary serialization. The Data.Array+  module supplies the `serialize` and `deserialize` operations for arrays.+* __Unpinned Arrays__: Unboxed arrays are now created unpinned by default,+  they were created pinned earlier. During IO operations, unpinned arrays+  are automatically copied to pinned memory. When arrays are directly+  passed to IO operations programmers can choose to create them pinned to+  avoid a copy.  To create pinned arrays, use the internal APIs with the+  `pinned*` prefix.+* StreamK now supports native exception handling routines (handle, bracketIO).+  Earlier we had to convert it to the `Stream` type for exception handling.++### Deprecations++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of deprecations.++### Internal API Changes++* Fold constructor has changed, added a `final` field to support+  finalization and cleanup of a chain of folds. The `extract` field is+  now used only for mapping the fold internal state to fold result for+  scanning purposes. If your fold does not require cleanup you can just use+  your existing `extract` function as `final` as well to adapt to this change.+* Many low level internal modules have been removed, they are entirely+  exported from higher level internal modules. If you were importing any+  of the missing low level modules then import the higher level modules instead.+* Internal module changes:+  * Streamly.Internal.Serialize.FromBytes -> Streamly.Internal.Data.Binary.Parser+  * Streamly.Internal.Serialize.ToBytes ->   Streamly.Internal.Data.Binary.Stream+  * Streamly.Internal.Data.Unbox is now exported via Streamly.Internal.Data.Serialize+  * Streamly.Internal.Data.IORef.Unboxed is now exported via Streamly.Internal.Data.Serialize+ ## 0.1.0 (March 2023) -Also see [streamly-core-0.1.0 API Changelog](/core/docs/ApiChangelogs/0.1.0.txt) or+Also see [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt  `streamly` package is split into two packages, (1) `streamly-core` that
LICENSE view
@@ -279,3 +279,44 @@ LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++-------------------------------------------------------------------------------+th-utilities-0.2.5.0 (https://hackage.haskell.org/package/th-utilities)+-------------------------------------------------------------------------------+Copyright (c) 2016 FP Complete Corporation.++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.++-------------------------------------------------------------------------------+th-abstraction-0.5.0.0 (https://hackage.haskell.org/package/th-abstraction)+-------------------------------------------------------------------------------+Copyright (c) 2017-2020 Eric Mertens++Permission to use, copy, modify, and/or distribute this software for any purpose+with or without fee is hereby granted, provided that the above copyright notice+and this permission notice appear in all copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS+OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF+THIS SOFTWARE.
configure view
@@ -1,11 +1,11 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.71 for streamly-core 0.1.0.+# Generated by GNU Autoconf 2.72 for streamly-core 0.3.1. # # Report bugs to <streamly@composewell.com>. # #-# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation,+# Copyright (C) 1992-1996, 1998-2017, 2020-2023 Free Software Foundation, # Inc. # #@@ -17,7 +17,6 @@  # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh-as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then :   emulate sh@@ -26,12 +25,13 @@   # is contrary to our usage.  Disable this feature.   alias -g '${1+"$@"}'='"$@"'   setopt NO_GLOB_SUBST-else $as_nop-  case `(set -o) 2>/dev/null` in #(+else case e in #(+  e) case `(set -o) 2>/dev/null` in #(   *posix*) :     set -o posix ;; #(   *) :      ;;+esac ;; esac fi @@ -103,7 +103,7 @@       ;; esac-# We did not find ourselves, most probably we were run as `sh COMMAND'+# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then   as_myself=$0@@ -133,15 +133,14 @@ esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.+# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255   fi   # We don't want this to propagate to other subprocesses.           { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then-  as_bourne_compatible="as_nop=:-if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1+  as_bourne_compatible="if test \${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then :   emulate sh   NULLCMD=:@@ -149,12 +148,13 @@   # is contrary to our usage.  Disable this feature.   alias -g '\${1+\"\$@\"}'='\"\$@\"'   setopt NO_GLOB_SUBST-else \$as_nop-  case \`(set -o) 2>/dev/null\` in #(+else case e in #(+  e) case \`(set -o) 2>/dev/null\` in #(   *posix*) :     set -o posix ;; #(   *) :      ;;+esac ;; esac fi "@@ -172,8 +172,9 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ) then : -else \$as_nop-  exitcode=1; echo positional parameters were not saved.+else case e in #(+  e) exitcode=1; echo positional parameters were not saved. ;;+esac fi test x\$exitcode = x0 || exit 1 blah=\$(echo \$(echo blah))@@ -186,14 +187,15 @@   if (eval "$as_required") 2>/dev/null then :   as_have_required=yes-else $as_nop-  as_have_required=no+else case e in #(+  e) as_have_required=no ;;+esac fi   if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null then : -else $as_nop-  as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+else case e in #(+  e) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do@@ -226,12 +228,13 @@ if $as_found then : -else $as_nop-  if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&+else case e in #(+  e) if { test -f "$SHELL" || test -f "$SHELL.exe"; } && 	      as_run=a "$SHELL" -c "$as_bourne_compatible""$as_required" 2>/dev/null then :   CONFIG_SHELL=$SHELL as_have_required=yes-fi+fi ;;+esac fi  @@ -253,7 +256,7 @@ esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.+# out after a failed 'exec'. printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi@@ -273,7 +276,8 @@ $0: under such a shell if you do have one."   fi   exit 1-fi+fi ;;+esac fi fi SHELL=${CONFIG_SHELL-/bin/sh}@@ -312,14 +316,6 @@   as_fn_set_status $1   exit $1 } # as_fn_exit-# as_fn_nop-# ----------# Do nothing but, unlike ":", preserve the value of $?.-as_fn_nop ()-{-  return $?-}-as_nop=as_fn_nop  # as_fn_mkdir_p # -------------@@ -388,11 +384,12 @@   {     eval $1+=\$2   }'-else $as_nop-  as_fn_append ()+else case e in #(+  e) as_fn_append ()   {     eval $1=\$$1\$2-  }+  } ;;+esac fi # as_fn_append  # as_fn_arith ARG...@@ -406,21 +403,14 @@   {     as_val=$(( $* ))   }'-else $as_nop-  as_fn_arith ()+else case e in #(+  e) as_fn_arith ()   {     as_val=`expr "$@" || test $? -eq 1`-  }+  } ;;+esac fi # as_fn_arith -# as_fn_nop-# ----------# Do nothing but, unlike ":", preserve the value of $?.-as_fn_nop ()-{-  return $?-}-as_nop=as_fn_nop  # as_fn_error STATUS ERROR [LINENO LOG_FD] # ----------------------------------------@@ -494,6 +484,8 @@     /[$]LINENO/=   ' <$as_myself |     sed '+      t clear+      :clear       s/[$]LINENO.*/&-/       t lineno       b@@ -542,7 +534,6 @@ as_echo='printf %s\n' as_echo_n='printf %s' - rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then   rm -f conf$$.dir/conf$$.file@@ -554,9 +545,9 @@   if ln -s conf$$.file conf$$ 2>/dev/null; then     as_ln_s='ln -s'     # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -pR'.+    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.+    # In both cases, we have to default to 'cp -pR'.     ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||       as_ln_s='cp -pR'   elif ln conf$$.file conf$$ 2>/dev/null; then@@ -581,10 +572,12 @@ as_executable_p=as_fn_executable_p  # Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"+as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"+as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated  # Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"+as_tr_sh="eval sed '$as_sed_sh'" # deprecated   test -n "$DJDIR" || exec 7<&0 </dev/null@@ -610,8 +603,8 @@ # Identity of this package. PACKAGE_NAME='streamly-core' PACKAGE_TARNAME='streamly-core'-PACKAGE_VERSION='0.1.0'-PACKAGE_STRING='streamly-core 0.1.0'+PACKAGE_VERSION='0.3.1'+PACKAGE_STRING='streamly-core 0.3.1' PACKAGE_BUGREPORT='streamly@composewell.com' PACKAGE_URL='https://streamly.composewell.com' @@ -816,7 +809,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid feature name: \`$ac_useropt'"+      as_fn_error $? "invalid feature name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -842,7 +835,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid feature name: \`$ac_useropt'"+      as_fn_error $? "invalid feature name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -1055,7 +1048,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid package name: \`$ac_useropt'"+      as_fn_error $? "invalid package name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -1071,7 +1064,7 @@     ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`     # Reject names that are not valid shell variable names.     expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&-      as_fn_error $? "invalid package name: \`$ac_useropt'"+      as_fn_error $? "invalid package name: '$ac_useropt'"     ac_useropt_orig=$ac_useropt     ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`     case $ac_user_opts in@@ -1101,8 +1094,8 @@   | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)     x_libraries=$ac_optarg ;; -  -*) as_fn_error $? "unrecognized option: \`$ac_option'-Try \`$0 --help' for more information"+  -*) as_fn_error $? "unrecognized option: '$ac_option'+Try '$0 --help' for more information"     ;;    *=*)@@ -1110,7 +1103,7 @@     # Reject names that are not valid shell variable names.     case $ac_envvar in #(       '' | [0-9]* | *[!_$as_cr_alnum]* )-      as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;+      as_fn_error $? "invalid variable name: '$ac_envvar'" ;;     esac     eval $ac_envvar=\$ac_optarg     export $ac_envvar ;;@@ -1160,7 +1153,7 @@   as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done -# There might be people who depend on the old broken behavior: `$host'+# There might be people who depend on the old broken behavior: '$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias@@ -1228,7 +1221,7 @@   test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."   as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi-ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"+ac_msg="sources are in $srcdir, but 'cd $srcdir' does not work" ac_abs_confdir=`( 	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" 	pwd)`@@ -1256,7 +1249,7 @@   # Omit some internal or obsolete options to make the list less imposing.   # This message is too long to be a string in the A/UX 3.1 sh.   cat <<_ACEOF-\`configure' configures streamly-core 0.1.0 to adapt to many kinds of systems.+'configure' configures streamly-core 0.3.1 to adapt to many kinds of systems.  Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1270,11 +1263,11 @@       --help=short        display options specific to this package       --help=recursive    display the short help of all the included packages   -V, --version           display version information and exit-  -q, --quiet, --silent   do not print \`checking ...' messages+  -q, --quiet, --silent   do not print 'checking ...' messages       --cache-file=FILE   cache test results in FILE [disabled]-  -C, --config-cache      alias for \`--cache-file=config.cache'+  -C, --config-cache      alias for '--cache-file=config.cache'   -n, --no-create         do not create output files-      --srcdir=DIR        find the sources in DIR [configure dir or \`..']+      --srcdir=DIR        find the sources in DIR [configure dir or '..']  Installation directories:   --prefix=PREFIX         install architecture-independent files in PREFIX@@ -1282,10 +1275,10 @@   --exec-prefix=EPREFIX   install architecture-dependent files in EPREFIX                           [PREFIX] -By default, \`make install' will install all the files in-\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc.  You can specify-an installation prefix other than \`$ac_default_prefix' using \`--prefix',-for instance \`--prefix=\$HOME'.+By default, 'make install' will install all the files in+'$ac_default_prefix/bin', '$ac_default_prefix/lib' etc.  You can specify+an installation prefix other than '$ac_default_prefix' using '--prefix',+for instance '--prefix=\$HOME'.  For better control, use the options below. @@ -1318,7 +1311,7 @@  if test -n "$ac_init_help"; then   case $ac_init_help in-     short | recursive ) echo "Configuration of streamly-core 0.1.0:";;+     short | recursive ) echo "Configuration of streamly-core 0.3.1:";;    esac   cat <<\_ACEOF @@ -1336,7 +1329,7 @@   CPPFLAGS    (Objective) C/C++ preprocessor flags, e.g. -I<include dir> if               you have headers in a nonstandard directory <include dir> -Use these variables to override the choices made by `configure' or to help+Use these variables to override the choices made by 'configure' or to help it to find libraries and programs with nonstandard names/locations.  Report bugs to <streamly@composewell.com>.@@ -1404,10 +1397,10 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then   cat <<\_ACEOF-streamly-core configure 0.1.0-generated by GNU Autoconf 2.71+streamly-core configure 0.3.1+generated by GNU Autoconf 2.72 -Copyright (C) 2021 Free Software Foundation, Inc.+Copyright (C) 2023 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF@@ -1446,11 +1439,12 @@        } && test -s conftest.$ac_objext then :   ac_retval=0-else $as_nop-  printf "%s\n" "$as_me: failed program was:" >&5+else case e in #(+  e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -	ac_retval=1+	ac_retval=1 ;;+esac fi   eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno   as_fn_set_status $ac_retval@@ -1469,8 +1463,8 @@ if eval test \${$3+y} then :   printf %s "(cached) " >&6-else $as_nop-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */ $4 #include <$2>@@ -1478,10 +1472,12 @@ if ac_fn_c_try_compile "$LINENO" then :   eval "$3=yes"-else $as_nop-  eval "$3=no"+else case e in #(+  e) eval "$3=no" ;;+esac fi-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac fi eval ac_res=\$$3 	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5@@ -1521,11 +1517,12 @@        } then :   ac_retval=0-else $as_nop-  printf "%s\n" "$as_me: failed program was:" >&5+else case e in #(+  e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -	ac_retval=1+	ac_retval=1 ;;+esac fi   # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information   # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would@@ -1548,15 +1545,15 @@ if eval test \${$3+y} then :   printf %s "(cached) " >&6-else $as_nop-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */ /* Define $2 to an innocuous variant, in case <limits.h> declares $2.    For example, HP-UX 11i <limits.h> declares gettimeofday.  */ #define $2 innocuous_$2  /* System header to define __stub macros and hopefully few prototypes,-   which can conflict with char $2 (); below.  */+   which can conflict with char $2 (void); below.  */  #include <limits.h> #undef $2@@ -1567,7 +1564,7 @@ #ifdef __cplusplus extern "C" #endif-char $2 ();+char $2 (void); /* The GNU C library defines this for functions which it implements     to always fail with ENOSYS.  Some functions are actually named     something starting with __ and the normal name is an alias.  */@@ -1586,11 +1583,13 @@ if ac_fn_c_try_link "$LINENO" then :   eval "$3=yes"-else $as_nop-  eval "$3=no"+else case e in #(+  e) eval "$3=no" ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam \-    conftest$ac_exeext conftest.$ac_ext+    conftest$ac_exeext conftest.$ac_ext ;;+esac fi eval ac_res=\$$3 	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5@@ -1622,8 +1621,8 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by streamly-core $as_me 0.1.0, which was-generated by GNU Autoconf 2.71.  Invocation command line was+It was created by streamly-core $as_me 0.3.1, which was+generated by GNU Autoconf 2.72.  Invocation command line was    $ $0$ac_configure_args_raw @@ -1869,10 +1868,10 @@ printf "%s\n" "$as_me: loading site script $ac_site_file" >&6;}     sed 's/^/| /' "$ac_site_file" >&5     . "$ac_site_file" \-      || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+      || { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; }   fi done @@ -1908,9 +1907,7 @@ /* Most of the following tests are stolen from RCS 5.7 src/conf.sh.  */ struct buf { int x; }; struct buf * (*rcsopen) (struct buf *, struct stat *, int);-static char *e (p, i)-     char **p;-     int i;+static char *e (char **p, int i) {   return p[i]; }@@ -1924,6 +1921,21 @@   return s; } +/* C89 style stringification. */+#define noexpand_stringify(a) #a+const char *stringified = noexpand_stringify(arbitrary+token=sequence);++/* C89 style token pasting.  Exercises some of the corner cases that+   e.g. old MSVC gets wrong, but not very hard. */+#define noexpand_concat(a,b) a##b+#define expand_concat(a,b) noexpand_concat(a,b)+extern int vA;+extern int vbee;+#define aye A+#define bee B+int *pvA = &expand_concat(v,aye);+int *pvbee = &noexpand_concat(v,bee);+ /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default.  It has    function prototypes and stuff, but not \xHH hex character constants.    These do not provoke an error unfortunately, instead are silently treated@@ -1951,16 +1963,19 @@  # Test code for whether the C compiler supports C99 (global declarations) ac_c_conftest_c99_globals='-// Does the compiler advertise C99 conformance?+/* Does the compiler advertise C99 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L # error "Compiler does not advertise C99 conformance" #endif +// See if C++-style comments work.+ #include <stdbool.h> extern int puts (const char *); extern int printf (const char *, ...); extern int dprintf (int, const char *, ...); extern void *malloc (size_t);+extern void free (void *);  // Check varargs macros.  These examples are taken from C99 6.10.3.5. // dprintf is used instead of fprintf to avoid needing to declare@@ -2010,7 +2025,6 @@ static inline int test_restrict (ccp restrict text) {-  // See if C++-style comments work.   // Iterate through items via the restricted pointer.   // Also check for declarations in for loops.   for (unsigned int i = 0; *(text+i) != '\''\0'\''; ++i)@@ -2076,6 +2090,8 @@   ia->datasize = 10;   for (int i = 0; i < ia->datasize; ++i)     ia->data[i] = i * 1.234;+  // Work around memory leak warnings.+  free (ia);    // Check named initializers.   struct named_init ni = {@@ -2097,7 +2113,7 @@  # Test code for whether the C compiler supports C11 (global declarations) ac_c_conftest_c11_globals='-// Does the compiler advertise C11 conformance?+/* Does the compiler advertise C11 conformance? */ #if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L # error "Compiler does not advertise C11 conformance" #endif@@ -2220,12 +2236,12 @@   eval ac_new_val=\$ac_env_${ac_var}_value   case $ac_old_set,$ac_new_set in     set,)-      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5-printf "%s\n" "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&5+printf "%s\n" "$as_me: error: '$ac_var' was set to '$ac_old_val' in the previous run" >&2;}       ac_cache_corrupted=: ;;     ,set)-      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5-printf "%s\n" "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' was not set in the previous run" >&5+printf "%s\n" "$as_me: error: '$ac_var' was not set in the previous run" >&2;}       ac_cache_corrupted=: ;;     ,);;     *)@@ -2234,18 +2250,18 @@ 	ac_old_val_w=`echo x $ac_old_val` 	ac_new_val_w=`echo x $ac_new_val` 	if test "$ac_old_val_w" != "$ac_new_val_w"; then-	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5-printf "%s\n" "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}+	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: '$ac_var' has changed since the previous run:" >&5+printf "%s\n" "$as_me: error: '$ac_var' has changed since the previous run:" >&2;} 	  ac_cache_corrupted=: 	else-	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5-printf "%s\n" "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}+	  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&5+printf "%s\n" "$as_me: warning: ignoring whitespace changes in '$ac_var' since the previous run:" >&2;} 	  eval $ac_var=\$ac_old_val 	fi-	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   former value:  \`$ac_old_val'" >&5-printf "%s\n" "$as_me:   former value:  \`$ac_old_val'" >&2;}-	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   current value: \`$ac_new_val'" >&5-printf "%s\n" "$as_me:   current value: \`$ac_new_val'" >&2;}+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   former value:  '$ac_old_val'" >&5+printf "%s\n" "$as_me:   former value:  '$ac_old_val'" >&2;}+	{ printf "%s\n" "$as_me:${as_lineno-$LINENO}:   current value: '$ac_new_val'" >&5+printf "%s\n" "$as_me:   current value: '$ac_new_val'" >&2;}       fi;;   esac   # Pass precious variables to config.status.@@ -2261,11 +2277,11 @@   fi done if $ac_cache_corrupted; then-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;}   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 printf "%s\n" "$as_me: error: changes in the environment can compromise the build" >&2;}-  as_fn_error $? "run \`${MAKE-make} distclean' and/or \`rm $cache_file'+  as_fn_error $? "run '${MAKE-make} distclean' and/or 'rm $cache_file' 	    and start over" "$LINENO" 5 fi ## -------------------- ##@@ -2312,8 +2328,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2335,7 +2351,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2357,8 +2374,8 @@ if test ${ac_cv_prog_ac_ct_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$ac_ct_CC"; then+else case e in #(+  e) if test -n "$ac_ct_CC"; then   ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2380,7 +2397,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then@@ -2415,8 +2433,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2438,7 +2456,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2460,8 +2479,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else   ac_prog_rejected=no@@ -2500,7 +2519,8 @@     ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@"   fi fi-fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2524,8 +2544,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2547,7 +2567,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2573,8 +2594,8 @@ if test ${ac_cv_prog_ac_ct_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$ac_ct_CC"; then+else case e in #(+  e) if test -n "$ac_ct_CC"; then   ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2596,7 +2617,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then@@ -2634,8 +2656,8 @@ if test ${ac_cv_prog_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$CC"; then+else case e in #(+  e) if test -n "$CC"; then   ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2657,7 +2679,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi CC=$ac_cv_prog_CC if test -n "$CC"; then@@ -2679,8 +2702,8 @@ if test ${ac_cv_prog_ac_ct_CC+y} then :   printf %s "(cached) " >&6-else $as_nop-  if test -n "$ac_ct_CC"; then+else case e in #(+  e) if test -n "$ac_ct_CC"; then   ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR@@ -2702,7 +2725,8 @@   done IFS=$as_save_IFS -fi+fi ;;+esac fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then@@ -2731,10 +2755,10 @@ fi  -test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+test -z "$CC" && { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; }  # Provide some information about the compiler. printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5@@ -2806,8 +2830,8 @@   printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5   test $ac_status = 0; } then :-  # Autoconf-2.13 could set the ac_cv_exeext variable to `no'.-# So ignore a value of `no', otherwise this would lead to `EXEEXT = no'+  # Autoconf-2.13 could set the ac_cv_exeext variable to 'no'.+# So ignore a value of 'no', otherwise this would lead to 'EXEEXT = no' # in a Makefile.  We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf.@@ -2827,7 +2851,7 @@ 	   ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` 	fi 	# We set ac_cv_exeext here because the later test for it is not-	# safe: cross compilers may not add the suffix if given an `-o'+	# safe: cross compilers may not add the suffix if given an '-o' 	# argument, so we may need to know it at that point already. 	# Even if this section looks crufty: it has the advantage of 	# actually working.@@ -2838,8 +2862,9 @@ done test "$ac_cv_exeext" = no && ac_cv_exeext= -else $as_nop-  ac_file=''+else case e in #(+  e) ac_file='' ;;+esac fi if test -z "$ac_file" then :@@ -2848,13 +2873,14 @@ printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables-See \`config.log' for more details" "$LINENO" 5; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5-printf "%s\n" "yes" >&6; }+See 'config.log' for more details" "$LINENO" 5; }+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: yes" >&5+printf "%s\n" "yes" >&6; } ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 printf %s "checking for C compiler default output file name... " >&6; }@@ -2878,10 +2904,10 @@   printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5   test $ac_status = 0; } then :-  # If both `conftest.exe' and `conftest' are `present' (well, observable)-# catch `conftest.exe'.  For instance with Cygwin, `ls conftest' will-# work properly (i.e., refer to `conftest.exe'), while it won't with-# `rm'.+  # If both 'conftest.exe' and 'conftest' are 'present' (well, observable)+# catch 'conftest.exe'.  For instance with Cygwin, 'ls conftest' will+# work properly (i.e., refer to 'conftest.exe'), while it won't with+# 'rm'. for ac_file in conftest.exe conftest conftest.*; do   test -f "$ac_file" || continue   case $ac_file in@@ -2891,11 +2917,12 @@     * ) break;;   esac done-else $as_nop-  { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+else case e in #(+  e) { { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; } ;;+esac fi rm -f conftest conftest$ac_cv_exeext { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5@@ -2911,6 +2938,8 @@ main (void) { FILE *f = fopen ("conftest.out", "w");+ if (!f)+  return 1;  return ferror (f) || fclose (f) != 0;    ;@@ -2950,26 +2979,27 @@     if test "$cross_compiling" = maybe; then 	cross_compiling=yes     else-	{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+	{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error 77 "cannot run C compiled programs.-If you meant to cross compile, use \`--host'.-See \`config.log' for more details" "$LINENO" 5; }+If you meant to cross compile, use '--host'.+See 'config.log' for more details" "$LINENO" 5; }     fi   fi fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 printf "%s\n" "$cross_compiling" >&6; } -rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out+rm -f conftest.$ac_ext conftest$ac_cv_exeext \+  conftest.o conftest.obj conftest.out ac_clean_files=$ac_clean_files_save { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 printf %s "checking for suffix of object files... " >&6; } if test ${ac_cv_objext+y} then :   printf %s "(cached) " >&6-else $as_nop-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */  int@@ -3001,16 +3031,18 @@        break;;   esac done-else $as_nop-  printf "%s\n" "$as_me: failed program was:" >&5+else case e in #(+  e) printf "%s\n" "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 -{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-printf "%s\n" "$as_me: error: in \`$ac_pwd':" >&2;}+{ { printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: in '$ac_pwd':" >&5+printf "%s\n" "$as_me: error: in '$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile-See \`config.log' for more details" "$LINENO" 5; }+See 'config.log' for more details" "$LINENO" 5; } ;;+esac fi-rm -f conftest.$ac_cv_objext conftest.$ac_ext+rm -f conftest.$ac_cv_objext conftest.$ac_ext ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 printf "%s\n" "$ac_cv_objext" >&6; }@@ -3021,8 +3053,8 @@ if test ${ac_cv_c_compiler_gnu+y} then :   printf %s "(cached) " >&6-else $as_nop-  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+else case e in #(+  e) cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */  int@@ -3039,12 +3071,14 @@ if ac_fn_c_try_compile "$LINENO" then :   ac_compiler_gnu=yes-else $as_nop-  ac_compiler_gnu=no+else case e in #(+  e) ac_compiler_gnu=no ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu-+ ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 printf "%s\n" "$ac_cv_c_compiler_gnu" >&6; }@@ -3062,8 +3096,8 @@ if test ${ac_cv_prog_cc_g+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_save_c_werror_flag=$ac_c_werror_flag+else case e in #(+  e) ac_save_c_werror_flag=$ac_c_werror_flag    ac_c_werror_flag=yes    ac_cv_prog_cc_g=no    CFLAGS="-g"@@ -3081,8 +3115,8 @@ if ac_fn_c_try_compile "$LINENO" then :   ac_cv_prog_cc_g=yes-else $as_nop-  CFLAGS=""+else case e in #(+  e) CFLAGS=""       cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */ @@ -3097,8 +3131,8 @@ if ac_fn_c_try_compile "$LINENO" then : -else $as_nop-  ac_c_werror_flag=$ac_save_c_werror_flag+else case e in #(+  e) ac_c_werror_flag=$ac_save_c_werror_flag 	 CFLAGS="-g" 	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3115,12 +3149,15 @@ then :   ac_cv_prog_cc_g=yes fi-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac fi-rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext ;;+esac fi rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext-   ac_c_werror_flag=$ac_save_c_werror_flag+   ac_c_werror_flag=$ac_save_c_werror_flag ;;+esac fi { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 printf "%s\n" "$ac_cv_prog_cc_g" >&6; }@@ -3147,8 +3184,8 @@ if test ${ac_cv_prog_cc_c11+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_cv_prog_cc_c11=no+else case e in #(+  e) ac_cv_prog_cc_c11=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3165,25 +3202,28 @@   test "x$ac_cv_prog_cc_c11" != "xno" && break done rm -f conftest.$ac_ext-CC=$ac_save_CC+CC=$ac_save_CC ;;+esac fi  if test "x$ac_cv_prog_cc_c11" = xno then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; }-else $as_nop-  if test "x$ac_cv_prog_cc_c11" = x+else case e in #(+  e) if test "x$ac_cv_prog_cc_c11" = x then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c11" >&5 printf "%s\n" "$ac_cv_prog_cc_c11" >&6; }-     CC="$CC $ac_cv_prog_cc_c11"+     CC="$CC $ac_cv_prog_cc_c11" ;;+esac fi   ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11-  ac_prog_cc_stdc=c11+  ac_prog_cc_stdc=c11 ;;+esac fi fi if test x$ac_prog_cc_stdc = xno@@ -3193,8 +3233,8 @@ if test ${ac_cv_prog_cc_c99+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_cv_prog_cc_c99=no+else case e in #(+  e) ac_cv_prog_cc_c99=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3211,25 +3251,28 @@   test "x$ac_cv_prog_cc_c99" != "xno" && break done rm -f conftest.$ac_ext-CC=$ac_save_CC+CC=$ac_save_CC ;;+esac fi  if test "x$ac_cv_prog_cc_c99" = xno then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; }-else $as_nop-  if test "x$ac_cv_prog_cc_c99" = x+else case e in #(+  e) if test "x$ac_cv_prog_cc_c99" = x then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 printf "%s\n" "$ac_cv_prog_cc_c99" >&6; }-     CC="$CC $ac_cv_prog_cc_c99"+     CC="$CC $ac_cv_prog_cc_c99" ;;+esac fi   ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99-  ac_prog_cc_stdc=c99+  ac_prog_cc_stdc=c99 ;;+esac fi fi if test x$ac_prog_cc_stdc = xno@@ -3239,8 +3282,8 @@ if test ${ac_cv_prog_cc_c89+y} then :   printf %s "(cached) " >&6-else $as_nop-  ac_cv_prog_cc_c89=no+else case e in #(+  e) ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h.  */@@ -3257,25 +3300,28 @@   test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext-CC=$ac_save_CC+CC=$ac_save_CC ;;+esac fi  if test "x$ac_cv_prog_cc_c89" = xno then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 printf "%s\n" "unsupported" >&6; }-else $as_nop-  if test "x$ac_cv_prog_cc_c89" = x+else case e in #(+  e) if test "x$ac_cv_prog_cc_c89" = x then :   { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 printf "%s\n" "none needed" >&6; }-else $as_nop-  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5+else case e in #(+  e) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 printf "%s\n" "$ac_cv_prog_cc_c89" >&6; }-     CC="$CC $ac_cv_prog_cc_c89"+     CC="$CC $ac_cv_prog_cc_c89" ;;+esac fi   ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89-  ac_prog_cc_stdc=c89+  ac_prog_cc_stdc=c89 ;;+esac fi fi @@ -3343,8 +3389,8 @@ # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. #-# `ac_cv_env_foo' variables (set or unset) will be overridden when-# loading this file, other *unset* `ac_cv_foo' will be assigned the+# 'ac_cv_env_foo' variables (set or unset) will be overridden when+# loading this file, other *unset* 'ac_cv_foo' will be assigned the # following values.  _ACEOF@@ -3374,14 +3420,14 @@   (set) 2>&1 |     case $as_nl`(ac_space=' '; set) 2>&1` in #(     *${as_nl}ac_space=\ *)-      # `set' does not quote correctly, so add quotes: double-quote+      # 'set' does not quote correctly, so add quotes: double-quote       # substitution turns \\\\ into \\, and sed turns \\ into \.       sed -n \ 	"s/'/'\\\\''/g; 	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"       ;; #(     *)-      # `set' quotes correctly as required by POSIX, so do not add quotes.+      # 'set' quotes correctly as required by POSIX, so do not add quotes.       sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"       ;;     esac |@@ -3471,7 +3517,6 @@  # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh-as_nop=: if test ${ZSH_VERSION+y} && (emulate sh) >/dev/null 2>&1 then :   emulate sh@@ -3480,12 +3525,13 @@   # is contrary to our usage.  Disable this feature.   alias -g '${1+"$@"}'='"$@"'   setopt NO_GLOB_SUBST-else $as_nop-  case `(set -o) 2>/dev/null` in #(+else case e in #(+  e) case `(set -o) 2>/dev/null` in #(   *posix*) :     set -o posix ;; #(   *) :      ;;+esac ;; esac fi @@ -3557,7 +3603,7 @@       ;; esac-# We did not find ourselves, most probably we were run as `sh COMMAND'+# We did not find ourselves, most probably we were run as 'sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then   as_myself=$0@@ -3586,7 +3632,6 @@ } # as_fn_error  - # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking.@@ -3626,11 +3671,12 @@   {     eval $1+=\$2   }'-else $as_nop-  as_fn_append ()+else case e in #(+  e) as_fn_append ()   {     eval $1=\$$1\$2-  }+  } ;;+esac fi # as_fn_append  # as_fn_arith ARG...@@ -3644,11 +3690,12 @@   {     as_val=$(( $* ))   }'-else $as_nop-  as_fn_arith ()+else case e in #(+  e) as_fn_arith ()   {     as_val=`expr "$@" || test $? -eq 1`-  }+  } ;;+esac fi # as_fn_arith  @@ -3731,9 +3778,9 @@   if ln -s conf$$.file conf$$ 2>/dev/null; then     as_ln_s='ln -s'     # ... but there are two gotchas:-    # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.-    # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.-    # In both cases, we have to default to `cp -pR'.+    # 1) On MSYS, both 'ln -s file dir' and 'ln file dir' fail.+    # 2) DJGPP < 2.04 has no symlinks; 'ln -s' creates a wrapper executable.+    # In both cases, we have to default to 'cp -pR'.     ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||       as_ln_s='cp -pR'   elif ln conf$$.file conf$$ 2>/dev/null; then@@ -3814,10 +3861,12 @@ as_executable_p=as_fn_executable_p  # Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"+as_sed_cpp="y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g"+as_tr_cpp="eval sed '$as_sed_cpp'" # deprecated  # Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+as_sed_sh="y%*+%pp%;s%[^_$as_cr_alnum]%_%g"+as_tr_sh="eval sed '$as_sed_sh'" # deprecated   exec 6>&1@@ -3832,8 +3881,8 @@ # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log="-This file was extended by streamly-core $as_me 0.1.0, which was-generated by GNU Autoconf 2.71.  Invocation command line was+This file was extended by streamly-core $as_me 0.3.1, which was+generated by GNU Autoconf 2.72.  Invocation command line was    CONFIG_FILES    = $CONFIG_FILES   CONFIG_HEADERS  = $CONFIG_HEADERS@@ -3860,7 +3909,7 @@  cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\-\`$as_me' instantiates files and other configuration actions+'$as_me' instantiates files and other configuration actions from templates according to the current configuration.  Unless the files and actions are specified as TAGs, all are instantiated by default. @@ -3888,11 +3937,11 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config='$ac_cs_config_escaped' ac_cs_version="\\-streamly-core config.status 0.1.0-configured by $0, generated by GNU Autoconf 2.71,+streamly-core config.status 0.3.1+configured by $0, generated by GNU Autoconf 2.72,   with options \\"\$ac_cs_config\\" -Copyright (C) 2021 Free Software Foundation, Inc.+Copyright (C) 2023 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." @@ -3943,8 +3992,8 @@     ac_need_defaults=false;;   --he | --h)     # Conflict between --help and --header-    as_fn_error $? "ambiguous option: \`$1'-Try \`$0 --help' for more information.";;+    as_fn_error $? "ambiguous option: '$1'+Try '$0 --help' for more information.";;   --help | --hel | -h )     printf "%s\n" "$ac_cs_usage"; exit ;;   -q | -quiet | --quiet | --quie | --qui | --qu | --q \@@ -3952,8 +4001,8 @@     ac_cs_silent=: ;;    # This is an error.-  -*) as_fn_error $? "unrecognized option: \`$1'-Try \`$0 --help' for more information." ;;+  -*) as_fn_error $? "unrecognized option: '$1'+Try '$0 --help' for more information." ;;    *) as_fn_append ac_config_targets " $1"      ac_need_defaults=false ;;@@ -4003,7 +4052,7 @@   case $ac_config_target in     "src/config.h") CONFIG_HEADERS="$CONFIG_HEADERS src/config.h" ;; -  *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;+  *) as_fn_error $? "invalid argument: '$ac_config_target'" "$LINENO" 5;;   esac done @@ -4021,7 +4070,7 @@ # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned:-# after its creation but before its name has been assigned to `$tmp'.+# after its creation but before its name has been assigned to '$tmp'. $debug || {   tmp= ac_tmp=@@ -4045,13 +4094,13 @@  # Set up the scripts for CONFIG_HEADERS section. # No need to generate them if there are no CONFIG_HEADERS.-# This happens for instance with `./config.status Makefile'.+# This happens for instance with './config.status Makefile'. if test -n "$CONFIG_HEADERS"; then cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF -# Transform confdefs.h into an awk script `defines.awk', embedded as+# Transform confdefs.h into an awk script 'defines.awk', embedded as # here-document in config.status, that substitutes the proper values into # config.h.in to produce config.h. @@ -4161,7 +4210,7 @@   esac   case $ac_mode$ac_tag in   :[FHL]*:*);;-  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;+  :L* | :C*:*) as_fn_error $? "invalid tag '$ac_tag'" "$LINENO" 5;;   :[FH]-) ac_tag=-:-;;   :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;   esac@@ -4183,19 +4232,19 @@       -) ac_f="$ac_tmp/stdin";;       *) # Look for the file first in the build tree, then in the source tree 	 # (if the path is not absolute).  The absolute path cannot be DOS-style,-	 # because $ac_f cannot contain `:'.+	 # because $ac_f cannot contain ':'. 	 test -f "$ac_f" || 	   case $ac_f in 	   [\\/$]*) false;; 	   *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; 	   esac ||-	   as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;+	   as_fn_error 1 "cannot find input file: '$ac_f'" "$LINENO" 5;;       esac       case $ac_f in *\'*) ac_f=`printf "%s\n" "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac       as_fn_append ac_file_inputs " '$ac_f'"     done -    # Let's still pretend it is `configure' which instantiates (i.e., don't+    # Let's still pretend it is 'configure' which instantiates (i.e., don't     # use $as_me), people would be surprised to read:     #    /* config.h.  Generated by config.status.  */     configure_input='Generated from '`
configure.ac view
@@ -3,7 +3,7 @@ # See https://www.gnu.org/software/autoconf/manual/autoconf.html for help on # the macros used in this file. -AC_INIT([streamly-core], [0.1.0], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])+AC_INIT([streamly-core], [0.3.1], [streamly@composewell.com], [streamly-core], [https://streamly.composewell.com])  # To suppress "WARNING: unrecognized options: --with-compiler" AC_ARG_WITH([compiler], [GHC])
+ docs/ApiChangelogs/0.1.0-0.2.0.txt view
@@ -0,0 +1,1471 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Unicode.Parser+    [A] double :: Monad m => Parser Char m Double+[C] Streamly.FileSystem.Handle+    [A] readWith :: MonadIO m => Int -> Handle -> Stream m Word8+    [A] readChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8)+[C] Streamly.FileSystem.Dir+    [C] readEither+        [O] readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+        [N] readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)+    [C] read+        [O] read :: MonadIO m => FilePath -> Stream m FilePath+        [N] read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+[C] Streamly.Data.Unfold+    [A] class Enum a => Enumerable a+    [A] second :: b -> Unfold m (a, b) c -> Unfold m a c+    [A] first :: a -> Unfold m (a, b) c -> Unfold m b c+    [A] enumerateFromTo :: (Enumerable a, Monad m) => Unfold m (a, a) a+    [A] enumerateFromThenTo :: (Enumerable a, Monad m) => Unfold m (a, a, a) a+    [A] enumerateFromThen :: (Enumerable a, Monad m) => Unfold m (a, a) a+    [A] enumerateFrom :: (Enumerable a, Monad m) => Unfold m a a+[C] Streamly.Data.StreamK+    [C] parseChunks+        [O] parseChunks :: (Monad m, Unbox a) => ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b)+        [N] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [C] parseBreakChunks+        [O] parseBreakChunks :: (Monad m, Unbox a) => ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+        [N] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: forall m a b. Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+    [A] parse :: Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b)+    [A] handle :: (MonadCatch m, Exception e) => (e -> m (StreamK m a)) -> StreamK m a -> StreamK m a+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> StreamK m a) -> StreamK m a+[C] Streamly.Data.Stream+    [A] wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [C] handle+        [O] handle :: (MonadCatch m, Exception e) => (e -> Stream m a) -> Stream m a -> Stream m a+        [N] handle :: (MonadCatch m, Exception e) => (e -> m (Stream m a)) -> Stream m a -> Stream m a+    [A] groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b+[C] Streamly.Data.ParserK+    [D] fromParser :: (MonadIO m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [D] fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK (Array a) m b+    [A] adaptCG :: Monad m => Parser a m b -> ParserK (Array a) m b+    [A] adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [A] adapt :: Monad m => Parser a m b -> ParserK a m b+[C] Streamly.Data.Parser+    [A] groupByRollingEither :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)+    [A] groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+[A] Streamly.Data.MutByteArray+    [A] class Unbox a+    [A] class Serialize a+    [A] SerializeConfig+    [A] MutByteArray+    [A] unpin :: MutByteArray -> IO MutByteArray+    [A] sizeOf :: (Unbox a, SizeOfRep (Rep a)) => Proxy a -> Int+    [A] serializeAt :: Serialize a => Int -> MutByteArray -> a -> IO Int+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pinnedNew :: Int -> IO MutByteArray+    [A] pin :: MutByteArray -> IO MutByteArray+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [A] new :: Int -> IO MutByteArray+    [A] isPinned :: MutByteArray -> Bool+    [A] inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] deserializeAt :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+    [A] deriveUnbox :: Q [Dec] -> Q [Dec]+    [A] deriveSerializeWith :: (SerializeConfig -> SerializeConfig) -> Q [Dec] -> Q [Dec]+    [A] deriveSerialize :: Q [Dec] -> Q [Dec]+    [A] addSizeTo :: Serialize a => Int -> a -> Int+[C] Streamly.Data.MutArray.Generic+    [A] write :: MonadIO m => Fold m a (MutArray a)+    [A] readRev :: MonadIO m => MutArray a -> Stream m a+    [A] read :: MonadIO m => MutArray a -> Stream m a+    [A] putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [A] modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] length :: MutArray a -> Int+    [A] getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+    [C] getIndex+        [O] getIndex :: MonadIO m => Int -> MutArray a -> m a+        [N] getIndex :: MonadIO m => Int -> MutArray a -> m (Maybe a)+    [A] fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)+    [A] fromList :: MonadIO m => [a] -> m (MutArray a)+[C] Streamly.Data.MutArray+    [A] unpin :: MutArray a -> IO (MutArray a)+    [A] readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] putIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [D] pokeByteIndex :: Unbox a => Int -> MutByteArray -> a -> IO ()+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] pin :: MutArray a -> IO (MutArray a)+    [D] peekByteIndex :: Unbox a => Int -> MutByteArray -> IO a+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [D] newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modify :: forall m a. (MonadIO m, Unbox a) => MutArray a -> (a -> a) -> m ()+    [A] isPinned :: MutArray a -> Bool+    [A] getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [C] getIndex+        [O] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+        [N] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)+[C] Streamly.Data.Array.Generic+    [A] toList :: Array a -> [a]+    [A] getIndex :: Int -> Array a -> Maybe a+[C] Streamly.Data.Array+    [A] unpin :: Array a -> IO (Array a)+    [D] pokeByteIndex :: Unbox a => Int -> MutByteArray -> a -> IO ()+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pin :: Array a -> IO (Array a)+    [D] peekByteIndex :: Unbox a => Int -> MutByteArray -> IO a+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [A] isPinned :: Array a -> Bool+[C] Streamly.Console.Stdio++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Unicode.Stream+    [C] writeCharUtf8'+        [O] writeCharUtf8' :: Monad m => Fold m Word8 Char+        [N] writeCharUtf8' :: Monad m => Parser Word8 m Char+[C] Streamly.Internal.Unicode.Parser+    [A] number :: Monad m => Parser Char m (Integer, Int)+    [A] mkDouble :: Integer -> Int -> Double+    [A] doubleParser :: Monad m => Parser Char m (Int, Int)+    [C] double+        [O] double :: Parser Char m Double+        [N] double :: Monad m => Parser Char m Double+[R] Streamly.Internal.Serialize.ToBytes+[R] Streamly.Internal.Serialize.FromBytes+[C] Streamly.Internal.FileSystem.File+    [A] writeAppendWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m Word8 -> m ()+    [A] writeAppendChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+    [A] writeAppendArray :: FilePath -> Array a -> IO ()+    [A] writeAppend :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+    [R] appendWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m Word8 -> m ()+    [R] appendChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array a) -> m ()+    [R] appendArray :: FilePath -> Array a -> IO ()+    [R] append :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+[C] Streamly.Internal.FileSystem.Dir+    [C] reader+        [O] reader :: MonadIO m => Unfold m FilePath FilePath+        [N] reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+    [C] readFiles+        [O] readFiles :: MonadIO m => FilePath -> Stream m FilePath+        [N] readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+    [C] readEitherPaths+        [O] readEitherPaths :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+        [N] readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)+    [C] readEither+        [O] readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+        [N] readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath)+    [C] readDirs+        [O] readDirs :: MonadIO m => FilePath -> Stream m FilePath+        [N] readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+    [C] read+        [O] read :: MonadIO m => FilePath -> Stream m FilePath+        [N] read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath+    [C] fileReader+        [O] fileReader :: MonadIO m => Unfold m FilePath FilePath+        [N] fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+    [C] eitherReaderPaths+        [O] eitherReaderPaths :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+        [N] eitherReaderPaths :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)+    [C] eitherReader+        [O] eitherReader :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+        [N] eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)+    [C] dirReader+        [O] dirReader :: MonadIO m => Unfold m FilePath FilePath+        [N] dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+[R] Streamly.Internal.Data.Unfold.Type+[R] Streamly.Internal.Data.Unfold.Enumeration+[C] Streamly.Internal.Data.Unfold+    [C] Unfold+        [A] Unfold :: (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b+    [A] takeWhileMWithInput :: Monad m => (a -> b -> m Bool) -> Unfold m a b -> Unfold m a b+    [A] manyInterleave :: Monad m => Unfold m a b -> Unfold m c a -> Unfold m c b+    [A] enumerateFromStepIntegral :: (Monad m, Integral a) => Unfold m (a, a) a+    [A] crossApplySnd :: Unfold m a b -> Unfold m a c -> Unfold m a c+    [A] crossApplyFst :: Unfold m a b -> Unfold m a c -> Unfold m a b+    [A] concatMap :: Monad m => (b -> Unfold m a c) -> Unfold m a b -> Unfold m a c+[R] Streamly.Internal.Data.Unboxed+[C] Streamly.Internal.Data.Time.Units+    [R] Streamly.Internal.Data.Unboxed.Unbox+    [A] Streamly.Internal.Data.Unbox.Unbox+        [A] instance Streamly.Internal.Data.Unbox.Unbox Streamly.Internal.Data.Time.Units.NanoSecond64+        [A] instance Streamly.Internal.Data.Unbox.Unbox Streamly.Internal.Data.Time.Units.MilliSecond64+        [A] instance Streamly.Internal.Data.Unbox.Unbox Streamly.Internal.Data.Time.Units.MicroSecond64+[R] Streamly.Internal.Data.Time.Clock.Type+[A] Streamly.Internal.Data.StreamK+    [A] CrossStreamK+    [A] (FixityR,6)+    [A] (FixityR,6)+    [A] (FixityR,6)+    [A] (FixityR,5)+    [A] (FixityR,5)+    [A] (FixityR,6)+    [A] (FixityR,5)+    [A] StreamK+        [A] MkStream :: (forall r. State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r) -> StreamK m a+    [A] zipWithM :: Monad m => (a -> b -> m c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] zipWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] unfoldrMWith :: Monad m => (m a -> StreamK m a -> StreamK m a) -> (b -> m (Maybe (a, b))) -> b -> StreamK m a+    [A] unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> StreamK m a+    [A] unfoldr :: (b -> Maybe (a, b)) -> b -> StreamK m a+    [A] uncons :: Applicative m => StreamK m a -> m (Maybe (a, StreamK m a))+    [A] unShare :: StreamK m a -> StreamK m a+    [A] unCross :: CrossStreamK m a -> StreamK m a+    [A] toStream :: Applicative m => StreamK m a -> Stream m a+    [A] toList :: Monad m => StreamK m a -> m [a]+    [A] the :: (Eq a, Monad m) => StreamK m a -> m (Maybe a)+    [A] takeWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] take :: Int -> StreamK m a -> StreamK m a+    [A] tail :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))+    [A] sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a+    [A] sequence :: Monad m => StreamK m (m a) -> StreamK m a+    [A] scanlx' :: (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> StreamK m b+    [A] scanl' :: (b -> a -> b) -> b -> StreamK m a -> StreamK m b+    [A] reverse :: StreamK m a -> StreamK m a+    [A] replicateMWith :: (m a -> StreamK m a -> StreamK m a) -> Int -> m a -> StreamK m a+    [A] replicateM :: Monad m => Int -> m a -> StreamK m a+    [A] replicate :: Int -> a -> StreamK m a+    [A] repeatMWith :: (m a -> t m a -> t m a) -> m a -> t m a+    [A] repeatM :: Monad m => m a -> StreamK m a+    [A] repeat :: a -> StreamK m a+    [A] parseDBreak :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+    [A] parseD :: Monad m => Parser a m b -> StreamK m a -> m (Either ParseError b)+    [A] parseChunksGeneric :: Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakChunksGeneric :: forall m a b. Monad m => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: forall m a b. Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b, StreamK m a)+    [A] parse :: Monad m => ParserK a m b -> StreamK m a -> m (Either ParseError b)+    [A] null :: Monad m => StreamK m a -> m Bool+    [A] notElem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+    [A] nilM :: Applicative m => m b -> StreamK m a+    [A] nil :: StreamK m a+    [A] mkStream :: (forall r. State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r) -> StreamK m a+    [A] mkCross :: StreamK m a -> CrossStreamK m a+    [A] minimumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+    [A] minimum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+    [A] mfix :: Monad m => (m a -> StreamK m a) -> StreamK m a+    [A] mergeMapWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] mergeIterateWith :: (StreamK m a -> StreamK m a -> StreamK m a) -> (a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] mergeByM :: Monad m => (a -> a -> m Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+    [A] mergeBy :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+    [A] maximumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+    [A] maximum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+    [A] mapMaybe :: (a -> Maybe b) -> StreamK m a -> StreamK m b+    [A] mapM_ :: Monad m => (a -> m b) -> StreamK m a -> m ()+    [A] mapMWith :: (m b -> StreamK m b -> StreamK m b) -> (a -> m b) -> StreamK m a -> StreamK m b+    [A] mapMSerial :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+    [A] mapM :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+    [A] map :: (a -> b) -> StreamK m a -> StreamK m b+    [A] lookup :: (Monad m, Eq a) => a -> StreamK m (a, b) -> m (Maybe b)+    [A] liftInner :: (Monad m, MonadTrans t, Monad (t m)) => StreamK m a -> StreamK (t m) a+    [A] last :: Monad m => StreamK m a -> m (Maybe a)+    [A] iterateMWith :: Monad m => (m a -> StreamK m a -> StreamK m a) -> (a -> m a) -> m a -> StreamK m a+    [A] iterateM :: Monad m => (a -> m a) -> m a -> StreamK m a+    [A] iterate :: (a -> a) -> a -> StreamK m a+    [A] intersperseM :: Monad m => m a -> StreamK m a -> StreamK m a+    [A] intersperse :: Monad m => a -> StreamK m a -> StreamK m a+    [A] interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a+    [A] interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a+    [A] interleave :: StreamK m a -> StreamK m a -> StreamK m a+    [A] insertBy :: (a -> a -> Ordering) -> a -> StreamK m a -> StreamK m a+    [A] init :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))+    [A] hoist :: (Monad m, Monad n) => (forall x. m x -> n x) -> StreamK m a -> StreamK n a+    [A] head :: Monad m => StreamK m a -> m (Maybe a)+    [A] handle :: (MonadCatch m, Exception e) => (e -> m (StreamK m a)) -> StreamK m a -> StreamK m a+    [A] fromYieldK :: YieldK m a -> StreamK m a+    [A] fromStream :: Monad m => Stream m a -> StreamK m a+    [A] fromStopK :: StopK m -> StreamK m a+    [A] fromPure :: a -> StreamK m a+    [A] fromList :: [a] -> StreamK m a+    [A] fromIndicesMWith :: (m a -> StreamK m a -> StreamK m a) -> (Int -> m a) -> StreamK m a+    [A] fromIndicesM :: Monad m => (Int -> m a) -> StreamK m a+    [A] fromIndices :: (Int -> a) -> StreamK m a+    [A] fromFoldableM :: (Foldable f, Monad m) => f (m a) -> StreamK m a+    [A] fromFoldable :: Foldable f => f a -> StreamK m a+    [A] fromEffect :: Monad m => m a -> StreamK m a+    [A] foldrT :: (Monad m, Monad (s m), MonadTrans s) => (a -> s m b -> s m b) -> s m b -> StreamK m a -> s m b+    [A] foldrSShared :: (a -> StreamK m b -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldrSM :: Monad m => (m a -> StreamK m b -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldrS :: (a -> StreamK m b -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldrM :: (a -> m b -> m b) -> m b -> StreamK m a -> m b+    [A] foldr1 :: Monad m => (a -> a -> a) -> StreamK m a -> m (Maybe a)+    [A] foldr :: Monad m => (a -> b -> b) -> b -> StreamK m a -> m b+    [A] foldlx' :: forall m a b x. Monad m => (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> m b+    [A] foldlT :: (Monad m, Monad (s m), MonadTrans s) => (s m b -> a -> s m b) -> s m b -> StreamK m a -> s m b+    [A] foldlS :: (StreamK m b -> a -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b+    [A] foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b+    [A] foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b+    [A] foldl' :: Monad m => (b -> a -> b) -> b -> StreamK m a -> m b+    [A] foldStreamShared :: State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> StreamK m a -> m r+    [A] foldStream :: State StreamK m a -> (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> StreamK m a -> m r+    [A] foldEither :: Monad m => Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))+    [A] foldConcat :: Monad m => Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)+    [A] foldBreak :: Monad m => Fold m a b -> StreamK m a -> m (b, StreamK m a)+    [A] fold :: Monad m => Fold m a b -> StreamK m a -> m b+    [A] findM :: Monad m => (a -> m Bool) -> StreamK m a -> m (Maybe a)+    [A] findIndices :: (a -> Bool) -> StreamK m a -> StreamK m Int+    [A] find :: Monad m => (a -> Bool) -> StreamK m a -> m (Maybe a)+    [A] filter :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] evalStateT :: Monad m => m s -> StreamK (StateT s m) a -> StreamK m a+    [A] elem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+    [A] dropWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+    [A] drop :: Int -> StreamK m a -> StreamK m a+    [A] drain :: Monad m => StreamK m a -> m ()+    [A] deleteBy :: (a -> a -> Bool) -> a -> StreamK m a -> StreamK m a+    [A] crossWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] crossApplyWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m (a -> b) -> StreamK m a -> StreamK m b+    [A] crossApplySnd :: StreamK m a -> StreamK m b -> StreamK m b+    [A] crossApplyFst :: StreamK m a -> StreamK m b -> StreamK m a+    [A] crossApply :: StreamK m (a -> b) -> StreamK m a -> StreamK m b+    [A] cross :: Monad m => StreamK m a -> StreamK m b -> StreamK m (a, b)+    [A] consMBy :: Monad m => (StreamK m a -> StreamK m a -> StreamK m a) -> m a -> StreamK m a -> StreamK m a+    [A] consM :: Monad m => m a -> StreamK m a -> StreamK m a+    [A] consK :: YieldK m a -> StreamK m a -> StreamK m a+    [A] cons :: a -> StreamK m a -> StreamK m a+    [A] conjoin :: Monad m => StreamK m a -> StreamK m a -> StreamK m a+    [A] concatMapWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] concatMapEffect :: Monad m => (b -> StreamK m a) -> m b -> StreamK m a+    [A] concatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b+    [A] concatIterateWith :: (StreamK m a -> StreamK m a -> StreamK m a) -> (a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] concatIterateScanWith :: Monad m => (StreamK m a -> StreamK m a -> StreamK m a) -> (b -> a -> m (b, StreamK m a)) -> m b -> StreamK m a -> StreamK m a+    [A] concatIterateLeftsWith :: b ~ Either a c => (StreamK m b -> StreamK m b -> StreamK m b) -> (a -> StreamK m b) -> StreamK m b -> StreamK m b+    [A] concatEffect :: Monad m => m (StreamK m a) -> StreamK m a+    [A] buildSM :: Monad m => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a+    [A] buildS :: ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a+    [A] buildM :: Monad m => (forall r. (a -> StreamK m a -> m r) -> (a -> m r) -> m r -> m r) -> StreamK m a+    [A] build :: forall m a. (forall b. (a -> b -> b) -> b -> b) -> StreamK m a+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> StreamK m a) -> StreamK m a+    [A] bindWith :: (StreamK m b -> StreamK m b -> StreamK m b) -> StreamK m a -> (a -> StreamK m b) -> StreamK m b+    [A] before :: Monad m => m b -> StreamK m a -> StreamK m a+    [A] augmentSM :: Monad m => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] augmentS :: ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a+    [A] append :: StreamK m a -> StreamK m a -> StreamK m a+    [A] any :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+    [A] all :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+    [A] (.:) :: a -> StreamK m a -> StreamK m a+    [A] (!!) :: Monad m => StreamK m a -> Int -> m (Maybe a)+[R] Streamly.Internal.Data.Stream.StreamK.Type+[R] Streamly.Internal.Data.Stream.StreamK.Transformer+[R] Streamly.Internal.Data.Stream.StreamK+[R] Streamly.Internal.Data.Stream.StreamD.Type+[R] Streamly.Internal.Data.Stream.StreamD.Transformer+[R] Streamly.Internal.Data.Stream.StreamD.Transform+[R] Streamly.Internal.Data.Stream.StreamD.Top+[R] Streamly.Internal.Data.Stream.StreamD.Step+[R] Streamly.Internal.Data.Stream.StreamD.Nesting+[R] Streamly.Internal.Data.Stream.StreamD.Lift+[R] Streamly.Internal.Data.Stream.StreamD.Generate+[R] Streamly.Internal.Data.Stream.StreamD.Exception+[R] Streamly.Internal.Data.Stream.StreamD.Eliminate+[R] Streamly.Internal.Data.Stream.StreamD.Container+[D] Streamly.Internal.Data.Stream.StreamD+[R] Streamly.Internal.Data.Stream.Common+[R] Streamly.Internal.Data.Stream.Chunked+[C] Streamly.Internal.Data.Stream+    [A] class Enum a => Enumerable a+    [A] Stream+        [A] UnStream :: (State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a+    [A] Step+        [A] Yield :: a -> s -> Step s a+        [A] Stop :: Step s a+        [A] Skip :: s -> Step s a+    [A] InterleaveState+        [A] InterleaveSecondOnly :: s2 -> InterleaveState s1 s2+        [A] InterleaveSecond :: s1 -> s2 -> InterleaveState s1 s2+        [A] InterleaveFirstOnly :: s1 -> InterleaveState s1 s2+        [A] InterleaveFirst :: s1 -> s2 -> InterleaveState s1 s2+    [A] FoldManyPost+        [A] FoldManyPostYield :: b -> FoldManyPost s fs b a -> FoldManyPost s fs b a+        [A] FoldManyPostStart :: s -> FoldManyPost s fs b a+        [A] FoldManyPostLoop :: s -> fs -> FoldManyPost s fs b a+        [A] FoldManyPostDone :: FoldManyPost s fs b a+    [A] FoldMany+        [A] FoldManyYield :: b -> FoldMany s fs b a -> FoldMany s fs b a+        [A] FoldManyStart :: s -> FoldMany s fs b a+        [A] FoldManyLoop :: s -> fs -> FoldMany s fs b a+        [A] FoldManyFirst :: fs -> s -> FoldMany s fs b a+        [A] FoldManyDone :: FoldMany s fs b a+    [A] CrossStream+    [A] ConcatUnfoldInterleaveState+        [A] ConcatUnfoldInterleaveOuter :: o -> [i] -> ConcatUnfoldInterleaveState o i+        [A] ConcatUnfoldInterleaveInnerR :: [i] -> [i] -> ConcatUnfoldInterleaveState o i+        [A] ConcatUnfoldInterleaveInnerL :: [i] -> [i] -> ConcatUnfoldInterleaveState o i+        [A] ConcatUnfoldInterleaveInner :: o -> [i] -> ConcatUnfoldInterleaveState o i+    [A] ConcatMapUState+        [A] ConcatMapUOuter :: o -> ConcatMapUState o i+        [A] ConcatMapUInner :: o -> i -> ConcatMapUState o i+    [A] AppendState+        [A] AppendSecond :: s2 -> AppendState s1 s2+        [A] AppendFirst :: s1 -> AppendState s1 s2+    [A] pattern Stream :: (State StreamK m a -> s -> m (Step s a)) -> s -> Stream m a+    [A] zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+    [A] zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] with :: Monad m => (Stream m a -> Stream m (s, a)) -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a)) -> ((s, a) -> b) -> Stream m a -> Stream m a+    [A] usingStateT :: Monad m => m s -> (Stream (StateT s m) a -> Stream (StateT s m) a) -> Stream m a -> Stream m a+    [A] usingReaderT :: Monad m => m r -> (Stream (ReaderT r m) a -> Stream (ReaderT r m) a) -> Stream m a -> Stream m a+    [A] uniqBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a+    [A] uniq :: (Eq a, Monad m) => Stream m a -> Stream m a+    [A] unionWithStreamGenericBy :: MonadIO m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] unionWithStreamAscBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+    [A] unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a+    [A] unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfoldIterateDfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldIterateBfsRev :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldIterateBfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a+    [A] unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b+    [A] unfold :: Applicative m => Unfold m a b -> a -> Stream m b+    [A] uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+    [A] unCross :: CrossStream m a -> Stream m a+    [A] transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b+    [A] trace_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a+    [A] toStreamK :: Monad m => Stream m a -> StreamK m a+    [A] toListRev :: Monad m => Stream m a -> m [a]+    [A] toList :: Monad m => Stream m a -> m [a]+    [A] timestamped :: MonadIO m => Stream m a -> Stream m (AbsTime, a)+    [A] timestampWith :: MonadIO m => Double -> Stream m a -> Stream m (AbsTime, a)+    [A] timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)+    [A] times :: MonadIO m => Stream m (AbsTime, RelTime64)+    [A] timeout :: AbsTime -> t m ()+    [A] timeIndexed :: MonadIO m => Stream m a -> Stream m (RelTime64, a)+    [A] timeIndexWith :: MonadIO m => Double -> Stream m a -> Stream m (RelTime64, a)+    [A] the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)+    [A] tapOffsetEvery :: Monad m => Int -> Int -> Fold m a b -> Stream m a -> Stream m a+    [A] tap :: Monad m => Fold m a b -> Stream m a -> Stream m a+    [A] takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] takeWhileLast :: (a -> Bool) -> Stream m a -> Stream m a+    [A] takeWhileAround :: (a -> Bool) -> Stream m a -> Stream m a+    [A] takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] takeEndByM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] take :: Applicative m => Int -> Stream m a -> Stream m a+    [A] tail :: Monad m => Stream m a -> m (Maybe (Stream m a))+    [A] stripSuffixUnbox :: (MonadIO m, Eq a, Unbox a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] stripSuffix :: (Monad m, Eq a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] stripPrefix :: (Monad m, Eq a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] strideFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a+    [A] splitOnSuffixSeqAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnSuffixSeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) => Bool -> Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnSeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) => Array a -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnPrefix :: (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOnAny :: [Array a] -> Fold m a b -> Stream m a -> Stream m b+    [A] splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] splitInnerBySuffix :: (Monad m, Eq (f a), Monoid (f a)) => (f a -> m (f a, Maybe (f a))) -> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)+    [A] splitInnerBy :: Monad m => (f a -> m (f a, Maybe (f a))) -> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)+    [A] slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] sequence :: Monad m => Stream m (m a) -> Stream m a+    [A] scanlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+    [A] scanlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+    [A] scanlMAfter' :: Monad m => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+    [A] scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+    [A] scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+    [A] scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+    [A] scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+    [A] scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [A] scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [A] scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b+    [A] scanMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] scan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)+    [A] runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a+    [A] runInnerWithState :: Monad m => (forall b. s -> t m b -> m (b, s)) -> m s -> Stream (t m) a -> Stream m (s, a)+    [A] runInnerWith :: Monad m => (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a+    [A] roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b+    [A] rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b+    [A] rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b+    [A] reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a+    [A] reverse :: Monad m => Stream m a -> Stream m a+    [A] replicateM :: Monad m => Int -> m a -> Stream m a+    [A] replicate :: Monad m => Int -> a -> Stream m a+    [A] repeated :: Stream m a -> Stream m a+    [A] repeatM :: Monad m => m a -> Stream m a+    [A] repeat :: Monad m => a -> Stream m a+    [A] relTimesWith :: MonadIO m => Double -> Stream m RelTime64+    [A] relTimes :: MonadIO m => Stream m RelTime64+    [A] refoldMany :: Monad m => Refold m x a b -> m x -> Stream m a -> Stream m b+    [A] refoldIterateM :: Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b+    [A] reduceIterateBfs :: Monad m => (a -> a -> m a) -> Stream m a -> m (Maybe a)+    [A] reassembleBy :: Fold m a b -> (a -> a -> Int) -> Stream m a -> Stream m b+    [A] prune :: (a -> Bool) -> Stream m a -> Stream m a+    [A] prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+    [A] postscanlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+    [A] postscanlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+    [A] postscanlMAfter' :: Monad m => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+    [A] postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+    [A] postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+    [A] postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+    [A] postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] parseSequence :: Stream m (Parser a m b) -> Stream m a -> Stream m b+    [A] parseManyTill :: Parser a m b -> Parser a m x -> Stream m a -> Stream m b+    [A] parseManyD :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseMany :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseIterateD :: Monad m => (b -> Parser a m b) -> b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseIterate :: Monad m => (b -> Parser a m b) -> b -> Stream m a -> Stream m (Either ParseError b)+    [A] parseD :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)+    [A] parseBreakD :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+    [A] parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+    [A] parse :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)+    [A] onException :: MonadCatch m => m b -> Stream m a -> Stream m a+    [A] null :: Monad m => Stream m a -> m Bool+    [A] nub :: (Monad m, Ord a) => Stream m a -> Stream m a+    [A] notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+    [A] nilM :: Applicative m => m b -> Stream m a+    [A] nil :: Applicative m => Stream m a+    [A] morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a+    [A] mkCross :: Stream m a -> CrossStream m a+    [A] minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+    [A] minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+    [A] mergeMinBy :: (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] mergeFstBy :: (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] mergeByM :: Monad m => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] mergeBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+    [A] maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+    [A] mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b+    [A] mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b+    [A] mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()+    [A] mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b+    [A] map :: Monad m => (a -> b) -> Stream m a -> Stream m b+    [A] lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)+    [A] liftInnerWith :: Monad (t m) => (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a+    [A] liftInner :: (Monad m, MonadTrans t, Monad (t m)) => Stream m a -> Stream (t m) a+    [A] last :: Monad m => Stream m a -> m (Maybe a)+    [A] joinOuterGeneric :: MonadIO m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [A] joinOuterAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (Maybe a, Maybe b)+    [A] joinOuter :: (Ord k, MonadIO m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)+    [A] joinLeftGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [A] joinLeftAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+    [A] joinLeft :: (Ord k, Monad m) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)+    [A] joinInnerGeneric :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)+    [A] joinInnerAscBy :: (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)+    [A] joinInner :: (Monad m, Ord k) => Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)+    [A] iterateM :: Monad m => (a -> m a) -> m a -> Stream m a+    [A] iterate :: Monad m => (a -> a) -> a -> Stream m a+    [A] isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) => Stream m a -> Stream m a -> m Bool+    [A] isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+    [A] isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+    [A] isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+    [A] isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a) => Stream m a -> Stream m a -> m Bool+    [A] intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseMWith :: Int -> m a -> Stream m a -> Stream m a+    [A] intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseMSuffixWith :: forall m a. Monad m => Int -> m a -> Stream m a -> Stream m a+    [A] intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a+    [A] intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a+    [A] intersperseM :: Monad m => m a -> Stream m a -> Stream m a+    [A] intersperse :: Monad m => a -> Stream m a -> Stream m a+    [A] intersectBySorted :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] interposeSuffixM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interposeSuffix :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interpose :: Monad m => c -> Unfold m b c -> Stream m b -> Stream m c+    [A] interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] interleave :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] intercalateSuffix :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] intercalate :: Monad m => Unfold m b c -> b -> Stream m b -> Stream m c+    [A] insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a+    [A] indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)+    [A] indexed :: Monad m => Stream m a -> Stream m (Int, a)+    [A] headElse :: Monad m => a -> Stream m a -> m a+    [A] head :: Monad m => Stream m a -> m (Maybe a)+    [A] handle :: (MonadCatch m, Exception e) => (e -> m (Stream m a)) -> Stream m a -> Stream m a+    [A] groupsWhile :: Monad m => (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] groupsRollingBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Stream m a -> Stream m b+    [A] groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b+    [A] gintercalateSuffix :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [A] gintercalate :: Monad m => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c+    [A] ghandle :: (MonadCatch m, Exception e) => (e -> Stream m a -> m (Stream m a)) -> Stream m a -> Stream m a+    [A] generateM :: Monad m => Int -> (Int -> m a) -> Stream m a+    [A] generate :: Monad m => Int -> (Int -> a) -> Stream m a+    [A] generalizeInner :: Monad m => Stream Identity a -> Stream m a+    [A] gbracket_ :: Monad m => m c -> (c -> m d) -> (c -> e -> Stream m b -> m (Stream m b)) -> (forall s. m s -> m (Either e s)) -> (c -> Stream m b) -> Stream m b+    [A] gbracket :: MonadIO m => IO c -> (c -> IO d1) -> (c -> e -> Stream m b -> IO (Stream m b)) -> (c -> IO d2) -> (forall s. m s -> m (Either e s)) -> (c -> Stream m b) -> Stream m b+    [A] fromStreamK :: Applicative m => StreamK m a -> Stream m a+    [A] fromPure :: Applicative m => a -> Stream m a+    [A] fromPtrN :: (Monad m, Storable a) => Int -> Ptr a -> Stream m a+    [A] fromPtr :: forall m a. (Monad m, Storable a) => Ptr a -> Stream m a+    [A] fromListM :: Monad m => [m a] -> Stream m a+    [A] fromList :: Applicative m => [a] -> Stream m a+    [A] fromIndicesM :: Monad m => (Int -> m a) -> Stream m a+    [A] fromIndices :: Monad m => (Int -> a) -> Stream m a+    [A] fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a+    [A] fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a+    [A] fromEffect :: Applicative m => m a -> Stream m a+    [A] fromByteStr# :: Monad m => Addr# -> Stream m Word8+    [A] foldrT :: (Monad m, Monad (t m), MonadTrans t) => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b+    [A] foldrS :: Monad m => (a -> Stream m b -> Stream m b) -> Stream m b -> Stream m a -> Stream m b+    [A] foldrMx :: Monad m => (a -> m x -> m x) -> m x -> (m x -> m b) -> Stream m a -> m b+    [A] foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+    [A] foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)+    [A] foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+    [A] foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b+    [A] foldlT :: (Monad m, Monad (s m), MonadTrans s) => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b+    [A] foldlS :: Monad m => (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b+    [A] foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b+    [A] foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b+    [A] foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+    [A] foldSequence :: Stream m (Fold m a b) -> Stream m a -> Stream m b+    [A] foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] foldIterateM :: Monad m => (b -> m (Fold m a b)) -> m b -> Stream m a -> Stream m b+    [A] foldIterateBfs :: Fold m a (Either a a) -> Stream m a -> m (Maybe a)+    [A] foldEither :: Monad m => Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))+    [A] foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)+    [A] foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b+    [A] foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)+    [A] fold :: Monad m => Fold m a b -> Stream m a -> m b+    [A] findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)+    [A] findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int+    [A] find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+    [A] finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a+    [A] finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a+    [A] filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] filterInStreamGenericBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] filterInStreamAscBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a+    [A] eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool+    [A] enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a+    [A] enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a+    [A] enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a+    [A] enumerateFromToFractional :: (Monad m, Fractional a, Ord a) => a -> a -> Stream m a+    [A] enumerateFromTo :: (Enumerable a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromThenToSmall :: (Monad m, Enum a) => a -> a -> a -> Stream m a+    [A] enumerateFromThenToIntegral :: (Monad m, Integral a) => a -> a -> a -> Stream m a+    [A] enumerateFromThenToFractional :: (Monad m, Fractional a, Ord a) => a -> a -> a -> Stream m a+    [A] enumerateFromThenTo :: (Enumerable a, Monad m) => a -> a -> a -> Stream m a+    [A] enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a) => a -> a -> Stream m a+    [A] enumerateFromThenNum :: (Monad m, Num a) => a -> a -> Stream m a+    [A] enumerateFromThenIntegral :: (Monad m, Integral a, Bounded a) => a -> a -> Stream m a+    [A] enumerateFromThenFractional :: (Monad m, Fractional a) => a -> a -> Stream m a+    [A] enumerateFromThen :: (Enumerable a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a+    [A] enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromNum :: (Monad m, Num a) => a -> Stream m a+    [A] enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a+    [A] enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a+    [A] enumerateFromBounded :: (Monad m, Enumerable a, Bounded a) => a -> Stream m a+    [A] enumerateFrom :: (Enumerable a, Monad m) => a -> Stream m a+    [A] enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a+    [A] elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int+    [A] elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+    [A] durations :: Double -> t m RelTime64+    [A] dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] dropWhileLast :: (a -> Bool) -> Stream m a -> Stream m a+    [A] dropWhileAround :: (a -> Bool) -> Stream m a -> Stream m a+    [A] dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] dropSuffix :: Stream m a -> Stream m a -> Stream m a+    [A] dropPrefix :: Stream m a -> Stream m a -> Stream m a+    [A] dropLast :: Int -> Stream m a -> Stream m a+    [A] dropInfix :: Stream m a -> Stream m a -> Stream m a+    [A] drop :: Monad m => Int -> Stream m a -> Stream m a+    [A] drain :: Monad m => Stream m a -> m ()+    [A] deleteInStreamGenericBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+    [A] deleteInStreamAscBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+    [A] deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a+    [A] delayPre :: MonadIO m => Double -> Stream m a -> Stream m a+    [A] delayPost :: MonadIO m => Double -> Stream m a -> Stream m a+    [A] delay :: MonadIO m => Double -> Stream m a -> Stream m a+    [A] crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+    [A] crossApplySnd :: Functor f => Stream f a -> Stream f b -> Stream f b+    [A] crossApplyFst :: Functor f => Stream f a -> Stream f b -> Stream f a+    [A] crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b+    [A] cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)+    [A] consM :: Applicative m => m a -> Stream m a -> Stream m a+    [A] cons :: Applicative m => a -> Stream m a -> Stream m a+    [A] concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+    [A] concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b+    [A] concatIterateScan :: Monad m => (b -> a -> m b) -> (b -> m (Maybe (b, Stream m a))) -> b -> Stream m a+    [A] concatIterateDfs :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatIterateBfsRev :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatIterateBfs :: Monad m => (a -> Maybe (Stream m a)) -> Stream m a -> Stream m a+    [A] concatEffect :: Monad m => m (Stream m a) -> Stream m a+    [A] concat :: Monad m => Stream m (Stream m a) -> Stream m a+    [A] cmpBy :: Monad m => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering+    [A] catRights :: Monad m => Stream m (Either a b) -> Stream m b+    [A] catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a+    [A] catLefts :: Monad m => Stream m (Either a b) -> Stream m a+    [A] catEithers :: Monad m => Stream m (Either a a) -> Stream m a+    [A] bracketUnsafe :: MonadCatch m => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+    [A] bracketIO3 :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> IO d) -> (b -> IO e) -> (b -> Stream m a) -> Stream m a+    [A] bracketIO :: (MonadIO m, MonadCatch m) => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+    [A] before :: Monad m => m b -> Stream m a -> Stream m a+    [A] append :: Monad m => Stream m a -> Stream m a -> Stream m a+    [A] any :: Monad m => (a -> Bool) -> Stream m a -> m Bool+    [A] all :: Monad m => (a -> Bool) -> Stream m a -> m Bool+    [A] afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a+    [A] afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a+    [A] absTimesWith :: MonadIO m => Double -> Stream m AbsTime+    [A] absTimes :: MonadIO m => Stream m AbsTime+    [A] (!!) :: Monad m => Stream m a -> Int -> m (Maybe a)+[R] Streamly.Internal.Data.Ring.Unboxed+[A] Streamly.Internal.Data.Ring.Generic+    [A] Ring+        [A] [ringMax] :: Ring a -> !Int+        [A] [ringHead] :: Ring a -> !Int+        [A] [ringArr] :: Ring a -> MutArray a+        [A] Ring :: MutArray a -> !Int -> !Int -> Ring a+    [A] writeLastN :: MonadIO m => Int -> Fold m a (Ring a)+    [A] unsafeInsertRingWith :: Ring a -> a -> IO Int+    [A] toStreamWith :: Int -> Ring a -> Stream m a+    [A] toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+    [A] seek :: MonadIO m => Int -> Ring a -> m (Ring a)+    [A] createRing :: MonadIO m => Int -> m (Ring a)+    [A] copyToMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+[C] Streamly.Internal.Data.Ring+    [C] Ring+        [A] [ringStart] :: Ring a -> {-# UNPACK #-} !ForeignPtr a+        [R] [ringMax] :: Ring a -> !Int+        [R] [ringHead] :: Ring a -> !Int+        [A] [ringBound] :: Ring a -> {-# UNPACK #-} !Ptr a+        [R] [ringArr] :: Ring a -> MutArray a+        [C] Ring+            [O] Ring :: MutArray a -> !Int -> !Int -> Ring a+            [N] Ring :: {-# UNPACK #-} !ForeignPtr a -> {-# UNPACK #-} !Ptr a -> Ring a+    [A] GHC.Show.Show+        [A] instance (GHC.Show.Show a, GHC.Show.Show b, GHC.Show.Show c, GHC.Show.Show d) => GHC.Show.Show (Streamly.Internal.Data.Ring.Tuple4' a b c d)+    [A] writeN :: Int -> Fold m a (Ring a)+    [R] writeLastN :: MonadIO m => Int -> Fold m a (Ring a)+    [R] unsafeInsertRingWith :: Ring a -> a -> IO Int+    [A] unsafeInsert :: Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)+    [A] unsafeFoldRingNM :: forall m a b. (MonadIO m, Storable a) => Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+    [A] unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a) => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+    [A] unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a) => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b+    [A] unsafeFoldRing :: forall a b. Storable a => Ptr a -> (b -> a -> b) -> b -> Ring a -> b+    [A] unsafeEqArrayN :: Ring a -> Ptr a -> Array a -> Int -> Bool+    [A] unsafeEqArray :: Ring a -> Ptr a -> Array a -> Bool+    [R] toStreamWith :: Int -> Ring a -> Stream m a+    [R] toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)+    [A] startOf :: Ring a -> Ptr a+    [A] slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a) => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b+    [A] slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a) => Int -> Fold m (a, Maybe a) b -> Fold m a b+    [A] slide :: Ring a -> a -> m (Ring a)+    [R] seek :: MonadIO m => Int -> Ring a -> m (Ring a)+    [A] ringsOf :: Int -> Stream m a -> Stream m (MutArray a)+    [A] readRev :: Unfold m (MutArray a) a+    [A] read :: forall m a. (MonadIO m, Storable a) => Unfold m (Ring a, Ptr a, Int) a+    [A] putIndex :: Ring a -> Int -> a -> m ()+    [A] newRing :: Int -> m (Ring a)+    [A] new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)+    [A] moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a+    [A] modifyIndex :: Ring a -> Int -> (a -> (a, b)) -> m b+    [A] length :: Ring a -> Int+    [A] getIndexUnsafe :: Ring a -> Int -> m a+    [A] getIndexRev :: Ring a -> Int -> m a+    [A] getIndex :: Ring a -> Int -> m a+    [A] fromArray :: MutArray a -> Ring a+    [R] createRing :: MonadIO m => Int -> m (Ring a)+    [A] castUnsafe :: Ring a -> Ring b+    [A] cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)+    [A] bytesFree :: Ring a -> Int+    [A] byteLength :: Ring a -> Int+    [A] byteCapacity :: Ring a -> Int+    [A] asBytes :: Ring a -> Ring Word8+    [A] advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a+[R] Streamly.Internal.Data.Producer.Type+[R] Streamly.Internal.Data.Producer.Source+[C] Streamly.Internal.Data.Producer+    [A] Source+    [A] unread :: [b] -> Source a b -> Source a b+    [A] translate :: Functor m => (a -> c) -> (c -> a) -> Producer m c b -> Producer m a b+    [A] source :: Maybe a -> Source a b+    [A] producer :: Monad m => Producer m a b -> Producer m (Source a b) b+    [A] parseManyD :: Monad m => Parser a m b -> Producer m (Source x a) a -> Producer m (Source x a) (Either ParseError b)+    [A] parseMany :: Monad m => Parser a m b -> Producer m (Source x a) a -> Producer m (Source x a) (Either ParseError b)+    [A] parse :: Monad m => Parser a m b -> Producer m (Source s a) a -> Source s a -> m (Either ParseError b, Source s a)+    [A] lmap :: (a -> a) -> Producer m a b -> Producer m a b+    [A] isEmpty :: Source a b -> Bool+[R] Streamly.Internal.Data.Pipe.Type+[C] Streamly.Internal.Data.Pipe+    [A] Step+        [A] Yield :: a -> s -> Step s a+        [A] Continue :: s -> Step s a+    [A] PipeState+        [A] Produce :: s2 -> PipeState s1 s2+        [A] Consume :: s1 -> PipeState s1 s2+    [C] Pipe+        [A] Pipe :: (s1 -> a -> m (Step (PipeState s1 s2) b)) -> (s2 -> m (Step (PipeState s1 s2) b)) -> s1 -> Pipe m a b+[A] Streamly.Internal.Data.ParserK+    [A] Step+        [A] Partial :: !Int -> (Input a -> m (Step a m r)) -> Step a m r+        [A] Error :: !Int -> String -> Step a m r+        [A] Done :: !Int -> r -> Step a m r+        [A] Continue :: !Int -> (Input a -> m (Step a m r)) -> Step a m r+    [A] ParseResult+        [A] Success :: !Int -> !b -> ParseResult b+        [A] Failure :: !Int -> !String -> ParseResult b+    [A] Input+        [A] None :: Input a+        [A] Chunk :: a -> Input a+    [A] ParserK+        [A] [runParser] :: ParserK a m b -> forall r. (ParseResult b -> Int -> Input a -> m (Step a m r)) -> Int -> Int -> Input a -> m (Step a m r)+        [A] MkParser :: (forall r. (ParseResult b -> Int -> Input a -> m (Step a m r)) -> Int -> Int -> Input a -> m (Step a m r)) -> ParserK a m b+    [A] fromPure :: b -> ParserK a m b+    [A] fromEffect :: Monad m => m b -> ParserK a m b+    [A] die :: String -> ParserK a m b+    [A] adaptCG :: Monad m => Parser a m b -> ParserK (Array a) m b+    [A] adaptC :: (Monad m, Unbox a) => Parser a m b -> ParserK (Array a) m b+    [A] adapt :: Monad m => Parser a m b -> ParserK a m b+[R] Streamly.Internal.Data.Parser.ParserK.Type+[R] Streamly.Internal.Data.Parser.ParserD.Type+[R] Streamly.Internal.Data.Parser.ParserD.Tee+[R] Streamly.Internal.Data.Parser.ParserD+[C] Streamly.Internal.Data.Parser+    [A] Step+        [A] Partial :: !Int -> !s -> Step s b+        [A] Error :: !String -> Step s b+        [A] Done :: !Int -> !b -> Step s b+        [A] Continue :: !Int -> !s -> Step s b+    [A] Parser+        [A] Parser :: (s -> a -> m (Step s b)) -> m (Initial s b) -> (s -> m (Step s b)) -> Parser a m b+    [A] Initial+        [A] IPartial :: !s -> Initial s b+        [A] IError :: !String -> Initial s b+        [A] IDone :: !b -> Initial s b+    [A] GHC.Show.Show+        [A] instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (Streamly.Internal.Data.Parser.Tuple'Fused a b)+    [A] ParseError+        [A] ParseError :: String -> ParseError+    [A] zipWithM :: Monad m => (a -> b -> m c) -> Stream m a -> Fold m c x -> Parser b m x+    [A] zip :: Monad m => Stream m a -> Fold m (a, b) x -> Parser b m x+    [A] wordWithQuotes :: (Monad m, Eq a) => Bool -> (a -> a -> Maybe a) -> a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordProcessQuotes :: (Monad m, Eq a) => a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordKeepQuotes :: (Monad m, Eq a) => a -> (a -> Maybe a) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordFramedBy :: Monad m => (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] toFold :: Monad m => Parser a m b -> Fold m a b+    [A] takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeP :: Monad m => Int -> Parser a m b -> Parser a m b+    [A] takeGE :: Monad m => Int -> Fold m a b -> Parser a m b+    [A] takeFramedBy_ :: Monad m => (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeFramedByGeneric :: Monad m => Maybe (a -> Bool) -> Maybe (a -> Bool) -> Maybe (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeFramedByEsc_ :: Monad m => (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b+    [A] takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeEndByEsc :: Monad m => (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] takeEitherSepBy :: (a -> Bool) -> Fold m (Either a b) c -> Parser a m c+    [A] takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b+    [A] takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b+    [A] subsequenceBy :: (a -> a -> Bool) -> Stream m a -> Parser a m ()+    [A] streamEqBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Parser a m ()+    [A] split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+    [A] splitWith :: Monad m => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+    [A] splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] splitManyPost :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] spanByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+    [A] spanBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+    [A] span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)+    [A] some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] sequence :: Monad m => Stream m (Parser a m b) -> Fold m b c -> Parser a m c+    [A] sepByAll :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] sepBy1 :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] sepBy :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] satisfy :: Monad m => (a -> Bool) -> Parser a m a+    [A] sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b+    [A] roundRobin :: t (Parser a m b) -> Fold m b c -> Parser a m c+    [A] rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c+    [A] retryMaxTotal :: Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] retryMaxSuccessive :: Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] retry :: Parser a m b -> Parser a m b+    [A] postscan :: Fold m a b -> Parser b m c -> Parser a m c+    [A] peek :: Monad m => Parser a m a+    [A] oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+    [A] oneNotEq :: (Monad m, Eq a) => a -> Parser a m a+    [A] oneEq :: (Monad m, Eq a) => a -> Parser a m a+    [A] one :: Monad m => Parser a m a+    [A] noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+    [A] noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+    [A] noErrorUnsafeSplitWith :: Monad m => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+    [A] noErrorUnsafeConcatMap :: Monad m => (b -> Parser a m c) -> Parser a m b -> Parser a m c+    [A] maybe :: Monad m => (a -> Maybe b) -> Parser a m b+    [A] manyTillP :: Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c+    [A] manyTill :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] manyThen :: Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] manyP :: Parser a m b -> Parser b m c -> Parser a m c+    [A] many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] makeIndexFilter :: (Fold m (s, a) b -> Parser a m b) -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b) -> ((s, a) -> Bool) -> Fold m a b -> Parser a m b+    [A] lookAhead :: Monad m => Parser a m b -> Parser a m b+    [A] lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r+    [A] lmap :: (a -> b) -> Parser b m r -> Parser a m r+    [A] listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]+    [A] listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]+    [A] indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b+    [A] groupByRollingEither :: Monad m => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)+    [A] groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+    [A] groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+    [A] fromPure :: Monad m => b -> Parser a m b+    [A] fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b+    [A] fromFold :: Monad m => Fold m a b -> Parser a m b+    [A] fromEffect :: Monad m => m b -> Parser a m b+    [A] filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+    [A] extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)+    [A] eof :: Monad m => Parser a m ()+    [A] either :: Monad m => (a -> Either String b) -> Parser a m b+    [A] dropWhile :: Monad m => (a -> Bool) -> Parser a m ()+    [A] dieM :: Monad m => m String -> Parser a m b+    [A] die :: Monad m => String -> Parser a m b+    [A] deintercalateAll :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+    [A] deintercalate1 :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+    [A] deintercalate :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+    [A] countBetween :: Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] count :: Int -> Parser a m b -> Fold m b c -> Parser a m c+    [A] concatMap :: Monad m => (b -> Parser a m c) -> Parser a m b -> Parser a m c+    [A] blockWithQuotes :: (Monad m, Eq a) => (a -> Bool) -> (a -> Bool) -> a -> a -> Fold m a b -> Parser a m b+    [A] bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1+    [A] alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a+[A] Streamly.Internal.Data.MutByteArray+    [A] class Unbox a+    [A] class SizeOfRep (f :: Type -> Type)+    [A] class Serialize a+    [A] TypeOfType+        [A] UnitType :: Name -> TypeOfType+        [A] TheType :: SimpleDataCon -> TypeOfType+        [A] MultiType :: [SimpleDataCon] -> TypeOfType+    [A] SimpleDataCon+        [A] SimpleDataCon :: Name -> [Field] -> SimpleDataCon+    [A] SerializeConfig+        [A] [cfgRecordSyntaxWithHeader] :: SerializeConfig -> Bool+        [A] [cfgInlineSize] :: SerializeConfig -> Maybe Inline+        [A] [cfgInlineSerialize] :: SerializeConfig -> Maybe Inline+        [A] [cfgInlineDeserialize] :: SerializeConfig -> Maybe Inline+        [A] [cfgConstructorTagAsString] :: SerializeConfig -> Bool+        [A] SerializeConfig :: Maybe Inline -> Maybe Inline -> Maybe Inline -> Bool -> Bool -> SerializeConfig+    [A] PinnedState+        [A] Unpinned :: PinnedState+        [A] Pinned :: PinnedState+    [A] MutByteArray+        [A] MutByteArray :: MutableByteArray# RealWorld -> MutByteArray+    [A] DataType+        [A] [dtTvs] :: DataType -> [Name]+        [A] [dtName] :: DataType -> Name+        [A] [dtCxt] :: DataType -> Cxt+        [A] [dtCons] :: DataType -> [DataCon]+        [A] DataType :: Name -> [Name] -> Cxt -> [DataCon] -> DataType+    [A] DataCon+        [A] [dcTvs] :: DataCon -> [Name]+        [A] [dcName] :: DataCon -> Name+        [A] [dcFields] :: DataCon -> [(Maybe Name, Type)]+        [A] [dcCxt] :: DataCon -> Cxt+        [A] DataCon :: Name -> [Name] -> Cxt -> [(Maybe Name, Type)] -> DataCon+    [A] BoundedPtr+        [A] BoundedPtr :: MutByteArray -> Int -> Int -> BoundedPtr+    [A] Streamly.Internal.Data.Serialize.Type.Serialize+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize Streamly.Internal.Data.MutByteArray.LiftedInteger+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize GHC.Num.Integer.Integer+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize a => Streamly.Internal.Data.Serialize.Type.Serialize (GHC.Maybe.Maybe a)+        [A] instance Streamly.Internal.Data.Serialize.Type.Serialize (Data.Proxy.Proxy a)+        [A] instance (Streamly.Internal.Data.Serialize.Type.Serialize a, Streamly.Internal.Data.Serialize.Type.Serialize b) => Streamly.Internal.Data.Serialize.Type.Serialize (Data.Either.Either a b)+    [A] Peeker+        [A] Peeker :: Builder BoundedPtr IO a -> Peeker a+    [A] type Field = (Maybe Name, Type)+    [A] xorCmp :: [Word8] -> Name -> Name -> Q Exp+    [A] wListToString :: [Word8] -> String+    [A] w8_int :: Word8 -> Int+    [A] w32_int :: Word32 -> Int+    [A] unpin :: MutByteArray -> IO MutByteArray+    [A] typeOfType :: Type -> [DataCon] -> TypeOfType+    [A] skipByte :: Peeker ()+    [A] sizeOfRep :: SizeOfRep f => f x -> Int+    [A] sizeOfMutableByteArray :: MutByteArray -> IO Int+    [A] sizeOf :: (Unbox a, SizeOfRep (Rep a)) => Proxy a -> Int+    [A] simplifyDataCon :: DataCon -> SimpleDataCon+    [A] serializeW8List :: Name -> Name -> [Word8] -> Q Exp+    [A] serializeConfig :: SerializeConfig+    [A] serializeAt :: Serialize a => Int -> MutByteArray -> a -> IO Int+    [A] runPeeker :: Peeker a -> BoundedPtr -> IO a+    [A] reifyDataType :: Name -> Q DataType+    [A] readUnsafe :: Unbox a => Peeker a+    [A] read :: Unbox a => Peeker a+    [A] putSliceUnsafe :: MonadIO m => MutByteArray -> Int -> MutByteArray -> Int -> Int -> m ()+    [A] pokeRep :: PokeRep f => f a -> BoundedPtr -> IO BoundedPtr+    [A] pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+    [A] pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+    [A] pokeAt :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutByteArray -> a -> IO ()+    [A] pinnedNewAlignedBytes :: Int -> Int -> IO MutByteArray+    [A] pinnedNew :: Int -> IO MutByteArray+    [A] pinnedCloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] pin :: MutByteArray -> IO MutByteArray+    [A] peekRep :: PeekRep f => Peeker (f x)+    [A] peekAt :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutByteArray -> IO a+    [A] openConstructor :: Name -> Int -> Q Pat+    [A] nil :: MutByteArray+    [A] newBytesAs :: PinnedState -> Int -> IO MutByteArray+    [A] new :: Int -> IO MutByteArray+    [A] mkSerializeExprFields :: Name -> [Field] -> Q Exp+    [A] mkRecSizeOfExpr :: SimpleDataCon -> Q Exp+    [A] mkRecSerializeExpr :: Name -> SimpleDataCon -> Q Exp+    [A] mkRecDeserializeExpr :: Name -> Name -> Name -> SimpleDataCon -> Q Exp+    [A] mkFieldName :: Int -> Name+    [A] mkDeserializeKeysDec :: Name -> Name -> SimpleDataCon -> Q [Dec]+    [A] mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp+    [A] matchConstructor :: Name -> Int -> Q Exp -> Q Match+    [A] makeN :: Int -> Name+    [A] makeI :: Int -> Name+    [A] makeA :: Int -> Name+    [A] litProxy :: Unbox a => Proxy a -> Q Exp+    [A] litIntegral :: Integral a => a -> Q Exp+    [A] isUnitType :: [DataCon] -> Bool+    [A] isRecordSyntax :: SimpleDataCon -> Bool+    [A] isPinned :: MutByteArray -> Bool+    [A] int_w8 :: Int -> Word8+    [A] int_w32 :: Int -> Word32+    [A] inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig+    [A] getMutableByteArray# :: MutByteArray -> MutableByteArray# RealWorld+    [A] genericSizeOf :: forall a. SizeOfRep (Rep a) => Proxy a -> Int+    [A] genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) => MutByteArray -> Int -> a -> IO ()+    [A] genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) => MutByteArray -> Int -> IO a+    [A] errorUnsupported :: String -> a+    [A] errorUnimplemented :: a+    [A] encodeRecordFields :: Bool -> SerializeConfig -> SerializeConfig+    [A] encodeConstrNames :: Bool -> SerializeConfig -> SerializeConfig+    [A] deserializeAt :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+    [A] deriveUnbox :: Q [Dec] -> Q [Dec]+    [A] deriveSerializeWith :: (SerializeConfig -> SerializeConfig) -> Q [Dec] -> Q [Dec]+    [A] deriveSerialize :: Q [Dec] -> Q [Dec]+    [A] conUpdateFuncDec :: Name -> [Field] -> Q [Dec]+    [A] cloneSliceUnsafeAs :: MonadIO m => PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray+    [A] cloneSliceUnsafe :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+    [A] c2w :: Char -> Word8+    [A] asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+    [A] addSizeTo :: Serialize a => Int -> a -> Int+    [A] _x :: Name+    [A] _val :: Name+    [A] _tag :: Name+    [A] _initialOffset :: Name+    [A] _endOffset :: Name+    [A] _arr :: Name+    [A] _acc :: Name+[A] Streamly.Internal.Data.MutArray.Stream+    [A] SpliceState+        [A] SpliceYielding :: arr -> SpliceState s arr -> SpliceState s arr+        [A] SpliceInitial :: s -> SpliceState s arr+        [A] SpliceFinish :: SpliceState s arr+        [A] SpliceBuffering :: s -> arr -> SpliceState s arr+    [A] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [A] splitOn :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [A] packArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] lpackArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (Either ParseError (MutArray a))+    [A] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactEQ :: Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compact :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+[A] Streamly.Internal.Data.MutArray.Generic+    [A] MutArray+        [A] [arrTrueLen] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrStart] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrLen] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrContents#] :: MutArray a -> MutableArray# RealWorld a+        [A] MutArray :: MutableArray# RealWorld a -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> MutArray a+    [A] writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] writeN :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] write :: MonadIO m => Fold m a (MutArray a)+    [A] uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)+    [A] toStreamK :: MonadIO m => MutArray a -> StreamK m a+    [A] toList :: MonadIO m => MutArray a -> m [a]+    [A] strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+    [A] snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)+    [A] reader :: MonadIO m => Unfold m (MutArray a) a+    [A] readRev :: MonadIO m => MutArray a -> Stream m a+    [A] read :: MonadIO m => MutArray a -> Stream m a+    [A] putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+    [A] putIndices :: MonadIO m => MutArray a -> Fold m (Int, a) ()+    [A] putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+    [A] putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()+    [A] producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a+    [A] producer :: MonadIO m => Producer m (MutArray a) a+    [A] nil :: MonadIO m => m (MutArray a)+    [A] new :: MonadIO m => Int -> m (MutArray a)+    [A] modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] length :: MutArray a -> Int+    [A] getSliceUnsafe :: Int -> Int -> MutArray a -> MutArray a+    [A] getSlice :: Int -> Int -> MutArray a -> MutArray a+    [A] getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+    [A] getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+    [A] getIndex :: MonadIO m => Int -> MutArray a -> m (Maybe a)+    [A] fromStreamN :: MonadIO m => Int -> Stream m a -> m (MutArray a)+    [A] fromStream :: MonadIO m => Stream m a -> m (MutArray a)+    [A] fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a)+    [A] fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)+    [A] fromList :: MonadIO m => [a] -> m (MutArray a)+    [A] eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool+    [A] cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering+    [A] clone :: MonadIO m => MutArray a -> m (MutArray a)+    [A] chunksOf :: forall m a. MonadIO m => Int -> Stream m a -> Stream m (MutArray a)+[A] Streamly.Internal.Data.MutArray+    [A] MutByteArray+    [A] MutArray+        [A] [arrStart] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrEnd] :: MutArray a -> {-# UNPACK #-} !Int+        [A] [arrContents] :: MutArray a -> {-# UNPACK #-} !MutByteArray+        [A] [arrBound] :: MutArray a -> {-# UNPACK #-} !Int+        [A] MutArray :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> MutArray a+    [A] IORef+    [A] ArrayUnsafe+        [A] ArrayUnsafe :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> ArrayUnsafe a+    [A] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] writeNWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] writeIORef :: Unbox a => IORef a -> a -> IO ()+    [A] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [A] writeAppendWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+    [A] writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] writeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] writeAppend :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+    [A] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> MutArray a -> m ()+    [A] unpin :: MutArray a -> IO (MutArray a)+    [A] toStreamKWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+    [A] toStreamKRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> StreamK m a+    [A] toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+    [A] toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a+    [A] toStreamDWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] toStreamDRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]+    [A] swapIndices :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> MutArray a -> m ()+    [A] strip :: forall a m. (Unbox a, MonadIO m) => (a -> Bool) -> MutArray a -> m (MutArray a)+    [A] splitOn :: (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> Stream m (MutArray a)+    [A] splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)+    [A] spliceWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)+    [A] spliceUnsafe :: MonadIO m => MutArray a -> MutArray a -> m (MutArray a)+    [A] spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+    [A] spliceCopy :: forall m a. MonadIO m => MutArray a -> MutArray a -> m (MutArray a)+    [A] splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)+    [A] snocWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+    [A] snocUnsafe :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] snocMay :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (Maybe (MutArray a))+    [A] snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()+    [A] roundUpToPower2 :: Int -> Int+    [A] rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)+    [A] reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()+    [A] resizeExp :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] resize :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] readerRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Unfold m (MutArray a) a+    [A] readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+    [A] reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a+    [A] readRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] readIORef :: Unbox a => IORef a -> IO a+    [A] read :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Stream m a+    [A] putIndices :: forall m a. (MonadIO m, Unbox a) => MutArray a -> Fold m (Int, a) ()+    [A] putIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] producerWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Producer m (MutArray a) a+    [A] producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a+    [A] pollIntIORef :: (MonadIO m, Unbox a) => IORef a -> Stream m a+    [A] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (MutArray a)+    [A] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] pinnedNewBytes :: MonadIO m => Int -> m (MutArray a)+    [A] pinnedNewAligned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)+    [A] pinnedNew :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] pinnedFromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] pinnedFromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] pinnedClone :: MonadIO m => MutArray a -> m (MutArray a)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [A] pin :: MutArray a -> IO (MutArray a)+    [A] permute :: MutArray a -> m Bool+    [A] partitionBy :: forall m a. (MonadIO m, Unbox a) => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)+    [A] nil :: MutArray a+    [A] newIORef :: forall a. Unbox a => a -> IO (IORef a)+    [A] newArrayWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int -> m MutByteArray) -> Int -> Int -> m (MutArray a)+    [A] new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] modifyIndices :: forall m a. (MonadIO m, Unbox a) => MutArray a -> (Int -> a -> a) -> Fold m Int ()+    [A] modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIndex :: forall m a b. (MonadIO m, Unbox a) => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] modifyIORef' :: Unbox a => IORef a -> (a -> a) -> IO ()+    [A] modify :: forall m a. (MonadIO m, Unbox a) => MutArray a -> (a -> a) -> m ()+    [A] mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()+    [A] memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()+    [A] memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool+    [A] length :: forall a. Unbox a => MutArray a -> Int+    [A] isPinned :: MutArray a -> Bool+    [A] getSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [A] getSliceUnsafe :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [A] getSlice :: forall a. Unbox a => Int -> Int -> MutArray a -> MutArray a+    [A] getIndicesD :: (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a+    [A] getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+    [A] getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (Maybe a)+    [A] genSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (MutArray a)+    [A] fromStreamD :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+    [A] fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+    [A] fromPureStream :: (MonadIO m, Unbox a) => Stream Identity a -> m (MutArray a)+    [A] fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [A] foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b+    [A] foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] divideBy :: Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()+    [A] cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+    [A] clone :: MonadIO m => MutArray a -> m (MutArray a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (MutArray a)+    [A] castUnsafe :: MutArray a -> MutArray b+    [A] cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)+    [A] c_memchr :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)+    [A] bytesFree :: MutArray a -> Int+    [A] byteLength :: MutArray a -> Int+    [A] byteCapacity :: MutArray a -> Int+    [A] bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()+    [A] breakOn :: MonadIO m => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))+    [A] blockSize :: Int+    [A] asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] asBytes :: MutArray a -> MutArray Word8+    [A] arrayChunkBytes :: Int+    [A] allocBytesToElemCount :: Unbox a => a -> Int -> Int+[C] Streamly.Internal.Data.IsMap+    [A] mapTraverseWithKey :: (IsMap f, Applicative t) => (Key f -> a -> t b) -> f a -> t (f b)+[R] Streamly.Internal.Data.IORef.Unboxed+[R] Streamly.Internal.Data.Fold.Window+[R] Streamly.Internal.Data.Fold.Type+[R] Streamly.Internal.Data.Fold.Tee+[R] Streamly.Internal.Data.Fold.Step+[R] Streamly.Internal.Data.Fold.Container+[D] Streamly.Internal.Data.Fold.Chunked+[C] Streamly.Internal.Data.Fold+    [A] ManyState+    [C] Fold+        [C] Fold+            [O] Fold :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b+            [N] Fold :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> (s -> m b) -> Fold m a b+    [A] windowSumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a+    [A] windowSum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a+    [A] windowRollingMapM :: Monad m => (Maybe a -> a -> m (Maybe b)) -> Fold m (a, Maybe a) (Maybe b)+    [A] windowRollingMap :: Monad m => (Maybe a -> a -> Maybe b) -> Fold m (a, Maybe a) (Maybe b)+    [A] windowRange :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))+    [A] windowPowerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a+    [A] windowPowerSum :: (Monad m, Num a) => Int -> Fold m (a, Maybe a) a+    [A] windowMinimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+    [A] windowMean :: forall m a. (Monad m, Fractional a) => Fold m (a, Maybe a) a+    [A] windowMaximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)+    [A] windowLmap :: (c -> a) -> Fold m (a, Maybe a) b -> Fold m (c, Maybe c) b+    [A] windowLength :: (Monad m, Num b) => Fold m (a, Maybe a) b+    [A] toSet :: (Monad m, Ord a) => Fold m a (Set a)+    [A] toMapIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)+    [A] toMap :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)+    [A] toIntSet :: Monad m => Fold m Int IntSet+    [A] toContainerIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+    [A] toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (f b)+    [A] nubInt :: Monad m => Fold m Int (Maybe Int)+    [A] nub :: (Monad m, Ord a) => Fold m a (Maybe a)+    [A] mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)+    [A] kvToMap :: (Monad m, Ord k) => Fold m a b -> Fold m (k, a) (Map k b)+    [A] frequency :: (Monad m, Ord a) => Fold m a (Map a Int)+    [A] demuxToMapIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [A] demuxToMap :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+    [A] demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)+    [A] demuxToContainer :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)+    [A] demuxKvToMap :: (Monad m, Ord k) => (k -> m (Fold m a b)) -> Fold m (k, a) (Map k b)+    [A] demuxKvToContainer :: (Monad m, IsMap f, Traversable f) => (Key f -> m (Fold m a b)) -> Fold m (Key f, a) (f b)+    [A] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [A] demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))+    [A] demuxGeneric :: (Monad m, IsMap f, Traversable f) => (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (m (f b), Maybe (Key f, b))+    [A] demux :: (Monad m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, b))+    [A] cumulative :: Fold m (a, Maybe a) b -> Fold m a b+    [A] countDistinctInt :: Monad m => Fold m Int Int+    [A] countDistinct :: (Monad m, Ord a) => Fold m a Int+    [A] classifyIO :: (MonadIO m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [A] classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))+    [A] classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) => (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))+    [A] classify :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [A] chainStepM :: Applicative m => (s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)+[C] Streamly.Internal.Data.Builder+    [C] Builder+        [C] Builder+            [O] Builder :: (s -> m (s, a)) -> Builder s m a+            [N] Builder :: (s -> m (a, s)) -> Builder s m a+[A] Streamly.Internal.Data.Binary.Stream+    [A] class ToBytes a+    [A] word8 :: Applicative m => Word8 -> Stream m Word8+    [A] word64le :: Monad m => Word64 -> Stream m Word8+    [A] word64host :: Monad m => Word64 -> Stream m Word8+    [A] word64be :: Monad m => Word64 -> Stream m Word8+    [A] word32le :: Monad m => Word32 -> Stream m Word8+    [A] word32be :: Monad m => Word32 -> Stream m Word8+    [A] word16le :: Monad m => Word16 -> Stream m Word8+    [A] word16be :: Monad m => Word16 -> Stream m Word8+    [A] unit :: Applicative m => Stream m Word8+    [A] toBytes :: ToBytes a => a -> Stream m Word8+    [A] ordering :: Applicative m => Ordering -> Stream m Word8+    [A] int8 :: Applicative m => Int8 -> Stream m Word8+    [A] int64le :: Monad m => Int64 -> Stream m Word8+    [A] int64be :: Monad m => Int64 -> Stream m Word8+    [A] int32le :: Monad m => Int32 -> Stream m Word8+    [A] int32be :: Monad m => Int32 -> Stream m Word8+    [A] int16le :: Monad m => Int16 -> Stream m Word8+    [A] int16be :: Monad m => Int16 -> Stream m Word8+    [A] float32le :: Monad m => Float -> Stream m Word8+    [A] float32be :: Monad m => Float -> Stream m Word8+    [A] double64le :: Monad m => Double -> Stream m Word8+    [A] double64be :: Monad m => Double -> Stream m Word8+    [A] charUtf8 :: Monad m => Char -> Stream m Word8+    [A] charLatin1 :: Applicative m => Char -> Stream m Word8+    [A] bool :: Applicative m => Bool -> Stream m Word8+[A] Streamly.Internal.Data.Binary.Parser+    [A] class FromBytes a+    [A] word8 :: Monad m => Parser Word8 m Word8+    [A] word64le :: Monad m => Parser Word8 m Word64+    [A] word64host :: MonadIO m => Parser Word8 m Word64+    [A] word64be :: Monad m => Parser Word8 m Word64+    [A] word32le :: Monad m => Parser Word8 m Word32+    [A] word32be :: Monad m => Parser Word8 m Word32+    [A] word16le :: Monad m => Parser Word8 m Word16+    [A] word16be :: Monad m => Parser Word8 m Word16+    [A] unit :: Monad m => Parser Word8 m ()+    [A] ordering :: Monad m => Parser Word8 m Ordering+    [A] int8 :: Monad m => Parser Word8 m Int8+    [A] int64le :: Monad m => Parser Word8 m Int64+    [A] int64be :: Monad m => Parser Word8 m Int64+    [A] int32le :: Monad m => Parser Word8 m Int32+    [A] int32be :: Monad m => Parser Word8 m Int32+    [A] int16le :: Monad m => Parser Word8 m Int16+    [A] int16be :: Monad m => Parser Word8 m Int16+    [A] fromBytes :: FromBytes a => Parser Word8 m a+    [A] float32le :: MonadIO m => Parser Word8 m Float+    [A] float32be :: MonadIO m => Parser Word8 m Float+    [A] eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8+    [A] double64le :: MonadIO m => Parser Word8 m Double+    [A] double64be :: MonadIO m => Parser Word8 m Double+    [A] charLatin1 :: Monad m => Parser Word8 m Char+    [A] bool :: Monad m => Parser Word8 m Bool+[R] Streamly.Internal.Data.Array.Type+[A] Streamly.Internal.Data.Array.Stream+    [A] unlines :: forall m a. (MonadIO m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] toArray :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+    [A] splitOnSuffix :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] splitOn :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] runArrayParserDBreak :: forall m a b. (MonadIO m, Unbox a) => Parser (Array a) m b -> Stream m (Array a) -> m (Either ParseError b, Stream m (Array a))+    [A] runArrayFoldMany :: (Monad m, Unbox a) => ChunkFold m a b -> StreamK m (Array a) -> StreamK m (Either ParseError b)+    [A] runArrayFoldBreak :: (MonadIO m, Unbox a) => ChunkFold m a b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] runArrayFold :: (MonadIO m, Unbox a) => ChunkFold m a b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] parseChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakChunks :: (Monad m, Unbox a) => ParserK (Array a) m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] parseBreak :: (MonadIO m, Unbox a) => Parser a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] lpackArraysChunksOf :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [A] interposeSuffix :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] intercalateSuffix :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a+    [A] foldBreakD :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))+    [A] foldBreak :: (MonadIO m, Unbox a) => Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] compact :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+[R] Streamly.Internal.Data.Array.Mut.Type+[R] Streamly.Internal.Data.Array.Mut.Stream+[R] Streamly.Internal.Data.Array.Mut+[R] Streamly.Internal.Data.Array.Generic.Mut.Type+[C] Streamly.Internal.Data.Array.Generic+    [A] getIndex :: Int -> Array a -> Maybe a+    [A] fromPureStream :: Stream Identity a -> Array a+    [A] fromByteStr# :: Addr# -> Array Word8+    [A] chunksOf :: forall m a. MonadIO m => Int -> Stream m a -> Stream m (Array a)+[C] Streamly.Internal.Data.Array+    [A] ArrayUnsafe+        [A] ArrayUnsafe :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> ArrayUnsafe a+    [C] Array+        [A] [arrStart] :: Array a -> {-# UNPACK #-} !Int+        [A] [arrEnd] :: Array a -> {-# UNPACK #-} !Int+        [A] [arrContents] :: Array a -> {-# UNPACK #-} !MutByteArray+        [A] Array :: {-# UNPACK #-} !MutByteArray -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> Array a+    [A] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [R] writeNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (Array a)+    [A] unsafeMakePure :: Monad m => Fold IO a b -> Fold m a b+    [A] unsafeIndexIO :: forall a. Unbox a => Int -> Array a -> IO a+    [D] unsafeIndex :: forall a. Unbox a => Int -> Array a -> a+    [A] unsafeFreezeWithShrink :: Unbox a => MutArray a -> Array a+    [A] unpin :: Array a -> IO (Array a)+    [A] toStreamKRev :: forall m a. (Monad m, Unbox a) => Array a -> StreamK m a+    [A] toStreamK :: forall m a. (Monad m, Unbox a) => Array a -> StreamK m a+    [A] toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [A] toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [A] splitAt :: Unbox a => Int -> Array a -> (Array a, Array a)+    [A] splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)+    [A] serialize :: Serialize a => a -> Array Word8+    [A] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (Array a)+    [A] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] pinnedSerialize :: Serialize a => a -> Array Word8+    [A] pinnedFromListN :: Unbox a => Int -> [a] -> Array a+    [A] pinnedFromList :: Unbox a => [a] -> Array a+    [A] pinnedClone :: MonadIO m => Array a -> m (Array a)+    [A] pinnedChunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] pin :: Array a -> IO (Array a)+    [A] nil :: Array a+    [A] isPinned :: Array a -> Bool+    [A] getIndexUnsafe :: forall a. Unbox a => Int -> Array a -> a+    [A] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)+    [A] fromStreamD :: forall m a. (MonadIO m, Unbox a) => Stream m a -> m (Array a)+    [A] fromPureStream :: Unbox a => Stream Identity a -> Array a+    [A] fromListRevN :: Unbox a => Int -> [a] -> Array a+    [A] fromListRev :: Unbox a => [a] -> Array a+    [A] fromByteStr# :: Addr# -> Array Word8+    [A] foldr :: Unbox a => (a -> b -> b) -> b -> Array a -> b+    [A] foldl' :: forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b+    [A] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8+    [A] deserialize :: Serialize a => Array Word8 -> a+    [A] clone :: MonadIO m => Array a -> m (Array a)+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [A] byteLength :: Array a -> Int+    [A] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+    [A] breakOn :: MonadIO m => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))
+ docs/ApiChangelogs/0.2.0-0.2.2.txt view
@@ -0,0 +1,306 @@+---------------------------------+API Annotations+---------------------------------++[A] : Added+[R] : Removed+[C] : Changed+[O] : Old definition+[N] : New definition+[D] : Deprecated++---------------------------------+API diff+---------------------------------++[C] Streamly.Data.Stream+    [A] (FixityR,5)+    [A] (FixityR,5)+[C] Streamly.Data.MutArray.Generic+    [A] emptyOf :: MonadIO m => Int -> m (MutArray a)+    [A] createOf :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] create :: MonadIO m => Fold m a (MutArray a)+[C] Streamly.Data.MutArray+    [A] pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] appendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] append :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+[C] Streamly.Data.Array.Generic+    [A] createOf :: MonadIO m => Int -> Fold m a (Array a)+    [A] create :: MonadIO m => Fold m a (Array a)+[C] Streamly.Data.Array+    [A] class Serialize a+    [A] serializeAt :: Serialize a => Int -> MutByteArray -> a -> IO Int+    [A] pinnedSerialize :: Serialize a => a -> Array Word8+    [A] deserializeAt :: Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+    [A] deserialize :: Serialize a => Array Word8 -> a+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] addSizeTo :: Serialize a => Int -> a -> Int++---------------------------------+Internal API diff+---------------------------------++[C] Streamly.Internal.Unicode.Stream+    [A] encodeUtf16le' :: Stream m Char -> Stream m Word16+    [A] decodeUtf16le' :: Stream m Word16 -> Stream m Char+[A] Streamly.Internal.FileSystem.Path+    [A] class IsPath a+    [A] Rel+    [A] File+    [A] Dir+    [A] Abs+    [A] Streamly.Internal.FileSystem.Path.IsPath+        [A] instance Streamly.Internal.FileSystem.Path.IsPath Streamly.Internal.FileSystem.Path.Path+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Rel Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Rel (Streamly.Internal.FileSystem.Path.File Streamly.Internal.FileSystem.Path.Path))+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Rel (Streamly.Internal.FileSystem.Path.Dir Streamly.Internal.FileSystem.Path.Path))+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.File Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Dir Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Abs Streamly.Internal.FileSystem.Path.Path)+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Abs (Streamly.Internal.FileSystem.Path.File Streamly.Internal.FileSystem.Path.Path))+        [A] instance Streamly.Internal.FileSystem.Path.IsPath (Streamly.Internal.FileSystem.Path.Abs (Streamly.Internal.FileSystem.Path.Dir Streamly.Internal.FileSystem.Path.Path))+    [A] GHC.Show.Show+        [A] instance GHC.Show.Show Streamly.Internal.FileSystem.Path.PathException+    [A] GHC.Exception.Type.Exception+        [A] instance GHC.Exception.Type.Exception Streamly.Internal.FileSystem.Path.PathException+    [A] GHC.Classes.Eq+        [A] instance GHC.Classes.Eq Streamly.Internal.FileSystem.Path.PathException+    [A] Path+        [A] Path :: Array Word8 -> Path+    [A] toString :: Path -> [Char]+    [A] toPath :: IsPath a => a -> Path+    [A] toChunk :: Path -> Array Word8+    [A] toChars :: Monad m => Path -> Stream m Char+    [A] relfile :: QuasiQuoter+    [A] reldir :: QuasiQuoter+    [A] rel :: QuasiQuoter+    [A] primarySeparator :: Char+    [A] path :: QuasiQuoter+    [A] mkRelFile :: String -> Q Exp+    [A] mkRelDir :: String -> Q Exp+    [A] mkRel :: String -> Q Exp+    [A] mkPath :: String -> Q Exp+    [A] mkFile :: String -> Q Exp+    [A] mkDir :: String -> Q Exp+    [A] mkAbsFile :: String -> Q Exp+    [A] mkAbsDir :: String -> Q Exp+    [A] mkAbs :: String -> Q Exp+    [A] isSeparator :: Char -> Bool+    [A] fromString :: MonadThrow m => [Char] -> m Path+    [A] fromPathUnsafe :: IsPath a => Path -> a+    [A] fromPath :: (IsPath a, MonadThrow m) => Path -> m a+    [A] fromChunkUnsafe :: Array Word8 -> Path+    [A] fromChunk :: MonadThrow m => Array Word8 -> m Path+    [A] fromChars :: MonadThrow m => Stream Identity Char -> m Path+    [A] file :: QuasiQuoter+    [A] extendPath :: Path -> Path -> Path+    [A] extendDir :: (IsPath (a (Dir Path)), IsPath b, IsPath (a b)) => a (Dir Path) -> Rel b -> a b+    [A] dir :: QuasiQuoter+    [A] adaptPath :: (MonadThrow m, IsPath a, IsPath b) => a -> m b+    [A] absfile :: QuasiQuoter+    [A] absdir :: QuasiQuoter+    [A] abs :: QuasiQuoter+[C] Streamly.Internal.Data.Stream+    [A] (FixityR,5)+    [A] (FixityR,5)+    [C] splitInnerBySuffix+        [O] splitInnerBySuffix :: (Monad m, Eq (f a), Monoid (f a)) => (f a -> m (f a, Maybe (f a))) -> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)+        [N] splitInnerBySuffix :: Monad m => (f a -> Bool) -> (f a -> m (f a, Maybe (f a))) -> (f a -> f a -> m (f a)) -> Stream m (f a) -> Stream m (f a)+    [D] sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+    [A] indexOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)+[C] Streamly.Internal.Data.MutByteArray+    [A] unsafePinnedAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+    [A] unsafeAsPtr :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+    [D] nil :: MutByteArray+    [A] empty :: MutByteArray+    [D] asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+[D] Streamly.Internal.Data.MutArray.Stream+    [D] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [D] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+[C] Streamly.Internal.Data.MutArray.Generic+    [D] writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+    [D] writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] unsafeCreateOf :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] emptyOf :: MonadIO m => Int -> m (MutArray a)+    [A] createWith :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] createOf :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] create :: MonadIO m => Fold m a (MutArray a)+[C] Streamly.Internal.Data.MutArray+    [A] SpliceState+        [A] SpliceYielding :: arr -> SpliceState s arr -> SpliceState s arr+        [A] SpliceInitial :: s -> SpliceState s arr+        [A] SpliceFinish :: SpliceState s arr+        [A] SpliceBuffering :: s -> arr -> SpliceState s arr+    [R] MutByteArray+    [D] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [D] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] writeChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [D] writeAppendWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+    [D] writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] unsafePinnedAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] 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] unsafeAsPtr :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] unsafeAppendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] toStreamWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] toStreamRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [R] toStreamDWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [R] toStreamDRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> MutArray a -> Stream m a+    [A] slicerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [A] sliceIndexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] revCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] resizeExp :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] resize :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] pokeSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+    [A] pokeAppendMay :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (Maybe (MutArray Word8))+    [A] pokeAppend :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> a -> m (MutArray Word8)+    [D] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [D] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [D] pinnedNewBytes :: MonadIO m => Int -> m (MutArray a)+    [A] pinnedEmptyOf :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] pinnedCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] peekUnconsUnsafe :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (a, MutArray Word8)+    [A] peekUncons :: forall m a. (MonadIO m, Unbox a) => MutArray Word8 -> m (Maybe a, MutArray Word8)+    [A] peekSkipUnsafe :: Int -> MutArray Word8 -> MutArray Word8+    [A] pPinnedCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [A] pCompactLE :: forall m a. (MonadIO m, Unbox a) => Int -> Parser (MutArray a) m (MutArray a)+    [D] nil :: MutArray a+    [A] lPinnedCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] lCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+    [A] indexReaderWith :: (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a+    [A] indexReader :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+    [A] growExp :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [A] grow :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)+    [D] getSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (MutArray a)+    [R] getIndicesD :: (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m Int -> Unfold m (MutArray a) a+    [D] getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a+    [D] genSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (MutArray a) (Int, Int)+    [A] fromStreamN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (MutArray a)+    [D] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (MutArray a)+    [D] fromStreamD :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)+    [A] fromPureStreamN :: (MonadIO m, Unbox a) => Int -> Stream Identity a -> m (MutArray a)+    [A] fromPtrN :: MonadIO m => Int -> Ptr Word8 -> m (MutArray Word8)+    [A] fromChunksRealloced :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> m (MutArray a)+    [A] fromChunksK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [A] fromByteStr# :: MonadIO m => Addr# -> m (MutArray Word8)+    [D] fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (MutArray a) -> m (MutArray a)+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] fPinnedCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] fCompactGE :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m (MutArray a) (MutArray a)+    [A] emptyOf :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] empty :: MutArray a+    [A] createWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] createOfWith :: forall m a. (MonadIO m, Unbox a) => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)+    [A] concatWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a+    [A] concatRevWith :: forall m a. (Monad m, Unbox a) => (forall b. IO b -> m b) -> Stream m (MutArray a) -> Stream m a+    [A] concatRev :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] concat :: forall m a. (MonadIO m, Unbox a) => Stream m (MutArray a) -> Stream m a+    [A] compactOnByteSuffix :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [A] compactOnByte :: MonadIO m => Word8 -> Stream m (MutArray Word8) -> Stream m (MutArray Word8)+    [A] compactLeAs :: forall m a. (MonadIO m, Unbox a) => PinnedState -> Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [A] compactEQ :: Int -> Stream m (MutArray a) -> Stream m (MutArray a)+    [D] cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+    [A] byteEq :: MonadIO m => MutArray a -> MutArray a -> m Bool+    [A] byteCmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering+    [A] buildChunks :: (MonadIO m, Unbox a) => Int -> Fold m a (StreamK n (MutArray a))+    [D] asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b+    [A] appendWith :: forall m a. (MonadIO m, Unbox a) => (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)+    [A] appendN :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a) -> Fold m a (MutArray a)+    [A] append :: forall m a. (MonadIO m, Unbox a) => m (MutArray a) -> Fold m a (MutArray a)+[D] Streamly.Internal.Data.Array.Stream+    [C] interposeSuffix+        [O] interposeSuffix :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+        [N] interposeSuffix :: forall m a. (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [C] concatRev+        [O] concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+        [N] concatRev :: forall m a. (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [D] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+[C] Streamly.Internal.Data.Array.Generic+    [A] createOf :: MonadIO m => Int -> Fold m a (Array a)+    [A] create :: MonadIO m => Fold m a (Array a)+[C] Streamly.Internal.Data.Array+    [R] ArrayUnsafe+    [D] writeWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] writeNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] unsafePinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] unsafePinnedAsPtr :: MonadIO m => Array a -> (Ptr a -> m b) -> m b+    [A] unsafeCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [D] toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> Stream m a+    [C] splice+        [O] splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)+        [N] splice :: MonadIO m => Array a -> Array a -> m (Array a)+    [A] slicerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Array a)+    [A] sliceIndexerFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Int, Int)+    [D] pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a) => Int -> Int -> Fold m a (Array a)+    [D] pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [D] pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] pinnedCreateOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] pinnedCreate :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] pinnedCompactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] 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))+    [D] nil :: Array a+    [A] lPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [A] lCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) () -> Fold m (Array a) ()+    [A] interposeSuffix :: forall m a. (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a+    [A] intercalateSuffix :: (Monad m, Unbox a) => Array a -> Stream m (Array a) -> Stream m a+    [A] indexReaderFromThenTo :: Unfold m (Int, Int, Int, Array a) a+    [A] indexReader :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+    [A] indexFinder :: (a -> Bool) -> Unfold Identity (Array a) Int+    [D] getSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Array a)+    [R] getIndicesFromThenTo :: Unfold m (Int, Int, Int, Array a) a+    [D] getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+    [D] genSlicesFromLen :: forall m a. (Monad m, Unbox a) => Int -> Int -> Unfold m (Array a) (Int, Int)+    [D] fromStreamDN :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)+    [D] fromStreamD :: forall m a. (MonadIO m, Unbox a) => Stream m a -> m (Array a)+    [A] fromPureStreamN :: Unbox a => Int -> Stream Identity a -> Array a+    [A] fromPtrN :: Int -> Ptr Word8 -> Array Word8+    [A] fromChunksK :: (MonadIO m, Unbox a) => StreamK m (Array a) -> m (Array a)+    [A] fromChunks :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+    [A] fromByteStr :: Ptr Word8 -> Array Word8+    [A] foldChunks :: (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m b+    [A] foldBreakChunksK :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> StreamK m (Array a) -> m (b, StreamK m (Array a))+    [A] foldBreakChunks :: forall m a b. (MonadIO m, Unbox a) => Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))+    [D] flattenArraysRev :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [D] flattenArrays :: forall m a. (MonadIO m, Unbox a) => Stream m (Array a) -> Stream m a+    [C] findIndicesOf+        [O] findIndicesOf :: (a -> Bool) -> Unfold Identity (Array a) Int+        [N] findIndicesOf :: (a -> Bool) -> Array a -> Stream Identity Int+    [A] fPinnedCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] fCompactGE :: (MonadIO m, Unbox a) => Int -> Fold m (Array a) (Array a)+    [A] empty :: Array a+    [A] createWith :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] concatRev :: forall m a. (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+    [A] compactOnByteSuffix :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] compactOnByte :: MonadIO m => Word8 -> Stream m (Array Word8) -> Stream m (Array Word8)+    [A] compactLE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] compactGE :: (MonadIO m, Unbox a) => Int -> Stream m (Array a) -> Stream m (Array a)+    [A] byteEq :: Array a -> Array a -> Bool+    [A] byteCmp :: Array a -> Array a -> Ordering+    [A] buildChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+    [D] bufferChunks :: (MonadIO m, Unbox a) => Stream m a -> m (StreamK m (Array a))+    [D] asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b
+ 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,8 +1,140 @@ # Changelog +## 0.3.1 (May 2026)++* Fixed `Path.fromString` truncation when unicode chars are present.+* Fixed `DirIO.followSymlinks` option not working correctly on macOS.++## 0.3.0 (Sep 2025)++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)++* Add fixities `infixr 5` for `cons` and `consM` functions.+* Fix a bug in Array `Eq` instance when the type is a sum type with+  differently sized constructors.+* lpackArraysChunksOf, compact, writeChunksWith, putChunksWith now take the+  buffer size in number of array elements instead of bytes.++## 0.2.1 (Dec 2023)++* Make the serialization of the unit constructor deterministic.+* Expose `pinnedSerialize` & `deserialize` via `Streamly.Data.Array`.++## 0.2.0 (Nov 2023)++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of API changes in this release. Only a few significant+changes are mentioned here.++### Breaking Changes++* `ParserK` in `Streamly.Data.ParserK` is not implicitly specialized+  to arrays anymore. To adapt to the new code, change `ParserK a m+  b` to `ParserK (Array a) m b` where the `Array` type comes from+  `Streamly.Data.Array`. This change also affected the signatures of+  `parseChunks` and `parseBreakChunks`.+* Changed the signature of 'Streamly.Data.Stream.handle' to make the+  exception handler monadic.+* Behavior change: Exceptions are now rethrown promptly in `bracketIO`.++### Enhancements++* __Serialization__: Added a `Streamly.Data.MutByteArray` module with a+  `Serialize` type class for fast binary serialization. The Data.Array+  module supplies the `serialize` and `deserialize` operations for arrays.+* __Unpinned Arrays__: Unboxed arrays are now created unpinned by default,+  they were created pinned earlier. During IO operations, unpinned arrays+  are automatically copied to pinned memory. When arrays are directly+  passed to IO operations programmers can choose to create them pinned to+  avoid a copy.  To create pinned arrays, use the internal APIs with the+  `pinned*` prefix.+* StreamK now supports native exception handling routines (handle, bracketIO).+  Earlier we had to convert it to the `Stream` type for exception handling.++### Deprecations++See [0.1.0-0.2.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0-0.2.0.txt)+for a full list of deprecations.++### Internal API Changes++* Fold constructor has changed, added a `final` field to support+  finalization and cleanup of a chain of folds. The `extract` field is+  now used only for mapping the fold internal state to fold result for+  scanning purposes. If your fold does not require cleanup you can just use+  your existing `extract` function as `final` as well to adapt to this change.+* Many low level internal modules have been removed, they are entirely+  exported from higher level internal modules. If you were importing any+  of the missing low level modules then import the higher level modules instead.+* Internal module changes:+  * Streamly.Internal.Serialize.FromBytes -> Streamly.Internal.Data.Binary.Parser+  * Streamly.Internal.Serialize.ToBytes ->   Streamly.Internal.Data.Binary.Stream+  * Streamly.Internal.Data.Unbox is now exported via Streamly.Internal.Data.Serialize+  * Streamly.Internal.Data.IORef.Unboxed is now exported via Streamly.Internal.Data.Serialize+ ## 0.1.0 (March 2023) -Also see [streamly-core-0.1.0 API Changelog](/core/docs/ApiChangelogs/0.1.0.txt) or+Also see [streamly-core-0.1.0 API Changelog](https://github.com/composewell/streamly/blob/streamly-0.10.0/core/docs/ApiChangelogs/0.1.0.txt) or https://hackage.haskell.org/package/streamly-core-0.1.0/docs/docs/ApiChangelogs/0.1.0.txt  `streamly` package is split into two packages, (1) `streamly-core` that
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,14 +0,0 @@-{- $setup->>> :m->>> :set -XFlexibleContexts->>> 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.Stream as Stream--}
− src/DocTestDataFold.hs 
@@ -1,28 +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->>> import qualified Streamly.Internal.Data.Fold.Window as FoldW--}
− 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.Array.Mut 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.Array.Generic.Mut.Type 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/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.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.Fold.Window as Window->>> import qualified Streamly.Internal.Data.Parser as Parser->>> import qualified Streamly.Internal.Data.Stream as Stream->>> import qualified Streamly.Internal.Data.Unfold as Unfold->>> import qualified Streamly.Internal.FileSystem.Dir as Dir--}
− src/DocTestDataStreamK.hs 
@@ -1,20 +0,0 @@-{- $setup-->>> :m->>> 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.Stream.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/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)@@ -24,33 +47,8 @@     -- * Write (stderr)     , writeErr     , writeErrChunks--    -- * Deprecated-    , read-    , readChunks     ) where -import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Unfold (Unfold)--import Streamly.Internal.Console.Stdio hiding (read, readChunks) import Prelude hiding (read)---- Same as 'reader'------ @since 0.8.0-{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE read #-}-read :: MonadIO m => Unfold m () Word8-read = reader---- Same as 'chunkReader'------ @since 0.8.0-{-# DEPRECATED readChunks "Please use 'chunkReader' instead" #-}-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m () (Array Word8)-readChunks = chunkReader+import Streamly.Internal.Console.Stdio
+ src/Streamly/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
@@ -29,59 +29,88 @@     -- $overview      -- * The Array Type-      A.Array+      Array +    -- * Pinning & Unpinning+    -- | Arrays are created unpinned by default unless pinned versions of+    -- creation APIs are used. Look for APIs with @pinned@ prefix in+    -- "Streamly.Internal.Data.Array" for some unreleased pinned creation APIs.+    -- If an array is to be sent to the OS without any further modification+    -- then it should be created pinned in the first place instead of pinning+    -- it later. Pinning an unpinned array has a copy overhead. OS interfacing+    -- APIs create a pinned array directly or convert an unpinned array to+    -- pinned array before sending it to the OS.+    , pin+    , unpin+    , isPinned+     -- * Construction     -- | When performance matters, the fastest way to generate an array is-    -- 'writeN'. 'IsList' and 'IsString' instances can be+    -- 'createOf'. 'IsList' and 'IsString' instances can be     -- used to conveniently construct arrays from literal values.     -- 'OverloadedLists' extension or 'fromList' can be used to construct an     -- array from a list literal.  Similarly, 'OverloadedStrings' extension or     -- 'fromList' can be used to construct an array from a string literal. -    -- Pure List APIs-    , A.fromListN-    , A.fromList+    -- ** From Stream+    , createOf+    , create+    , createOfLast -- drop old (ring buffer) -    -- Monadic APIs-    , A.writeN      -- drop new-    , A.write       -- full buffer-    , writeLastN    -- drop old (ring buffer)+    -- ** From List+    , fromListN+    , fromList -    -- * Conversion+    -- * To List     -- 'GHC.Exts.toList' from "GHC.Exts" can be used to convert an array to a     -- list.-    , A.toList+    , toList +    -- * To Stream+    , read+    , readRev+     -- * Unfolds-    , A.reader-    , A.readerRev+    , reader+    , readerRev +    -- * Stream of Arrays+    , chunksOf+    , toParserK+    , parse+    , parseBreak+    , parsePos+    , parseBreakPos+     -- * Casting     , cast     , asBytes      -- * Random Access-    , A.length+    , length     -- , (!!)-    , A.getIndex+    , getIndex -    -- * Unbox Type Class+    -- * Serialization+    , serialize'+    , deserialize++    -- * Re-exports     , Unbox (..)+    , Serialize(..)      -- * Deprecated-    , read-    , readRev+    , pinnedSerialize+    , writeN      -- drop new+    , write       -- full buffer+    , writeLastN     ) where -#include "inline.hs"--import Streamly.Internal.Data.Unfold (Unfold)-import Streamly.Internal.Data.Array as A hiding (read, readRev)+import Streamly.Internal.Data.Array+import Streamly.Internal.Data.MutByteArray (Unbox(..), Serialize(..)) -import Streamly.Internal.Data.Unboxed (Unbox (..))-import Prelude hiding (read)+import Prelude hiding (read, length)  #include "DocTestDataArray.hs" @@ -97,7 +126,7 @@ -- -- Convert array to stream, and fold the stream: ----- >>> fold f arr = Stream.unfold Array.reader arr & Stream.fold f+-- >>> fold f arr = Array.read arr & Stream.fold f -- >>> fold Fold.sum (Array.fromList [1,2,3::Int]) -- 6 --@@ -105,18 +134,17 @@ -- -- Convert array to stream, transform, and fold back to array: ----- >>> amap f arr = Stream.unfold Array.reader arr & fmap f & Stream.fold Array.write+-- >>> amap f arr = Array.read arr & fmap f & Stream.fold (Array.createOf (Array.length arr)) -- >>> amap (+1) (Array.fromList [1,2,3::Int]) -- fromList [2,3,4] -- -- == Pinned and Unpinned Arrays ----- The array type can use both pinned and unpinned memory under the hood.--- Currently the array creation APIs create arrays in pinned memory but it will--- change to unpinned in future releases. The change should not affect users--- functionally unless they are directly accessing the internal memory of the--- array via internal APIs. As of now unpinned arrays can be created using--- unreleased APIs.+-- The array type can use both pinned and unpinned memory under the hood. The+-- default array creation operations create unpinned arrays. IO operations+-- automatically copy an array to pinned memory if the array passed to it is+-- unpinned. Programmers can use appropriate pinned array generation APIs to+-- reduce the copying if it happens. -- -- Unpinned arrays have the advantage of allowing automatic defragmentation of -- the memory by GC. Whereas pinned arrays have the advantage of not requiring@@ -127,42 +155,26 @@ -- -- == Creating Arrays from Non-IO Streams ----- Array creation folds require 'MonadIO' because they need to sequence effects--- in IO streams. To operate on streams in pure Monads like 'Identity' you can--- morph it to IO monad as follows:+-- Array creation folds require 'MonadIO' otherwise the compiler may+-- incorrectly share the array memory thinking it is pure. ----- The 'MonadIO' based folds can be morphed to 'Identity' stream folds:+-- See the 'fromPureStream' unreleased API to generate an array from an+-- Identity stream safely without using MonadIO constraint. ----- >>> purely = Fold.morphInner (Identity . unsafePerformIO)--- >>> Stream.fold (purely Array.write) $ Stream.fromList [1,2,3::Int]--- Identity fromList [1,2,3]+-- >>> fromPureStream = Stream.fold Array.create . Stream.generalizeInner ----- Since it is a pure stream we can use 'unsafePerformIO' to extract the result--- of fold from IO.+-- >>> stream = Stream.fromList [1,2,3] :: Stream Identity Int+-- >>> fromPureStream stream+-- fromList [1,2,3] ----- Alternatively, 'Identity' streams can be generalized to IO streams:+-- == Performance Considerations ----- >>> pure = Stream.fromList [1,2,3] :: Stream Identity Int--- >>> generally = Stream.morphInner (return . runIdentity)--- >>> Stream.fold Array.write (generally pure :: Stream IO Int)--- fromList [1,2,3]+-- 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 -- -- This module is designed to be imported qualified: -- -- >>> import qualified Streamly.Data.Array as Array---- | Same as 'reader'----{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE_NORMAL read #-}-read :: (Monad m, Unbox a) => Unfold m (Array a) a-read = reader---- | Same as 'readerRev'----{-# DEPRECATED readRev "Please use 'readerRev' instead" #-}-{-# INLINE_NORMAL readRev #-}-readRev :: (Monad m, Unbox a) => Unfold m (Array a) a-readRev = readerRev
src/Streamly/Data/Array/Generic.hs view
@@ -15,29 +15,45 @@     ( Array      -- * Construction-    , A.fromListN-    , A.fromList+    , fromListN+    , fromList      -- MonadicAPIs-    , A.writeN-    , A.write+    , createOf+    , create +    -- * Conversion+    , toList+     -- * Streams-    , A.read-    , A.readRev+    , read+    , readRev      -- * Unfolds-    , A.reader+    , reader+    -- , A.readerRev +    -- * Stream of Arrays+    , chunksOf+    , toParserK+    , parse+    , parseBreak+    , parsePos+    , parseBreakPos+     -- * Random Access-    , A.length+    , length+    , getIndex      -- -- * Folding Arrays     -- , A.streamFold     -- , A.fold++    -- * Deprecated+    , writeN+    , write     ) where -import Streamly.Internal.Data.Array.Generic (Array)--import qualified Streamly.Internal.Data.Array.Generic as A+import Streamly.Internal.Data.Array.Generic+import Prelude hiding (length, read)
src/Streamly/Data/Fold.hs view
@@ -7,9 +7,163 @@ -- 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+-- to consume a stream of data and reduce it to a final value, or transform it+-- in a stateful manner using scans. A data stream can be reduced into a stream+-- of folded data elements by folding segments of the stream. Fold combinators+-- can be used to compose multiple folds in parallel or to create a pipeline of+-- folds such that the next fold consumes the result of the previous fold. To+-- run these folds on a stream see 'Streamly.Data.Stream.fold',+-- 'Streamly.Data.Stream.scan', 'Streamly.Data.Stream.postscan',+-- 'Streamly.Data.Stream.scanMaybe', 'Streamly.Data.Stream.foldMany' and other+-- operations accepting 'Fold' type as argument "Streamly.Data.Stream".+--+-- == Reducing a Stream+--+-- A 'Fold' is a consumer of a stream of values. A fold driver (such as+-- 'Streamly.Data.Stream.fold') initializes the fold @accumulator@, runs the+-- fold @step@ function in a loop, processing the input stream one element at a+-- time and accumulating the result. The loop continues until the fold+-- terminates, at which point the accumulated result is returned.+--+-- For example, a 'sum' Fold represents a stream consumer that adds the values+-- in the input stream:+--+-- >>> Stream.fold Fold.sum $ Stream.fromList [1..100]+-- 5050+--+-- Conceptually, a 'Fold' is a data type that mimics a strict left fold+-- ('Data.List.foldl').  The above example is similar to a left fold using+-- @(+)@ as the step and @0@ as the initial value of the accumulator:+--+-- >>> Data.List.foldl' (+) 0 [1..100]+-- 5050+--+-- 'Fold's have an early termination capability e.g. the 'one' fold terminates+-- after consuming one element:+--+-- >>> Stream.fold Fold.one $ Stream.fromList [1..]+-- Just 1+--+-- The above example is similar to the following right fold:+--+-- >>> Prelude.foldr (\x _ -> Just x) Nothing [1..]+-- Just 1+--+-- 'Fold's can be combined together using combinators. For example, to create a+-- fold that sums first two elements in a stream:+--+-- >>> sumTwo = Fold.take 2 Fold.sum+-- >>> Stream.fold sumTwo $ Stream.fromList [1..100]+-- 3+--+-- == Parallel Composition+--+-- Folds can be combined to run in parallel on the same input. For example, to+-- compute the average of numbers in a stream without going through the stream+-- twice:+--+-- >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)+-- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]+-- 50.5+--+-- Folds can be combined so as to partition the input stream over multiple+-- folds. For example, to count even and odd numbers in a stream:+--+-- >>> split n = if even n then Left n else Right n+-- >>> stream = fmap split $ Stream.fromList [1..100]+-- >>> countEven = fmap (("Even " ++) . show) Fold.length+-- >>> countOdd = fmap (("Odd "  ++) . show) Fold.length+-- >>> f = Fold.partition countEven countOdd+-- >>> Stream.fold f stream+-- ("Even 50","Odd 50")+--+-- == Sequential Composition+--+-- Terminating folds can be combined to parse the stream serially such that the+-- first fold consumes the input until it terminates and the second fold+-- consumes the rest of the input until it terminates:+--+-- >>> f = Fold.splitWith (,) (Fold.take 8 Fold.toList) (Fold.takeEndBy (== '\n') Fold.toList)+-- >>> Stream.fold f $ Stream.fromList "header: hello\n"+-- ("header: ","hello\n")+--+-- == Splitting a Stream+--+-- A 'Fold' can be applied repeatedly on a stream to transform it to a stream+-- of fold results. To split a stream on newlines:+--+-- >>> f = Fold.takeEndBy (== '\n') Fold.toList+-- >>> Stream.fold Fold.toList $ Stream.foldMany f $ Stream.fromList "Hello there!\nHow are you\n"+-- ["Hello there!\n","How are you\n"]+--+-- Similarly, we can split the input of a fold too:+--+-- >>> Stream.fold (Fold.many f Fold.toList) $ Stream.fromList "Hello there!\nHow are you\n"+-- ["Hello there!\n","How are you\n"]+--+-- == Folds vs. Streams+--+-- We can often use streams or folds to achieve the same goal. However, streams+-- are required for composition of producers (e.g.+-- 'Data.Stream.append' or 'Data.Stream.mergeBy') whereas folds are+-- required for composition of consumers (e.g.  'splitWith', 'partition'+-- or 'teeWith').+--+-- Streams are producers, transformations on streams happen on the output side:+--+-- >>> :{+--  f stream =+--        Stream.filter odd stream+--      & fmap (+1)+--      & Stream.fold Fold.sum+-- :}+--+-- >>> f $ Stream.fromList [1..100 :: Int]+-- 2550+--+-- Folds are stream consumers with an input stream and an output value, stream+-- transformations on folds happen on the input side:+--+-- >>> :{+-- f =+--        Fold.filter odd+--      $ Fold.lmap (+1)+--      $ Fold.sum+-- :}+--+-- >>> Stream.fold f $ Stream.fromList [1..100 :: Int]+-- 2550+--+-- Notice the similiarity in the definition of @f@ in both cases, the only+-- difference is the composition by @&@ vs @$@ and the use @lmap@ vs @map@, the+-- difference is due to output vs input side transformations.+--+-- == Experimental APIs+-- -- Please refer to "Streamly.Internal.Data.Fold" for more functions that have -- not yet been released. @@ -21,25 +175,38 @@     --     -- $setup -    -- * Overview-    -- $overview--    -- * 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@@ -72,10 +239,6 @@     , toListRev     , toSet     , toIntSet-    , toMap-    , toMapIO-    , demuxToMap-    , demuxToMapIO     , topBy      -- ** Non-Empty Accumulators@@ -97,10 +260,6 @@     , uniqBy     , nub     , nubInt-    , classify-    , classifyIO-    , demux-    , demuxIO      -- ** Terminating Folds     , one@@ -122,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)@@ -173,10 +309,7 @@     , lmap     , lmapM -    -- ** Scanning and Filtering-    , scan-    , postscan-    , scanMaybe+    -- ** Filtering     , filter     , filterM @@ -189,12 +322,36 @@      -- ** Trimming     , take-    -- , takeInterval     , takeEndBy     , takeEndBy_+    , takeEndBySeq+    , takeEndBySeq_ -    -- ** Serial Append+    -- ** 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      -- ** Parallel Distribution     -- | For applicative composition using distribution see@@ -219,18 +376,25 @@     -- ** Unzipping     , unzip -    -- ** Splitting-    , many-    , groupsOf-    -- , intervalsOf+    -- * 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+    , demuxerToMap+    , demuxerToMapIO++    {-+    -- ** Key-value Scanners+    , demuxScan+    , demuxScanIO+    -}+     -- ** Nesting     , concatMap -    -- * Transforming the Monad-    , morphInner-     -- * Deprecated+    , foldlM1'     , chunksOf     , foldr     , drainBy@@ -241,136 +405,29 @@     , variance     , stdDev     , serialWith+    , classify+    , classifyIO+    , demux+    , demuxIO+    , demuxToMap+    , demuxToMapIO+    , scan+    , postscan+    , scanMaybe     ) where  import Prelude-       hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,-               foldl, map, mapM_, sequence, all, any, sum, product, elem,-               notElem, maximum, minimum, head, last, tail, length, null,-               reverse, iterate, init, and, or, lookup, foldr1, (!!),-               scanl, scanl1, replicate, concatMap, mconcat, foldMap, unzip,+       hiding (Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith,+               map, mapM_, sequence, all, any,+               notElem, head, last, tail,+               reverse, iterate, init, and, or, lookup, (!!),+               scanl, scanl1, replicate, concatMap, mconcat, unzip,                span, splitAt, break, mapM, maybe)  import Streamly.Internal.Data.Fold-import Streamly.Internal.Data.Fold.Container  #include "DocTestDataFold.hs"---- $overview------ A 'Fold' is a consumer of a stream of values. A fold driver (such as--- 'Streamly.Data.Stream.fold') initializes the fold @accumulator@, runs the--- fold @step@ function in a loop, processing the input stream one element at a--- time and accumulating the result. The loop continues until the fold--- terminates, at which point the accumulated result is returned.------ For example, a 'sum' Fold represents a stream consumer that adds the values--- in the input stream:------ >>> Stream.fold Fold.sum $ Stream.fromList [1..100]--- 5050------ Conceptually, a 'Fold' is a data type that mimics a strict left fold--- ('Data.List.foldl').  The above example is similar to a left fold using--- @(+)@ as the step and @0@ as the initial value of the accumulator:------ >>> Data.List.foldl' (+) 0 [1..100]--- 5050------ 'Fold's have an early termination capability e.g. the 'one' fold terminates--- after consuming one element:------ >>> Stream.fold Fold.one $ Stream.fromList [1..]--- Just 1------ The above example is similar to the following right fold:------ >>> Prelude.foldr (\x _ -> Just x) Nothing [1..]--- Just 1------ 'Fold's can be combined together using combinators. For example, to create a--- fold that sums first two elements in a stream:------ >>> sumTwo = Fold.take 2 Fold.sum--- >>> Stream.fold sumTwo $ Stream.fromList [1..100]--- 3------ Folds can be combined to run in parallel on the same input. For example, to--- compute the average of numbers in a stream without going through the stream--- twice:------ >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]--- 50.5------ Folds can be combined so as to partition the input stream over multiple--- folds. For example, to count even and odd numbers in a stream:------ >>> split n = if even n then Left n else Right n--- >>> stream = fmap split $ Stream.fromList [1..100]--- >>> countEven = fmap (("Even " ++) . show) Fold.length--- >>> countOdd = fmap (("Odd "  ++) . show) Fold.length--- >>> f = Fold.partition countEven countOdd--- >>> Stream.fold f stream--- ("Even 50","Odd 50")------ Terminating folds can be combined to parse the stream serially such that the--- first fold consumes the input until it terminates and the second fold--- consumes the rest of the input until it terminates:------ >>> f = Fold.splitWith (,) (Fold.take 8 Fold.toList) (Fold.takeEndBy (== '\n') Fold.toList)--- >>> Stream.fold f $ Stream.fromList "header: hello\n"--- ("header: ","hello\n")------ A 'Fold' can be applied repeatedly on a stream to transform it to a stream--- of fold results. To split a stream on newlines:------ >>> f = Fold.takeEndBy (== '\n') Fold.toList--- >>> Stream.fold Fold.toList $ Stream.foldMany f $ Stream.fromList "Hello there!\nHow are you\n"--- ["Hello there!\n","How are you\n"]------ Similarly, we can split the input of a fold too:------ >>> Stream.fold (Fold.many f Fold.toList) $ Stream.fromList "Hello there!\nHow are you\n"--- ["Hello there!\n","How are you\n"]------ = Folds vs. Streams------ We can often use streams or folds to achieve the same goal. However, streams--- are more efficient in composition of producers (e.g.--- 'Data.Stream.append' or 'Data.Stream.mergeBy') whereas folds are--- more efficient in composition of consumers (e.g.  'splitWith', 'partition'--- or 'teeWith').------ Streams are producers, transformations on streams happen on the output side:------ >>> :{---  f stream =---        Stream.filter odd stream---      & fmap (+1)---      & Stream.fold Fold.sum--- :}------ >>> f $ Stream.fromList [1..100 :: Int]--- 2550------ Folds are stream consumers with an input stream and an output value, stream--- transformations on folds happen on the input side:------ >>> :{--- f =---        Fold.filter odd---      $ Fold.lmap (+1)---      $ Fold.sum--- :}------ >>> Stream.fold f $ Stream.fromList [1..100 :: Int]--- 2550------ Notice the similiarity in the definition of @f@ in both cases, the only--- difference is the composition by @&@ vs @$@ and the use @lmap@ vs @map@, the--- difference is due to output vs input side transformations.  -------------------------------------------------------------------------------- -- Deprecated
src/Streamly/Data/MutArray.hs view
@@ -12,7 +12,7 @@ -- contents of a mutable array can be modified in-place. For general -- documentation, please refer to the original module. ----- Please refer to "Streamly.Internal.Data.Array.Mut" for functions that have+-- Please refer to "Streamly.Internal.Data.MutArray" for functions that have -- not yet been released. -- -- For mutable arrays that work on boxed types, not requiring the 'Unbox'@@ -32,36 +32,55 @@     -- * Construction      -- Uninitialized Arrays-    , new-    , newPinned+    , emptyOf+    , emptyOf'      -- From containers     , fromListN     , fromList-    , writeN      -- drop new-    , write       -- full buffer-    -- writeLastN+    , createOf+    , create+    -- createOfLast +    -- * Pinning & Unpinning+    , pin+    , unpin+    , isPinned+     -- * Appending elements     , snoc      -- * Appending streams-    , writeAppendN-    , writeAppend+    , appendN+    , append2      -- * Inplace mutation     , putIndex+    , unsafePutIndex+    , modifyIndex+    , unsafeModifyIndex+    , modify      -- * Random access     , getIndex+    , unsafeGetIndex      -- * Conversion     , toList +    -- * Streams+    , read+    , readRev+     -- * Unfolds     , 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@@ -69,13 +88,33 @@     -- * Size     , length -    -- * Unbox Type Class+    -- * Re-exports     , Unbox (..)++    -- * Deprecated+    , pinnedEmptyOf+    , newPinned+    , new+    , pinnedNew+    , writeN+    , write+    , writeAppendN+    , writeAppend+    , putIndexUnsafe+    , modifyIndexUnsafe+    , getIndexUnsafe+    , append     ) where  import Prelude hiding (length, read)-import Streamly.Internal.Data.Array.Mut-import Streamly.Internal.Data.Unboxed (Unbox (..))+import Streamly.Internal.Data.MutArray+import Streamly.Internal.Data.Unbox (Unbox (..))+import Control.Monad.IO.Class (MonadIO)  #include "DocTestDataMutArray.hs"++{-# DEPRECATED newPinned "Please use emptyOf' instead." #-}+{-# INLINE newPinned #-}+newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+newPinned = emptyOf'
src/Streamly/Data/MutArray/Generic.hs view
@@ -23,27 +23,54 @@       MutArray      -- * Construction-    , writeN+    , emptyOf+    , fromListN+    , fromList+    , createOf+    , create      -- * Appending elements-    , new     , snoc +    -- * Inplace mutation+    , putIndex+    , unsafePutIndex+    , modifyIndex+    , unsafeModifyIndex+    -- , modify++    -- * Random reads+    , getIndex+    , unsafeGetIndex+     -- * Conversion     , toList +    -- * Streams+    , read+    , readRev+     -- * Unfolds     , reader+    -- , readerRev -    -- * Random reads-    , getIndex+    -- * Stream of Arrays+    , chunksOf -    -- * Inplace mutation-    , putIndex-    , modifyIndex+    -- * Size+    , length++    -- * Deprecated+    , new+    , writeN+    , write+    , modifyIndexUnsafe+    , putIndexUnsafe+    , getIndexUnsafe     ) where -import Streamly.Internal.Data.Array.Generic.Mut.Type+import Streamly.Internal.Data.MutArray.Generic+import  Prelude hiding (read, length)  #include "DocTestDataMutArrayGeneric.hs"
+ src/Streamly/Data/MutByteArray.hs view
@@ -0,0 +1,131 @@+-- |+-- Module      : Streamly.Data.MutByteArray+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- 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+-- encoded values. This is an experimental feature which allows JSON like+-- properties with faster speed. For example, you can change the order of+-- constructors or record fields without affecting serialized value.+--+-- == 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' in the+-- "Streamly.Internal.Data.Array" module.+--+-- == Mutable Byte Array+--+-- 'MutByteArray' is a primitive mutable array in the IO monad. 'Unbox' and+-- 'Serialize' type classes use this primitive array to serialize data to and+-- deserialize it from. This array is used to build higher level unboxed+-- array types 'Streamly.Data.MutArray.MutArray' and 'Streamly.Data.Array.Array'.+--+-- == Using 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+-- Haskell data types. Instances of this type class can be derived using+-- 'Generic' or template haskell based deriving functions provided in this+-- module.+--+-- Writing a data type to an array using the array creation routines in+-- "Streamly.Data.Array" or "Streamly.Data.MutArray" (e.g. @writeN@ or+-- @fromListN@), serializes the type to the array. Similarly, reading the data+-- type from the array deserializes it. You can also serialize and deserialize+-- directly to and from a 'MutByteArray', using the type class methods.+--+-- == 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+-- 'deriveSerialize' to derive the instances of the type class automatically+-- and then use the type class methods to serialize and deserialize to and from+-- a 'MutByteArray'.+--+-- See 'Streamly.Internal.Data.Array.pinnedSerialize' and+-- 'Streamly.Internal.Data.Array.deserialize' for 'Array' type based+-- serialization.+--+-- == Comparing serialized values+--+-- When using the `Unbox` type class the same value may result in differing+-- serialized bytes because of unused uninitialized data in case of sum types.+-- Therefore, byte comparison of serialized values is not reliable.+--+-- However, the 'Serialize' type class guarantees that the serialized values+-- are always exactly the same and byte comparison of serialized is reliable.+--+module Streamly.Data.MutByteArray+    (++    -- * Mutable Byte Array+    -- | The standard way to read from or write to a 'MutByteArray' is by using+    -- the 'Unbox' or 'Serialize' type class methods.+      MutByteArray+    , isPinned+    , pin+    , unpin+    , new+    , pinnedNew++    -- * Unbox+    , Unbox(..)+    , deriveUnbox++    -- * Serialize+    , Serialize(..)++    -- ** Instance Config+    , SerializeConfig+    , inlineAddSizeTo+    , inlineSerializeAt+    , inlineDeserializeAt++    -- ** Instance Deriving+    , deriveSerialize+    , deriveSerializeWith+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Streamly.Internal.Data.MutByteArray
src/Streamly/Data/Parser.hs view
@@ -7,13 +7,174 @@ -- Stability   : pre-release -- Portability : GHC ----- Fast, composable stream consumers with ability to terminate, backtrack and--- fail, supporting stream fusion. Parsers are a natural extension of--- "Streamly.Data.Fold". Parsers and folds can be interconverted.+-- Parsers are more powerful but less general than 'Streamly.Data.Fold.Fold's: ----- Please refer to "Streamly.Internal.Data.Parser" for functions that have--- not yet been released.+-- * folds cannot fail but parsers can fail and backtrack.+-- * folds can be composed as a Tee but parsers cannot.+-- * folds can be converted to parsers. --+-- 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.+--+-- == High Performance by Static Parser Fusion+--+-- 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.+--+-- 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 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. As a thumb rule, when recursion+-- or heavy nesting is needed use ParserK.+--+-- === 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+-- >>> import qualified Streamly.Data.Stream as Stream+-- >>> import Control.Applicative ((<|>))+--+-- >>> :{+-- >>> p, p1, p2 :: Monad m => Parser Char m String+-- >>> p1 = Parser.satisfy (== '(') *> p+-- >>> p2 = Parser.fromFold Fold.toList+-- >>> p = p1 <|> p2+-- >>> :}+--+-- 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+--+-- >>> :{+-- >>> 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"+-- Right "hello"+--+-- For this reason Applicative, Alternative or Monad compositions with+-- recursion cannot be used with the 'Parser' type. Alternative type class based+-- operations like 'asum' and Alternative based generic parser combinators use+-- recursion. Similarly, Applicative type class based operations like+-- 'Prelude.sequence' use recursion. Custom implementations of many such+-- operations are provided in this module (e.g. 'some', 'many'), and those+-- should be used instead.+--+-- == Parsers Galore!+--+-- 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,+--+-- * 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>+-- 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.+--+-- == Error Reporting+--+-- 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.+--+-- == Experimental APIs+--+-- Please refer to "Streamly.Internal.Data.Parser" for functions that have not+-- yet been released.+-- module Streamly.Data.Parser     (     -- * Setup@@ -22,16 +183,15 @@     --     -- $setup -    -- * Overview-    -- $overview-     -- * Parser Type       Parser+    , ParseError(..)+    , ParseErrorPos(..)      -- -- * Downgrade to Fold     -- , toFold -    -- * Parsers+    -- * Elementary Parsers     -- ** From Folds     , fromFold @@ -44,7 +204,7 @@     , peek     , eof -    -- ** Element parsers+    -- ** Single Elements      -- All of these can be expressed in terms of either     , one@@ -61,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@@ -78,6 +238,7 @@     -- ** Look Ahead     , lookAhead +    -- * Tokenizing Combinators     -- ** Tokenize by length     -- , takeBetween     , takeEQ@@ -96,8 +257,8 @@      -- ** Grouping     , groupBy-    -- , groupByRolling-    -- , groupByRollingEither+    , groupByRolling+    , groupByRollingEither      -- ** Framing     -- , wordFramedBy@@ -108,12 +269,12 @@     -- -- * Alternative     -- , alt -    -- ** Splitting+    -- * Splitting     , many     , some     , manyTill -    -- ** De-interleaving+    -- * De-interleaving     , deintercalate     ) @@ -123,55 +284,3 @@ import Prelude hiding (dropWhile, takeWhile, filter)  #include "DocTestDataParser.hs"---- $overview------ Several combinators in this module can be many times faster than CPS based--- parsers because of stream fusion. For example,--- 'Streamly.Internal.Data.Parser.many' combinator in this module is much--- faster than the 'Control.Applicative.many' combinator of--- 'Control.Applicative.Alternative' type class used by CPS based parsers.------ The use of 'Alternative' type class, in parsers has another drawback.--- Alternative based parsers use plain Haskell lists to collect the results. In--- a strict Monad like IO, the results are necessarily buffered before they can--- be consumed.  This may not perform optimally in streaming applications--- processing large amounts of data.  Equivalent combinators in this module can--- consume the results of parsing using a 'Fold' or another parser, thus--- providing a scalable and composable consumer.------ Note that these parsers do not report the error context (e.g. line number or--- column). This may be supported in future.------ mtl instances are not provided. If the 'Parser' type is the top most layer--- (which should be the case almost always) you can just use 'fromEffect' to--- execute the lower layer monad effects.------ == Performance Notes------ The 'Parser' type represents a stream consumer by composing state as data--- which enables stream fusion. Stream fusion generates a tight loop without--- any constructor allocations between the stages, providing C like performance--- for the loop. Stream fusion works when multiple functions are combined in a--- pipeline statically. Therefore, the operations in this module must be--- inlined and must not be used recursively to allow for stream fusion. Note--- that operations like 'sequence', and 'asum' that compose pasrers using--- recursion should be avoided with these parsers. You can use these with the--- 'ParserK' module instead.------ Using the 'Parser' type, parsing operations like 'one', 'splitWith' etc.--- degrade quadratically (O(n^2)) when combined many times. If you need to--- combine these operations, say more than 8 times in a single loop, then you--- should consider using the continuation style parser type 'ParserK' instead.--- Also, if you need to use these operations in a recursive loop you should use--- 'ParserK' instead.------ The 'ParserK' type represents a stream consumer by composing function calls,--- therefore, a function call overhead is incurred at each composition. It is--- quite fast in general but may be a few times slower than a fused parser.--- However, it allows for scalable dynamic composition especially parsers can--- be used in recursive calls. Using the 'ParserK' type operations like--- 'splitWith' provide linear (O(n)) performance with respect to the number of--- compositions..------ 'Parser' and 'ParserK' types can be interconverted.
src/Streamly/Data/ParserK.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Data.ParserK -- Copyright   : (c) 2023 Composewell Technologies@@ -6,39 +7,150 @@ -- Stability   : pre-release -- Portability : GHC ----- Parsers using Continuation Passing Style (CPS). See notes in--- "Streamly.Data.Parser" module to know when to use this module.+-- See the general notes about parsing in the "Streamly.Data.Parser" module.+-- This (ParserK) module implements a Continuation Passing Style (CPS) wrapper+-- over the fused "Streamly.Data.Parser" module. It is a faster CPS parser than+-- attoparsec. ----- To run a 'ParserK' use 'Streamly.Data.StreamK.parseChunks'.+-- 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 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.+--+-- == How to parse a stream?+--+-- 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'+--+-- 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.+--+-- 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.+--+-- 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.+--+-- == Applicative  Composition+--+-- 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 = StreamK.toParserK $+--     token (Parser.satisfy isDigit) (Parser.satisfy isAlpha) -- e.g. "9a"+--     <|>+--     token (Parser.satisfy isAlpha) (Parser.satisfy isDigit) -- e.g. "a9"+-- :}+--+-- == 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 <- StreamK.toParserK $+--              Digit <$> Parser.satisfy isDigit+--          <|> Alpha <$> Parser.satisfy isAlpha+--     -- Note: the parse depends on what we parsed already+--     x2 <- StreamK.toParserK $+--           case x1 of+--              Digit _ -> Parser.satisfy isAlpha+--              Alpha _ -> Parser.satisfy isDigit+--     return $ case x1 of+--         Digit x -> [x,x2]+--         Alpha x -> [x,x2]+-- :}+--+-- == Experimental APIs+--+-- Please refer to "Streamly.Internal.Data.ParserK" for functions that have+-- not yet been released.+-- module Streamly.Data.ParserK     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Parser Type       ParserK      -- * Parsers-    -- ** Conversions-    , fromFold-    , fromParser-    -- , toParser -    -- ** Without Input+    -- -- ** Without Input     , fromPure     , fromEffect     , die++    -- * Deprecated+    , fromFold+    , fromParser+    , adapt+    , adaptC+    , adaptCG     )  where  import Control.Monad.IO.Class (MonadIO) import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Unboxed (Unbox)-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.Data.Array (Array)+import qualified Streamly.Internal.Data.Parser as ParserD+import qualified Streamly.Internal.Data.Array as Array -import Streamly.Internal.Data.Parser.ParserK.Type+import Streamly.Internal.Data.ParserK --- | Convert a 'Fold' to a 'ParserK'.---+#include "DocTestDataParserK.hs"++{-# DEPRECATED fromFold "Please use \"Array.toParserK . Parser.fromFold\" instead." #-} {-# INLINE fromFold #-}-fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK a m b-fromFold = fromParser . ParserD.fromFold+fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK (Array a) m b+fromFold = Array.toParserK . ParserD.fromFold++{-# 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 = 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,18 +8,130 @@ -- Stability   : released -- Portability : GHC ----- Fast, composable stream producers with ability to terminate, supporting--- stream fusion.+-- 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. ----- Please refer to "Streamly.Internal.Data.Stream" for more functions that have--- not yet been released.+-- == Console Echo Example ----- For continuation passing style (CPS) stream type, please refer to--- the "Streamly.Data.StreamK" module.+-- 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@@ -37,15 +149,19 @@     -- * Construction     -- | Functions ending in the general shape @b -> Stream m a@.     ---    -- See also: "Streamly.Internal.Data.Stream.Generate" for-    -- @Pre-release@ functions.+    -- Useful Idioms:+    --+    -- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0+    -- >>> fromIndicesM f = Stream.mapM f $ Stream.enumerateFrom 0+    -- >>> fromListM = Stream.sequence . Stream.fromList+    -- >>> fromFoldable = StreamK.toStream . StreamK.fromFoldable+    -- >>> fromFoldableM = Stream.sequence . fromFoldable      -- ** Primitives-    -- | Primitives to construct a stream from pure values or monadic actions.-    -- All other stream construction and generation combinators described later-    -- can be expressed in terms of these primitives. However, the special-    -- versions provided in this module can be much more efficient in most-    -- cases. Users can create custom combinators using these primitives.+    -- | 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@@ -57,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.@@ -103,8 +219,6 @@     -- | Functions ending in the general shape @Stream m a -> m b@ or @Stream m     -- a -> m (b, Stream m a)@     ---    -- See also: "Streamly.Internal.Data.Stream.Eliminate" for @Pre-release@-    -- functions.  -- EXPLANATION: In imperative terms a fold can be considered as a loop over the stream -- that reduces the stream to a single value.@@ -192,7 +306,9 @@      -- ** Parsing     , parse-    -- , parseBreak+    , parseBreak+    , parsePos+    , parseBreakPos      -- ** Lazy Right Folds     -- | Consuming a stream to build a right associated expression, suitable@@ -203,12 +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.-    -- , drain+    -- | 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)+    -- >>> 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@@ -236,8 +397,6 @@     -- * Scanning     -- | Stateful one-to-one transformations.     ---    -- See also: "Streamly.Internal.Data.Stream.Transform" for-    -- @Pre-release@ functions.      {-     -- ** Left scans@@ -252,10 +411,27 @@     , scanl1M'     -} -    -- ** Scanning By 'Fold'-    , scan-    , postscan+    -- ** Scanning By 'Scanl'+    -- | Useful idioms:+    --+    -- >>> 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@@ -264,6 +440,8 @@      -- * Insertion     -- | Add elements to the stream.+    --+    -- >>> insert = Stream.insertBy compare      -- Inserting elements is a special case of interleaving/merging streams.     , insertBy@@ -294,17 +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.-    , scanMaybe+    --+    -- 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 (==))+    -- >>> 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@@ -326,34 +520,42 @@     -- , elemIndices      -- * Combining Two Streams+    -- | Note that these operations are suitable for statically fusing a few+    -- streams, they have a quadratic O(n^2) time complexity wrt to the number+    -- of streams. If you want to compose many streams dynamically using binary+    -- combining operations see the corresponding operations in+    -- "Streamly.Data.StreamK".+    --+    -- When fusing more than two streams it is more efficient if the binary+    -- operations are composed as a balanced tree rather than a right+    -- associative or left associative one e.g.:+    --+    -- >>> s1 = Stream.fromList [1,2] `Stream.append` Stream.fromList [3,4]+    -- >>> s2 = Stream.fromList [4,5] `Stream.append` Stream.fromList [6,7]+    -- >>> s = s1 `Stream.append` s2+     -- ** Appending+    -- | Equivalent of Data.List append:+    --+    -- >>> (++) = Stream.append     , append      -- ** Interleaving-    -- | When interleaving more than two streams you may want to interleave-    -- them pairwise creating a balanced binary merge tree.     , interleave      -- ** Merging-    -- | When merging more than two streams you may want to merging them-    -- pairwise creating a balanced binary merge tree.-    ---    -- Merging of @n@ streams can be performed by combining the streams pair-    -- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used-    -- with 'concatMapWith' it will have O(n^2) performance.-     , mergeBy     , mergeByM      -- ** Zipping-    -- | When zipping more than two streams you may want to zip them-    -- pairwise creating a balanced binary tree.+    -- | Idioms and equivalents of Data.List APIs:     ---    -- Zipping of @n@ streams can be performed by combining the streams pair-    -- wise using 'mergeMapWith' with O(n * log n) time complexity. If used-    -- with 'concatMapWith' it will have O(n^2) performance.+    -- >>> 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@@ -364,86 +566,189 @@     -- 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-    , foldMany -- XXX Rename to foldRepeat+    -- | Idioms and equivalents of Data.List APIs:+    --+    -- >>> 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-    , Array.chunksOf +    -- * Splitting+    -- | 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-    -- | Most of these combinators inhibit stream fusion, therefore, when+    -- | __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     -- stream of arrays before flattening it to a stream of chars.     ---    -- See also: "Streamly.Internal.Data.Stream.Exception" for-    -- @Pre-release@ functions.-     , onException     , handle      -- * 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.+    --+    -- __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.+    --+    -- 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@@ -453,129 +758,33 @@     , runReaderT     , runStateT -    -- -- * Stream Types-    -- $serial-    -- , Interleave-    -- , Zip+    -- * Deprecated+    , scan+    , scanMaybe+    , postscan+    , splitOn+    , unfoldMany+    , intercalate+    , intercalateSuffix+    , chunksOf     ) where -import qualified Streamly.Internal.Data.Array.Type as Array-import Streamly.Internal.Data.Stream.StreamD+import Streamly.Internal.Data.Stream import Prelude        hiding (filter, drop, dropWhile, take, takeWhile, zipWith, foldr,-               foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem,-               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 employs stream fusion for C-like performance when--- looping over data. It represents a stream source or transformation by--- defining a state machine with explicit state, and a step function working on--- the state. A typical stream operation consumes elements from the previous--- state machine in the pipeline, transforms them and yields new values for the--- 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--- 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 or function call--- overheads. However, the stream is represented as a state machine and to--- generate elements it has to navigate the decision tree of the state machine.--- Moreover, the state machine is cranked for each element in the stream. This--- performs extremely well when the number of states are limited. The state--- machine starts getting expensive as the number of states increase. For--- example, generating a million element stream from a list requires a single--- state and is very efficient. However, using fused 'cons' to generate a--- million element stream would be a disaster.------ A typical worst case scenario for fused stream model is a large number of--- `cons` or `append` operations. A few static `cons` or `append` operations--- are very fast and much faster than a CPS style stream. However, if we--- construct a large stream using `cons` it introduces as many states in the--- state machine as the number of elements. If we compose the `cons` as a--- binary tree it will take @n * log n@ time to navigate the tree, and @n * n@--- if it is a right associative composition.------ For quadratic cases of fused stream, after a certain threshold the CPS--- stream would perform much better and exhibit linear performance behavior.--- Operations like 'cons' or 'append'; are typically recursively called to--- construct a lazy infinite stream. For such use cases the CPS style 'StreamK'--- type is provided. CPS streams do not have a state machine that needs to be--- cranked for each element, past state has no effect on the future element--- processing. However, it incurs a function call overhead for each operation--- for each element, which could be very large overhead compared to fused state--- machines even if it has many states and cranks it for each element. But in--- some cases scales tip in favor of the CPS stream. In those cases even though--- CPS has a large constant overhead, it has a linear performance rather than--- quadratic.------ As a general guideline, if you have to use 'cons' or 'append' or operations--- of similar nature, at a large scale, then 'StreamK' should be used. When you--- need to compose the stream dynamically or recursively, then 'StreamK' should--- be used. Typically you would use a dynamically generated 'StreamK' with--- chunks of data which can then be processed by statically fused stream--- pipeline operations.------ 'Stream' and 'StreamK' types can be interconverted. See--- "Streamly.Data.StreamK" module for conversion operations.------ == Useful Idioms------ >>> fromListM = Stream.sequence . Stream.fromList--- >>> fromIndices f = fmap f $ Stream.enumerateFrom 0+{-# 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/Stream/Zip.hs 
@@ -1,16 +0,0 @@--- |--- Module      : Streamly.Data.Stream.Zip--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : released--- Portability : GHC----module Streamly.Data.Stream.Zip-    (-      ZipStream (..)-    )-where--import Streamly.Internal.Data.Stream.Zip
src/Streamly/Data/StreamK.hs view
@@ -8,12 +8,57 @@ -- Stability   : released -- Portability : GHC ----- Streams using Continuation Passing Style (CPS). See the @Stream vs StreamK@--- section in the "Streamly.Data.Stream" module to know when to use this--- module.+-- Streams represented as chains of 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. ----- Please refer to "Streamly.Internal.Data.Stream.StreamK" for more functions--- that have not yet been released.+-- In addition to the combinators in this module, you can use operations from+-- "Streamly.Data.Stream" for StreamK as well by converting StreamK to Stream+-- ('toStream'), and vice-versa ('fromStream'). Please refer to+-- "Streamly.Internal.Data.StreamK" for more functions that have not yet been+-- released.+--+-- For documentation see the corresponding combinators in+-- "Streamly.Data.Stream". Documentation has been omitted in this module unless+-- there is a difference worth mentioning or if the combinator does not exist+-- in "Streamly.Data.Stream".+--+-- == 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: --@@ -36,14 +81,21 @@     --     -- $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.+    -- All other stream construction and generation combinators described later+    -- can be expressed in terms of these primitives. However, the special+    -- versions provided in this module can be much more efficient in some+    -- cases. Users can create custom combinators using these primitives.     , nil     , nilM     , cons@@ -54,12 +106,17 @@     , fromEffect      -- ** From Stream+    -- | Please note that 'Stream' type does not observe any exceptions from+    -- the consumer of the stream whereas 'StreamK' does.     , fromStream     , toStream      -- ** From Containers     , fromFoldable +    -- ** To Containers+    , toList+     -- * Elimination      -- ** Primitives@@ -70,16 +127,24 @@     -- , foldBreak      -- ** Parsing-    -- , parseBreak-    , parseBreakChunks-    , parseChunks+    , toParserK+    , parse+    , parseBreak+    , parsePos+    , parseBreakPos      -- * Transformation     , mapM     , dropWhile     , take+    , filter      -- * Combining Two Streams+    -- | Unlike the operations in "Streamly.Data.Stream", these operations can+    -- be used to dynamically compose large number of streams e.g. using the+    -- 'concatMapWith' and 'mergeMapWith' operations. They have a linear O(n)+    -- time complexity wrt to the number of streams being composed.+     -- ** Appending     , append @@ -103,51 +168,50 @@     -- , CrossStreamK (..)      -- * Stream of streams+    -- | Some useful idioms:+    --+    -- >>> concatFoldableWith f = Prelude.foldr f StreamK.nil+    -- >>> concatMapFoldableWith f g = Prelude.foldr (f . g) StreamK.nil+    -- >>> concatForFoldableWith f xs g = Prelude.foldr (f . g) StreamK.nil xs+    --     , concatEffect-    -- , concatMap+    , concatMap+    , bfsConcatMap+    , fairConcatMap     , concatMapWith++    , concatFor+    , bfsConcatFor+    , fairConcatFor++    , concatForM+    , bfsConcatForM+    , fairConcatForM+     , mergeMapWith      -- * Buffered Operations     , reverse     , sortBy++    -- * Exceptions+    -- | Please note that 'Stream' type does not observe any exceptions from+    -- the consumer of the stream whereas 'StreamK' does.+    , handle++    -- * Resource Management+    -- | Please note that 'Stream' type does not observe any exceptions from+    -- the consumer of the stream whereas 'StreamK' does.+    , bracketIO++    -- * Deprecated+    , parseBreakChunks+    , parseChunks     ) where -import Streamly.Internal.Data.Stream.StreamK-import Prelude hiding (reverse, zipWith, mapM, dropWhile, take)+import Streamly.Internal.Data.StreamK+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]------ == Exception Handling------ There are no native exception handling operations in the StreamK module,--- please convert to 'Stream' type and use exception handling operations from--- "Streamly.Data.Stream".
src/Streamly/Data/Unfold.hs view
@@ -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'. --@@ -53,6 +53,9 @@     , replicateM     , iterateM +    -- ** Enumeration+    , Enumerable (..)+     -- ** From Containers     , fromList     , fromListM@@ -62,6 +65,9 @@     -- ** Mapping on Input     , lmap     , lmapM+    , first+    , second+    , carry      -- ** Mapping on Output     , mapM@@ -83,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
@@ -1,4 +1,4 @@-#include "inline.hs"+{-# LANGUAGE CPP #-}  -- | -- Module      : Streamly.FileSystem.Handle@@ -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@@ -40,6 +44,12 @@ -- module Streamly.FileSystem.Handle     (+     -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Singleton IO     -- | Read or write a single buffer.       getChunk@@ -75,13 +85,13 @@     -- position of the file handle. The stream ends as soon as EOF is     -- encountered. -    -- -- *** Streams-    -- , read-    -- , readWith-    -- , readChunks-    -- , readChunksWith+    -- *** Streams+    , read+    , readWith+    , readChunks+    , readChunksWith -    -- -- *** Unfolds+    -- *** Unfolds     , reader     , readerWith     , chunkReader@@ -98,34 +108,14 @@     , writeChunks       -- * Deprecated-    , read     , readWithBufferOf-    , readChunks     , readChunksWithBufferOf     , writeChunksWithBufferOf     , writeWithBufferOf     ) where -import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Unfold.Type (Unfold)-import System.IO (Handle)--import Streamly.Internal.FileSystem.Handle hiding (read, readChunks)+import Streamly.Internal.FileSystem.Handle import Prelude hiding (read) --- | Same as 'reader'----{-# DEPRECATED read "Please use 'reader' instead" #-}-{-# INLINE read #-}-read :: MonadIO m => Unfold m Handle Word8-read = reader---- | Same as 'chunkReader'----{-# DEPRECATED readChunks "Please use 'chunkReader' instead" #-}-{-# INLINE readChunks #-}-readChunks :: MonadIO m => Unfold m Handle (Array Word8)-readChunks = chunkReader+#include "DocTestFileSystemHandle.hs"
+ src/Streamly/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 @@ -47,13 +63,12 @@ import Prelude hiding (read)  import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream (Stream) import Streamly.Internal.Data.Unfold (Unfold) import Streamly.Internal.Data.Fold (Fold)  import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-    (intersperseMSuffix)+import qualified Streamly.Internal.Data.Stream as Stream 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
@@ -2,572 +2,1178 @@ -- | -- Module      : Streamly.Internal.Data.Array -- Copyright   : (c) 2019 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array-    (-    -- * Setup-    -- $setup--    -- * Design Notes-    -- $design--    -- * The Array Type-      Array--    -- * Construction--    -- Pure List APIs-    , A.fromListN-    , A.fromList--    -- Stream Folds-    , fromStreamN-    , fromStream--    -- Monadic Folds-    , A.writeN      -- drop new-    , A.writeNAligned-    , A.write       -- full buffer-    , writeLastN--    -- * Elimination-    -- ** Conversion-    , A.toList--    -- ** Streams-    , A.read-    , A.readRev--    -- ** Unfolds-    , reader-    , readerUnsafe-    , A.readerRev-    , producer -- experimental--    -- * Random Access-    -- , (!!)-    , getIndex-    , A.unsafeIndex -- XXX Rename to getIndexUnsafe??-    , getIndexRev-    , last           -- XXX getIndexLast?-    , getIndices-    , getIndicesFromThenTo-    -- , getIndicesFrom    -- read from a given position to the end of file-    -- , getIndicesUpto    -- read from beginning up to the given position-    -- , getIndicesFromTo-    -- , getIndicesFromRev  -- read from a given position to the beginning of file-    -- , getIndicesUptoRev  -- read from end to the given position in file--    -- * Size-    , length-    , null--    -- * Search-    , binarySearch-    , findIndicesOf-    -- , findIndexOf-    -- , find--    -- * Casting-    , cast-    , asBytes-    , castUnsafe-    , asPtrUnsafe-    , asCStringUnsafe-    , A.unsafeFreeze -- asImmutableUnsafe?-    , A.unsafeThaw   -- asMutableUnsafe?--    -- * Subarrays-    , getSliceUnsafe-    -- , getSlice-    , genSlicesFromLen-    , getSlicesFromLen-    , splitOn--    -- * Streaming Operations-    , streamTransform--    -- ** Folding-    , streamFold-    , fold--    -- * Deprecated-    , A.toStream-    , A.toStreamRev-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Exception (assert)-import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity)-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Foreign.C.String (CString)-import Foreign.Ptr (castPtr)-import Foreign.Storable (Storable)-import Streamly.Internal.Data.Unboxed-    ( Unbox-    , peekWith-    , sizeOf-    )-import Prelude hiding (length, null, last, map, (!!), read, concat)--import Streamly.Internal.Data.Array.Mut.Type (ArrayUnsafe(..))-import Streamly.Internal.Data.Array.Type-    (Array(..), length, asPtrUnsafe)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple3Fused'(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Mut as MA-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Producer.Type as Producer-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Ring.Unboxed as RB-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Unfold as Unfold--#include "DocTestDataArray.hs"---- $design------ To summarize:------  * Arrays are finite and fixed in size---  * provide /O(1)/ access to elements---  * store only data and not functions---  * provide efficient IO interfacing------ 'Foldable' instance is not provided because the implementation would be much--- less efficient compared to folding via streams.  'Semigroup' and 'Monoid'--- instances should be used with care; concatenating arrays using binary--- operations can be highly inefficient.  Instead, use--- 'Streamly.Internal.Data.Stream.Chunked.toArray' to concatenate N--- arrays at once.------ Each array is one pointer visible to the GC.  Too many small arrays (e.g.--- single byte) are only as good as holding those elements in a Haskell list.--- However, small arrays can be compacted into large ones to reduce the--- overhead. To hold 32GB memory in 32k sized buffers we need 1 million arrays--- if we use one array for each chunk. This is still significant to add--- pressure to GC.------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ | Create an 'Array' from the first N elements of a stream. The array is--- allocated to size N, if the stream terminates before N elements then the--- array may hold less than N elements.------ /Pre-release/-{-# INLINE fromStreamN #-}-fromStreamN :: (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)-fromStreamN n m = do-    when (n < 0) $ error "writeN: negative write count specified"-    A.fromStreamDN n m---- | Create an 'Array' from a stream. This is useful when we want to create a--- single array from a stream of unknown size. 'writeN' is at least twice--- as efficient when the size is already known.------ Note that if the input stream is too large memory allocation for the array--- may fail.  When the stream size is not known, `chunksOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (Array a)-fromStream = Stream.fold A.write--- write m = A.fromStreamD $ D.fromStreamK m------------------------------------------------------------------------------------ Elimination----------------------------------------------------------------------------------{-# INLINE_NORMAL producer #-}-producer :: forall m a. (Monad m, Unbox a) => Producer m (Array a) a-producer =-    Producer.translate A.unsafeThaw A.unsafeFreeze-        $ MA.producerWith (return . unsafeInlineIO)---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a-reader = Producer.simplify producer---- | Unfold an array into a stream, does not check the end of the array, the--- user is responsible for terminating the stream within the array bounds. For--- high performance application where the end condition can be determined by--- a terminating fold.------ Written in the hope that it may be faster than "read", however, in the case--- for which this was written, "read" proves to be faster even though the core--- generated with unsafeRead looks simpler.------ /Pre-release/----{-# INLINE_NORMAL readerUnsafe #-}-readerUnsafe :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a-readerUnsafe = Unfold step inject-    where--    inject (Array contents start end) =-        return (ArrayUnsafe contents end start)--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe contents end p) = do-            -- 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.-            let !x = unsafeInlineIO $ peekWith contents p-            let !p1 = INDEX_NEXT(p,a)-            return $ D.Yield x (ArrayUnsafe contents end p1)---- |------ >>> import qualified Streamly.Internal.Data.Array.Type as Array--- >>> null arr = Array.byteLength arr == 0------ /Pre-release/-{-# INLINE null #-}-null :: Array a -> Bool-null arr = A.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 <$> peekWith (arrContents arr) elemPtr-                else return Nothing---- |------ >>> import qualified Streamly.Internal.Data.Array as Array--- >>> 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------------------------------------------------------------------------------------ | @writeLastN 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 = A.unsafeFreeze <$> Fold step initial done--    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 <- liftIO $ MA.newPinned n-        foldFunc i rh snoc' arr rb--    -- XXX We should write a read unfold for ring.-    snoc' b a = liftIO $ MA.snocUnsafe b a--    foldFunc i-        | i < n = RB.unsafeFoldRingM-        | otherwise = RB.unsafeFoldRingFullM------------------------------------------------------------------------------------ Random Access-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Searching------------------------------------------------------------------------------------ | Given a sorted array, perform a binary search to find the given element.--- Returns the index of the element if found.------ /Unimplemented/-{-# INLINE binarySearch #-}-binarySearch :: a -> Array a -> Maybe Int-binarySearch = undefined---- find/findIndex etc can potentially be implemented more efficiently on arrays--- compared to streams by using SIMD instructions.--- We can also return a bit array instead.---- | Perform a linear search to find all the indices where a given element is--- present in an array.------ /Unimplemented/-findIndicesOf :: (a -> Bool) -> Unfold Identity (Array a) Int-findIndicesOf = undefined--{--findIndexOf :: (a -> Bool) -> Array a -> Maybe Int-findIndexOf p = Unfold.fold Fold.one . Stream.unfold (findIndicesOf p)--find :: (a -> Bool) -> Array a -> Bool-find = Unfold.fold Fold.null . Stream.unfold (findIndicesOf p)--}------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ XXX We can potentially use SIMD instructions on arrays to fold faster.------------------------------------------------------------------------------------ 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)---- | 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.sliceOnSuffix predicate (A.toStreamD arr)--{-# 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 from len =-    Unfold.lmap A.unsafeThaw (MA.genSlicesFromLen from len)---- | 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 getSlicesFromLen #-}-getSlicesFromLen :: forall m a. (Monad m, Unbox a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (Array a) (Array a)-getSlicesFromLen from len =-    fmap A.unsafeFreeze-        $ Unfold.lmap A.unsafeThaw (MA.getSlicesFromLen from len)------------------------------------------------------------------------------------ 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 <$> peekWith (arrContents arr) elemPtr-                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.------ This is the most general operation. We can implement other operations in--- terms of this:------ @--- read =---      let u = lmap (\arr -> (0, length arr - 1)) Unfold.enumerateFromTo---       in Unfold.lmap f (getIndices arr)------ readRev =---      let i = length arr - 1---       in Unfold.lmap f (getIndicesFromThenTo i (i - 1) 0)--- @------ /Pre-release/-{-# INLINE getIndices #-}-getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a-getIndices m =-    let unf = MA.getIndicesD (return . unsafeInlineIO) m-     in Unfold.lmap A.unsafeThaw unf---- | Unfolds @(from, then, to, array)@ generating a finite stream whose first--- element is the array value from the index @from@ and the successive elements--- are from the indices in increments of @then@ up to @to@. Index enumeration--- can occur downwards or upwards depending on whether @then@ comes before or--- after @from@.------ @--- getIndicesFromThenTo =---     let f (from, next, to, arr) =---             (Stream.enumerateFromThenTo from next to, arr)---      in Unfold.lmap f getIndices--- @------ /Unimplemented/-{-# INLINE getIndicesFromThenTo #-}-getIndicesFromThenTo :: Unfold m (Int, Int, Int, Array a) a-getIndicesFromThenTo = undefined------------------------------------------------------------------------------------ Transform via stream operations------------------------------------------------------------------------------------ for non-length changing operations we can use the original length for--- allocation. If we can predict the length then we can use the prediction for--- new allocation. Otherwise we can use a hint and adjust dynamically.--{---- | Transform an array into another array using a pipe transformation--- operation.----{-# INLINE runPipe #-}-runPipe :: (MonadIO m, Unbox a, Unbox b)-    => Pipe m a b -> Array a -> m (Array b)-runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (A.read arr)--}---- XXX For transformations that cannot change the number of elements e.g. "map"--- we can use a predetermined array length.------ | Transform an array into another array using a stream transformation--- operation.------ /Pre-release/-{-# INLINE streamTransform #-}-streamTransform :: forall m a b. (MonadIO m, Unbox a, Unbox b)-    => (Stream m a -> Stream m b) -> Array a -> m (Array b)-streamTransform f arr =-    Stream.fold (A.writeWith (length arr)) $ f (A.read arr)------------------------------------------------------------------------------------ Casts------------------------------------------------------------------------------------ | 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-    Array a -> Array b-castUnsafe (Array contents start end) =-    Array contents start end---- | Cast an @Array a@ into an @Array Word8@.-------asBytes :: Array a -> Array 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) => Array a -> Maybe (Array b)-cast arr =-    let len = A.byteLength arr-        r = len `mod` SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr---- | Convert an array of any type into a null terminated CString Ptr.------ /Unsafe/------ /O(n) Time: (creates a copy of the array)/------ /Pre-release/----asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b-asCStringUnsafe arr act = do-    -- XXX Ensure a pinned allocation here.-    let arr1 = asBytes arr <> A.fromList [0]-    asPtrUnsafe arr1 $ \ptr -> act (castPtr ptr)------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ XXX We can directly use toStreamD and D.fold here.---- | 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 (A.read arr)---- | Fold an array using a stream fold operation.------ /Pre-release/-{-# INLINE streamFold #-}-streamFold :: (Monad m, Unbox a) => (Stream m a -> m b) -> Array a -> m b-streamFold f arr = f (A.read arr)+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Array+    (+    -- * Setup+    -- $setup++    -- * Design Notes+    -- $design++    -- * The Array Type+      module Streamly.Internal.Data.Array.Type++    -- * Construction+    -- Monadic Folds+    , createOfLast++    -- * Random Access+    -- , getIndicesFrom    -- read from a given position to the end of file+    -- , getIndicesUpto    -- read from beginning up to the given position+    -- , getIndicesFromTo+    -- , getIndicesFromRev  -- read from a given position to the beginning of file+    -- , getIndicesUptoRev  -- read from end to the given position in file+    , indexReader+    , indexReaderFromThenTo++    -- * Search+    , binarySearch+    , findIndicesOf+    -- getIndicesOf+    , indexFinder -- see splitOn+    -- , findIndexOf+    -- , find++    -- * Casting+    , cast+    , asBytes+    , unsafeCast+    , asCStringUnsafe -- XXX asCString+    , asCWString++    -- * Subarrays+    -- , sliceOffLen+    , indexerFromLen+    , splitterFromLen++    -- * Streaming Operations+    , streamTransform++    -- * Folding+    , streamFold+    , foldM+    , foldRev++    -- * Stream of Arrays+    , concatSepBy+    , concatEndBy+    , concatEndBySeq++    , compactMax+    , compactMax'+    , compactSepByByte_+    , compactEndByByte_+    , compactEndByLn_++    -- * Parsing Stream of Arrays+    , foldBreakChunks -- Uses Stream, bad perf on break+    , foldChunks+    , foldBreak+    -- , parseBreakChunksK -- XXX uses Parser. parseBreak is better?+    , toParserK+    , parseBreak+    , parseBreakPos+    , parse+    , parsePos++    -- * Serialization+    , encodeAs+    , serialize+    , 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.Proxy (Proxy(..))+import Data.Word (Word8)+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)++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 (ParseError(..), ParseErrorPos(..))+import Streamly.Internal.Data.ParserK.Type+    (ParserK, ParseResult(..), Input(..), Step(..))+import Streamly.Internal.Data.Stream (Stream(..))+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 (unsafeInlineIO)++import qualified Streamly.Internal.Data.Fold.Type as Fold+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.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.Type as StreamK+import qualified Streamly.Internal.Data.Unfold as Unfold++import Streamly.Internal.Data.Array.Type++#include "DocTestDataArray.hs"++-- $design+--+-- To summarize:+--+--  * Arrays are finite and fixed in size+--  * provide /O(1)/ access to elements+--  * store only data and not functions+--  * provide efficient IO interfacing+--+-- 'Foldable' instance is not provided because the implementation would be much+-- less efficient compared to folding via streams.  'Semigroup' and 'Monoid'+-- instances should be used with care; concatenating arrays using binary+-- operations can be highly inefficient.  Instead, use+-- 'Streamly.Internal.Data.Stream.Chunked.toArray' to concatenate N+-- arrays at once.+--+-- Each array is one pointer visible to the GC.  Too many small arrays (e.g.+-- single byte) are only as good as holding those elements in a Haskell list.+-- However, small arrays can be compacted into large ones to reduce the+-- overhead. To hold 32GB memory in 32k sized buffers we need 1 million arrays+-- if we use one array for each chunk. This is still significant to add+-- pressure to GC.++-------------------------------------------------------------------------------+-- Folds with Array as the container+-------------------------------------------------------------------------------++-- 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 createOfLast #-}+createOfLast ::+       (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+createOfLast n = Fold.ifThen (pure (n <= 0)) (Fold.fromPure empty) lst++    where++    lst =+        let f = fmap unsafeFreeze . RB.toMutArray+         in Fold.rmapM f $ RB.createOfLast n++{-# DEPRECATED writeLastN "Please use createOfLast instead." #-}+{-# INLINE writeLastN #-}+writeLastN :: (Unbox a, MonadIO m) => Int -> Fold m a (Array a)+writeLastN = createOfLast++-------------------------------------------------------------------------------+-- Random Access+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Searching+-------------------------------------------------------------------------------++-- | Given a sorted array, perform a binary search to find the given element.+-- Returns the index of the element if found.+--+-- /Unimplemented/+{-# INLINE binarySearch #-}+binarySearch :: a -> Array a -> Maybe Int+binarySearch = undefined++-- find/findIndex etc can potentially be implemented more efficiently on arrays+-- compared to streams by using SIMD instructions.+-- We can also return a bit array instead.++-- Can use SIMD.++-- | Perform a linear search to find all the indices where a given element is+-- present in an array.+--+-- /Unimplemented/+indexFinder :: (a -> Bool) -> Unfold Identity (Array a) Int+indexFinder = undefined++-- |+-- /Unimplemented/+findIndicesOf :: (a -> Bool) -> Array a -> Stream Identity Int+findIndicesOf p = Stream.unfold (indexFinder p)++{-+findIndexOf :: (a -> Bool) -> Array a -> Maybe Int+findIndexOf p = Unfold.fold Fold.one . Stream.unfold (indexFinder p)++find :: (a -> Bool) -> Array a -> Bool+find = Unfold.fold Fold.null . Stream.unfold (indexFinder p)+-}++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- XXX We can potentially use SIMD instructions on arrays to fold faster.++-------------------------------------------------------------------------------+-- Slice+-------------------------------------------------------------------------------++getSliceUnsafe ::+       forall a. Unbox a+    => Int -- ^ starting index+    -> Int -- ^ length of the slice+    -> Array a+    -> Array a+RENAME(getSliceUnsafe,unsafeSliceOffLen)++splitOn :: (Monad m, Unbox a) =>+    (a -> Bool) -> Array a -> Stream m (Array a)+RENAME(splitOn,splitEndBy_)++{-# 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)+indexerFromLen from len =+    Unfold.lmap unsafeThaw (MA.indexerFromLen from len)+RENAME(sliceIndexerFromLen,indexerFromLen)++{-# 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 = 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 splitterFromLen #-}+splitterFromLen, slicerFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (Array a) (Array a)+splitterFromLen from len =+    fmap unsafeFreeze+        $ Unfold.lmap unsafeThaw (MA.splitterFromLen from len)+RENAME(slicerFromLen,splitterFromLen)++{-# 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 = splitterFromLen++-------------------------------------------------------------------------------+-- Random reads and writes+-------------------------------------------------------------------------------++-- | 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.+--+-- This is the most general operation. We can implement other operations in+-- terms of this:+--+-- @+-- read =+--      let u = lmap (\arr -> (0, length arr - 1)) Unfold.enumerateFromTo+--       in Unfold.lmap f (indexReader arr)+--+-- readRev =+--      let i = length arr - 1+--       in Unfold.lmap f (indexReaderFromThenTo i (i - 1) 0)+-- @+--+-- /Pre-release/+{-# INLINE indexReader #-}+indexReader :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+indexReader m =+    let unf = MA.indexReaderWith (return . unsafeInlineIO) m+     in Unfold.lmap unsafeThaw unf++-- XXX DO NOT REMOVE, change the signature to use Stream instead of unfold+{-# DEPRECATED getIndices "Please use getIndices instead." #-}+{-# INLINE getIndices #-}+getIndices :: (Monad m, Unbox a) => Stream m Int -> Unfold m (Array a) a+getIndices = indexReader++-- | Unfolds @(from, then, to, array)@ generating a finite stream whose first+-- element is the array value from the index @from@ and the successive elements+-- are from the indices in increments of @then@ up to @to@. Index enumeration+-- can occur downwards or upwards depending on whether @then@ comes before or+-- after @from@.+--+-- @+-- getIndicesFromThenTo =+--     let f (from, next, to, arr) =+--             (Stream.enumerateFromThenTo from next to, arr)+--      in Unfold.lmap f getIndices+-- @+--+-- /Unimplemented/+{-# INLINE indexReaderFromThenTo #-}+indexReaderFromThenTo :: Unfold m (Int, Int, Int, Array a) a+indexReaderFromThenTo = undefined++-------------------------------------------------------------------------------+-- Transform via stream operations+-------------------------------------------------------------------------------++-- for non-length changing operations we can use the original length for+-- allocation. If we can predict the length then we can use the prediction for+-- new allocation. Otherwise we can use a hint and adjust dynamically.++{-+-- | Transform an array into another array using a pipe transformation+-- operation.+--+{-# INLINE runPipe #-}+runPipe :: (MonadIO m, Unbox a, Unbox b)+    => Pipe m a b -> Array a -> m (Array b)+runPipe f arr = P.runPipe (toArrayMinChunk (length arr)) $ f (read arr)+-}++-- XXX For transformations that cannot change the number of elements e.g. "map"+-- we can use a predetermined array length.+--+-- | Transform an array into another array using a stream transformation+-- operation.+--+-- /Pre-release/+{-# INLINE streamTransform #-}+streamTransform :: forall m a b. (MonadIO m, Unbox a, Unbox b)+    => (Stream m a -> Stream m b) -> Array a -> m (Array b)+streamTransform f arr =+    Stream.fold (createWith (length arr)) $ f (read arr)++-------------------------------------------------------------------------------+-- Casts+-------------------------------------------------------------------------------++-- | 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/+--+unsafeCast, castUnsafe ::+#ifdef DEVBUILD+    Unbox b =>+#endif+    Array a -> Array b+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 = 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) => Array a -> Maybe (Array b)+cast arr =+    let len = byteLength arr+        r = len `mod` SIZE_OF(b)+     in if r /= 0+        then Nothing+        else Just $ unsafeCast arr++-- | Convert an array of any element type into a null terminated CString Ptr.+-- The array is copied to pinned memory.+--+-- /Unsafe/+--+-- /O(n) Time: (creates a copy of the array)/+--+-- /Pre-release/+--+asCStringUnsafe :: Array a -> (CString -> IO b) -> IO b+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 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 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/+{-# INLINE streamFold #-}+streamFold :: (Monad m, Unbox a) => (Stream m a -> m b) -> Array a -> m b+streamFold f arr = f (read arr)++--------------------------------------------------------------------------------+-- Serialization+--------------------------------------------------------------------------------++{-# INLINE encodeAs #-}+encodeAs :: forall a. Serialize a => PinnedState -> a -> Array Word8+encodeAs ps a =+    unsafeInlineIO $ do+        let len = Serialize.addSizeTo 0 a+        mbarr <- MBA.newAs ps len+        off <- Serialize.serializeAt 0 mbarr a+        assertM(len == off)+        pure $ Array mbarr 0 off++-- |+-- Properties:+-- 1. Identity: @deserialize . serialize == id@+-- 2. Encoded equivalence: @serialize a == serialize a@+{-# INLINE serialize #-}+serialize :: Serialize a => a -> Array Word8+serialize = encodeAs Unpinned++-- | Serialize a Haskell type to a pinned byte array. The array is allocated+-- using pinned memory so that it can be used directly in OS APIs for writing+-- to file or sending over the network.+--+-- Properties:+--+-- 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, Array Word8)+deserialize arr =+    let (a, b) = unsafeInlineIO $ MA.deserialize (unsafeThaw arr)+     in (a, unsafeFreeze b)++-------------------------------------------------------------------------------+-- Streams of Arrays+-------------------------------------------------------------------------------++-- TODO: efficiently compare two streams of arrays. Two streams can have chunks+-- of different sizes, we can handle that in the stream comparison abstraction.+-- This could be useful e.g. to fast compare whether two files differ.++-- | Insert the given element between arrays and flatten.+--+-- >>> concatSepBy x = Stream.unfoldEachSepBy x Array.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++-- | Insert the given element after each array and flatten. This is similar to+-- unlines.+--+-- >>> concatEndBy x = Stream.unfoldEachEndBy x Array.reader+--+{-# INLINE_NORMAL concatEndBy #-}+concatEndBy, interposeSuffix :: forall m a. (Monad m, Unbox a)+    => a -> Stream m (Array a) -> Stream m a+-- concatEndBy x = D.unfoldEachEndBy x reader+concatEndBy sep (D.Stream step state) = D.Stream step' (OuterLoop state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (OuterLoop st) = do+        r <- step (adaptState gst) st+        return $ case r of+            D.Yield Array{..} s ->+                D.Skip (InnerLoop s arrContents arrStart arrEnd)+            D.Skip s -> D.Skip (OuterLoop s)+            D.Stop -> D.Stop++    step' _ (InnerLoop st _ p end) | p == end =+        return $ D.Yield sep $ OuterLoop st++    step' _ (InnerLoop st contents p end) = do+        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.+--+-- >>> concatEndBySeq x = Stream.unfoldEachEndBySeq x Array.reader+--+{-# INLINE concatEndBySeq #-}+concatEndBySeq, intercalateSuffix :: (Monad m, Unbox a)+    => Array a -> Stream m (Array a) -> Stream m a+concatEndBySeq x = D.unfoldEachEndBySeq x reader++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 compactMax #-}+compactMax, compactLE :: (MonadIO m, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+compactMax n stream =+    D.map unsafeFreeze $ MA.compactMax n $ D.map unsafeThaw stream++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)+compactMax' n stream =+    D.map unsafeFreeze $ MA.compactMax' n $ D.map unsafeThaw stream++{-# 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 compactSepByByte_ #-}+compactSepByByte_, compactOnByte+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+compactSepByByte_ byte =+    fmap unsafeFreeze . MA.compactSepByByte_ byte . fmap unsafeThaw++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)+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+-------------------------------------------------------------------------------++-- XXX This should not be used for breaking a stream as the D.cons used in+-- reconstructing the stream could be very bad for performance. This can only+-- be useful in folding without breaking.+{-# INLINE_NORMAL foldBreakChunks #-}+foldBreakChunks :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> Stream m (Array a) -> m (b, Stream m (Array a))+foldBreakChunks (Fold fstep initial _ final) stream@(Stream step state) = do+    res <- initial+    case res of+        Fold.Partial fs -> go SPEC state fs+        Fold.Done fb -> return $! (fb, stream)++    where++    {-# INLINE go #-}+    go !_ st !fs = do+        r <- step defState st+        case r of+            Stream.Yield (Array contents start end) s ->+                let fp = Tuple' end contents+                 in goArray SPEC s fp start fs+            Stream.Skip s -> go SPEC s fs+            Stream.Stop -> do+                b <- final fs+                return (b, D.nil)++    goArray !_ s (Tuple' end _) !cur !fs+        | cur == end = do+            go SPEC s fs+    goArray !_ st fp@(Tuple' end contents) !cur !fs = do+        x <- liftIO $ peekAt cur contents+        res <- fstep fs x+        let next = INDEX_NEXT(cur,a)+        case res of+            Fold.Done b -> do+                let arr = Array contents next end+                return $! (b, D.cons arr (D.Stream step st))+            Fold.Partial fs1 -> goArray SPEC st fp next fs1++-- This may be more robust wrt fusion compared to unfoldMany?++-- | Fold a stream of arrays using a 'Fold'. This is equivalent to the+-- following:+--+-- >>> 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.unfoldEach reader++-- | Fold a stream of arrays using a 'Fold' and return the remaining stream.+--+-- The following alternative to this function allows composing the fold using+-- the parser Monad:+--+-- @+-- foldBreakStreamK f s =+--       fmap (first (fromRight undefined))+--     $ StreamK.parseBreakChunks (ParserK.adaptC (Parser.fromFold f)) s+-- @+--+-- We can compare perf and remove this one or define it in terms of that.+--+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+-}+foldBreak (Fold fstep initial _ final) stream = do+    res <- initial+    case res of+        Fold.Partial fs -> go fs stream+        Fold.Done fb -> return (fb, stream)++    where++    {-# INLINE go #-}+    go !fs st = do+        let stop = (, StreamK.nil) <$> final fs+            single a = yieldk a StreamK.nil+            yieldk (Array contents start end) r =+                let fp = Tuple' end contents+                 in goArray fs r fp start+         in StreamK.foldStream defState yieldk single stop st++    goArray !fs st (Tuple' end _) !cur+        | cur == end = do+            go fs st+    goArray !fs st fp@(Tuple' end contents) !cur = do+        x <- liftIO $ peekAt cur contents+        res <- fstep fs x+        let next = INDEX_NEXT(cur,a)+        case res of+            Fold.Done b -> do+                let arr = Array contents next end+                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.+--+{-# INLINE_NORMAL parseBreakD #-}+parseBreakD ::+       forall m a b. (MonadIO m, MonadThrow m, Unbox a)+    => PRD.Parser a m b+    -> D.Stream m (Array.Array a)+    -> m (b, D.Stream m (Array.Array a))+parseBreakD+    (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do++    res <- initial+    case res of+        PRD.IPartial s -> go SPEC state (List []) s+        PRD.IDone b -> return (b, stream)+        PRD.IError err -> throwM $ ParseError err++    where++    -- "backBuf" contains last few items in the stream that we may have to+    -- backtrack to.+    --+    -- XXX currently we are using a dumb list based approach for backtracking+    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.+    -- That will allow us more efficient random back and forth movement.+    go !_ st backBuf !pst = do+        r <- step defState st+        case r of+            D.Yield (Array contents start end) s ->+                gobuf SPEC s backBuf+                    (Tuple' end contents) start pst+            D.Skip s -> go SPEC s backBuf pst+            D.Stop -> do+                b <- extract pst+                return (b, D.nil)++    -- Use strictness on "cur" to keep it unboxed+    gobuf !_ s backBuf (Tuple' end _) !cur !pst+        | cur == end = do+            go SPEC s backBuf pst+    gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do+        x <- liftIO $ peekByteIndex contents cur+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            PR.Partial 0 pst1 ->+                 gobuf SPEC s (List []) fp next pst1+            PR.Partial n pst1 -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let src0 = Prelude.take n (x:getList backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                let !(Array cont1 start end1) = src+                    fp1 = Tuple' end1 cont1+                gobuf SPEC s (List []) fp1 start pst1+            PR.Continue 0 pst1 ->+                gobuf SPEC s (List (x:getList backBuf)) fp next pst1+            PR.Continue n pst1 -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let (src0, buf1) = splitAt n (x:getList backBuf)+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    src = arr0 <> arr1+                let !(Array cont1 start end1) = src+                    fp1 = Tuple' end1 cont1+                gobuf SPEC s (List buf1) fp1 start pst1+            PR.Done 0 b -> do+                let arr = Array contents next end+                return (b, D.cons arr (D.Stream step s))+            PR.Done n b -> do+                assert (n <= Prelude.length (x:getList backBuf)) (return ())+                let src0 = Prelude.take n (x:getList backBuf)+                    -- XXX create the array in reverse instead+                    arr0 = A.fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    -- XXX Use StreamK to avoid adding arbitrary layers of+                    -- constructors every time.+                    str = D.cons arr0 (D.cons arr1 (D.Stream step s))+                return (b, str)+            PR.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.+--+-- '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.+--+-- /Internal/+--+{-# INLINE_NORMAL parseBreakChunksK #-}+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))+parseBreakChunksK (Parser pstep initial extract) stream = do+    res <- initial+    case res of+        IPartial s -> go s stream []+        IDone b -> return (Right b, stream)+        IError err -> return (Left (ParseError err), stream)++    where++    -- "backBuf" contains last few items in the stream that we may have to+    -- backtrack to.+    --+    -- XXX currently we are using a dumb list based approach for backtracking+    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.+    -- That will allow us more efficient random back and forth movement.+    go !pst st backBuf = do+        let stop = goStop pst backBuf -- (, K.nil) <$> extract pst+            single a = yieldk a StreamK.nil+            yieldk arr r = goArray pst backBuf r arr+         in StreamK.foldStream defState yieldk single stop st++    -- Use strictness on "cur" to keep it unboxed+    goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf+    goArray !pst backBuf st (Array contents cur end) = do+        x <- liftIO $ peekAt cur contents+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            Parser.SPartial 1 s ->+                 goArray s [] st (Array contents next end)+            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.SContinue 1 s ->+                goArray s (x:backBuf) st (Array contents next end)+            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.SDone 1 b -> do+                let arr = Array contents next end+                return (Right b, StreamK.cons arr st)+            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+                    -- arr0 = A.fromListRevN n src0+                    arr0 = fromListN n (Prelude.reverse src0)+                    arr1 = Array contents next end+                    str = StreamK.cons arr0 (StreamK.cons arr1 st)+                return (Right b, str)+            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 st)+                return (Left (ParseError err), str)++    -- This is a simplified goArray+    goExtract !pst backBuf (Array _ cur end)+        | cur == end = goStop pst backBuf+    goExtract !pst backBuf (Array contents cur end) = do+        x <- liftIO $ peekAt cur contents+        pRes <- pstep pst x+        let next = INDEX_NEXT(cur,a)+        case pRes of+            Parser.SPartial 0 s ->+                 goExtract s [] (Array contents next end)+            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.SContinue 0 s ->+                goExtract s backBuf (Array contents next end)+            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.SDone 0 b -> do+                let arr = Array contents next end+                return (Right b, StreamK.fromPure arr)+            Parser.SDone m b -> do+                assertM(m <= 0)+                let n = negate m+                assert (n <= Prelude.length backBuf) (return ())+                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.SError err -> do+                let n = Prelude.length backBuf+                    arr0 = fromListN n (Prelude.reverse backBuf)+                    arr1 = Array contents cur end+                    str = StreamK.cons arr0 (StreamK.fromPure arr1)+                return (Left (ParseError err), str)++    -- This is a simplified goExtract+    {-# INLINE goStop #-}+    goStop !pst backBuf = do+        pRes <- extract pst+        case pRes of+            Parser.SPartial _ _ -> error "Bug: parseBreak: Partial in extract"+            Parser.SContinue 0 s ->+                goStop s backBuf+            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.SDone 0 b ->+                return (Right b, StreamK.nil)+            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.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
@@ -4,278 +4,64 @@ -- -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com--- Stability   : pre-release -- Portability : GHC -- module Streamly.Internal.Data.Array.Generic-    ( Array(..)--    -- * Construction-    , nil-    , writeN-    , write-    , writeWith-    , writeLastN--    , fromStreamN-    , fromStream--    , fromListN-    , fromList--    -- * Elimination-    , length-    , reader--    , toList-    , read-    , readRev--    , foldl'-    , foldr-    , streamFold-    , fold+    (+    module Streamly.Internal.Data.Array.Generic.Type -    -- * Random Access-    , getIndexUnsafe-    , getSliceUnsafe-    , strip+    -- * Parsing Stream of Arrays+    , parse+    , parsePos+    , parseBreak+    , parseBreakPos     ) where -#include "inline.hs"--import Control.Monad (replicateM)-import Control.Monad.IO.Class (MonadIO)-import GHC.Base (MutableArray#, RealWorld)-import GHC.IO (unsafePerformIO)-import Text.Read (readPrec)--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Streamly.Internal.Data.Array.Generic.Mut.Type as MArray-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Producer.Type as Producer-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Ring as RB-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D-import qualified Text.ParserCombinators.ReadPrec as ReadPrec--import Prelude hiding (foldr, length, 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 writeN #-}-writeN :: MonadIO m => Int -> Fold m a (Array a)-writeN = fmap unsafeFreeze <$> MArray.writeN--{-# INLINE_NORMAL writeWith #-}-writeWith :: MonadIO m => Int -> Fold m a (Array a)-writeWith elemCount = unsafeFreeze <$> MArray.writeWith elemCount---- | Fold the whole input to a single array.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: MonadIO m => Fold m a (Array a)-write = fmap unsafeFreeze MArray.write------------------------------------------------------------------------------------ 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)+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))+import Streamly.Internal.Data.StreamK.Type (StreamK) -{-# INLINE_NORMAL read #-}-read :: Monad m => Array a -> Stream m a-read arr@Array{..} =-    D.map (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)+import qualified Streamly.Internal.Data.ParserDrivers as Drivers+import qualified Streamly.Internal.Data.ParserK.Type as ParserK -{-# 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+import Prelude hiding (Foldable(..), read)+import Streamly.Internal.Data.Array.Generic.Type  ---------------------------------------------------------------------------------- Elimination - using Folds+-- ParserK Chunked Generic ------------------------------------------------------------------------------- -{-# 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--------------------------------------------------------------------------------+{-# 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 --- | /O(1)/ Lookup the element at the given index. Index starts from 0. Does--- not check the bounds.+-- | Like 'parseBreak' but includes stream position information in the error+-- messages. ----- @since 0.8.0-{-# INLINE getIndexUnsafe #-}-getIndexUnsafe :: Int -> Array a -> a-getIndexUnsafe i arr =-    unsafePerformIO $ MArray.getIndexUnsafe i (unsafeThaw arr)--{-# 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.toMutArray 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/Mut/Type.hs 
@@ -1,796 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnboxedTuples #-}--- |--- Module      : Streamly.Internal.Data.Array.Generic.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Generic.Mut.Type-(-    -- * Type-    -- $arrayNotes-      MutArray (..)--    -- * Constructing and Writing-    -- ** Construction-    , nil--    -- *** Uninitialized Arrays-    , new-    -- , newArrayWith--    -- *** From streams-    , writeNUnsafe-    , writeN-    , writeWith-    , write--    -- , writeRevN-    -- , writeRev--    -- ** From containers-    -- , fromListN-    -- , fromList-    -- , fromStreamDN-    -- , fromStreamD--    -- * Random writes-    , putIndex-    , putIndexUnsafe-    , putIndices-    -- , putFromThenTo-    -- , putFrom -- start writing at the given position-    -- , putUpto -- write from beginning up to the given position-    -- , putFromTo-    -- , putFromRev-    -- , putUptoRev-    , modifyIndexUnsafe-    , modifyIndex-    -- , modifyIndices-    -- , modify-    -- , swapIndices--    -- * Growing and Shrinking-    -- Arrays grow only at the end, though it is possible to grow on both sides-    -- and therefore have a cons as well as snoc. But that will require two-    -- bounds in the array representation.--    -- ** Reallocation-    , realloc-    , uninit--    -- ** Appending elements-    , snocWith-    , snoc-    -- , snocLinear-    -- , snocMay-    , snocUnsafe--    -- ** Appending streams-    -- , writeAppendNUnsafe-    -- , writeAppendN-    -- , writeAppendWith-    -- , writeAppend--    -- ** Truncation-    -- These are not the same as slicing the array at the beginning, they may-    -- reduce the length as well as the capacity of the array.-    -- , truncateWith-    -- , truncate-    -- , truncateExp--    -- * Eliminating and Reading--    -- ** Unfolds-    , reader-    -- , readerRev-    , producerWith -- experimental-    , producer -- experimental--    -- ** To containers-    , toStreamD-    , readRev-    , toStreamK-    -- , toStreamKRev-    , toList--    -- ** Random reads-    , getIndex-    , getIndexUnsafe-    -- , getIndices-    -- , getFromThenTo-    -- , getIndexRev--    -- * Size-    , length--    -- * In-place Mutation Algorithms-    , strip-    -- , reverse-    -- , permute-    -- , partitionBy-    -- , shuffleBy-    -- , divideBy-    -- , mergeBy--    -- * Folding-    -- , foldl'-    -- , foldr-    , cmp-    , eq--    -- * Arrays of arrays-    --  We can add dimensionality parameter to the array type to get-    --  multidimensional arrays. Multidimensional arrays would just be a-    --  convenience wrapper on top of single dimensional arrays.--    -- | Operations dealing with multiple arrays, streams of arrays or-    -- multidimensional array representations.--    -- ** Construct from streams-    -- , chunksOf-    -- , arrayStreamKFromStreamD-    -- , writeChunks--    -- ** Eliminate to streams-    -- , flattenArrays-    -- , flattenArraysRev-    -- , fromArrayStreamK--    -- ** Construct from arrays-    -- get chunks without copying-    , getSliceUnsafe-    , getSlice-    -- , getSlicesFromLenN-    -- , splitAt -- XXX should be able to express using getSlice-    -- , breakOn--    -- ** Appending arrays-    -- , spliceCopy-    -- , spliceWith-    -- , splice-    -- , spliceExp-    , putSliceUnsafe-    -- , appendSlice-    -- , appendSliceFrom--    , clone-    )-where--#include "inline.hs"-#include "assert.hs"--import Control.Monad (when)-import Control.Monad.IO.Class (MonadIO(..))-import GHC.Base-    ( MutableArray#-    , RealWorld-    , copyMutableArray#-    , newArray#-    , readArray#-    , writeArray#-    )-import GHC.IO (IO(..))-import GHC.Int (Int(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer (..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import Prelude hiding (read, length)--#include "DocTestDataMutArrayGeneric.hs"------------------------------------------------------------------------------------ MutArray Data Type----------------------------------------------------------------------------------data MutArray a =-    MutArray-        { arrContents# :: MutableArray# RealWorld a-          -- ^ The internal contents of the array representing the entire array.--        , arrStart :: {-# UNPACK #-}!Int-          -- ^ The starting index of this slice.--        , arrLen :: {-# UNPACK #-}!Int-          -- ^ The length of this slice.--        , arrTrueLen :: {-# UNPACK #-}!Int-          -- ^ This is the true length of the array. Coincidentally, this also-          -- represents the first index beyond the maximum acceptable index of-          -- the array. This is specific to the array contents itself and not-          -- dependent on the slice. This value should not change and is shared-          -- across all the slices.-        }--{-# INLINE bottomElement #-}-bottomElement :: a-bottomElement =-    error-        $ unwords-              [ funcName-              , "This is the bottom element of the array."-              , "This is a place holder and should never be reached!"-              ]--    where--    funcName = "Streamly.Internal.Data.Array.Generic.Mut.Type.bottomElement:"---- XXX Would be nice if GHC can provide something like newUninitializedArray# so--- that we do not have to write undefined or error in the whole array.---- | @new count@ allocates a zero length array that can be extended to hold--- up to 'count' items without reallocating.------ /Pre-release/-{-# INLINE new #-}-new :: MonadIO m => Int -> m (MutArray a)-new n@(I# n#) =-    liftIO-        $ IO-        $ \s# ->-              case newArray# n# bottomElement s# of-                  (# s1#, arr# #) ->-                      let ma = MutArray arr# 0 0 n-                       in (# s1#, ma #)---- XXX This could be pure?---- |--- Definition:------ >>> nil = MutArray.new 0-{-# INLINE nil #-}-nil :: MonadIO m => m (MutArray a)-nil = new 0------------------------------------------------------------------------------------ Random writes------------------------------------------------------------------------------------ | Write the given element to the given index of the array. Does not check if--- the index is out of bounds of the array.------ /Pre-release/-{-# INLINE putIndexUnsafe #-}-putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()-putIndexUnsafe i MutArray {..} x =-    assert (i >= 0 && i < arrLen)-    (liftIO-        $ IO-        $ \s# ->-              case i + arrStart of-                  I# n# ->-                      let s1# = writeArray# arrContents# n# x s#-                       in (# s1#, () #))--invalidIndex :: String -> Int -> a-invalidIndex label i =-    error $ label ++ ": invalid array index " ++ show i---- | /O(1)/ Write the given element at the given index in the array.--- Performs in-place mutation of the array.------ >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))------ /Pre-release/-{-# INLINE putIndex #-}-putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()-putIndex i arr@MutArray {..} x =-    if i >= 0 && i < arrLen-    then putIndexUnsafe i arr x-    else invalidIndex "putIndex" i---- | Write an input stream of (index, value) pairs to an array. Throws an--- error if any index is out of bounds.------ /Pre-release/-{-# INLINE putIndices #-}-putIndices :: MonadIO m-    => MutArray a -> Fold m (Int, a) ()-putIndices arr = FL.foldlM' step (return ())--    where--    step () (i, x) = liftIO (putIndex i arr x)---- | Modify a given index of an array using a modifier function without checking--- the bounds.------ Unsafe because it does not check the bounds of the array.------ /Pre-release/-modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndexUnsafe i MutArray {..} f = do-    liftIO-        $ IO-        $ \s# ->-              case i + arrStart of-                  I# n# ->-                      case readArray# arrContents# n# s# of-                          (# s1#, a #) ->-                              let (a1, b) = f a-                                  s2# = writeArray# arrContents# n# a1 s1#-                               in (# s2#, b #)---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndex i arr@MutArray {..} f = do-    if i >= 0 && i < arrLen-    then modifyIndexUnsafe i arr f-    else invalidIndex "modifyIndex" i------------------------------------------------------------------------------------ Resizing------------------------------------------------------------------------------------ | Reallocates the array according to the new size. This is a safe function--- that always creates a new array and copies the old array into the new one.--- If the reallocated size is less than the original array it results in a--- truncated version of the original array.----realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)-realloc n arr = do-    arr1 <- new n-    let !newLen@(I# newLen#) = min n (arrLen arr)-        !(I# arrS#) = arrStart arr-        !(I# arr1S#) = arrStart arr1-        arrC# = arrContents# arr-        arr1C# = arrContents# arr1-    liftIO-        $ IO-        $ \s# ->-              let s1# = copyMutableArray# arrC# arrS# arr1C# arr1S# newLen# s#-               in (# s1#, arr1 {arrLen = newLen, arrTrueLen = n} #)--reallocWith ::-       MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)-reallocWith label sizer reqSize arr = do-    let oldSize = arrLen arr-        newSize = sizer oldSize-        safeSize = max newSize (oldSize + reqSize)-    assert (newSize >= oldSize + reqSize || error badSize) (return ())-    realloc safeSize arr--    where--    badSize = concat-        [ label-        , ": new array size is less than required size "-        , show reqSize-        , ". Please check the sizing function passed."-        ]------------------------------------------------------------------------------------ Snoc------------------------------------------------------------------------------------ XXX Not sure of the behavior of writeArray# if we specify an index which is--- out of bounds. This comment should be rewritten based on that.--- | Really really unsafe, appends the element into the first array, may--- cause silent data corruption or if you are lucky a segfault if the index--- is out of bounds.------ /Internal/-{-# INLINE snocUnsafe #-}-snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)-snocUnsafe arr@MutArray {..} a = do-    assert (arrStart + arrLen < arrTrueLen) (return ())-    let arr1 = arr {arrLen = arrLen + 1}-    putIndexUnsafe arrLen arr1 a-    return arr1---- NOINLINE to move it out of the way and not pollute the instruction cache.-{-# NOINLINE snocWithRealloc #-}-snocWithRealloc :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)-snocWithRealloc sizer arr x = do-    arr1 <- reallocWith "snocWithRealloc" sizer 1 arr-    snocUnsafe arr1 x---- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of--- the array increases by 1.------ If there is no reserved space available in @arr@ it is reallocated to a size--- in bytes determined by the @sizer oldSize@ function, where @oldSize@ is the--- original size of the array.------ Note that the returned array may be a mutated version of the original array.------ /Pre-release/-{-# INLINE snocWith #-}-snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)-snocWith sizer arr@MutArray {..} x = do-    if arrStart + arrLen < arrTrueLen-    then snocUnsafe arr x-    else snocWithRealloc sizer arr x---- XXX round it to next power of 2.---- | The array is mutated to append an additional element to it. If there is no--- reserved space available in the array then it is reallocated to double the--- original size.------ This is useful to reduce allocations when appending unknown number of--- elements.------ Note that the returned array may be a mutated version of the original array.------ >>> snoc = MutArray.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.------ /Pre-release/-{-# INLINE snoc #-}-snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)-snoc = snocWith (* 2)---- | Make the uninitialized memory in the array available for use extending it--- by the supplied length beyond the current length of the array. The array may--- be reallocated.----{-# INLINE uninit #-}-uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)-uninit arr@MutArray{..} len =-    if arrStart + arrLen + len <= arrTrueLen-    then return $ arr {arrLen = arrLen + len}-    else realloc (arrLen + len) arr------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a-getIndexUnsafe n MutArray {..} =-    liftIO-        $ IO-        $ \s# ->-              let !(I# i#) = arrStart + n-               in readArray# arrContents# i# s#---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: MonadIO m => Int -> MutArray a -> m a-getIndex i arr@MutArray {..} =-    if i >= 0 && i < arrLen-    then getIndexUnsafe i arr-    else invalidIndex "getIndex" i------------------------------------------------------------------------------------ Subarrays------------------------------------------------------------------------------------ XXX We can also get immutable slices.---- | /O(1)/ Slice an array in constant time.------ Unsafe: The bounds of the slice are not checked.------ /Unsafe/------ /Pre-release/-{-# INLINE getSliceUnsafe #-}-getSliceUnsafe-    :: Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSliceUnsafe index len arr@MutArray {..} =-    assert (index >= 0 && len >= 0 && index + len <= arrLen)-        $ arr {arrStart = arrStart + index, arrLen = len}---- | /O(1)/ Slice an array in constant time. Throws an error if the slice--- extends out of the array bounds.------ /Pre-release/-{-# INLINE getSlice #-}-getSlice-    :: Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSlice index len arr@MutArray{..} =-    if index >= 0 && len >= 0 && index + len <= arrLen-    then arr {arrStart = arrStart + index, arrLen = len}-    else error-             $ "getSlice: invalid slice, index "-             ++ show index ++ " length " ++ show len------------------------------------------------------------------------------------ to Lists and streams------------------------------------------------------------------------------------ XXX Maybe faster to create a list explicitly instead of mapM, if list fusion--- does not work well.---- | Convert an 'Array' into a list.------ /Pre-release/-{-# INLINE toList #-}-toList :: MonadIO m => MutArray a -> m [a]-toList arr@MutArray{..} = mapM (`getIndexUnsafe` arr) [0 .. (arrLen - 1)]---- | Use the 'read' unfold instead.------ @toStreamD = D.unfold read@------ We can try this if the unfold has any performance issues.-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: MonadIO m => MutArray a -> D.Stream m a-toStreamD arr@MutArray{..} =-    D.mapM (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)---- Check equivalence with StreamK.fromStream . toStreamD and remove-{-# INLINE toStreamK #-}-toStreamK :: MonadIO m => MutArray a -> K.StreamK m a-toStreamK arr@MutArray{..} = K.unfoldrM step 0--    where--    step i-        | i == arrLen = return Nothing-        | otherwise = do-            x <- getIndexUnsafe i arr-            return $ Just (x, i + 1)--{-# INLINE_NORMAL readRev #-}-readRev :: MonadIO m => MutArray a -> D.Stream m a-readRev arr@MutArray{..} =-    D.mapM (`getIndexUnsafe` arr)-        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ XXX deduplicate this across unboxed array and this module?---- | The default chunk size by which the array creation routines increase the--- size of the array when the array is grown linearly.-arrayChunkSize :: Int-arrayChunkSize = 1024---- | Like 'writeN' but does not check the array bounds when writing. The fold--- driver must not call the step function more than 'n' times otherwise it will--- corrupt the memory and crash. This function exists mainly because any--- conditional in the step function blocks fusion causing 10x performance--- slowdown.------ /Pre-release/-{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)-writeNUnsafe n = Fold step initial return--    where--    initial = FL.Partial <$> new (max n 0)--    step arr x = FL.Partial <$> snocUnsafe arr x---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'Array'.------ >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)------ /Pre-release/-{-# INLINE_NORMAL writeN #-}-writeN :: MonadIO m => Int -> Fold m a (MutArray a)-writeN n = FL.take n $ writeNUnsafe n---- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)--- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)--- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)---- | @writeWith minCount@ folds the whole input to a single array. The array--- starts at a size big enough to hold minCount elements, the size is doubled--- every time the array needs to be grown.------ /Caution! Do not use this on infinite streams./------ /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: MonadIO m => Int -> Fold m a (MutArray a)--- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)-writeWith elemCount = FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ new elemCount--    step arr@(MutArray _ start end bound) x-        | end == bound = do-        let oldSize = end - start-            newSize = max (oldSize * 2) 1-        arr1 <- liftIO $ realloc newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x--    -- extract = liftIO . rightSize-    extract = return---- | Fold the whole input to a single array.------ Same as 'writeWith' using an initial array size of 'arrayChunkSize' bytes--- rounded up to the element size.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: MonadIO m => Fold m a (MutArray a)-write = writeWith arrayChunkSize------------------------------------------------------------------------------------ Unfolds------------------------------------------------------------------------------------ | Resumable unfold of an array.----{-# INLINE_NORMAL producerWith #-}-producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a-producerWith liftio = Producer step inject extract--    where--    {-# INLINE inject #-}-    inject arr = return (arr, 0)--    {-# INLINE extract #-}-    extract (arr, i) =-        return $ arr {arrStart = arrStart arr + i, arrLen = arrLen arr - i}--    {-# INLINE_LATE step #-}-    step (arr, i)-        | assert (arrLen arr >= 0) (i == arrLen arr) = return D.Stop-    step (arr, i) = do-        x <- liftio $ getIndexUnsafe i arr-        return $ D.Yield x (arr, i + 1)---- | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: MonadIO m => Producer m (MutArray a) a-producer = producerWith liftIO---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: MonadIO m => Unfold m (MutArray a) a-reader = Producer.simplify producer------------------------------------------------------------------------------------- Appending arrays------------------------------------------------------------------------------------- | Put a sub range of a source array into a subrange of a destination array.--- This is not safe as it does not check the bounds.-{-# INLINE putSliceUnsafe #-}-putSliceUnsafe :: MonadIO m =>-    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()-putSliceUnsafe src srcStart dst dstStart len = liftIO $ do-    assertM(len <= arrLen dst)-    assertM(len <= arrLen src)-    let !(I# srcStart#) = srcStart + arrStart src-        !(I# dstStart#) = dstStart + arrStart dst-        !(I# len#) = len-    let arrS# = arrContents# src-        arrD# = arrContents# dst-    IO $ \s# -> (# copyMutableArray#-                    arrS# srcStart# arrD# dstStart# len# s#-                , () #)--{-# INLINE clone #-}-clone :: MonadIO m => MutArray a -> m (MutArray a)-clone src = liftIO $ do-    let len = arrLen src-    dst <- new len-    putSliceUnsafe src 0 dst 0 len-    return dst------------------------------------------------------------------------------------ Size----------------------------------------------------------------------------------{-# INLINE length #-}-length :: MutArray a -> Int-length = arrLen------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Compare the length of the arrays. If the length is equal, compare the--- lexicographical ordering of two underlying byte arrays otherwise return the--- result of length comparison.------ /Pre-release/-{-# INLINE cmp #-}-cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering-cmp a1 a2 =-    case compare lenA1 lenA2 of-        EQ -> loop (lenA1 - 1)-        x -> return x--    where--    lenA1 = length a1-    lenA2 = length a2--    loop i-        | i < 0 = return EQ-        | otherwise = do-            v1 <- getIndexUnsafe i a1-            v2 <- getIndexUnsafe i a2-            case compare v1 v2 of-                EQ -> loop (i - 1)-                x -> return x--{-# INLINE eq #-}-eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool-eq a1 a2 =-    if lenA1 == lenA2-    then loop (lenA1 - 1)-    else return False--    where--    lenA1 = length a1-    lenA2 = length a2--    loop i-        | i < 0 = return True-        | otherwise = do-            v1 <- getIndexUnsafe i a1-            v2 <- getIndexUnsafe i a2-            if v1 == v2-            then loop (i - 1)-            else return False--{-# INLINE strip #-}-strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)-strip p arr = liftIO $ do-    let lastIndex = length arr - 1-    indexR <- getIndexR lastIndex -- last predicate failing index-    if indexR < 0-    then nil-    else do-        indexL <- getIndexL 0 -- first predicate failing index-        if indexL == 0 && indexR == lastIndex-        then return arr-        else-           let newLen = indexR - indexL + 1-            in return $ getSliceUnsafe indexL newLen arr--    where--    getIndexR idx-        | idx < 0 = return idx-        | otherwise = do-            r <- getIndexUnsafe idx arr-            if p r-            then getIndexR (idx - 1)-            else return idx--    getIndexL idx = do-        r <- getIndexUnsafe idx arr-        if p r-        then getIndexL (idx + 1)-        else return idx
+ src/Streamly/Internal/Data/Array/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/Mut.hs 
@@ -1,86 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Mut--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Array.Mut-    (-      module Streamly.Internal.Data.Array.Mut.Type-    , splitOn-    , genSlicesFromLen-    , getSlicesFromLen-    , fromStream-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Unfold as Unfold--import Prelude hiding (foldr, length, read, splitAt)-import Streamly.Internal.Data.Array.Mut.Type---- | Split the array into a stream of slices using a predicate. The element--- matching the predicate is dropped.------ /Pre-release/-{-# INLINE splitOn #-}-splitOn :: (MonadIO m, Unbox a) =>-    (a -> Bool) -> MutArray a -> Stream m (MutArray a)-splitOn predicate arr =-    fmap (\(i, len) -> getSliceUnsafe i len arr)-        $ D.sliceOnSuffix predicate (toStreamD arr)---- | Generate a stream of array slice descriptors ((index, len)) of specified--- length from an array, starting from the supplied array index. The last slice--- may be shorter than the requested length depending on the array length.------ /Pre-release/-{-# INLINE genSlicesFromLen #-}-genSlicesFromLen :: forall m a. (Monad m, Unbox a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (MutArray a) (Int, Int)-genSlicesFromLen from len =-    let fromThenTo n = (from, from + len, n - 1)-        mkSlice n i = return (i, min len (n - i))-     in Unfold.lmap length-        $ Unfold.mapM2 mkSlice-        $ Unfold.lmap fromThenTo Unfold.enumerateFromThenTo---- | Generate a stream of slices of specified length from an array, starting--- from the supplied array index. The last slice may be shorter than the--- requested length depending on the array length.------ /Pre-release/-{-# INLINE getSlicesFromLen #-}-getSlicesFromLen :: forall m a. (Monad m, Unbox a)-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> Unfold m (MutArray a) (MutArray a)-getSlicesFromLen from len =-    let mkSlice arr (i, n) = return $ getSliceUnsafe i n arr-     in Unfold.mapM2 mkSlice (genSlicesFromLen from len)---- | Create an 'Array' from a stream. This is useful when we want to create a--- single array from a stream of unknown size. 'writeN' is at least twice--- as efficient when the size is already known.------ Note that if the input stream is too large memory allocation for the array--- may fail.  When the stream size is not known, `chunksOf` followed by--- processing of indvidual arrays in the resulting stream should be preferred.------ /Pre-release/-{-# INLINE fromStream #-}-fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (MutArray a)-fromStream = fromStreamD--- fromStream (Stream m) = P.fold write m
− src/Streamly/Internal/Data/Array/Mut/Stream.hs 
@@ -1,323 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Array.Mut.Stream--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Combinators to efficiently manipulate streams of mutable arrays.----module Streamly.Internal.Data.Array.Mut.Stream-    (-    -- * Generation-      chunksOf--    -- * Compaction-    , packArraysChunksOf-    , SpliceState (..)-    , lpackArraysChunksOf-    , compact-    , compactLE-    , compactEQ-    , compactGE-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (when)-import Data.Bifunctor (first)-import Data.Proxy (Proxy(..))-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Array.Mut.Type (MutArray(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser (ParseError)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Internal.Data.Array.Mut.Type as MArray-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD---- | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ > chunksOf n = Stream.foldMany (MArray.writeN n)------ /Pre-release/-{-# INLINE chunksOf #-}-chunksOf :: (MonadIO m, Unbox a)-    => Int -> Stream m a -> Stream m (MutArray a)-chunksOf = MArray.chunksOf------------------------------------------------------------------------------------ Compact----------------------------------------------------------------------------------data SpliceState s arr-    = SpliceInitial s-    | SpliceBuffering s arr-    | SpliceYielding arr (SpliceState s arr)-    | SpliceFinish---- XXX This can be removed once compactLEFold/compactLE are implemented.------ | This mutates the first array (if it has space) to append values from the--- second one. This would work for immutable arrays as well because an--- immutable array never has space so a new array is allocated instead of--- mutating it.------ | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size. Note that if a single array is bigger than the--- specified size we do not split it to fit. When we coalesce multiple arrays--- if the size would exceed the specified size we do not coalesce therefore the--- actual array size may be less than the specified chunk size.------ @since 0.7.0-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)-packArraysChunksOf n (D.Stream step state) =-    D.Stream step' (SpliceInitial state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (SpliceInitial st) = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Mut.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"-        r <- step gst st-        case r of-            D.Yield arr s -> return $-                let len = MArray.byteLength arr-                 in if len >= n-                    then D.Skip (SpliceYielding arr (SpliceInitial s))-                    else D.Skip (SpliceBuffering s arr)-            D.Skip s -> return $ D.Skip (SpliceInitial s)-            D.Stop -> return D.Stop--    step' gst (SpliceBuffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                let len = MArray.byteLength buf + MArray.byteLength arr-                if len > n-                then return $-                    D.Skip (SpliceYielding buf (SpliceBuffering s arr))-                else do-                    buf' <- if MArray.byteCapacity buf < n-                            then liftIO $ MArray.realloc n buf-                            else return buf-                    buf'' <- MArray.splice buf' arr-                    return $ D.Skip (SpliceBuffering s buf'')-            D.Skip s -> return $ D.Skip (SpliceBuffering s buf)-            D.Stop -> return $ D.Skip (SpliceYielding buf SpliceFinish)--    step' _ SpliceFinish = return D.Stop--    step' _ (SpliceYielding arr next) = return $ D.Yield arr next---- XXX Remove this once compactLEFold is implemented--- lpackArraysChunksOf = Fold.many compactLEFold----{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()-lpackArraysChunksOf n (Fold step1 initial1 extract1) =-    Fold step initial extract--    where--    initial = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.Array.Mut.Type.packArraysChunksOf: the size of "-                 ++ "arrays [" ++ show n ++ "] must be a natural number"--        r <- initial1-        return $ first (Tuple' Nothing) r--    extract (Tuple' Nothing r1) = extract1 r1-    extract (Tuple' (Just buf) r1) = do-        r <- step1 r1 buf-        case r of-            FL.Partial rr -> extract1 rr-            FL.Done _ -> return ()--    step (Tuple' Nothing r1) arr =-            let len = MArray.byteLength arr-             in if len >= n-                then do-                    r <- step1 r1 arr-                    case r of-                        FL.Done _ -> return $ FL.Done ()-                        FL.Partial s -> do-                            extract1 s-                            res <- initial1-                            return $ first (Tuple' Nothing) res-                else return $ FL.Partial $ Tuple' (Just arr) r1--    step (Tuple' (Just buf) r1) arr = do-            let len = MArray.byteLength buf + MArray.byteLength arr-            buf' <- if MArray.byteCapacity buf < len-                    then liftIO $ MArray.realloc (max n len) buf-                    else return buf-            buf'' <- MArray.splice buf' arr--            -- XXX this is common in both the equations of step-            if len >= n-            then do-                r <- step1 r1 buf''-                case r of-                    FL.Done _ -> return $ FL.Done ()-                    FL.Partial s -> do-                        extract1 s-                        res <- initial1-                        return $ first (Tuple' Nothing) res-            else return $ FL.Partial $ Tuple' (Just buf'') r1---- XXX Same as compactLE, to be removed once that is implemented.------ | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ /Internal/-{-# INLINE compact #-}-compact :: (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compact = packArraysChunksOf---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size. Note that if a single array is bigger than the--- specified size we do not split it to fit. When we coalesce multiple arrays--- if the size would exceed the specified size we do not coalesce therefore the--- actual array size may be less than the specified chunk size.------ /Internal/-{-# INLINE_NORMAL compactLEParserD #-}-compactLEParserD ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> ParserD.Parser (MutArray a) m (MutArray a)-compactLEParserD n = ParserD.Parser step initial extract--    where--    nBytes = n * SIZE_OF(a)--    initial =-        return-            $ if n <= 0-              then error-                       $ functionPath-                       ++ ": the size of arrays ["-                       ++ show n ++ "] must be a natural number"-              else ParserD.IPartial Nothing--    step Nothing arr =-        return-            $ let len = MArray.byteLength arr-               in if len >= nBytes-                  then ParserD.Done 0 arr-                  else ParserD.Partial 0 (Just arr)-    step (Just buf) arr =-        let len = MArray.byteLength buf + MArray.byteLength arr-         in if len > nBytes-            then return $ ParserD.Done 1 buf-            else do-                buf1 <--                    if MArray.byteCapacity buf < nBytes-                    then liftIO $ MArray.realloc nBytes buf-                    else return buf-                buf2 <- MArray.splice buf1 arr-                return $ ParserD.Partial 0 (Just buf2)--    extract Nothing = return $ ParserD.Done 0 MArray.nil-    extract (Just buf) = return $ ParserD.Done 0 buf--    functionPath =-        "Streamly.Internal.Data.Array.Mut.Stream.compactLEParserD"---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- minimum specified size. Note that if all the arrays in the stream together--- are smaller than the specified size the resulting array will be smaller than--- the specified size. When we coalesce multiple arrays if the size would exceed--- the specified size we stop coalescing further.------ /Internal/-{-# INLINE_NORMAL compactGEFold #-}-compactGEFold ::-       forall m a. (MonadIO m, Unbox a)-    => Int -> FL.Fold m (MutArray a) (MutArray a)-compactGEFold n = Fold step initial extract--    where--    nBytes = n * SIZE_OF(a)--    initial =-        return-            $ if n < 0-              then error-                       $ functionPath-                       ++ ": the size of arrays ["-                       ++ show n ++ "] must be a natural number"-              else FL.Partial Nothing--    step Nothing arr =-        return-            $ let len = MArray.byteLength arr-               in if len >= nBytes-                  then FL.Done arr-                  else FL.Partial (Just arr)-    step (Just buf) arr = do-        let len = MArray.byteLength buf + MArray.byteLength arr-        buf1 <--            if MArray.byteCapacity buf < len-            then liftIO $ MArray.realloc (max len nBytes) buf-            else return buf-        buf2 <- MArray.splice buf1 arr-        if len >= n-        then return $ FL.Done buf2-        else return $ FL.Partial (Just buf2)--    extract Nothing = return MArray.nil-    extract (Just buf) = return buf--    functionPath =-        "Streamly.Internal.Data.Array.Mut.Stream.compactGEFold"---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ /Internal/-compactLE :: (MonadIO m, Unbox a) =>-    Int -> Stream m (MutArray a) -> Stream m (Either ParseError (MutArray a))-compactLE n = D.parseManyD (compactLEParserD n)---- | Like 'compactLE' but generates arrays of exactly equal to the size--- specified except for the last array in the stream which could be shorter.------ /Unimplemented/-{-# INLINE compactEQ #-}-compactEQ :: -- (MonadIO m, Unbox a) =>-    Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compactEQ _n _xs = undefined-    -- IsStream.fromStreamD $ D.foldMany (compactEQFold n) (IsStream.toStreamD xs)---- | Like 'compactLE' but generates arrays of size greater than or equal to the--- specified except for the last array in the stream which could be shorter.------ /Internal/-{-# INLINE compactGE #-}-compactGE ::-       (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)-compactGE n = D.foldMany (compactGEFold n)
− src/Streamly/Internal/Data/Array/Mut/Type.hs 
@@ -1,2356 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UnboxedTuples #-}--- |--- Module      : Streamly.Internal.Data.Array.Mut.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Pinned and unpinned mutable array for 'Unboxed' types. Fulfils the following--- goals:------ * Random access (array)--- * Efficient storage (unboxed)--- * Performance (unboxed access)--- * Performance - in-place operations (mutable)--- * Performance - GC (pinned, mutable)--- * interfacing with OS (pinned)------ Stream and Fold APIs allow easy, efficient and convenient operations on--- arrays.------ Mutable arrays and file system files are quite similar, they can grow and--- their content is mutable. Therefore, both have similar APIs as well. We--- strive to keep the API consistent for both. Ideally, you should be able to--- replace one with another with little changes to the code.--module Streamly.Internal.Data.Array.Mut.Type-    (-    -- * Type-    -- $arrayNotes-      MutArray (..)-    , MutableByteArray-    , touch-    , pin-    , unpin--    -- * Constructing and Writing-    -- ** Construction-    , nil--    -- *** Uninitialized Arrays-    , newPinned-    , newPinnedBytes-    , newAlignedPinned-    , new-    , newArrayWith--    -- *** Initialized Arrays-    , withNewArrayUnsafe--    -- *** From streams-    , ArrayUnsafe (..)-    , writeNWithUnsafe-    , writeNWith-    , writeNUnsafe-    , writeN-    , writeNAligned--    , writeWith-    , write--    , writeRevN-    -- , writeRev--    -- ** From containers-    , fromListN-    , fromList-    , fromListRevN-    , fromListRev-    , fromStreamDN-    , fromStreamD--    -- * Random writes-    , putIndex-    , putIndexUnsafe-    , putIndices-    -- , putFromThenTo-    -- , putFrom -- start writing at the given position-    -- , putUpto -- write from beginning up to the given position-    -- , putFromTo-    -- , putFromRev-    -- , putUptoRev-    , modifyIndexUnsafe-    , modifyIndex-    , modifyIndices-    , modify-    , swapIndices-    , unsafeSwapIndices--    -- * Growing and Shrinking-    -- Arrays grow only at the end, though it is possible to grow on both sides-    -- and therefore have a cons as well as snoc. But that will require two-    -- bounds in the array representation.--    -- ** Appending elements-    , snocWith-    , snoc-    , snocLinear-    , snocMay-    , snocUnsafe--    -- ** Appending streams-    , writeAppendNUnsafe-    , writeAppendN-    , writeAppendWith-    , writeAppend--    -- * Eliminating and Reading--    -- ** To streams-    , reader-    , readerRevWith-    , readerRev--    -- ** To containers-    , toStreamDWith-    , toStreamDRevWith-    , toStreamKWith-    , toStreamKRevWith-    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toList--    -- experimental-    , producerWith-    , producer--    -- ** Random reads-    , getIndex-    , getIndexUnsafe-    , getIndices-    , getIndicesD-    -- , getFromThenTo-    , getIndexRev--    -- * Memory Management-    , blockSize-    , arrayChunkBytes-    , allocBytesToElemCount-    , realloc-    , resize-    , resizeExp-    , rightSize--    -- * Size-    , length-    , byteLength-    -- , capacity-    , byteCapacity-    , bytesFree--    -- * In-place Mutation Algorithms-    , strip-    , reverse-    , permute-    , partitionBy-    , shuffleBy-    , divideBy-    , mergeBy-    , bubble--    -- * Casting-    , cast-    , castUnsafe-    , asBytes-    , asPtrUnsafe--    -- * Folding-    , foldl'-    , foldr-    , cmp--    -- * Arrays of arrays-    --  We can add dimensionality parameter to the array type to get-    --  multidimensional arrays. Multidimensional arrays would just be a-    --  convenience wrapper on top of single dimensional arrays.--    -- | Operations dealing with multiple arrays, streams of arrays or-    -- multidimensional array representations.--    -- ** Construct from streams-    , chunksOf-    , arrayStreamKFromStreamD-    , writeChunks--    -- ** Eliminate to streams-    , flattenArrays-    , flattenArraysRev-    , fromArrayStreamK--    -- ** Construct from arrays-    -- get chunks without copying-    , getSliceUnsafe-    , getSlice-    -- , getSlicesFromLenN-    , splitAt -- XXX should be able to express using getSlice-    , breakOn--    -- ** Appending arrays-    , spliceCopy-    , spliceWith-    , splice-    , spliceExp-    , spliceUnsafe-    , putSliceUnsafe-    -- , putSlice-    -- , appendSlice-    -- , appendSliceFrom--    -- * Utilities-    , roundUpToPower2-    , memcpy-    , memcmp-    , c_memchr-    )-where--#include "assert.hs"-#include "inline.hs"-#include "ArrayMacros.h"-#include "MachDeps.h"--import Control.Monad (when, void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, (.|.), (.&.))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Foreign.C.Types (CSize(..), CInt(..))-import Foreign.Ptr (plusPtr, minusPtr, nullPtr)-import Streamly.Internal.Data.Unboxed-    ( MutableByteArray(..)-    , Unbox-    , getMutableByteArray#-    , peekWith-    , pokeWith-    , sizeOf-    , touch-    )-import GHC.Base-    ( IO(..)-    , Int(..)-    , byteArrayContents#-    , compareByteArrays#-    , copyMutableByteArray#-    )-import GHC.Base (noinline)-import GHC.Exts (unsafeCoerce#)-import GHC.Ptr (Ptr(..))--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer (..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.StreamK.Type (StreamK)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (arrayPayloadSize, defaultChunkSize)--import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Producer as Producer-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Unboxed as Unboxed-import qualified Prelude--import Prelude hiding-    (length, foldr, read, unlines, splitAt, reverse, truncate)--#include "DocTestDataMutArray.hs"------------------------------------------------------------------------------------ Foreign helpers----------------------------------------------------------------------------------foreign import ccall unsafe "string.h memcpy" c_memcpy-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "string.h memchr" c_memchr-    :: Ptr Word8 -> Word8 -> CSize -> IO (Ptr Word8)--foreign import ccall unsafe "string.h memcmp" c_memcmp-    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt---- | Given an 'Unboxed' type (unused first arg) and a number of bytes, return--- how many elements of that type will completely fit in those bytes.----{-# INLINE bytesToElemCount #-}-bytesToElemCount :: forall a. Unbox a => a -> Int -> Int-bytesToElemCount _ n = n `div` SIZE_OF(a)---- XXX we are converting Int to CSize-memcpy :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()-memcpy dst src len = void (c_memcpy dst src (fromIntegral len))---- XXX we are converting Int to CSize--- return True if the memory locations have identical contents-{-# INLINE memcmp #-}-memcmp :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool-memcmp p1 p2 len = do-    r <- c_memcmp p1 p2 (fromIntegral len)-    return $ r == 0------------------------------------------------------------------------------------ MutArray Data Type------------------------------------------------------------------------------------ $arrayNotes------ We can use an 'Unboxed' constraint in the MutArray type and the constraint--- can be automatically provided to a function that pattern matches on the--- MutArray type. However, it has huge performance cost, so we do not use it.--- Investigate a GHC improvement possiblity.---- | An unboxed mutable array. An array is created with a given length--- and capacity. Length is the number of valid elements in the array.  Capacity--- is the maximum number of elements that the array can be expanded to without--- having to reallocate the memory.------ The elements in the array can be mutated in-place without changing the--- reference (constructor). However, the length of the array cannot be mutated--- in-place.  A new array reference is generated when the length changes.  When--- the length is increased (upto the maximum reserved capacity of the array),--- the array is not reallocated and the new reference uses the same underlying--- memory as the old one.------ Several routines in this module allow the programmer to control the capacity--- of the array. The programmer can control the trade-off between memory usage--- and performance impact due to reallocations when growing or shrinking the--- array.----data MutArray a =-#ifdef DEVBUILD-    Unbox a =>-#endif-    -- The array is a range into arrContents. arrContents may be a superset of-    -- the slice represented by the array. All offsets are in bytes.-    MutArray-    { arrContents :: {-# UNPACK #-} !MutableByteArray-    , arrStart :: {-# UNPACK #-} !Int  -- ^ index into arrContents-    , arrEnd   :: {-# UNPACK #-} !Int    -- ^ index into arrContents-                                       -- Represents the first invalid index of-                                       -- the array.-    , arrBound :: {-# UNPACK #-} !Int    -- ^ first invalid index of arrContents.-    }------------------------------------------------------------------------------------ Pinning & Unpinning----------------------------------------------------------------------------------{-# INLINE pin #-}-pin :: MutArray a -> IO (MutArray a)-pin arr@MutArray{..} = do-    contents <- Unboxed.pin arrContents-    return $ arr {arrContents = contents}--{-# INLINE unpin #-}-unpin :: MutArray a -> IO (MutArray a)-unpin arr@MutArray{..} = do-    contents <- Unboxed.unpin arrContents-    return $ arr {arrContents = contents}------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ XXX Change the names to use "new" instead of "newArray". That way we can use--- the same names for managed file system objects as well. For unmanaged ones--- we can use open/create etc as usual.------ A new array is similar to "touch" creating a zero length file. An mmapped--- array would be similar to a sparse file with holes. TBD: support mmapped--- files and arrays.---- GHC always guarantees word-aligned memory, alignment is important only when--- we need more than that.  See stg_newAlignedPinnedByteArrayzh and--- allocatePinned in GHC source.---- | @newArrayWith allocator alignment count@ allocates a new array of zero--- length and with a capacity to hold @count@ elements, using @allocator--- size alignment@ as the memory allocator function.------ Alignment must be greater than or equal to machine word size and a power of--- 2.------ Alignment is ignored if the allocator allocates unpinned memory.------ /Pre-release/-{-# INLINE newArrayWith #-}-newArrayWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> Int -> m MutableByteArray) -> Int -> Int -> m (MutArray a)-newArrayWith alloc alignSize count = do-    let size = max (count * SIZE_OF(a)) 0-    contents <- alloc size alignSize-    return $ MutArray-        { arrContents = contents-        , arrStart = 0-        , arrEnd   = 0-        , arrBound = size-        }--nil ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a-nil = MutArray Unboxed.nil 0 0 0----- | Allocates a pinned empty array that can hold 'count' items.  The memory of--- the array is uninitialized and the allocation is aligned as per the--- 'Unboxed' instance of the type.------ /Pre-release/-{-# INLINE newPinnedBytes #-}-newPinnedBytes :: MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    Int -> m (MutArray a)-newPinnedBytes bytes = do-    contents <- liftIO $ Unboxed.newPinnedBytes bytes-    return $ MutArray-        { arrContents = contents-        , arrStart = 0-        , arrEnd   = 0-        , arrBound = bytes-        }---- | Like 'newArrayWith' but using an allocator is a pinned memory allocator and--- the alignment is dictated by the 'Unboxed' instance of the type.------ /Internal/-{-# INLINE newAlignedPinned #-}-newAlignedPinned :: (MonadIO m, Unbox a) => Int -> Int -> m (MutArray a)-newAlignedPinned =-    newArrayWith (\s a -> liftIO $ Unboxed.newAlignedPinnedBytes s a)---- XXX can unaligned allocation be more efficient when alignment is not needed?------ | Allocates an empty pinned array that can hold 'count' items.  The memory of--- the array is uninitialized and the allocation is aligned as per the 'Unboxed'--- instance of the type.----{-# INLINE newPinned #-}-newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)-newPinned =-    newArrayWith-        (\s _ -> liftIO $ Unboxed.newPinnedBytes s)-        (error "newPinned: alignSize is not used")---- | Allocates an empty unpinned array that can hold 'count' items.  The memory--- of the array is uninitialized.----{-# INLINE new #-}-new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)-new =-    newArrayWith-        (\s _ -> liftIO $ Unboxed.newUnpinnedBytes s)-        (error "new: alignment is not used in unpinned arrays.")---- XXX This should create a full length uninitialzed array so that the pointer--- can be used.---- | Allocate a pinned MutArray of the given size and run an IO action passing--- the array start pointer.------ /Internal/-{-# INLINE withNewArrayUnsafe #-}-withNewArrayUnsafe ::-       (MonadIO m, Unbox a) => Int -> (Ptr a -> m ()) -> m (MutArray a)-withNewArrayUnsafe count f = do-    arr <- newPinned count-    asPtrUnsafe arr-        $ \p -> f p >> return arr------------------------------------------------------------------------------------ Random writes------------------------------------------------------------------------------------ | Write the given element to the given index of the array. Does not check if--- the index is out of bounds of the array.------ /Pre-release/-{-# INLINE putIndexUnsafe #-}-putIndexUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> MutArray a -> a -> m ()-putIndexUnsafe i MutArray{..} x = do-    let index = INDEX_OF(arrStart, i, a)-    assert (i >= 0 && INDEX_VALID(index, arrEnd, a)) (return ())-    liftIO $ pokeWith arrContents index x--invalidIndex :: String -> Int -> a-invalidIndex label i =-    error $ label ++ ": invalid array index " ++ show i---- | /O(1)/ Write the given element at the given index in the array.--- Performs in-place mutation of the array.------ >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))--- >>> f = MutArray.putIndices--- >>> putIndex ix arr val = Stream.fold (f arr) (Stream.fromPure (ix, val))----{-# INLINE putIndex #-}-putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()-putIndex i MutArray{..} x = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ pokeWith arrContents index x-    else invalidIndex "putIndex" i---- | Write an input stream of (index, value) pairs to an array. Throws an--- error if any index is out of bounds.------ /Pre-release/-{-# INLINE putIndices #-}-putIndices :: forall m a. (MonadIO m, Unbox a)-    => MutArray a -> Fold m (Int, a) ()-putIndices arr = FL.foldlM' step (return ())--    where--    step () (i, x) = liftIO (putIndex i arr x)---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndexUnsafe :: forall m a b. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndexUnsafe i MutArray{..} f = liftIO $ do-        let index = INDEX_OF(arrStart,i,a)-        assert (i >= 0 && INDEX_NEXT(index,a) <= arrEnd) (return ())-        r <- peekWith arrContents index-        let (x, res) = f r-        pokeWith arrContents index x-        return res---- | Modify a given index of an array using a modifier function.------ /Pre-release/-modifyIndex :: forall m a b. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> (a -> (a, b)) -> m b-modifyIndex i MutArray{..} f = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ do-        r <- peekWith arrContents index-        let (x, res) = f r-        pokeWith arrContents index x-        return res-    else invalidIndex "modifyIndex" i----- | Modify the array indices generated by the supplied stream.------ /Pre-release/-{-# INLINE modifyIndices #-}-modifyIndices :: forall m a . (MonadIO m, Unbox a)-    => MutArray a -> (Int -> a -> a) -> Fold m Int ()-modifyIndices arr f = FL.foldlM' step initial--    where--    initial = return ()--    step () i =-        let f1 x = (f i x, ())-         in modifyIndex i arr f1---- | Modify each element of an array using the supplied modifier function.------ /Pre-release/-modify :: forall m a. (MonadIO m, Unbox a)-    => MutArray a -> (a -> a) -> m ()-modify MutArray{..} f = liftIO $-    go arrStart--    where--    go i =-        when (INDEX_VALID(i,arrEnd,a)) $ do-            r <- peekWith arrContents i-            pokeWith arrContents i (f r)-            go (INDEX_NEXT(i,a))---- XXX We could specify the number of bytes to swap instead of Proxy. Need--- to ensure that the memory does not overlap.-{-# INLINE swapArrayByteIndices #-}-swapArrayByteIndices ::-       forall a. Unbox a-    => Proxy a-    -> MutableByteArray-    -> Int-    -> Int-    -> IO ()-swapArrayByteIndices _ arrContents i1 i2 = do-    r1 <- peekWith arrContents i1-    r2 <- peekWith arrContents i2-    pokeWith arrContents i1 (r2 :: a)-    pokeWith arrContents i2 (r1 :: a)---- | Swap the elements at two indices without validating the indices.------ /Unsafe/: This could result in memory corruption if indices are not valid.------ /Pre-release/-{-# INLINE unsafeSwapIndices #-}-unsafeSwapIndices :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> MutArray a -> m ()-unsafeSwapIndices i1 i2 MutArray{..} = liftIO $ do-        let t1 = INDEX_OF(arrStart,i1,a)-            t2 = INDEX_OF(arrStart,i2,a)-        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2---- | Swap the elements at two indices.------ /Pre-release/-swapIndices :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> MutArray a -> m ()-swapIndices i1 i2 MutArray{..} = liftIO $ do-        let t1 = INDEX_OF(arrStart,i1,a)-            t2 = INDEX_OF(arrStart,i2,a)-        when (i1 < 0 || INDEX_INVALID(t1,arrEnd,a))-            $ invalidIndex "swapIndices" i1-        when (i2 < 0 || INDEX_INVALID(t2,arrEnd,a))-            $ invalidIndex "swapIndices" i2-        swapArrayByteIndices (Proxy :: Proxy a) arrContents t1 t2------------------------------------------------------------------------------------ Rounding------------------------------------------------------------------------------------ XXX Should we use bitshifts in calculations or it gets optimized by the--- compiler/processor itself?------ | The page or block size used by the GHC allocator. Allocator allocates at--- least a block and then allocates smaller allocations from within a block.-blockSize :: Int-blockSize = 4 * 1024---- | Allocations larger than 'largeObjectThreshold' are in multiples of block--- size and are always pinned. The space beyond the end of a large object up to--- the end of the block is unused.-largeObjectThreshold :: Int-largeObjectThreshold = (blockSize * 8) `div` 10---- XXX Should be done only when we are using the GHC allocator.--- | Round up an array larger than 'largeObjectThreshold' to use the whole--- block.-{-# INLINE roundUpLargeArray #-}-roundUpLargeArray :: Int -> Int-roundUpLargeArray size =-    if size >= largeObjectThreshold-    then-        assert-            (blockSize /= 0 && ((blockSize .&. (blockSize - 1)) == 0))-            ((size + blockSize - 1) .&. negate blockSize)-    else size--{-# INLINE isPower2 #-}-isPower2 :: Int -> Bool-isPower2 n = n .&. (n - 1) == 0--{-# INLINE roundUpToPower2 #-}-roundUpToPower2 :: Int -> Int-roundUpToPower2 n =-#if WORD_SIZE_IN_BITS == 64-    1 + z6-#else-    1 + z5-#endif--    where--    z0 = n - 1-    z1 = z0 .|. z0 `shiftR` 1-    z2 = z1 .|. z1 `shiftR` 2-    z3 = z2 .|. z2 `shiftR` 4-    z4 = z3 .|. z3 `shiftR` 8-    z5 = z4 .|. z4 `shiftR` 16-    z6 = z5 .|. z5 `shiftR` 32---- | @allocBytesToBytes elem allocatedBytes@ returns the array size in bytes--- such that the real allocation is less than or equal to @allocatedBytes@,--- unless @allocatedBytes@ is less than the size of one array element in which--- case it returns one element's size.----{-# INLINE allocBytesToBytes #-}-allocBytesToBytes :: forall a. Unbox a => a -> Int -> Int-allocBytesToBytes _ n = max (arrayPayloadSize n) (SIZE_OF(a))---- | Given an 'Unboxed' type (unused first arg) and real allocation size--- (including overhead), return how many elements of that type will completely--- fit in it, returns at least 1.----{-# INLINE allocBytesToElemCount #-}-allocBytesToElemCount :: Unbox a => a -> Int -> Int-allocBytesToElemCount x bytes =-    let n = bytesToElemCount x (allocBytesToBytes x bytes)-     in assert (n >= 1) n---- | The default chunk size by which the array creation routines increase the--- size of the array when the array is grown linearly.-arrayChunkBytes :: Int-arrayChunkBytes = 1024------------------------------------------------------------------------------------ Resizing------------------------------------------------------------------------------------ | Round the second argument down to multiples of the first argument.-{-# INLINE roundDownTo #-}-roundDownTo :: Int -> Int -> Int-roundDownTo elemSize size = size - (size `mod` elemSize)---- XXX See if resizing can be implemented by reading the old array as a stream--- and then using writeN to the new array.------ NOTE: we are passing elemSize explicitly to avoid an Unboxed constraint.--- Since this is not inlined Unboxed consrraint leads to dictionary passing--- which complicates some inspection tests.----{-# NOINLINE reallocExplicit #-}-reallocExplicit :: Int -> Int -> MutArray a -> IO (MutArray a)-reallocExplicit elemSize newCapacityInBytes MutArray{..} = do-    assertM(arrEnd <= arrBound)--    -- Allocate new array-    let newCapMaxInBytes = roundUpLargeArray newCapacityInBytes-    contents <- Unboxed.newPinnedBytes newCapMaxInBytes-    let !(MutableByteArray mbarrFrom#) = arrContents-        !(MutableByteArray mbarrTo#) = contents--    -- Copy old data-    let oldStart = arrStart-        !(I# oldStartInBytes#) = oldStart-        oldSizeInBytes = arrEnd - oldStart-        newCapInBytes = roundDownTo elemSize newCapMaxInBytes-        !newLenInBytes@(I# newLenInBytes#) = min oldSizeInBytes newCapInBytes-    assert (oldSizeInBytes `mod` elemSize == 0) (return ())-    assert (newLenInBytes >= 0) (return ())-    assert (newLenInBytes `mod` elemSize == 0) (return ())-    IO $ \s# -> (# copyMutableByteArray# mbarrFrom# oldStartInBytes#-                        mbarrTo# 0# newLenInBytes# s#, () #)--    return $ MutArray-        { arrStart = 0-        , arrContents = contents-        , arrEnd   = newLenInBytes-        , arrBound = newCapInBytes-        }---- | @realloc newCapacity array@ reallocates the array to the specified--- capacity in bytes.------ If the new size is less than the original array the array gets truncated.--- If the new size is not a multiple of array element size then it is rounded--- down to multiples of array size.  If the new size is more than--- 'largeObjectThreshold' then it is rounded up to the block size (4K).----{-# INLINABLE realloc #-}-realloc :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m (MutArray a)-realloc bytes arr = liftIO $ reallocExplicit (SIZE_OF(a)) bytes arr---- | @reallocWith label capSizer minIncrBytes array@. The label is used--- in error messages and the capSizer is used to determine the capacity of the--- new array in bytes given the current byte length of the array.-reallocWith :: forall m a. (MonadIO m , Unbox a) =>-       String-    -> (Int -> Int)-    -> Int-    -> MutArray a-    -> m (MutArray a)-reallocWith label capSizer minIncrBytes arr = do-    let oldSizeBytes = arrEnd arr - arrStart arr-        newCapBytes = capSizer oldSizeBytes-        newSizeBytes = oldSizeBytes + minIncrBytes-        safeCapBytes = max newCapBytes newSizeBytes-    assertM(safeCapBytes >= newSizeBytes || error (badSize newSizeBytes))--    realloc safeCapBytes arr--    where--    badSize newSize =-        concat-            [ label-            , ": new array size (in bytes) is less than required size "-            , show newSize-            , ". Please check the sizing function passed."-            ]---- | @resize newCapacity array@ changes the total capacity of the array so that--- it is enough to hold the specified number of elements.  Nothing is done if--- the specified capacity is less than the length of the array.------ If the capacity is more than 'largeObjectThreshold' then it is rounded up to--- the block size (4K).------ /Pre-release/-{-# INLINE resize #-}-resize :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resize nElems arr@MutArray{..} = do-    let req = SIZE_OF(a) * nElems-        len = arrEnd - arrStart-    if req < len-    then return arr-    else realloc req arr---- | Like 'resize' but if the byte capacity is more than 'largeObjectThreshold'--- then it is rounded up to the closest power of 2.------ /Pre-release/-{-# INLINE resizeExp #-}-resizeExp :: forall m a. (MonadIO m, Unbox a) =>-    Int -> MutArray a -> m (MutArray a)-resizeExp nElems arr@MutArray{..} = do-    let req = roundUpLargeArray (SIZE_OF(a) * nElems)-        req1 =-            if req > largeObjectThreshold-            then roundUpToPower2 req-            else req-        len = arrEnd - arrStart-    if req1 < len-    then return arr-    else realloc req1 arr---- | Resize the allocated memory to drop any reserved free space at the end of--- the array and reallocate it to reduce wastage.------ Up to 25% wastage is allowed to avoid reallocations.  If the capacity is--- more than 'largeObjectThreshold' then free space up to the 'blockSize' is--- retained.------ /Pre-release/-{-# INLINE rightSize #-}-rightSize :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m (MutArray a)-rightSize arr@MutArray{..} = do-    assert (arrEnd <= arrBound) (return ())-    let start = arrStart-        len = arrEnd - start-        capacity = arrBound - start-        target = roundUpLargeArray len-        waste = arrBound - arrEnd-    assert (target >= len) (return ())-    assert (len `mod` SIZE_OF(a) == 0) (return ())-    -- We trade off some wastage (25%) to avoid reallocations and copying.-    if target < capacity && len < 3 * waste-    then realloc target arr-    else return arr------------------------------------------------------------------------------------ Snoc------------------------------------------------------------------------------------ XXX We can possibly use a smallMutableByteArray to hold the start, end,--- bound pointers.  Using fully mutable handle will ensure that we do not have--- multiple references to the same array of different lengths lying around and--- potentially misused. In that case "snoc" need not return a new array (snoc--- :: MutArray a -> a -> m ()), it will just modify the old reference.  The array--- length will be mutable.  This means the length function would also be--- monadic.  Mutable arrays would behave more like files that grow in that--- case.---- | Snoc using a 'Ptr'. Low level reusable function.------ /Internal/-{-# INLINE snocNewEnd #-}-snocNewEnd :: (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m (MutArray a)-snocNewEnd newEnd arr@MutArray{..} x = liftIO $ do-    assert (newEnd <= arrBound) (return ())-    pokeWith arrContents arrEnd x-    return $ arr {arrEnd = newEnd}---- | Really really unsafe, appends the element into the first array, may--- cause silent data corruption or if you are lucky a segfault if the first--- array does not have enough space to append the element.------ /Internal/-{-# INLINE snocUnsafe #-}-snocUnsafe :: forall m a. (MonadIO m, Unbox a) =>-    MutArray a -> a -> m (MutArray a)-snocUnsafe arr@MutArray{..} = snocNewEnd (INDEX_NEXT(arrEnd,a)) arr---- | Like 'snoc' but does not reallocate when pre-allocated array capacity--- becomes full.------ /Internal/-{-# INLINE snocMay #-}-snocMay :: forall m a. (MonadIO m, Unbox a) =>-    MutArray a -> a -> m (Maybe (MutArray a))-snocMay arr@MutArray{..} x = liftIO $ do-    let newEnd = INDEX_NEXT(arrEnd,a)-    if newEnd <= arrBound-    then Just <$> snocNewEnd newEnd arr x-    else return Nothing---- NOINLINE to move it out of the way and not pollute the instruction cache.-{-# NOINLINE snocWithRealloc #-}-snocWithRealloc :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray a-    -> a-    -> m (MutArray a)-snocWithRealloc sizer arr x = do-    arr1 <- liftIO $ reallocWith "snocWith" sizer (SIZE_OF(a)) arr-    snocUnsafe arr1 x---- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of--- the array increases by 1.------ If there is no reserved space available in @arr@ it is reallocated to a size--- in bytes determined by the @sizer oldSizeBytes@ function, where--- @oldSizeBytes@ is the original size of the array in bytes.------ If the new array size is more than 'largeObjectThreshold' we automatically--- round it up to 'blockSize'.------ Note that the returned array may be a mutated version of the original array.------ /Pre-release/-{-# INLINE snocWith #-}-snocWith :: forall m a. (MonadIO m, Unbox a) =>-       (Int -> Int)-    -> MutArray a-    -> a-    -> m (MutArray a)-snocWith allocSize arr x = liftIO $ do-    let newEnd = INDEX_NEXT(arrEnd arr,a)-    if newEnd <= arrBound arr-    then snocNewEnd newEnd arr x-    else snocWithRealloc allocSize arr x---- | The array is mutated to append an additional element to it. If there--- is no reserved space available in the array then it is reallocated to grow--- it by 'arrayChunkBytes' rounded up to 'blockSize' when the size becomes more--- than 'largeObjectThreshold'.------ Note that the returned array may be a mutated version of the original array.------ Performs O(n^2) copies to grow but is thrifty on memory.------ /Pre-release/-{-# INLINE snocLinear #-}-snocLinear :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)-snocLinear = snocWith (+ allocBytesToBytes (undefined :: a) arrayChunkBytes)---- | The array is mutated to append an additional element to it. If there is no--- reserved space available in the array then it is reallocated to double the--- original size.------ This is useful to reduce allocations when appending unknown number of--- elements.------ Note that the returned array may be a mutated version of the original array.------ >>> snoc = MutArray.snocWith (* 2)------ Performs O(n * log n) copies to grow, but is liberal with memory allocation.----{-# INLINE snoc #-}-snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)-snoc = snocWith f--    where--    f oldSize =-        if isPower2 oldSize-        then oldSize * 2-        else roundUpToPower2 oldSize * 2------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ XXX Can this be deduplicated with array/foreign---- | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndexUnsafe i MutArray{..} = do-    let index = INDEX_OF(arrStart,i,a)-    assert (i >= 0 && INDEX_VALID(index,arrEnd,a)) (return ())-    liftIO $ peekWith arrContents index---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndex i MutArray{..} = do-    let index = INDEX_OF(arrStart,i,a)-    if i >= 0 && INDEX_VALID(index,arrEnd,a)-    then liftIO $ peekWith arrContents index-    else invalidIndex "getIndex" i---- | /O(1)/ Lookup the element at the given index from the end of the array.--- Index starts from 0.------ Slightly faster than computing the forward index and using getIndex.----{-# INLINE getIndexRev #-}-getIndexRev :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a-getIndexRev i MutArray{..} = do-    let index = RINDEX_OF(arrEnd,i,a)-    if i >= 0 && index >= arrStart-    then liftIO $ peekWith arrContents index-    else invalidIndex "getIndexRev" i--data GetIndicesState contents start end st =-    GetIndicesState contents start end st---- | Given an unfold that generates array indices, read the elements on those--- indices from the supplied MutArray. An error is thrown if an index is out of--- bounds.------ /Pre-release/-{-# INLINE getIndicesD #-}-getIndicesD :: (Monad m, Unbox a) =>-    (forall b. IO b -> m b) -> D.Stream m Int -> Unfold m (MutArray a) a-getIndicesD liftio (D.Stream stepi sti) = Unfold step inject--    where--    inject (MutArray contents start end _) =-        return $ GetIndicesState contents start end sti--    {-# INLINE_LATE step #-}-    step (GetIndicesState contents start end st) = do-        r <- stepi defState st-        case r of-            D.Yield i s -> do-                x <- liftio $ getIndex i (MutArray contents start end undefined)-                return $ D.Yield x (GetIndicesState contents start end s)-            D.Skip s -> return $ D.Skip (GetIndicesState contents start end s)-            D.Stop -> return D.Stop--{-# INLINE getIndices #-}-getIndices :: (MonadIO m, Unbox a) => Stream m Int -> Unfold m (MutArray a) a-getIndices = getIndicesD liftIO------------------------------------------------------------------------------------ Subarrays------------------------------------------------------------------------------------ XXX We can also get immutable slices.---- | /O(1)/ Slice an array in constant time.------ Unsafe: The bounds of the slice are not checked.------ /Unsafe/------ /Pre-release/-{-# INLINE getSliceUnsafe #-}-getSliceUnsafe :: forall a. Unbox a-    => Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSliceUnsafe index len (MutArray contents start e _) =-    let fp1 = INDEX_OF(start,index,a)-        end = fp1 + (len * SIZE_OF(a))-     in assert-            (index >= 0 && len >= 0 && end <= e)-            -- Note: In a slice we always use bound = end so that the slice-            -- user cannot overwrite elements beyond the end of the slice.-            (MutArray contents fp1 end end)---- | /O(1)/ Slice an array in constant time. Throws an error if the slice--- extends out of the array bounds.------ /Pre-release/-{-# INLINE getSlice #-}-getSlice :: forall a. Unbox a =>-       Int -- ^ from index-    -> Int -- ^ length of the slice-    -> MutArray a-    -> MutArray a-getSlice index len (MutArray contents start e _) =-    let fp1 = INDEX_OF(start,index,a)-        end = fp1 + (len * SIZE_OF(a))-     in if index >= 0 && len >= 0 && end <= e-        -- Note: In a slice we always use bound = end so that the slice user-        -- cannot overwrite elements beyond the end of the slice.-        then MutArray contents fp1 end end-        else error-                $ "getSlice: invalid slice, index "-                ++ show index ++ " length " ++ show len------------------------------------------------------------------------------------ In-place mutation algorithms------------------------------------------------------------------------------------ XXX consider the bulk update/accumulation/permutation APIs from vector.---- | You may not need to reverse an array because you can consume it in reverse--- using 'readerRev'. To reverse large arrays you can read in reverse and write--- to another array. However, in-place reverse can be useful to take adavantage--- of cache locality and when you do not want to allocate additional memory.----{-# INLINE reverse #-}-reverse :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m ()-reverse MutArray{..} = liftIO $ do-    let l = arrStart-        h = INDEX_PREV(arrEnd,a)-     in swap l h--    where--    swap l h = do-        when (l < h) $ do-            swapArrayByteIndices (Proxy :: Proxy a) arrContents l h-            swap (INDEX_NEXT(l,a)) (INDEX_PREV(h,a))---- | Generate the next permutation of the sequence, returns False if this is--- the last permutation.------ /Unimplemented/-{-# INLINE permute #-}-permute :: MutArray a -> m Bool-permute = undefined---- | Partition an array into two halves using a partitioning predicate. The--- first half retains values where the predicate is 'False' and the second half--- retains values where the predicate is 'True'.------ /Pre-release/-{-# INLINE partitionBy #-}-partitionBy :: forall m a. (MonadIO m, Unbox a)-    => (a -> Bool) -> MutArray a -> m (MutArray a, MutArray a)-partitionBy f arr@MutArray{..} = liftIO $ do-    if arrStart >= arrEnd-    then return (arr, arr)-    else do-        ptr <- go arrStart (INDEX_PREV(arrEnd,a))-        let pl = MutArray arrContents arrStart ptr ptr-            pr = MutArray arrContents ptr arrEnd arrEnd-        return (pl, pr)--    where--    -- Invariant low < high on entry, and on return as well-    moveHigh low high = do-        h <- peekWith arrContents high-        if f h-        then-            -- Correctly classified, continue the loop-            let high1 = INDEX_PREV(high,a)-             in if low == high1-                then return Nothing-                else moveHigh low high1-        else return (Just (high, h)) -- incorrectly classified--    -- Keep a low pointer starting at the start of the array (first partition)-    -- and a high pointer starting at the end of the array (second partition).-    -- Keep incrementing the low ptr and decrementing the high ptr until both-    -- are wrongly classified, at that point swap the two and continue until-    -- the two pointer cross each other.-    ---    -- Invariants when entering this loop:-    -- low <= high-    -- Both low and high are valid locations within the array-    go low high = do-        l <- peekWith arrContents low-        if f l-        then-            -- low is wrongly classified-            if low == high-            then return low-            else do -- low < high-                r <- moveHigh low high-                case r of-                    Nothing -> return low-                    Just (high1, h) -> do -- low < high1-                        pokeWith arrContents low h-                        pokeWith arrContents high1 l-                        let low1 = INDEX_NEXT(low,a)-                            high2 = INDEX_PREV(high1,a)-                        if low1 <= high2-                        then go low1 high2-                        else return low1 -- low1 > high2--        else do-            -- low is correctly classified-            let low1 = INDEX_NEXT(low,a)-            if low == high-            then return low1-            else go low1 high---- | Shuffle corresponding elements from two arrays using a shuffle function.--- If the shuffle function returns 'False' then do nothing otherwise swap the--- elements. This can be used in a bottom up fold to shuffle or reorder the--- elements.------ /Unimplemented/-{-# INLINE shuffleBy #-}-shuffleBy :: (a -> a -> m Bool) -> MutArray a -> MutArray a -> m ()-shuffleBy = undefined---- XXX we can also make the folds partial by stopping at a certain level.------ | @divideBy level partition array@  performs a top down hierarchical--- recursive partitioning fold of items in the container using the given--- function as the partition function.  Level indicates the level in the tree--- where the fold would stop.------ This performs a quick sort if the partition function is--- 'partitionBy (< pivot)'.------ /Unimplemented/-{-# INLINABLE divideBy #-}-divideBy ::-    Int -> (MutArray a -> m (MutArray a, MutArray a)) -> MutArray a -> m ()-divideBy = undefined---- | @mergeBy level merge array@ performs a pairwise bottom up fold recursively--- merging the pairs using the supplied merge function. Level indicates the--- level in the tree where the fold would stop.------ This performs a random shuffle if the merge function is random.  If we--- stop at level 0 and repeatedly apply the function then we can do a bubble--- sort.------ /Unimplemented/-mergeBy :: Int -> (MutArray a -> MutArray a -> m ()) -> MutArray a -> m ()-mergeBy = undefined------------------------------------------------------------------------------------ Size------------------------------------------------------------------------------------ | /O(1)/ Get the byte length of the array.----{-# INLINE byteLength #-}-byteLength :: MutArray a -> Int-byteLength MutArray{..} =-    let len = arrEnd - arrStart-    in assert (len >= 0) len---- Note: try to avoid the use of length in performance sensitive internal--- routines as it involves a costly 'div' operation. Instead use the end ptr--- in the array to check the bounds etc.------ | /O(1)/ Get the length of the array i.e. the number of elements in the--- array.------ Note that 'byteLength' is less expensive than this operation, as 'length'--- involves a costly division operation.----{-# INLINE length #-}-length :: forall a. Unbox a => MutArray a -> Int-length arr =-    let elemSize = SIZE_OF(a)-        blen = byteLength arr-     in assert (blen `mod` elemSize == 0) (blen `div` elemSize)---- | Get the total capacity of an array. An array may have space reserved--- beyond the current used length of the array.------ /Pre-release/-{-# INLINE byteCapacity #-}-byteCapacity :: MutArray a -> Int-byteCapacity MutArray{..} =-    let len = arrBound - arrStart-    in assert (len >= 0) len---- | The remaining capacity in the array for appending more elements without--- reallocation.------ /Pre-release/-{-# INLINE bytesFree #-}-bytesFree :: MutArray a -> Int-bytesFree MutArray{..} =-    let n = arrBound - arrEnd-    in assert (n >= 0) n------------------------------------------------------------------------------------ Streams of arrays - Creation----------------------------------------------------------------------------------data GroupState s contents start end bound-    = GroupStart s-    | GroupBuffer s contents start end bound-    | GroupYield-        contents start end bound (GroupState s contents start end bound)-    | GroupFinish---- | @chunksOf n stream@ groups the input stream into a stream of--- arrays of size n.------ @chunksOf n = StreamD.foldMany (MutArray.writeN n)@------ /Pre-release/-{-# INLINE_NORMAL chunksOf #-}-chunksOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> D.Stream m (MutArray a)--- XXX the idiomatic implementation leads to large regression in the D.reverse'--- benchmark. It seems it has difficulty producing optimized code when--- converting to StreamK. Investigate GHC optimizations.--- chunksOf n = D.foldMany (writeN n)-chunksOf n (D.Stream step state) =-    D.Stream step' (GroupStart state)--    where--    {-# INLINE_LATE step' #-}-    step' _ (GroupStart st) = do-        when (n <= 0) $-            -- XXX we can pass the module string from the higher level API-            error $ "Streamly.Internal.Data.MutArray.Mut.Type.chunksOf: "-                    ++ "the size of arrays [" ++ show n-                    ++ "] must be a natural number"-        (MutArray contents start end bound :: MutArray a) <- liftIO $ newPinned n-        return $ D.Skip (GroupBuffer st contents start end bound)--    step' gst (GroupBuffer st contents start end bound) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                liftIO $ pokeWith contents end x-                let end1 = INDEX_NEXT(end,a)-                return $-                    if end1 >= bound-                    then D.Skip-                            (GroupYield-                                contents start end1 bound (GroupStart s))-                    else D.Skip (GroupBuffer s contents start end1 bound)-            D.Skip s ->-                return $ D.Skip (GroupBuffer s contents start end bound)-            D.Stop ->-                return-                    $ D.Skip (GroupYield contents start end bound GroupFinish)--    step' _ (GroupYield contents start end bound next) =-        return $ D.Yield (MutArray contents start end bound) next--    step' _ GroupFinish = return D.Stop---- XXX buffer to a list instead?--- | Buffer the stream into arrays in memory.-{-# INLINE arrayStreamKFromStreamD #-}-arrayStreamKFromStreamD :: forall m a. (MonadIO m, Unbox a) =>-    D.Stream m a -> m (StreamK m (MutArray a))-arrayStreamKFromStreamD =-    let n = allocBytesToElemCount (undefined :: a) defaultChunkSize-     in D.foldr K.cons K.nil . chunksOf n------------------------------------------------------------------------------------ Streams of arrays - Flattening----------------------------------------------------------------------------------data FlattenState s contents a =-      OuterLoop s-    | InnerLoop s contents !Int !Int---- | Use the "reader" unfold instead.------ @flattenArrays = unfoldMany reader@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArrays #-}-flattenArrays :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArrays (D.Stream step state) = D.Stream step' (OuterLoop state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield MutArray{..} s ->-                D.Skip (InnerLoop s arrContents arrStart arrEnd)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p end) | assert (p <= end) (p == end) =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st contents p end) = do-        x <- liftIO $ peekWith contents p-        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)---- | Use the "readerRev" unfold instead.------ @flattenArrays = unfoldMany readerRev@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArraysRev #-}-flattenArraysRev :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (MutArray a) -> D.Stream m a-flattenArraysRev (D.Stream step state) = D.Stream step' (OuterLoop state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield MutArray{..} s ->-                let p = INDEX_PREV(arrEnd,a)-                 in D.Skip (InnerLoop s arrContents p arrStart)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p start) | p < start =-        return $ D.Skip $ OuterLoop st--    step' _ (InnerLoop st contents p start) = do-        x <- liftIO $ peekWith contents p-        let cur = INDEX_PREV(p,a)-        return $ D.Yield x (InnerLoop st contents cur start)------------------------------------------------------------------------------------ Unfolds----------------------------------------------------------------------------------data ArrayUnsafe a = ArrayUnsafe-    {-# UNPACK #-} !MutableByteArray   -- contents-    {-# UNPACK #-} !Int                -- index 1-    {-# UNPACK #-} !Int                -- index 2--toArrayUnsafe :: MutArray a -> ArrayUnsafe a-toArrayUnsafe (MutArray contents start end _) = ArrayUnsafe contents start end--fromArrayUnsafe ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    ArrayUnsafe a -> MutArray a-fromArrayUnsafe (ArrayUnsafe contents start end) =-         MutArray contents start end end--{-# INLINE_NORMAL producerWith #-}-producerWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> Producer m (MutArray a) a-producerWith liftio = Producer step (return . toArrayUnsafe) extract-    where--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe _ cur end)-        | assert (cur <= end) (cur == end) = return D.Stop-    step (ArrayUnsafe contents cur end) = do-            -- When we use a purely lazy Monad like Identity, we need to force a-            -- few actions for correctness and execution order sanity. We want-            -- the peek to occur right here and not lazily at some later point-            -- because we want the peek to be ordered with respect to the touch.-            !x <- liftio $ peekWith contents cur-            return $ D.Yield x (ArrayUnsafe contents (INDEX_NEXT(cur,a)) end)--    extract = return . fromArrayUnsafe---- | Resumable unfold of an array.----{-# INLINE_NORMAL producer #-}-producer :: forall m a. (MonadIO m, Unbox a) => Producer m (MutArray a) a-producer = producerWith liftIO---- | Unfold an array into a stream.----{-# INLINE_NORMAL reader #-}-reader :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a-reader = Producer.simplify producer--{-# INLINE_NORMAL readerRevWith #-}-readerRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> Unfold m (MutArray a) a-readerRevWith liftio = Unfold step inject-    where--    inject (MutArray contents start end _) =-        let p = INDEX_PREV(end,a)-         in return $ ArrayUnsafe contents start p--    {-# INLINE_LATE step #-}-    step (ArrayUnsafe _ start p) | p < start = return D.Stop-    step (ArrayUnsafe contents start p) = do-        !x <- liftio $ peekWith contents p-        return $ D.Yield x (ArrayUnsafe contents start (INDEX_PREV(p,a)))---- | Unfold an array into a stream in reverse order.----{-# INLINE_NORMAL readerRev #-}-readerRev :: forall m a. (MonadIO m, Unbox a) => Unfold m (MutArray a) a-readerRev = readerRevWith liftIO------------------------------------------------------------------------------------ to Lists and streams----------------------------------------------------------------------------------{---- Use foldr/build fusion to fuse with list consumers--- This can be useful when using the IsList instance-{-# INLINE_LATE toListFB #-}-toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> MutArray a -> b-toListFB c n MutArray{..} = go arrStart-    where--    go p | assert (p <= arrEnd) (p == arrEnd) = n-    go p =-        -- unsafeInlineIO allows us to run this in Identity monad for pure-        -- toList/foldr case which makes them much faster due to not-        -- accumulating the list and fusing better with the pure consumers.-        ---        -- This should be safe as the array contents are guaranteed to be-        -- evaluated/written to before we peek at them.-        -- XXX-        let !x = unsafeInlineIO $ do-                    r <- peekWith arrContents p-                    return r-        in c x (go (PTR_NEXT(p,a)))--}---- XXX Monadic foldr/build fusion?--- Reference: https://www.researchgate.net/publication/220676509_Monadic_augment_and_generalised_short_cut_fusion---- | Convert a 'MutArray' into a list.----{-# INLINE toList #-}-toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]-toList MutArray{..} = liftIO $ go arrStart-    where--    go p | assert (p <= arrEnd) (p == arrEnd) = return []-    go p = do-        x <- peekWith arrContents p-        (:) x <$> go (INDEX_NEXT(p,a))--{-# INLINE_NORMAL toStreamDWith #-}-toStreamDWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamDWith liftio MutArray{..} = D.Stream step arrStart--    where--    {-# INLINE_LATE step #-}-    step _ p | assert (p <= arrEnd) (p == arrEnd) = return D.Stop-    step _ p = liftio $ do-        r <- peekWith arrContents p-        return $ D.Yield r (INDEX_NEXT(p,a))---- | Use the 'reader' unfold instead.------ @toStreamD = D.unfold reader@------ We can try this if the unfold has any performance issues.-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a-toStreamD = toStreamDWith liftIO--{-# INLINE toStreamKWith #-}-toStreamKWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a-toStreamKWith liftio MutArray{..} = go arrStart--    where--    go p | assert (p <= arrEnd) (p == arrEnd) = K.nil-         | otherwise =-        let elemM = peekWith arrContents p-        in liftio elemM `K.consM` go (INDEX_NEXT(p,a))--{-# INLINE toStreamK #-}-toStreamK :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a-toStreamK = toStreamKWith liftIO--{-# INLINE_NORMAL toStreamDRevWith #-}-toStreamDRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> D.Stream m a-toStreamDRevWith liftio MutArray{..} =-    let p = INDEX_PREV(arrEnd,a)-    in D.Stream step p--    where--    {-# INLINE_LATE step #-}-    step _ p | p < arrStart = return D.Stop-    step _ p = liftio $ do-        r <- peekWith arrContents p-        return $ D.Yield r (INDEX_PREV(p,a))---- | Use the 'readerRev' unfold instead.------ @toStreamDRev = D.unfold readerRev@------ We can try this if the unfold has any perf issues.-{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> D.Stream m a-toStreamDRev = toStreamDRevWith liftIO--{-# INLINE toStreamKRevWith #-}-toStreamKRevWith ::-       forall m a. (Monad m, Unbox a)-    => (forall b. IO b -> m b) -> MutArray a -> StreamK m a-toStreamKRevWith liftio MutArray {..} =-    let p = INDEX_PREV(arrEnd,a)-    in go p--    where--    go p | p < arrStart = K.nil-         | otherwise =-        let elemM = peekWith arrContents p-        in liftio elemM `K.consM` go (INDEX_PREV(p,a))--{-# INLINE toStreamKRev #-}-toStreamKRev :: forall m a. (MonadIO m, Unbox a) => MutArray a -> StreamK m a-toStreamKRev = toStreamKRevWith liftIO------------------------------------------------------------------------------------ Folding------------------------------------------------------------------------------------ XXX Need something like "MutArray m a" enforcing monadic action to avoid the--- possibility of such APIs.------ | Strict left fold of an array.-{-# INLINE_NORMAL foldl' #-}-foldl' :: (MonadIO m, Unbox a) => (b -> a -> b) -> b -> MutArray a -> m b-foldl' f z arr = D.foldl' f z $ toStreamD arr---- | Right fold of an array.-{-# INLINE_NORMAL foldr #-}-foldr :: (MonadIO m, Unbox a) => (a -> b -> b) -> b -> MutArray a -> m b-foldr f z arr = D.foldr f z $ toStreamD arr------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ Note: Arrays may be allocated with a specific alignment at the beginning of--- the array. If you need to maintain that alignment on reallocations then you--- can resize the array manually before append, using an aligned resize--- operation.---- XXX Keep the bound intact to not lose any free space? Perf impact?---- | @writeAppendNUnsafe n alloc@ appends up to @n@ input items to the supplied--- array.------ Unsafe: Do not drive the fold beyond @n@ elements, it will lead to memory--- corruption or segfault.------ Any free space left in the array after appending @n@ elements is lost.------ /Internal/-{-# INLINE_NORMAL writeAppendNUnsafe #-}-writeAppendNUnsafe :: forall m a. (MonadIO m, Unbox a) =>-       Int-    -> m (MutArray a)-    -> Fold m a (MutArray a)-writeAppendNUnsafe n action =-    fmap fromArrayUnsafe $ FL.foldlM' step initial--    where--    initial = do-        assert (n >= 0) (return ())-        arr@(MutArray _ _ end bound) <- action-        let free = bound - end-            needed = n * SIZE_OF(a)-        -- XXX We can also reallocate if the array has too much free space,-        -- otherwise we lose that space.-        arr1 <--            if free < needed-            then noinline reallocWith "writeAppendNUnsafeWith" (+ needed) needed arr-            else return arr-        return $ toArrayUnsafe arr1--    step (ArrayUnsafe contents start end) x = do-        liftIO $ pokeWith contents end x-        return $ ArrayUnsafe contents start (INDEX_NEXT(end,a))---- | Append @n@ elements to an existing array. Any free space left in the array--- after appending @n@ elements is lost.------ >>> writeAppendN n initial = Fold.take n (MutArray.writeAppendNUnsafe n initial)----{-# INLINE_NORMAL writeAppendN #-}-writeAppendN :: forall m a. (MonadIO m, Unbox a) =>-    Int -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendN n initial = FL.take n (writeAppendNUnsafe n initial)---- | @writeAppendWith realloc action@ mutates the array generated by @action@ to--- append the input stream. If there is no reserved space available in the--- array it is reallocated to a size in bytes  determined by @realloc oldSize@,--- where @oldSize@ is the current size of the array in bytes.------ Note that the returned array may be a mutated version of original array.------ >>> writeAppendWith sizer = Fold.foldlM' (MutArray.snocWith sizer)------ /Pre-release/-{-# INLINE writeAppendWith #-}-writeAppendWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int) -> m (MutArray a) -> Fold m a (MutArray a)-writeAppendWith sizer = FL.foldlM' (snocWith sizer)---- | @append action@ mutates the array generated by @action@ to append the--- input stream. If there is no reserved space available in the array it is--- reallocated to double the size.------ Note that the returned array may be a mutated version of original array.------ >>> writeAppend = MutArray.writeAppendWith (* 2)----{-# INLINE writeAppend #-}-writeAppend :: forall m a. (MonadIO m, Unbox a) =>-    m (MutArray a) -> Fold m a (MutArray a)-writeAppend = writeAppendWith (* 2)---- XXX We can carry bound as well in the state to make sure we do not lose the--- remaining capacity. Need to check perf impact.------ | Like 'writeNUnsafe' but takes a new array allocator @alloc size@ function--- as argument.------ >>> writeNWithUnsafe alloc n = MutArray.writeAppendNUnsafe (alloc n) n------ /Pre-release/-{-# INLINE_NORMAL writeNWithUnsafe #-}-writeNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial--    where--    initial = toArrayUnsafe <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        liftIO $ pokeWith contents end x-        return-          $ ArrayUnsafe contents start (INDEX_NEXT(end,a))---- | Like 'writeN' but does not check the array bounds when writing. The fold--- driver must not call the step function more than 'n' times otherwise it will--- corrupt the memory and crash. This function exists mainly because any--- conditional in the step function blocks fusion causing 10x performance--- slowdown.------ >>> writeNUnsafe = MutArray.writeNWithUnsafe MutArray.newPinned----{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)-writeNUnsafe = writeNWithUnsafe newPinned---- | @writeNWith alloc n@ folds a maximum of @n@ elements into an array--- allocated using the @alloc@ function.------ >>> writeNWith alloc n = Fold.take n (MutArray.writeNWithUnsafe alloc n)--- >>> writeNWith alloc n = MutArray.writeAppendN (alloc n) n----{-# INLINE_NORMAL writeNWith #-}-writeNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeNWith alloc n = FL.take n (writeNWithUnsafe alloc n)---- | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'MutArray'.------ >>> writeN = MutArray.writeNWith MutArray.newPinned--- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)--- >>> writeN n = MutArray.writeAppendN n (MutArray.newPinned n)----{-# INLINE_NORMAL writeN #-}-writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeN = writeNWith newPinned---- | Like writeNWithUnsafe but writes the array in reverse order.------ /Internal/-{-# INLINE_NORMAL writeRevNWithUnsafe #-}-writeRevNWithUnsafe :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeRevNWithUnsafe alloc n = fromArrayUnsafe <$> FL.foldlM' step initial--    where--    toArrayUnsafeRev (MutArray contents _ _ bound) =-         ArrayUnsafe contents bound bound--    initial = toArrayUnsafeRev <$> alloc (max n 0)--    step (ArrayUnsafe contents start end) x = do-        let ptr = INDEX_PREV(start,a)-        liftIO $ pokeWith contents ptr x-        return-          $ ArrayUnsafe contents ptr end---- | Like writeNWith but writes the array in reverse order.------ /Internal/-{-# INLINE_NORMAL writeRevNWith #-}-writeRevNWith :: forall m a. (MonadIO m, Unbox a)-    => (Int -> m (MutArray a)) -> Int -> Fold m a (MutArray a)-writeRevNWith alloc n = FL.take n (writeRevNWithUnsafe alloc n)---- | Like writeN but writes the array in reverse order.------ /Pre-release/-{-# INLINE_NORMAL writeRevN #-}-writeRevN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (MutArray a)-writeRevN = writeRevNWith newPinned---- | @writeNAligned align n@ folds a maximum of @n@ elements from the input--- stream to a 'MutArray' aligned to the given size.------ >>> writeNAligned align = MutArray.writeNWith (MutArray.newAlignedPinned align)--- >>> writeNAligned align n = MutArray.writeAppendN n (MutArray.newAlignedPinned align n)------ /Pre-release/----{-# INLINE_NORMAL writeNAligned #-}-writeNAligned :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> Fold m a (MutArray a)-writeNAligned align = writeNWith (newAlignedPinned align)---- XXX Buffer to a list instead?------ | Buffer a stream into a stream of arrays.------ >>> writeChunks n = Fold.many (MutArray.writeN n) Fold.toStreamK------ Breaking an array into an array stream  can be useful to consume a large--- array sequentially such that memory of the array is released incrementatlly.------ See also: 'arrayStreamKFromStreamD'.------ /Unimplemented/----{-# INLINE_NORMAL writeChunks #-}-writeChunks :: (MonadIO m, Unbox a) =>-    Int -> Fold m a (StreamK n (MutArray a))-writeChunks n = FL.many (writeN n) FL.toStreamK---- XXX Compare writeWith with fromStreamD which uses an array of streams--- implementation. We can write this using writeChunks above if that is faster.--- If writeWith is faster then we should use that to implement--- fromStreamD.------ XXX The realloc based implementation needs to make one extra copy if we use--- shrinkToFit.  On the other hand, the stream of arrays implementation may--- buffer the array chunk pointers in memory but it does not have to shrink as--- we know the exact size in the end. However, memory copying does not seem to--- be as expensive as the allocations. Therefore, we need to reduce the number--- of allocations instead. Also, the size of allocations matters, right sizing--- an allocation even at the cost of copying sems to help.  Should be measured--- on a big stream with heavy calls to toArray to see the effect.------ XXX check if GHC's memory allocator is efficient enough. We can try the C--- malloc to compare against.---- | @writeWith minCount@ folds the whole input to a single array. The array--- starts at a size big enough to hold minCount elements, the size is doubled--- every time the array needs to be grown.------ /Caution! Do not use this on infinite streams./------ >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)--- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)--- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)------ /Pre-release/-{-# INLINE_NORMAL writeWith #-}-writeWith :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (MutArray a)--- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)-writeWith elemCount =-    FL.rmapM extract $ FL.foldlM' step initial--    where--    initial = do-        when (elemCount < 0) $ error "writeWith: elemCount is negative"-        liftIO $ newPinned elemCount--    step arr@(MutArray _ start end bound) x-        | INDEX_NEXT(end,a) > bound = do-        let oldSize = end - start-            newSize = max (oldSize * 2) 1-        arr1 <- liftIO $ reallocExplicit (SIZE_OF(a)) newSize arr-        snocUnsafe arr1 x-    step arr x = snocUnsafe arr x--    extract = liftIO . rightSize---- | Fold the whole input to a single array.------ Same as 'writeWith' using an initial array size of 'arrayChunkBytes' bytes--- rounded up to the element size.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: forall m a. (MonadIO m, Unbox a) => Fold m a (MutArray a)-write = writeWith (allocBytesToElemCount (undefined :: a) arrayChunkBytes)------------------------------------------------------------------------------------ construct from streams, known size------------------------------------------------------------------------------------ | Use the 'writeN' fold instead.------ >>> fromStreamDN n = Stream.fold (MutArray.writeN n)----{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> m (MutArray a)--- fromStreamDN n = D.fold (writeN n)-fromStreamDN limit str = do-    (arr :: MutArray a) <- liftIO $ newPinned limit-    end <- D.foldlM' (fwrite (arrContents arr)) (return $ arrEnd arr) $ D.take limit str-    return $ arr {arrEnd = end}--    where--    fwrite arrContents ptr x = do-        liftIO $ pokeWith arrContents ptr x-        return $ INDEX_NEXT(ptr,a)---- | Create a 'MutArray' from the first N elements of a list. The array is--- allocated to size N, if the list terminates before N elements then the--- array may hold less than N elements.----{-# INLINABLE fromListN #-}-fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-fromListN n xs = fromStreamDN n $ D.fromList xs---- | Like fromListN but writes the array in reverse order.------ /Pre-release/-{-# INLINE fromListRevN #-}-fromListRevN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)-fromListRevN n xs = D.fold (writeRevN n) $ D.fromList xs------------------------------------------------------------------------------------ convert stream to a single array----------------------------------------------------------------------------------{-# INLINE arrayStreamKLength #-}-arrayStreamKLength :: (Monad m, Unbox a) => StreamK m (MutArray a) -> m Int-arrayStreamKLength as = K.foldl' (+) 0 (K.map length as)---- | Convert an array stream to an array. Note that this requires peak memory--- that is double the size of the array stream.----{-# INLINE fromArrayStreamK #-}-fromArrayStreamK :: (Unbox a, MonadIO m) =>-    StreamK m (MutArray a) -> m (MutArray a)-fromArrayStreamK as = do-    len <- arrayStreamKLength as-    fromStreamDN len $ D.unfoldMany reader $ D.fromStreamK as---- CAUTION: a very large number (millions) of arrays can degrade performance--- due to GC overhead because we need to buffer the arrays before we flatten--- all the arrays.------ XXX Compare if this is faster or "fold write".------ | We could take the approach of doubling the memory allocation on each--- overflow. This would result in more or less the same amount of copying as in--- the chunking approach. However, if we have to shrink in the end then it may--- result in an extra copy of the entire data.------ >>> fromStreamD = StreamD.fold MutArray.write----{-# INLINE fromStreamD #-}-fromStreamD :: (MonadIO m, Unbox a) => D.Stream m a -> m (MutArray a)-fromStreamD m = arrayStreamKFromStreamD m >>= fromArrayStreamK---- | Create a 'MutArray' from a list. The list must be of finite size.----{-# INLINE fromList #-}-fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-fromList xs = fromStreamD $ D.fromList xs---- XXX We are materializing the whole list first for getting the length. Check--- if the 'fromList' like chunked implementation would fare better.---- | Like 'fromList' but writes the contents of the list in reverse order.-{-# INLINE fromListRev #-}-fromListRev :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)-fromListRev xs = fromListRevN (Prelude.length xs) xs------------------------------------------------------------------------------------ Combining------------------------------------------------------------------------------------ | Put a sub range of a source array into a subrange of a destination array.--- This is not safe as it does not check the bounds.-{-# INLINE putSliceUnsafe #-}-putSliceUnsafe :: MonadIO m => MutArray a -> Int -> MutArray a -> Int -> Int -> m ()-putSliceUnsafe src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do-    assertM(lenBytes <= arrBound dst - dstStartBytes)-    assertM(lenBytes <= arrEnd src - srcStartBytes)-    let !(I# srcStartBytes#) = srcStartBytes-        !(I# dstStartBytes#) = dstStartBytes-        !(I# lenBytes#) = lenBytes-    let arrS# = getMutableByteArray# (arrContents src)-        arrD# = getMutableByteArray# (arrContents dst)-    IO $ \s# -> (# copyMutableByteArray#-                    arrS# srcStartBytes# arrD# dstStartBytes# lenBytes# s#-                , () #)---- | Copy two arrays into a newly allocated array.-{-# INLINE spliceCopy #-}-spliceCopy :: forall m a. MonadIO m =>-#ifdef DEVBUILD-    Unbox a =>-#endif-    MutArray a -> MutArray a -> m (MutArray a)-spliceCopy arr1 arr2 = liftIO $ do-    let start1 = arrStart arr1-        start2 = arrStart arr2-        len1 = arrEnd arr1 - start1-        len2 = arrEnd arr2 - start2-    newArrContents <- liftIO $ Unboxed.newPinnedBytes (len1 + len2)-    let len = len1 + len2-        newArr = MutArray newArrContents 0 len len-    putSliceUnsafe arr1 start1 newArr 0 len1-    putSliceUnsafe arr2 start2 newArr len1 len2-    return newArr---- | Really really unsafe, appends the second array into the first array. If--- the first array does not have enough space it may cause silent data--- corruption or if you are lucky a segfault.-{-# INLINE spliceUnsafe #-}-spliceUnsafe :: MonadIO m =>-    MutArray a -> MutArray a -> m (MutArray a)-spliceUnsafe dst src =-    liftIO $ do-         let startSrc = arrStart src-             srcLen = arrEnd src - startSrc-             endDst = arrEnd dst-         assertM(endDst + srcLen <= arrBound dst)-         putSliceUnsafe src startSrc dst endDst srcLen-         return $ dst {arrEnd = endDst + srcLen}---- | @spliceWith sizer dst src@ mutates @dst@ to append @src@. If there is no--- reserved space available in @dst@ it is reallocated to a size determined by--- the @sizer dstBytes srcBytes@ function, where @dstBytes@ is the size of the--- first array and @srcBytes@ is the size of the second array, in bytes.------ Note that the returned array may be a mutated version of first array.------ /Pre-release/-{-# INLINE spliceWith #-}-spliceWith :: forall m a. (MonadIO m, Unbox a) =>-    (Int -> Int -> Int) -> MutArray a -> MutArray a -> m (MutArray a)-spliceWith sizer dst@(MutArray _ start end bound) src = do-{--    let f = writeAppendWith (`sizer` byteLength src) (return dst)-     in D.fold f (toStreamD src)--}-    assert (end <= bound) (return ())-    let srcBytes = arrEnd src - arrStart src--    dst1 <--        if end + srcBytes >= bound-        then do-            let dstBytes = end - start-                newSizeInBytes = sizer dstBytes srcBytes-            when (newSizeInBytes < dstBytes + srcBytes)-                $ error-                    $ "splice: newSize is less than the total size "-                    ++ "of arrays being appended. Please check the "-                    ++ "sizer function passed."-            liftIO $ realloc newSizeInBytes dst-        else return dst-    spliceUnsafe dst1 src---- | The first array is mutated to append the second array. If there is no--- reserved space available in the first array a new allocation of exact--- required size is done.------ Note that the returned array may be a mutated version of first array.------ >>> splice = MutArray.spliceWith (+)------ /Pre-release/-{-# INLINE splice #-}-splice :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)-splice = spliceWith (+)---- | Like 'append' but the growth of the array is exponential. Whenever a new--- allocation is required the previous array size is at least doubled.------ This is useful to reduce allocations when folding many arrays together.------ Note that the returned array may be a mutated version of first array.------ >>> spliceExp = MutArray.spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------ /Pre-release/-{-# INLINE spliceExp #-}-spliceExp :: (MonadIO m, Unbox a) => MutArray a -> MutArray a -> m (MutArray a)-spliceExp = spliceWith (\l1 l2 -> max (l1 * 2) (l1 + l2))------------------------------------------------------------------------------------ Splitting------------------------------------------------------------------------------------ | Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m-    => Word8 -> MutArray Word8 -> m (MutArray Word8, Maybe (MutArray Word8))-breakOn sep arr@MutArray{..} = asPtrUnsafe arr $ \p -> liftIO $ do-    -- XXX Instead of using asPtrUnsafe (pinning memory) we can pass unlifted-    -- Addr# to memchr and it should be safe (from ghc 8.4).-    -- XXX We do not need memchr here, we can use a Haskell equivalent.-    loc <- c_memchr p sep (fromIntegral $ byteLength arr)-    let sepIndex = loc `minusPtr` p-    return $-        if loc == nullPtr-        then (arr, Nothing)-        else-            ( MutArray-                { arrContents = arrContents-                , arrStart = arrStart-                , arrEnd = arrStart + sepIndex -- exclude the separator-                , arrBound = arrStart + sepIndex-                }-            , Just $ MutArray-                    { arrContents = arrContents-                    , arrStart = arrStart + (sepIndex + 1)-                    , arrEnd = arrEnd-                    , arrBound = arrBound-                    }-            )---- | Create two slices of an array without copying the original array. The--- specified index @i@ is the first index of the second slice.----splitAt :: forall a. Unbox a => Int -> MutArray a -> (MutArray a, MutArray a)-splitAt i arr@MutArray{..} =-    let maxIndex = length arr - 1-    in  if i < 0-        then error "sliceAt: negative array index"-        else if i > maxIndex-             then error $ "sliceAt: specified array index " ++ show i-                        ++ " is beyond the maximum index " ++ show maxIndex-             else let off = i * SIZE_OF(a)-                      p = arrStart + off-                in ( MutArray-                  { arrContents = arrContents-                  , arrStart = arrStart-                  , arrEnd = p-                  , arrBound = p-                  }-                , MutArray-                  { arrContents = arrContents-                  , arrStart = p-                  , arrEnd = arrEnd-                  , arrBound = arrBound-                  }-                )------------------------------------------------------------------------------------ Casting------------------------------------------------------------------------------------ | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The array size must be a multiple of the size of type @b@--- otherwise accessing the last element of the array may result into a crash or--- a random value.------ /Pre-release/----castUnsafe ::-#ifdef DEVBUILD-    Unbox b =>-#endif-    MutArray a -> MutArray b-castUnsafe (MutArray contents start end bound) =-    MutArray contents start end bound---- | Cast an @MutArray a@ into an @MutArray Word8@.----asBytes :: MutArray a -> MutArray Word8-asBytes = castUnsafe---- | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The length of the array should be a multiple of the size of the--- target element otherwise 'Nothing' is returned.----cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)-cast arr =-    let len = byteLength arr-        r = len `mod` SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr---- XXX We can provide another API for "unsafe" FFI calls passing an unlifted--- pointer to the FFI call. For unsafe calls we do not need to pin the array.--- We can pass an unlifted pointer to the FFI routine to avoid GC kicking in--- before the pointer is wrapped.------ From the GHC manual:------ GHC, since version 8.4, guarantees that garbage collection will never occur--- during an unsafe call, even in the bytecode interpreter, and further--- guarantees that unsafe calls will be performed in the calling thread. Making--- it safe to pass heap-allocated objects to unsafe functions.---- Unsafe because of direct pointer operations. The user must ensure that they--- are writing within the legal bounds of the array. Should we just name it--- asPtr, the unsafety is implicit for any pointer operations. And we are safe--- from Haskell perspective because we will be pinning the memory.---- | Use an @MutArray a@ as @Ptr a@. This is useful when we want to pass an array--- as a pointer to some operating system call or to a "safe" FFI call.------ If the array is not pinned it is copied to pinned memory before passing it--- to the monadic action.------ /Performance Notes:/ Forces a copy if the array is not pinned. It is advised--- that the programmer keeps this in mind and creates a pinned array--- opportunistically before this operation occurs, to avoid the cost of a copy--- if possible.------ /Unsafe/------ /Pre-release/----asPtrUnsafe :: MonadIO m => MutArray a -> (Ptr a -> m b) -> m b-asPtrUnsafe arr f = do-  let contents = arrContents arr-      !ptr = Ptr (byteArrayContents#-                     (unsafeCoerce# (getMutableByteArray# contents)))-  -- XXX Check if the array is pinned, if not, copy it to a pinned array-  -- XXX We should probably pass to the IO action the byte length of the array-  -- as well so that bounds can be checked.-  r <- f (ptr `plusPtr` arrStart arr)-  liftIO $ touch contents-  return r------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ | Compare the length of the arrays. If the length is equal, compare the--- lexicographical ordering of two underlying byte arrays otherwise return the--- result of length comparison.------ /Pre-release/-{-# INLINE cmp #-}-cmp :: MonadIO m => MutArray a -> MutArray a -> m Ordering-cmp arr1 arr2 =-    liftIO-        $ do-            let marr1 = getMutableByteArray# (arrContents arr1)-                marr2 = getMutableByteArray# (arrContents arr2)-                !(I# st1#) = arrStart arr1-                !(I# st2#) = arrStart arr2-                !(I# len#) = byteLength arr1-            case compare (byteLength arr1) (byteLength arr2) of-                EQ -> do-                    r <- liftIO $ IO $ \s# ->-                             let res =-                                     I#-                                         (compareByteArrays#-                                              (unsafeCoerce# marr1)-                                              st1#-                                              (unsafeCoerce# marr2)-                                              st2#-                                              len#)-                              in (# s#, res #)-                    return $ compare r 0-                x -> return x------------------------------------------------------------------------------------ NFData------------------------------------------------------------------------------------ | Strip elements which match with predicate from both ends.------ /Pre-release/-{-# INLINE strip #-}-strip :: forall a m. (Unbox a, MonadIO m) =>-    (a -> Bool) -> MutArray a -> m (MutArray a)-strip eq arr@MutArray{..} = liftIO $ do-    st <- getStart arrStart-    end <- getLast arrEnd st-    return arr {arrStart = st, arrEnd = end, arrBound = end}--    where--    {--    -- XXX This should have the same perf but it does not, investigate.-    getStart = do-        r <- liftIO $ D.head $ D.findIndices (not . eq) $ toStreamD arr-        pure $-            case r of-                Nothing -> arrEnd-                Just i -> PTR_INDEX(arrStart,i,a)-    -}--    getStart cur = do-        if cur < arrEnd-        then do-            r <- peekWith arrContents cur-            if eq r-            then getStart (INDEX_NEXT(cur,a))-            else return cur-        else return cur--    getLast cur low = do-        if cur > low-        then do-            let prev = INDEX_PREV(cur,a)-            r <- peekWith arrContents prev-            if eq r-            then getLast prev low-            else return cur-        else return cur---- | Given an array sorted in ascending order except the last element being out--- of order, use bubble sort to place the last element at the right place such--- that the array remains sorted in ascending order.------ /Pre-release/-{-# INLINE bubble #-}-bubble :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> MutArray a -> m ()-bubble cmp0 arr =-    when (l > 1) $ do-        x <- getIndexUnsafe (l - 1) arr-        go x (l - 2)--        where--        l = length arr--        go x i =-            if i >= 0-            then do-                x1 <- getIndexUnsafe i arr-                case x `cmp0` x1 of-                    LT -> do-                        putIndexUnsafe (i + 1) arr x1-                        go x (i - 1)-                    _ -> putIndexUnsafe (i + 1) arr x-            else putIndexUnsafe (i + 1) arr x
+ src/Streamly/Internal/Data/Array/Stream.hs view
@@ -0,0 +1,723 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}+-- |+-- Module      : Streamly.Internal.Data.Array.Stream+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Combinators to efficiently manipulate streams of immutable arrays.+--+-- We can either push these in the MutArray module with a "chunks" prefix or+-- keep this as a separate module and release it.+--+module Streamly.Internal.Data.Array.Stream+{-# DEPRECATED "Please use \"Streamly.Internal.Data.Array\" instead." #-}+    (+    -- * Creation+      Array.chunksOf+    , Array.pinnedChunksOf+    , Array.bufferChunks++    -- * Flattening to elements+    , Array.concat+    , Array.flattenArrays+    , Array.concatRev+    , Array.flattenArraysRev+    , Array.interpose+    , Array.interposeSuffix+    , Array.intercalateSuffix+    , unlines++    -- * Elimination+    -- ** Element Folds+    -- The byte level foldBreak can work as efficiently as the chunk level. We+    -- can flatten the stream to byte stream and use that. But if we want the+    -- remaining stream to be a chunk stream then this could be handy. But it+    -- could also be implemented using parseBreak.+    , foldBreak+    , foldBreakD+    -- This is chunked parseBreak. A byte level parseBreak cannot work+    -- efficiently. Because the stream will have to be a StreamK for+    -- backtracking, StreamK at byte level would not be efficient.+    -- parseBreak p = K.parseBreakChunks (ParserK.adaptC p)+    , parseBreak+    -- , parseBreakD+    -- , foldManyChunks+    -- , parseManyChunks+    , K.parseBreakChunks+    , K.parseChunks++    -- ** Array Folds+    -- XXX Use parseBreakChunks/parseChunks instead+    -- foldBreak can be implemented using parseBreak. Use StreamK.+    , runArrayFold+    , runArrayFoldBreak+    -- , parseArr+    , runArrayParserDBreak -- StreamK.parseBreakChunks+    , runArrayFoldMany++    , toArray++    -- * Compaction+    -- We can use something like foldManyChunks, parseManyChunks with a take+    -- fold.+    , lpackArraysChunksOf -- Fold.compactChunks+    , compact -- rechunk, compactChunks++    -- * Splitting+    -- We can use something like foldManyChunks, parseManyChunks with an+    -- appropriate splitting fold.+    , splitOn       -- Stream.rechunkOn+    , splitOnSuffix -- Stream.rechunkOnSuffix+    )+where++#include "ArrayMacros.h"+#include "inline.hs"++import Data.Bifunctor (second)+import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+-- import Data.Bifunctor (first)+-- import Data.Either (fromRight)+import Data.Proxy (Proxy(..))+import Data.Word (Word8)+import Streamly.Internal.Data.Unbox (Unbox(..))+import Fusion.Plugin.Types (Fuse(..))+import GHC.Exts (SpecConstrAnnotation(..))+import GHC.Types (SPEC(..))+import Prelude hiding (null, last, (!!), read, concat, unlines)++import Streamly.Data.Fold (Fold)+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Chunked (ChunkFold(..))+import Streamly.Internal.Data.Parser (ParseError(..))+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.StreamK (StreamK, fromStream, toStream)+import Streamly.Internal.Data.SVar.Type (adaptState, defState)++import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.Parser as PRD+    (Parser(..), Initial(..))+-- import qualified Streamly.Internal.Data.ParserK as ParserK+import qualified Streamly.Internal.Data.Stream as D+import qualified Streamly.Internal.Data.StreamK as K++-- XXX Since these are immutable arrays MonadIO constraint can be removed from+-- most places.++-------------------------------------------------------------------------------+-- Intersperse and append+-------------------------------------------------------------------------------++{-# INLINE_NORMAL unlines #-}+unlines :: forall m a. (MonadIO m, Unbox a)+    => a -> D.Stream m (Array a) -> D.Stream m a+unlines = Array.interposeSuffix++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- XXX instead of writing two different versions of this operation, we should+-- write it as a pipe.+--+-- XXX Confirm that immutable arrays won't be modified.+{-# INLINE_NORMAL lpackArraysChunksOf #-}+lpackArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> Fold m (Array a) () -> Fold m (Array a) ()+lpackArraysChunksOf = Array.lCompactGE++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size in bytes.+--+-- @since 0.7.0+{-# INLINE compact #-}+compact :: (MonadIO m, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+compact = Array.compactLE++-- | Given a stream of arrays, splice them all together to generate a single+-- array. The stream must be /finite/.+--+-- @since 0.7.0+{-# INLINE toArray #-}+toArray :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+toArray = Array.fromChunks++-------------------------------------------------------------------------------+-- Split+-------------------------------------------------------------------------------++-- XXX Remove MonadIO constraint.+-- | Split a stream of arrays on a given separator byte, dropping the separator+-- and coalescing all the arrays between two separators into a single array.+--+-- @since 0.7.0+{-# INLINE splitOn #-}+splitOn+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+splitOn = Array.compactOnByte++{-# INLINE splitOnSuffix #-}+splitOnSuffix+    :: (MonadIO m)+    => Word8+    -> Stream m (Array Word8)+    -> Stream m (Array Word8)+splitOnSuffix = Array.compactOnByteSuffix++-------------------------------------------------------------------------------+-- Elimination - Running folds+-------------------------------------------------------------------------------++{-# INLINE_NORMAL foldBreakD #-}+foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>+    Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))+foldBreakD = Array.foldBreakChunks++-- | Fold an array stream using the supplied 'Fold'. Returns the fold result+-- and the unconsumed stream.+--+-- > foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)+--+-- Instead of using this we can adapt the fold to ParserK and use+-- parseBreakChunks instead. ParserK allows composing using Monad as well.+--+-- @+-- foldBreak f s =+--       fmap (first (fromRight undefined))+--     $ K.parseBreakChunks (ParserK.adaptC (PR.fromFold f)) s+-- @+--+-- We can compare perf and remove this one or define it in terms of that.+--+-- /Internal/+--+{-# INLINE_NORMAL foldBreak #-}+foldBreak ::+       (MonadIO m, Unbox a)+    => Fold m a b+    -> StreamK m (A.Array a)+    -> m (b, StreamK m (A.Array a))+foldBreak = Array.foldBreakChunksK+--+-- foldBreak f s = fmap fromStreamD <$> foldBreakD f (toStreamD s)+--+-- foldBreak f s =+--       fmap (first (fromRight undefined))+--     $ K.parseBreakChunks (ParserK.adaptC (PR.fromFold f)) s+--+-- If foldBreak performs better than runArrayFoldBreak we can use a rewrite+-- rule to rewrite runArrayFoldBreak to fold.+-- foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)++-------------------------------------------------------------------------------+-- Elimination - running element parsers+-------------------------------------------------------------------------------++-- When we have to take an array partially, take the last part of the array.+{-# INLINE takeArrayListRev #-}+takeArrayListRev :: forall a. Unbox a => Int -> [Array a] -> [Array a]+takeArrayListRev = go++    where++    go _ [] = []+    go n _ | n <= 0 = []+    go n (x:xs) =+        let len = Array.length x+        in if n > len+           then x : go (n - len) xs+           else if n == len+           then [x]+           else let !(Array contents _ end) = x+                    !start = end - (n * SIZE_OF(a))+                 in [Array contents start end]++-- When we have to take an array partially, take the last part of the array in+-- the first split.+{-# INLINE splitAtArrayListRev #-}+splitAtArrayListRev ::+    forall a. Unbox a => Int -> [Array a] -> ([Array a],[Array a])+splitAtArrayListRev n ls+  | n <= 0 = ([], ls)+  | otherwise = go n ls+    where+        go :: Int -> [Array a] -> ([Array a], [Array a])+        go _  []     = ([], [])+        go m (x:xs) =+            let len = Array.length x+                (xs', xs'') = go (m - len) xs+             in if m > len+                then (x:xs', xs'')+                else if m == len+                then ([x],xs)+                else let !(Array contents start end) = x+                         end1 = end - (m * SIZE_OF(a))+                         arr2 = Array contents start end1+                         arr1 = Array contents end1 end+                      in ([arr1], arr2:xs)++-- 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 an array stream using the supplied 'Parser'.  Returns the parse+-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.+--+-- >> parseBreak p = K.parseBreakChunks (ParserK.adaptC p)+--+-- This is redundant and we can just use parseBreakChunks, as ParserK can be+-- composed using Monad. The only advantage of this is that we do not need to+-- adapt.+--+-- We can compare perf and remove this one or define it in terms of that.+--+-- /Internal/+--+{-# INLINE_NORMAL parseBreak #-}+parseBreak ::+       (MonadIO m, Unbox a)+    => PR.Parser a m b+    -> StreamK m (A.Array a)+    -> m (Either ParseError b, StreamK m (A.Array a))+{-+parseBreak p s =+    fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)+-}+parseBreak p = Array.parseBreak (Array.toParserK p)++-------------------------------------------------------------------------------+-- Elimination - Running Array Folds and parsers+-------------------------------------------------------------------------------++-- | Note that this is not the same as using a @Parser (Array a) m b@ with the+-- regular "Streamly.Internal.Data.IsStream.parse" function. The regular parse+-- would consume the input arrays as single unit. This parser parses in the way+-- as described in the ChunkFold module. The input arrays are treated as @n@+-- element units and can be consumed partially. The remaining elements are+-- inserted in the source stream as an array.+--+{-# INLINE_NORMAL runArrayParserDBreak #-}+runArrayParserDBreak ::+       forall m a b. (MonadIO m, Unbox a)+    => PRD.Parser (Array a) m b+    -> D.Stream m (Array.Array a)+    -> m (Either ParseError b, D.Stream m (Array.Array a))+runArrayParserDBreak+    (PRD.Parser pstep initial extract)+    stream@(D.Stream step state) = do++    res <- initial+    case res of+        PRD.IPartial s -> go SPEC state (List []) s+        PRD.IDone b -> return (Right b, stream)+        PRD.IError err -> return (Left (ParseError err), stream)++    where++    -- "backBuf" contains last few items in the stream that we may have to+    -- backtrack to.+    --+    -- XXX currently we are using a dumb list based approach for backtracking+    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.+    -- That will allow us more efficient random back and forth movement.+    go _ st backBuf !pst = do+        r <- step defState st+        case r of+            D.Yield x s -> gobuf SPEC [x] s backBuf pst+            D.Skip s -> go SPEC s backBuf pst+            D.Stop -> goStop backBuf pst++    gobuf !_ [] s backBuf !pst = go SPEC s backBuf pst+    gobuf !_ (x:xs) s backBuf !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                 gobuf SPEC xs s (List []) pst1+            PR.Partial n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                gobuf SPEC src s (List []) pst1+            PR.Continue 0 pst1 ->+                gobuf SPEC xs s (List (x:getList backBuf)) pst1+            PR.Continue n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                gobuf SPEC src s (List buf1) pst1+            PR.Done 0 b -> do+                let str = D.append (D.fromList xs) (D.Stream step s)+                return (Right b, str)+            PR.Done n b -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src = Prelude.reverse src0 ++ xs+                return (Right b, D.append (D.fromList src) (D.Stream step s))+            PR.SError err -> do+                let src0 = x:getList backBuf+                    src = Prelude.reverse src0 ++ x:xs+                    strm = D.append (D.fromList src) (D.Stream step s)+                return (Left (ParseError err), strm)++    -- This is a simplified gobuf+    goExtract _ [] backBuf !pst = goStop backBuf pst+    goExtract _ (x:xs) backBuf !pst = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                 goExtract SPEC xs (List []) pst1+            PR.Partial n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                goExtract SPEC src (List []) pst1+            PR.Continue 0 pst1 ->+                goExtract SPEC xs (List (x:getList backBuf)) pst1+            PR.Continue n pst1 -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)+                    src  = Prelude.reverse src0 ++ xs+                goExtract SPEC src (List buf1) pst1+            PR.Done 0 b ->+                return (Right b, D.fromList xs)+            PR.Done n b -> do+                assert+                    (n <= sum (map Array.length (x:getList backBuf)))+                    (return ())+                let src0 = takeArrayListRev n (x:getList backBuf)+                    src = Prelude.reverse src0 ++ xs+                return (Right b, D.fromList src)+            PR.SError err -> do+                let src0 = getList backBuf+                    src = Prelude.reverse src0 ++ x:xs+                return (Left (ParseError err), D.fromList src)++    -- This is a simplified goExtract+    {-# INLINE goStop #-}+    goStop backBuf pst = do+        pRes <- extract pst+        case pRes of+            PR.FContinue 0 pst1 ->+                goStop backBuf pst1+            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.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.FError err -> do+                let src0 = getList backBuf+                    src = Prelude.reverse src0+                return (Left (ParseError err), D.fromList src)++{-+-- | Parse an array stream using the supplied 'Parser'.  Returns the parse+-- result and the unconsumed stream. Throws 'ParseError' if the parse fails.+--+-- /Internal/+--+{-# INLINE parseArr #-}+parseArr ::+       (MonadIO m, MonadThrow m, Unbox a)+    => ASF.Parser a m b+    -> Stream m (A.Array a)+    -> m (b, Stream m (A.Array a))+parseArr p s = fmap fromStreamD <$> parseBreakD p (toStreamD s)+-}++-- | Fold an array stream using the supplied array stream 'Fold'.+--+-- /Pre-release/+--+{-# INLINE runArrayFold #-}+runArrayFold :: (MonadIO m, Unbox a) =>+    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b)+runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStream s)++-- | Like 'fold' but also returns the remaining stream.+--+-- /Pre-release/+--+{-# INLINE runArrayFoldBreak #-}+runArrayFoldBreak :: (MonadIO m, Unbox a) =>+    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b, StreamK m (A.Array a))+runArrayFoldBreak (ChunkFold p) s =+    second fromStream <$> runArrayParserDBreak p (toStream s)++{-# ANN type ParseChunksState Fuse #-}+data ParseChunksState x inpBuf st pst =+      ParseChunksInit inpBuf st+    | ParseChunksInitBuf inpBuf+    | ParseChunksInitLeftOver inpBuf+    | ParseChunksStream st inpBuf !pst+    | ParseChunksStop inpBuf !pst+    | ParseChunksBuf inpBuf st inpBuf !pst+    | ParseChunksExtract inpBuf inpBuf !pst+    | ParseChunksYield x (ParseChunksState x inpBuf st pst)++{-# INLINE_NORMAL runArrayFoldManyD #-}+runArrayFoldManyD+    :: (Monad m, Unbox a)+    => ChunkFold m a b+    -> D.Stream m (Array a)+    -> D.Stream m (Either ParseError b)+runArrayFoldManyD+    (ChunkFold (PRD.Parser pstep initial extract)) (D.Stream step state) =++    D.Stream stepOuter (ParseChunksInit [] state)++    where++    {-# INLINE_LATE stepOuter #-}+    -- Buffer is empty, get the first element from the stream, initialize the+    -- fold and then go to stream processing loop.+    stepOuter gst (ParseChunksInit [] st) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                res <- initial+                case res of+                    PRD.IPartial ps ->+                        return $ D.Skip $ ParseChunksBuf [x] s [] ps+                    PRD.IDone pb -> do+                        let next = ParseChunksInit [x] s+                        return $ D.Skip $ ParseChunksYield (Right pb) next+                    PRD.IError err -> do+                        let next = ParseChunksInitLeftOver []+                        return+                            $ D.Skip+                            $ ParseChunksYield (Left (ParseError err)) next+            D.Skip s -> return $ D.Skip $ ParseChunksInit [] s+            D.Stop   -> return D.Stop++    -- Buffer is not empty, go to buffered processing loop+    stepOuter _ (ParseChunksInit src st) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ D.Skip $ ParseChunksBuf src st [] ps+            PRD.IDone pb ->+                let next = ParseChunksInit src st+                 in return $ D.Skip $ ParseChunksYield (Right pb) next+            PRD.IError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    -- This is a simplified ParseChunksInit+    stepOuter _ (ParseChunksInitBuf src) = do+        res <- initial+        case res of+            PRD.IPartial ps ->+                return $ D.Skip $ ParseChunksExtract src [] ps+            PRD.IDone pb ->+                let next = ParseChunksInitBuf src+                 in return $ D.Skip $ ParseChunksYield (Right pb) next+            PRD.IError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    -- XXX we just discard any leftover input at the end+    stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop++    -- Buffer is empty, process elements from the stream+    stepOuter gst (ParseChunksStream st backBuf pst) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                pRes <- pstep pst x+                case pRes of+                    PR.Partial 0 pst1 ->+                        return $ D.Skip $ ParseChunksStream s [] pst1+                    PR.Partial n pst1 -> do+                        assert+                            (n <= sum (map Array.length (x:backBuf)))+                            (return ())+                        let src0 = takeArrayListRev n (x:backBuf)+                            src  = Prelude.reverse src0+                        return $ D.Skip $ ParseChunksBuf src s [] pst1+                    PR.Continue 0 pst1 ->+                        return $ D.Skip $ ParseChunksStream s (x:backBuf) pst1+                    PR.Continue n pst1 -> do+                        assert+                            (n <= sum (map Array.length (x:backBuf)))+                            (return ())+                        let (src0, buf1) = splitAtArrayListRev n (x:backBuf)+                            src  = Prelude.reverse src0+                        return $ D.Skip $ ParseChunksBuf src s buf1 pst1+                    PR.Done 0 b -> do+                        return $ D.Skip $+                            ParseChunksYield (Right b) (ParseChunksInit [] s)+                    PR.Done n b -> do+                        assert+                            (n <= sum (map Array.length (x:backBuf)))+                            (return ())+                        let src0 = takeArrayListRev n (x:backBuf)+                            src = Prelude.reverse src0+                            next = ParseChunksInit src s+                        return+                            $ D.Skip+                            $ ParseChunksYield (Right b) next+                    PR.SError err -> do+                        let next = ParseChunksInitLeftOver []+                        return+                            $ D.Skip+                            $ ParseChunksYield (Left (ParseError err)) next++            D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst+            D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst++    -- go back to stream processing mode+    stepOuter _ (ParseChunksBuf [] s buf pst) =+        return $ D.Skip $ ParseChunksStream s buf pst++    -- buffered processing loop+    stepOuter _ (ParseChunksBuf (x:xs) s backBuf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ D.Skip $ ParseChunksBuf xs s [] pst1+            PR.Partial n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksBuf src s [] pst1+            PR.Continue 0 pst1 ->+                return $ D.Skip $ ParseChunksBuf xs s (x:backBuf) pst1+            PR.Continue n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksBuf src s buf1 pst1+            PR.Done 0 b ->+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)+            PR.Done n b -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src = Prelude.reverse src0 ++ xs+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInit src s)+            PR.SError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    -- This is a simplified ParseChunksBuf+    stepOuter _ (ParseChunksExtract [] buf pst) =+        return $ D.Skip $ ParseChunksStop buf pst++    stepOuter _ (ParseChunksExtract (x:xs) backBuf pst) = do+        pRes <- pstep pst x+        case pRes of+            PR.Partial 0 pst1 ->+                return $ D.Skip $ ParseChunksExtract xs [] pst1+            PR.Partial n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksExtract src [] pst1+            PR.Continue 0 pst1 ->+                return $ D.Skip $ ParseChunksExtract xs (x:backBuf) pst1+            PR.Continue n pst1 -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)+                    src  = Prelude.reverse src0 ++ xs+                return $ D.Skip $ ParseChunksExtract src buf1 pst1+            PR.Done 0 b ->+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)+            PR.Done n b -> do+                assert (n <= sum (map Array.length (x:backBuf))) (return ())+                let src0 = takeArrayListRev n (x:backBuf)+                    src = Prelude.reverse src0 ++ xs+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)+            PR.SError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next+++    -- This is a simplified ParseChunksExtract+    stepOuter _ (ParseChunksStop backBuf pst) = do+        pRes <- extract pst+        case pRes of+            PR.FContinue 0 pst1 ->+                return $ D.Skip $ ParseChunksStop backBuf pst1+            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.FDone 0 b ->+                return+                    $ D.Skip+                    $ ParseChunksYield (Right b) (ParseChunksInitLeftOver [])+            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.FError err -> do+                let next = ParseChunksInitLeftOver []+                return+                    $ D.Skip+                    $ ParseChunksYield (Left (ParseError err)) next++    stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next++-- | Apply an 'ChunkFold' repeatedly on an array stream and emit the+-- fold outputs in the output stream.+--+-- See "Streamly.Data.Stream.foldMany" for more details.+--+-- /Pre-release/+{-# INLINE runArrayFoldMany #-}+runArrayFoldMany+    :: (Monad m, Unbox a)+    => ChunkFold m a b+    -> StreamK m (Array a)+    -> StreamK m (Either ParseError b)+runArrayFoldMany p m = fromStream $ runArrayFoldManyD p (toStream m)
src/Streamly/Internal/Data/Array/Type.hs view
@@ -1,592 +1,1557 @@ {-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Array.Type--- Copyright   : (c) 2020 Composewell Technologies------ License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ See notes in "Streamly.Internal.Data.Array.Mut.Type"----module Streamly.Internal.Data.Array.Type-    (-    -- $arrayNotes-      Array (..)-    , asPtrUnsafe--    -- * Freezing and Thawing-    , unsafeFreeze-    , unsafeFreezeWithShrink-    , unsafeThaw--    -- * Pinning and Unpinning-    , pin-    , unpin--    -- * Construction-    , splice--    , fromList-    , fromListN-    , fromListRev-    , fromListRevN-    , fromStreamDN-    , fromStreamD--    -- * Split-    , breakOn--    -- * Elimination-    , unsafeIndexIO-    , unsafeIndex -- getIndexUnsafe-    , byteLength-    , length--    , foldl'-    , foldr-    , splitAt--    , toStreamD-    , toStreamDRev-    , toStreamK-    , toStreamKRev-    , toStream-    , toStreamRev-    , read-    , readRev-    , readerRev-    , toList--    -- * Folds-    , writeWith-    , writeN-    , writeNUnsafe-    , MA.ArrayUnsafe (..)-    , writeNAligned-    , write--    -- * Streams of arrays-    , chunksOf-    , bufferChunks-    , flattenArrays-    , flattenArraysRev-    )-where--#include "ArrayMacros.h"-#include "inline.hs"--import Control.Exception (assert)-import Control.Monad (replicateM)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity(..))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import GHC.Base (build)-import GHC.Exts (IsList, IsString(..))--import GHC.IO (unsafePerformIO)-import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.Array.Mut.Type (MutArray(..), MutableByteArray)-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Unboxed (Unbox, peekWith, sizeOf)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Text.Read (readPrec)--import Prelude hiding (length, foldr, read, unlines, splitAt)--import qualified GHC.Exts as Exts-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Unboxed as Unboxed-import qualified Streamly.Internal.Data.Unfold.Type as Unfold-import qualified Text.ParserCombinators.ReadPrec as ReadPrec--import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)--#include "DocTestDataArray.hs"------------------------------------------------------------------------------------ Array Data Type------------------------------------------------------------------------------------ $arrayNotes------ We can use an 'Unbox' constraint in the Array type and the constraint can--- be automatically provided to a function that pattern matches on the Array--- type. However, it has huge performance cost, so we do not use it.--- Investigate a GHC improvement possiblity.----data Array a =-#ifdef DEVBUILD-    Unbox a =>-#endif-    -- All offsets are in terms of bytes from the start of arraycontents-    Array-    { arrContents :: {-# UNPACK #-} !MutableByteArray-    , arrStart :: {-# UNPACK #-} !Int -- offset-    , arrEnd   :: {-# UNPACK #-} !Int   -- offset + len-    }------------------------------------------------------------------------------------ Utility functions------------------------------------------------------------------------------------ | Use an @Array a@ as @Ptr a@.------ See 'MA.asPtrUnsafe' in the Mutable array module for more details.------ /Unsafe/------ /Pre-release/----asPtrUnsafe :: MonadIO m => Array a -> (Ptr a -> m b) -> m b-asPtrUnsafe arr = MA.asPtrUnsafe (unsafeThaw arr)------------------------------------------------------------------------------------ Freezing and Thawing------------------------------------------------------------------------------------ XXX For debugging we can track slices/references through a weak IORef.  Then--- trigger a GC after freeze/thaw and assert that there are no references--- remaining.---- | Makes an immutable array using the underlying memory of the mutable--- array.------ Please make sure that there are no other references to the mutable array--- lying around, so that it is never used after freezing it using--- /unsafeFreeze/.  If the underlying array is mutated, the immutable promise--- is lost.------ /Pre-release/-{-# INLINE unsafeFreeze #-}-unsafeFreeze :: MutArray a -> Array a-unsafeFreeze (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-  return $ Array ac as ae---- | Makes a mutable array using the underlying memory of the immutable array.------ Please make sure that there are no other references to the immutable array--- lying around, so that it is never used after thawing it using /unsafeThaw/.--- If the resulting array is mutated, any references to the older immutable--- array are mutated as well.------ /Pre-release/-{-# INLINE unsafeThaw #-}-unsafeThaw :: Array a -> MutArray a-unsafeThaw (Array ac as ae) = MutArray ac as ae ae------------------------------------------------------------------------------------ Pinning & Unpinning----------------------------------------------------------------------------------{-# INLINE pin #-}-pin :: Array a -> IO (Array a)-pin = fmap unsafeFreeze . MA.pin . unsafeThaw--{-# INLINE unpin #-}-unpin :: Array a -> IO (Array a)-unpin = fmap unsafeFreeze . MA.unpin . unsafeThaw------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ Splice two immutable arrays creating a new array.-{-# INLINE splice #-}-splice :: (MonadIO m, Unbox a) => Array a -> Array a -> m (Array a)-splice arr1 arr2 =-    unsafeFreeze <$> MA.splice (unsafeThaw arr1) (unsafeThaw arr2)---- | Create an 'Array' 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 :: Unbox a => Int -> [a] -> Array a-fromListN n xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListN n xs---- | Create an 'Array' from the first N elements of a list in reverse order.--- The array is allocated to size N, if the list terminates before N elements--- then the array may hold less than N elements.------ /Pre-release/-{-# INLINABLE fromListRevN #-}-fromListRevN :: Unbox a => Int -> [a] -> Array a-fromListRevN n xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListRevN n xs---- | Create an 'Array' from a list. The list must be of finite size.----{-# INLINE fromList #-}-fromList :: Unbox a => [a] -> Array a-fromList xs = unsafePerformIO $ unsafeFreeze <$> MA.fromList xs---- | Create an 'Array' from a list in reverse order. The list must be of finite--- size.------ /Pre-release/-{-# INLINABLE fromListRev #-}-fromListRev :: Unbox a => [a] -> Array a-fromListRev xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListRev xs--{-# INLINE_NORMAL fromStreamDN #-}-fromStreamDN :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> m (Array a)-fromStreamDN limit str = unsafeFreeze <$> MA.fromStreamDN limit str--{-# INLINE_NORMAL fromStreamD #-}-fromStreamD :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m a -> m (Array a)-fromStreamD str = unsafeFreeze <$> MA.fromStreamD str------------------------------------------------------------------------------------ Streams of arrays----------------------------------------------------------------------------------{-# INLINE bufferChunks #-}-bufferChunks :: (MonadIO m, Unbox a) =>-    D.Stream m a -> m (K.StreamK m (Array a))-bufferChunks m = D.foldr K.cons K.nil $ chunksOf defaultChunkSize m---- | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ >>> chunksOf n = Stream.foldMany (Array.writeN n)------ /Pre-release/-{-# INLINE_NORMAL chunksOf #-}-chunksOf :: forall m a. (MonadIO m, Unbox a)-    => Int -> D.Stream m a -> D.Stream m (Array a)-chunksOf n str = D.map unsafeFreeze $ MA.chunksOf n str---- | Use the "read" unfold instead.------ @flattenArrays = unfoldMany read@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArrays #-}-flattenArrays :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (Array a) -> D.Stream m a-flattenArrays = MA.flattenArrays . D.map unsafeThaw---- | Use the "readRev" unfold instead.------ @flattenArrays = unfoldMany readRev@------ We can try this if there are any fusion issues in the unfold.----{-# INLINE_NORMAL flattenArraysRev #-}-flattenArraysRev :: forall m a. (MonadIO m, Unbox a)-    => D.Stream m (Array a) -> D.Stream m a-flattenArraysRev = MA.flattenArraysRev . D.map unsafeThaw---- Drops the separator byte-{-# INLINE breakOn #-}-breakOn :: MonadIO m-    => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))-breakOn sep arr = do-  (a, b) <- MA.breakOn sep (unsafeThaw arr)-  return (unsafeFreeze a, unsafeFreeze <$> b)------------------------------------------------------------------------------------ Elimination------------------------------------------------------------------------------------ | 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)---- | Return element at the specified index without checking the bounds.-{-# INLINE_NORMAL unsafeIndex #-}-unsafeIndex :: forall a. Unbox a => Int -> Array a -> a-unsafeIndex i arr = let !r = unsafeInlineIO $ unsafeIndexIO i arr in r---- | /O(1)/ Get the byte length of the array.----{-# INLINE byteLength #-}-byteLength :: Array a -> Int-byteLength = MA.byteLength . unsafeThaw---- | /O(1)/ Get the length of the array i.e. the number of elements in the--- array.----{-# INLINE length #-}-length :: Unbox a => Array a -> Int-length arr = MA.length (unsafeThaw arr)---- | Unfold an array into a stream in reverse order.----{-# INLINE_NORMAL readerRev #-}-readerRev :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a-readerRev = Unfold.lmap unsafeThaw $ MA.readerRevWith (return . unsafeInlineIO)--{-# INLINE_NORMAL toStreamD #-}-toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> D.Stream m a-toStreamD arr = MA.toStreamDWith (return . unsafeInlineIO) (unsafeThaw arr)--{-# INLINE toStreamK #-}-toStreamK :: forall m a. (Monad m, Unbox a) => Array a -> K.StreamK m a-toStreamK arr = MA.toStreamKWith (return . unsafeInlineIO) (unsafeThaw arr)--{-# INLINE_NORMAL toStreamDRev #-}-toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> D.Stream m a-toStreamDRev arr =-    MA.toStreamDRevWith (return . unsafeInlineIO) (unsafeThaw arr)--{-# INLINE toStreamKRev #-}-toStreamKRev :: forall m a. (Monad m, Unbox a) => Array a -> K.StreamK m a-toStreamKRev arr =-    MA.toStreamKRevWith (return . unsafeInlineIO) (unsafeThaw arr)---- | Convert an 'Array' into a stream.------ /Pre-release/-{-# INLINE_EARLY read #-}-read :: (Monad m, Unbox a) => Array a -> Stream m a-read = toStreamD---- | Same as 'read'----{-# DEPRECATED toStream "Please use 'read' instead." #-}-{-# INLINE_EARLY toStream #-}-toStream :: (Monad m, Unbox a) => Array a -> Stream m a-toStream = read--- XXX add fallback to StreamK rule--- {-# RULES "Streamly.Array.read fallback to StreamK" [1]---     forall a. S.readK (read a) = K.fromArray a #-}---- | Convert an 'Array' into a stream in reverse order.------ /Pre-release/-{-# INLINE_EARLY readRev #-}-readRev :: (Monad m, Unbox a) => Array a -> Stream m a-readRev = toStreamDRev---- | Same as 'readRev'----{-# DEPRECATED toStreamRev "Please use 'readRev' instead." #-}-{-# INLINE_EARLY toStreamRev #-}-toStreamRev :: (Monad m, Unbox a) => Array a -> Stream m a-toStreamRev = readRev---- XXX add fallback to StreamK rule--- {-# RULES "Streamly.Array.readRev fallback to StreamK" [1]---     forall a. S.toStreamK (readRev a) = K.revFromArray a #-}--{-# INLINE_NORMAL foldl' #-}-foldl' :: forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b-foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr--{-# INLINE_NORMAL foldr #-}-foldr :: Unbox a => (a -> b -> b) -> b -> Array a -> b-foldr f z arr = runIdentity $ D.foldr f z $ toStreamD arr---- | Create two slices of an array without copying the original array. The--- specified index @i@ is the first index of the second slice.----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)---- 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 -> Array a -> b-toListFB c n Array{..} = 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 peekWith at them.-        let !x = unsafeInlineIO $ peekWith arrContents p-        in c x (go (INDEX_NEXT(p,a)))---- | Convert an 'Array' into a list.----{-# INLINE toList #-}-toList :: Unbox a => Array a -> [a]-toList s = build (\c n -> toListFB c n s)------------------------------------------------------------------------------------ Folds------------------------------------------------------------------------------------ | @writeN n@ folds a maximum of @n@ elements from the input stream to an--- 'Array'.----{-# INLINE_NORMAL writeN #-}-writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)-writeN = fmap unsafeFreeze . MA.writeN---- | @writeNAligned alignment n@ folds a maximum of @n@ elements from the input--- stream to an 'Array' aligned to the given size.------ /Pre-release/----{-# INLINE_NORMAL writeNAligned #-}-writeNAligned :: forall m a. (MonadIO m, Unbox a)-    => Int -> Int -> Fold m a (Array a)-writeNAligned alignSize = fmap unsafeFreeze . MA.writeNAligned alignSize---- | Like 'writeN' but does not check the array bounds when writing. The fold--- driver must not call the step function more than 'n' times otherwise it will--- corrupt the memory and crash. This function exists mainly because any--- conditional in the step function blocks fusion causing 10x performance--- slowdown.----{-# INLINE_NORMAL writeNUnsafe #-}-writeNUnsafe :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (Array a)-writeNUnsafe n = unsafeFreeze <$> MA.writeNUnsafe n--{-# INLINE_NORMAL writeWith #-}-writeWith :: forall m a. (MonadIO m, Unbox a)-    => Int -> Fold m a (Array a)--- writeWith n = FL.rmapM spliceArrays $ toArraysOf n-writeWith elemCount = unsafeFreeze <$> MA.writeWith elemCount---- | Fold the whole input to a single array.------ /Caution! Do not use this on infinite streams./----{-# INLINE write #-}-write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)-write = fmap unsafeFreeze MA.write------------------------------------------------------------------------------------ Instances----------------------------------------------------------------------------------instance (Show a, Unbox a) => Show (Array a) where-    {-# INLINE show #-}-    show arr = "fromList " ++ show (toList arr)--instance (Unbox a, Read a, Show a) => Read (Array a) where-    {-# INLINE readPrec #-}-    readPrec = do-        fromListWord <- replicateM 9 ReadPrec.get-        if fromListWord == "fromList "-        then fromList <$> readPrec-        else ReadPrec.pfail--instance (a ~ Char) => IsString (Array a) where-    {-# INLINE fromString #-}-    fromString = fromList---- GHC versions 8.0 and below cannot derive IsList-instance Unbox a => IsList (Array a) where-    type (Item (Array a)) = a-    {-# INLINE fromList #-}-    fromList = fromList-    {-# INLINE fromListN #-}-    fromListN = fromListN-    {-# INLINE toList #-}-    toList = toList---- XXX we are assuming that Unboxed equality means element equality. This may--- or may not be correct? arrcmp is 40% faster compared to stream equality.-instance (Unbox a, Eq a) => Eq (Array a) where-    {-# INLINE (==) #-}-    arr1 == arr2 =-        (==) EQ $ unsafeInlineIO $! unsafeThaw arr1 `MA.cmp` unsafeThaw arr2--instance (Unbox a, Ord a) => Ord (Array a) where-    {-# INLINE compare #-}-    compare arr1 arr2 = runIdentity $-        D.cmpBy compare (toStreamD arr1) (toStreamD 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--#ifdef DEVBUILD--- Definitions using the Unboxed constraint from the Array type. These are to--- make the Foldable instance possible though it is much slower (7x slower).----{-# INLINE_NORMAL _toStreamD_ #-}-_toStreamD_ :: forall m a. MonadIO m => Int -> Array a -> D.Stream m a-_toStreamD_ size Array{..} = D.Stream step arrStart--    where--    {-# INLINE_LATE step #-}-    step _ p | p == arrEnd = return D.Stop-    step _ p = liftIO $ do-        x <- peekWith arrContents p-        return $ D.Yield x (p + size)--{--XXX Why isn't Unboxed implicit? This does not compile unless I use the Unboxed-contraint.-{-# INLINE_NORMAL _foldr #-}-_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b-_foldr f z arr =-    let !n = SIZE_OF(a)-    in unsafePerformIO $ D.foldr f z $ toStreamD_ n arr--- | Note that the 'Foldable' instance is 7x slower than the direct--- operations.-instance Foldable Array where-  foldr = _foldr--}--#endif------------------------------------------------------------------------------------ Semigroup and Monoid----------------------------------------------------------------------------------instance Unbox a => Semigroup (Array a) where-    arr1 <> arr2 = unsafePerformIO $ splice arr1 arr2--nil ::-#ifdef DEVBUILD-    Unbox a =>-#endif-    Array a-nil = Array Unboxed.nil 0 0--instance Unbox a => Monoid (Array a) where-    mempty = nil-    mappend = (<>)+{-# 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+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- See notes in "Streamly.Internal.Data.MutArray.Type"+--++module Streamly.Internal.Data.Array.Type+    (+    -- ** Type+    -- $arrayNotes+      Array (..)++    -- ** Conversion+    -- *** Mutable and Immutable+    , unsafeFreeze+    , unsafeFreezeWithShrink+    , unsafeThaw++    -- *** Pinned and Unpinned+    , pin+    , unpin+    , isPinned++    -- *** Casting+    , unsafePinnedAsPtr+    , unsafeAsForeignPtr++    -- * Subarrays+    , unsafeSliceOffLen++    -- ** Construction+    , empty++    -- * Random Access+    -- , (!!)+    , getIndex+    , getIndexRev+    , head+    , last+    , init+    , tail+    , uncons+    , unsnoc++    -- *** Slicing+    -- | Get a subarray without copying+    , unsafeBreakAt+    , breakAt+    , breakEndByWord8_+    , breakEndBy+    , breakEndBy_+    , revBreakEndBy+    , revBreakEndBy_+    -- drop+    -- dropRev/dropEnd+    , dropAround+    , dropWhile+    , revDropWhile++    -- *** Stream Folds+    , unsafeMakePure+    , createOf+    , createOf'+    , unsafeCreateOf+    , unsafeCreateOf'+    , create+    , create'+    , createWith++    -- *** From containers+    , fromListN+    , fromListN'+    , fromList+    , fromList'+    , fromListRevN+    , fromListRev+    , fromStreamN+    , fromStream+    , fromPureStreamN+    , fromPureStream+    , fromCString#+    , fromCString+    , fromW16CString#+    , fromW16CString+    , fromPtrN+    , fromChunks+    , fromChunksK+    , unsafeFromForeignPtr++    -- ** Reading++    -- *** Indexing+    , unsafeGetIndexIO+    , unsafeGetIndexRevIO+    , unsafeGetIndex+    , unsafeGetIndexRev++    -- *** To Streams+    , read+    , readRev+    , toStreamK+    , toStreamKRev++    -- *** To Containers+    , toList++    -- *** Unfolds+    , producer -- experimental+    , unsafeReader+    , reader+    , readerRev++    -- *** Size+    , null+    , length+    , byteLength++    -- ** Folding+    , foldl'+    , foldr+    , byteCmp+    , byteEq+    , listCmp+    , listEq++    -- ** Appending+    , splice -- XXX requires MonadIO+    -- appendString+    -- appendCString/CString#++    -- ** Streams of arrays+    -- *** Chunk+    -- | Group a stream into arrays.+    , chunksOf+    , 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.+    , concat+    , concatRev++    -- *** Compact+    -- | Append the arrays in a stream to form a stream of larger arrays.+    , createCompactMin+    , createCompactMin'+    , scanCompactMin+    , scanCompactMin'+    , compactMin++    -- ** Deprecated+    , breakOn+    , splitAt+    , asPtrUnsafe+    , unsafeIndex+    , bufferChunks+    , flattenArrays+    , flattenArraysRev+    , fromArrayStreamK+    , fromStreamDN+    , fromStreamD+    , toStreamD+    , toStreamDRev+    , toStream+    , toStreamRev+    , nil+    , writeWith+    , writeN+    , pinnedWriteN+    , writeNUnsafe+    , pinnedWriteNUnsafe+    , 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#, minusAddr#)+import GHC.Int (Int(..))+import GHC.ForeignPtr (ForeignPtr(..), ForeignPtrContents(..))++import GHC.IO (unsafePerformIO)+import GHC.Ptr (Ptr(..), nullPtr)+import Streamly.Internal.Data.Producer.Type (Producer(..))+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, head, init, last, read, tail, unlines, splitAt+    , dropWhile)++import qualified GHC.Exts as Exts+import qualified Streamly.Internal.Data.Fold.Type as Fold+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Streamly.Internal.Data.MutByteArray.Type as Unboxed+import qualified Streamly.Internal.Data.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++import Streamly.Internal.System.IO (unsafeInlineIO, defaultChunkSize)++#include "DocTestDataArray.hs"++-------------------------------------------------------------------------------+-- Notes+-------------------------------------------------------------------------------++-- IMPORTANT:++-- We need to be careful while using unsafePerformIO when array creation is+-- involved.+--+-- * We need to make sure the unsafe IO line does not float out of the binding.+-- * The order of the IO actions should be sane. For example, `touch` after `f`.+--+-- Assume the unsafe IO action floats up. If it makes sense given this+-- assumption, it's probably OK to use usafe IO.+--+-- A general approach should be never to use unsafe IO where Array creation is+-- involved or touch is involved.++-------------------------------------------------------------------------------+-- Array Data Type+-------------------------------------------------------------------------------++-- $arrayNotes+--+-- We can use an 'Unbox' constraint in the Array type and the constraint can+-- be automatically provided to a function that pattern matches on the Array+-- type. However, it has huge performance cost, so we do not use it.+-- Investigate a GHC improvement possiblity.+--+data Array a =+#ifdef DEVBUILD+    Unbox a =>+#endif+    -- All offsets are in terms of bytes from the start of arraycontents+    Array+    { arrContents :: {-# UNPACK #-} !MutByteArray+    , arrStart :: {-# UNPACK #-} !Int -- offset+    , arrEnd   :: {-# UNPACK #-} !Int   -- offset + len+    }++-------------------------------------------------------------------------------+-- 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 -> 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 arr f = MA.unsafePinnedAsPtr (unsafeThaw arr) (\p _ -> f p)++-------------------------------------------------------------------------------+-- Freezing and Thawing+-------------------------------------------------------------------------------++-- XXX For debugging we can track slices/references through a weak IORef.  Then+-- trigger a GC after freeze/thaw and assert that there are no references+-- remaining.++-- | Makes an immutable array using the underlying memory of the mutable+-- array.+--+-- Please make sure that there are no other references to the mutable array+-- lying around, so that it is never used after freezing it using+-- /unsafeFreeze/.  If the underlying array is mutated, the immutable promise+-- is lost.+--+-- /Pre-release/+{-# INLINE unsafeFreeze #-}+unsafeFreeze :: MutArray a -> Array a+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+  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.+--+-- Please make sure that there are no other references to the immutable array+-- lying around, so that it is never used after thawing it using /unsafeThaw/.+-- If the resulting array is mutated, any references to the older immutable+-- array are mutated as well.+--+-- /Pre-release/+{-# INLINE unsafeThaw #-}+unsafeThaw :: Array a -> MutArray a+unsafeThaw (Array ac as ae) = MA.MutArray ac as ae ae++-------------------------------------------------------------------------------+-- Pinning & Unpinning+-------------------------------------------------------------------------------++-- | Return a copy of the 'Array' in pinned memory if unpinned, else return the+-- original array.+{-# INLINE pin #-}+pin :: Array a -> IO (Array a)+pin = fmap unsafeFreeze . MA.pin . unsafeThaw++-- | Return a copy of the 'Array' in unpinned memory if pinned, else return the+-- original array.+{-# INLINE unpin #-}+unpin :: Array a -> IO (Array a)+unpin = fmap unsafeFreeze . MA.unpin . unsafeThaw++-- | Return 'True' if the array is allocated in pinned memory.+{-# INLINE isPinned #-}+isPinned :: Array a -> Bool+isPinned = MA.isPinned . unsafeThaw++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++-- | Copy two immutable arrays into a new array. If you want to splice more+-- than two arrays then this operation would be highly inefficient because it+-- would make a copy on every splice operation, instead use the+-- 'fromChunksK' operation to combine n immutable arrays.+{-# INLINE splice #-}+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)++-- | Create an 'Array' 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 :: Unbox a => Int -> [a] -> Array a+fromListN n xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListN n xs++-- | Like 'fromListN' but creates a pinned array.+{-# 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+-- then the array may hold less than N elements.+--+-- /Pre-release/+{-# INLINABLE fromListRevN #-}+fromListRevN :: Unbox a => Int -> [a] -> Array a+fromListRevN n xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListRevN n xs++-- | Create an 'Array' from a list. The list must be of finite size.+--+{-# INLINE fromList #-}+fromList :: Unbox a => [a] -> Array a+fromList xs = unsafePerformIO $ unsafeFreeze <$> MA.fromList xs++-- | Like 'fromList' but creates a pinned array.+{-# 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.+--+-- /Pre-release/+{-# INLINABLE fromListRev #-}+fromListRev :: Unbox a => [a] -> Array a+fromListRev xs = unsafePerformIO $ unsafeFreeze <$> MA.fromListRev xs++-- | Create an 'Array' from the first N elements of a stream. The array is+-- allocated to size N, if the stream terminates before N elements then the+-- array may hold less than N elements.+--+-- >>> fromStreamN n = Stream.fold (Array.createOf n)+--+-- /Pre-release/+{-# INLINE_NORMAL fromStreamN #-}+fromStreamN :: (MonadIO m, Unbox a) => Int -> Stream m a -> m (Array a)+fromStreamN n m = do+    when (n < 0) $ error "writeN: negative write count specified"+    unsafeFreeze <$> MA.fromStreamN n m+-- fromStreamN n = D.fold (writeN n)++{-# DEPRECATED fromStreamDN "Please use fromStreamN instead." #-}+fromStreamDN :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> m (Array a)+fromStreamDN = fromStreamN++-- | Create an 'Array' from a stream. This is useful when we want to create a+-- single array from a stream of unknown size. 'writeN' is at least twice+-- as efficient when the size is already known.+--+-- >>> 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+-- processing of indvidual arrays in the resulting stream should be preferred.+--+-- /Pre-release/+{-# INLINE_NORMAL fromStreamD #-}+fromStream :: (MonadIO m, Unbox a) => Stream m a -> m (Array a)+fromStream = D.fold write+-- fromStreamD str = unsafeFreeze <$> MA.fromStream str++{-# DEPRECATED fromStreamD "Please use fromStream instead." #-}+fromStreamD :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m a -> m (Array a)+fromStreamD = fromStream++-------------------------------------------------------------------------------+-- Slice+-------------------------------------------------------------------------------++-- | /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)++-------------------------------------------------------------------------------+-- 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+-------------------------------------------------------------------------------++{-# INLINE buildChunks #-}+buildChunks :: (MonadIO m, Unbox a) =>+    D.Stream m a -> m (K.StreamK m (Array a))+buildChunks m = D.foldr K.cons K.nil $ chunksOf defaultChunkSize m++{-# DEPRECATED bufferChunks "Please use buildChunks instead." #-}+bufferChunks :: (MonadIO m, Unbox a) =>+    D.Stream m a -> m (K.StreamK m (Array a))+bufferChunks = buildChunks++-- | @chunksOf n stream@ groups the elements in the input stream into arrays of+-- @n@ elements each.+--+-- Same as the following but may be more efficient:+--+-- >>> chunksOf n = Stream.foldMany (Array.createOf n)+--+-- /Pre-release/+{-# INLINE_NORMAL chunksOf #-}+chunksOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (Array a)+chunksOf n str = D.map unsafeFreeze $ MA.chunksOf n str++-- | Like 'chunksOf' but creates pinned arrays.+{-# INLINE_NORMAL chunksOf' #-}+pinnedChunksOf, chunksOf' :: forall m a. (MonadIO m, Unbox a)+    => Int -> D.Stream m a -> D.Stream m (Array a)+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.unfoldEach Array.reader+--+{-# INLINE_NORMAL concat #-}+concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a+concat = MA.concatWith (pure . unsafeInlineIO) . D.map unsafeThaw+-- concat = D.unfoldMany reader++{-# DEPRECATED flattenArrays "Please use \"unfoldMany reader\" instead." #-}+{-# INLINE flattenArrays #-}+flattenArrays :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (Array a) -> D.Stream m a+flattenArrays = concat++-- | Convert a stream of arrays into a stream of their elements reversing the+-- contents of each array before flattening.+--+-- >>> concatRev = Stream.unfoldEach Array.readerRev+--+{-# INLINE_NORMAL concatRev #-}+concatRev :: forall m a. (Monad m, Unbox a)+    => D.Stream m (Array a) -> D.Stream m a+-- XXX this requires MonadIO whereas the unfoldMany version does not+concatRev = MA.concatRevWith (pure . unsafeInlineIO) . D.map unsafeThaw+-- concatRev = D.unfoldMany readerRev++{-# DEPRECATED flattenArraysRev "Please use \"unfoldMany readerRev\" instead." #-}+{-# INLINE flattenArraysRev #-}+flattenArraysRev :: forall m a. (MonadIO m, Unbox a)+    => D.Stream m (Array a) -> D.Stream m a+flattenArraysRev = concatRev++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- XXX Note that this thaws immutable arrays for appending, that may be+-- problematic if multiple users do the same thing, however, thawed immutable+-- arrays would have no capacity to append, therefore, a copy will be forced+-- anyway.++-- | 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 createCompactMin #-}+createCompactMin, fCompactGE :: (MonadIO m, Unbox a) =>+    Int -> Fold m (Array a) (Array a)+createCompactMin n =+    fmap unsafeFreeze $ Fold.lmap unsafeThaw $ MA.createCompactMin n++RENAME(fCompactGE,createCompactMin)++-- | 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@.+--+-- >>> compactBySize n = Stream.foldMany (Array.createCompactMin n)+--+-- Generates unpinned arrays irrespective of the pinning status of input+-- arrays.+{-# INLINE compactMin #-}+compactMin, compactGE ::+       (MonadIO m, Unbox a)+    => Int -> Stream m (Array a) -> Stream m (Array a)+compactMin n stream =+    D.map unsafeFreeze $ MA.compactMin n $ D.map unsafeThaw stream++RENAME(compactGE,compactMin)++-- | Like 'compactBySizeGE' but for transforming folds instead of stream.+--+-- >>> 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) ()+lCompactGE n fld =+    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 breakEndByWord8_ #-}+breakEndByWord8_, breakOn :: MonadIO m+    => Word8 -> Array Word8 -> m (Array Word8, Maybe (Array Word8))+breakEndByWord8_ sep arr = do+  (a, b) <- MA.breakOn sep (unsafeThaw arr)+  return (unsafeFreeze a, unsafeFreeze <$> b)+RENAME(breakOn,breakEndByWord8_)++-------------------------------------------------------------------------------+-- Elimination+-------------------------------------------------------------------------------++-- | Return element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the array.+{-# 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 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 'unsafeGetIndex' instead" #-}+{-# INLINE_NORMAL unsafeIndex #-}+unsafeIndex :: forall a. Unbox a => Int -> Array a -> a+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 #-}+byteLength :: Array a -> Int+byteLength = MA.byteLength . unsafeThaw++-- | /O(1)/ Get the length of the array i.e. the number of elements in the+-- array.+--+{-# INLINE length #-}+length :: Unbox a => Array a -> Int+length arr = MA.length (unsafeThaw arr)++{-# INLINE_NORMAL producer #-}+producer :: forall m a. (Monad m, Unbox a) => Producer m (Array a) a+producer =+    Producer.translate unsafeThaw unsafeFreeze+        $ MA.producerWith (return . unsafeInlineIO)++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+reader = Producer.simplify producer++-- | Unfold an array into a stream, does not check the end of the array, the+-- user is responsible for terminating the stream within the array bounds. For+-- high performance application where the end condition can be determined by+-- a terminating fold.+--+-- Written in the hope that it may be faster than "read", however, in the case+-- for which this was written, "read" proves to be faster even though the core+-- generated with unsafeRead looks simpler.+--+-- /Pre-release/+--+{-# 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) =+        return (MA.ArrayUnsafe contents end start)++    {-# INLINE_LATE step #-}+    step (MA.ArrayUnsafe contents end p) = do+            -- 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.+            let !x = unsafeInlineIO $ peekAt p contents+            let !p1 = INDEX_NEXT(p,a)+            return $ D.Yield x (MA.ArrayUnsafe contents end p1)++-- | Unfold an array into a stream in reverse order.+--+{-# INLINE_NORMAL readerRev #-}+readerRev :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+readerRev = Unfold.lmap unsafeThaw $ MA.readerRevWith (return . unsafeInlineIO)++{-# DEPRECATED toStreamD "Please use 'read' instead." #-}+{-# INLINE_NORMAL toStreamD #-}+toStreamD :: forall m a. (Monad m, Unbox a) => Array a -> D.Stream m a+toStreamD = read++{-# INLINE toStreamK #-}+toStreamK :: forall m a. (Monad m, Unbox a) => Array a -> K.StreamK m a+toStreamK arr = MA.toStreamKWith (return . unsafeInlineIO) (unsafeThaw arr)++{-# DEPRECATED toStreamDRev "Please use 'readRev' instead." #-}+{-# INLINE_NORMAL toStreamDRev #-}+toStreamDRev :: forall m a. (Monad m, Unbox a) => Array a -> D.Stream m a+toStreamDRev = readRev++{-# INLINE toStreamKRev #-}+toStreamKRev :: forall m a. (Monad m, Unbox a) => Array a -> K.StreamK m a+toStreamKRev arr =+    MA.toStreamKRevWith (return . unsafeInlineIO) (unsafeThaw arr)++-- | Convert an 'Array' into a stream.+--+-- /Pre-release/+{-# INLINE_EARLY read #-}+read :: (Monad m, Unbox a) => Array a -> Stream m a+read arr = MA.toStreamWith (return . unsafeInlineIO) (unsafeThaw arr)++-- | Same as 'read'+--+{-# DEPRECATED toStream "Please use 'read' instead." #-}+{-# INLINE_EARLY toStream #-}+toStream :: (Monad m, Unbox a) => Array a -> Stream m a+toStream = read+-- XXX add fallback to StreamK rule+-- {-# RULES "Streamly.Array.read fallback to StreamK" [1]+--     forall a. S.readK (read a) = K.fromArray a #-}++-- | Convert an 'Array' into a stream in reverse order.+--+-- /Pre-release/+{-# INLINE_EARLY readRev #-}+readRev :: (Monad m, Unbox a) => Array a -> Stream m a+readRev arr = MA.toStreamRevWith (return . unsafeInlineIO) (unsafeThaw arr)++-- | Same as 'readRev'+--+{-# DEPRECATED toStreamRev "Please use 'readRev' instead." #-}+{-# INLINE_EARLY toStreamRev #-}+toStreamRev :: (Monad m, Unbox a) => Array a -> Stream m a+toStreamRev = readRev++-- XXX add fallback to StreamK rule+-- {-# RULES "Streamly.Array.readRev fallback to StreamK" [1]+--     forall a. S.toStreamK (readRev a) = K.revFromArray a #-}++{-# INLINE_NORMAL foldl' #-}+foldl' :: forall a b. Unbox a => (b -> a -> b) -> b -> Array a -> b+foldl' f z arr = runIdentity $ D.foldl' f z $ toStreamD arr++{-# INLINE_NORMAL foldr #-}+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 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 #-}+toListFB :: forall a b. Unbox a => (a -> b -> b) -> b -> Array a -> b+toListFB c n Array{..} = 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 peekAt at them.+        let !x = unsafeInlineIO $ peekAt p arrContents+        in c x (go (INDEX_NEXT(p,a)))++-- | Convert an 'Array' into a list.+--+{-# INLINE toList #-}+toList :: Unbox a => Array a -> [a]+toList s = build (\c n -> toListFB c n s)++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an+-- 'Array'.+--+{-# INLINE_NORMAL createOf #-}+createOf :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+createOf = fmap unsafeFreeze . MA.createOf++{-# 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 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 createOf' instead." #-}+{-# INLINE pinnedWriteN #-}+pinnedWriteN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+pinnedWriteN = createOf'++-- | @pinnedWriteNAligned alignment n@ folds a maximum of @n@ elements from the input+-- stream to an 'Array' aligned to the given size.+--+-- /Pre-release/+--+{-# INLINE_NORMAL pinnedWriteNAligned #-}+{-# DEPRECATED pinnedWriteNAligned  "To be removed." #-}+pinnedWriteNAligned :: forall m a. (MonadIO m, Unbox a)+    => Int -> Int -> Fold m a (Array a)+pinnedWriteNAligned alignSize = fmap unsafeFreeze . MA.pinnedWriteNAligned alignSize++-- | 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.+--+{-# INLINE_NORMAL unsafeCreateOf #-}+unsafeCreateOf :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+unsafeCreateOf n = unsafeFreeze <$> MA.unsafeCreateOf n++{-# DEPRECATED writeNUnsafe  "Please use unsafeCreateOf instead." #-}+{-# INLINE writeNUnsafe #-}+writeNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+writeNUnsafe = unsafeCreateOf++{-# INLINE_NORMAL unsafeCreateOf' #-}+unsafePinnedCreateOf, unsafeCreateOf' :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+unsafeCreateOf' n = unsafeFreeze <$> MA.unsafeCreateOf' n+RENAME_PRIME(unsafePinnedCreateOf,unsafeCreateOf)++{-# DEPRECATED pinnedWriteNUnsafe  "Please use unsafeCreateOf' instead." #-}+{-# INLINE pinnedWriteNUnsafe #-}+pinnedWriteNUnsafe :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+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)+-- createWith n = FL.rmapM spliceArrays $ toArraysOf n+createWith elemCount = unsafeFreeze <$> MA.createWith elemCount++{-# DEPRECATED writeWith "Please use createWith instead." #-}+{-# INLINE writeWith #-}+writeWith :: forall m a. (MonadIO m, Unbox a)+    => Int -> Fold m a (Array a)+writeWith = createWith++-- | Fold the whole input to a single array.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE create #-}+create :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+create = fmap unsafeFreeze MA.create++{-# 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 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 create' instead." #-}+{-# INLINE pinnedWrite #-}+pinnedWrite :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+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+-- depends on the result of step, therefore, as long as the fold is driven in+-- the correct order the operations would be correctly ordered. We need to+-- ensure that we strictly evaluate the previous step completely before the+-- next step.+--+-- To not share the same array we need to make sure that the result of+-- "initial" is not shared. Existential type ensures that it does not get+-- shared across different folds. However, if we invoke "initial" multiple+-- times for the same fold, there is a possiblity of sharing the two because+-- the compiler would consider it as a pure value. One such example is the+-- chunksOf combinator, or using an array creation fold with foldMany+-- combinator. Is there a proper way in GHC to tell it to not share a pure+-- expression in a particular case?+--+-- For this reason array creation folds have a MonadIO constraint. Pure folds+-- could be unsafe and dangerous. This is dangerous especially when used with+-- foldMany like operations.+--+-- >>> unsafePureWrite = Array.unsafeMakePure Array.create+--+{-# INLINE unsafeMakePure #-}+unsafeMakePure :: Monad m => Fold IO a b -> Fold m a b+unsafeMakePure (Fold step initial extract final) =+    Fold (\x a -> return $! unsafeInlineIO (step x a))+         (return $! unsafePerformIO initial)+         (\s -> return $! unsafeInlineIO $ extract s)+         (\s -> return $! unsafeInlineIO $ final s)++{-# INLINE fromPureStreamN #-}+fromPureStreamN :: Unbox a => Int -> Stream Identity a -> Array a+fromPureStreamN n x =+    unsafePerformIO $ fmap unsafeFreeze (MA.fromPureStreamN n x)++-- | Convert a pure stream in Identity monad to an immutable array.+--+-- Same as the following but with better performance:+--+-- >>> fromPureStream = Array.fromList . runIdentity . Stream.toList+--+fromPureStream :: Unbox a => Stream Identity a -> Array a+fromPureStream x = unsafePerformIO $ fmap unsafeFreeze (MA.fromPureStream x)+-- fromPureStream = runIdentity . D.fold (unsafeMakePure write)+-- fromPureStream = fromList . runIdentity . D.toList++-- | @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 to ensure that the pointer passed is+-- valid up to the given length.+--+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.+--+-- /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:+--+-- Note, you can use lazy unsafePerformIO _only if_ the pointer is immutable.+--+-- >>> Array.toList $ unsafePerformIO $ Array.fromCString# "\1\2\3\0"#+-- [1,2,3]+--+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 $ fromCString# addr++-- | 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)++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 = 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+-- that is double the size of the array stream.+--+{-# INLINE fromChunksK #-}+fromChunksK :: (MonadIO m, Unbox a) => StreamK m (Array a) -> m (Array a)+fromChunksK stream =+    -- We buffer the entire stream and then allocate the target array of the+    -- same size, thus requiring double the memory.+    fmap unsafeFreeze $ MA.fromChunksK $ fmap unsafeThaw stream++{-# DEPRECATED fromArrayStreamK "Please use fromChunksK instead." #-}+fromArrayStreamK :: (Unbox a, MonadIO m) => StreamK m (Array a) -> m (Array a)+fromArrayStreamK = fromChunksK++-- | Given a stream of arrays, splice them all together to generate a single+-- array. The stream must be /finite/.+--+{-# INLINE fromChunks #-}+fromChunks :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)+fromChunks s =+    -- XXX Check which implementation is better+    -- This may also require double the memory as we double the space every+    -- time, when copying the last array we may have reallocated almost double+    -- the space required before we right size it.+    fmap unsafeFreeze $ MA.fromChunksRealloced (fmap unsafeThaw s)+    -- fromChunkStreamK $ D.toStreamK s++-------------------------------------------------------------------------------+-- Instances+-------------------------------------------------------------------------------++instance (Show a, Unbox a) => Show (Array a) where+    {-# INLINE show #-}+    show arr = "fromList " ++ show (toList arr)++instance (Unbox a, Read a, Show a) => Read (Array a) where+    {-# INLINE readPrec #-}+    readPrec = do+        fromListWord <- replicateM 9 ReadPrec.get+        if fromListWord == "fromList "+        then fromList <$> readPrec+        else ReadPrec.pfail++instance (a ~ Char) => IsString (Array a) where+    {-# INLINE fromString #-}+    fromString = fromList++-- GHC versions 8.0 and below cannot derive IsList+instance Unbox a => IsList (Array a) where+    type (Item (Array a)) = a+    {-# INLINE fromList #-}+    fromList = fromList+    {-# INLINE fromListN #-}+    fromListN = fromListN+    {-# 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.+--+-- /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 :: Array a -> Array a -> Ordering+byteCmp arr1 arr2 =+    -- unsafePerformIO?+    unsafeInlineIO $! unsafeThaw arr1 `MA.byteCmp` unsafeThaw arr2++-- | Byte equality of two arrays.+--+-- >>> byteEq arr1 arr2 = (==) EQ $ Array.byteCmp arr1 arr2+--+-- /Unsafe/: See 'byteCmp'.+{-# INLINE byteEq #-}+byteEq :: Array a -> Array a -> Bool+byteEq arr1 arr2 = (==) EQ $ byteCmp arr1 arr2++#define MK_EQ_INSTANCE(typ)                              \+instance {-# OVERLAPPING #-} Eq (Array typ) where {      \+;    {-# INLINE (==) #-}                                 \+;    (==) = byteEq \+}++MK_EQ_INSTANCE(Char)+MK_EQ_INSTANCE(Word8)+MK_EQ_INSTANCE(Word16)+MK_EQ_INSTANCE(Word32)++-- XXX The Word64 default instance should be as fast because we are comparing+-- 64-bit at a time.+MK_EQ_INSTANCE(Word64)+MK_EQ_INSTANCE(Int)+MK_EQ_INSTANCE(Int8)+MK_EQ_INSTANCE(Int16)+MK_EQ_INSTANCE(Int32)++-- XXX The Int64 default instance should be as fast.+MK_EQ_INSTANCE(Int64)++-- | If the type allows a byte-by-byte comparison this instance can be+-- overlapped by a more specific instance that uses 'byteCmp'. Byte comparison+-- can be significantly faster.+--+instance {-# OVERLAPPABLE #-} (Unbox a, Eq a) => Eq (Array a) where+    {-# INLINE (==) #-}+    arr1 == arr2 =+        -- Does unboxed byte equality mean element equality?+        -- XXX This is incorrect for sum types, as we may have some+        -- uninitialized memory in that case. If we always initialize the+        -- unused memory to zero we can use this.+        -- Byte comparison is 40% faster compared to stream equality.+        -- (==) EQ $ unsafeInlineIO $! unsafeThaw arr1 `MA.cmp` unsafeThaw arr2+           (toStreamD arr1 :: Stream Identity a) == toStreamD arr2++instance (Unbox a, Ord a) => Ord (Array a) where+    {-# INLINE compare #-}+    compare arr1 arr2 = runIdentity $+        D.cmpBy compare (toStreamD arr1) (toStreamD 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++#ifdef DEVBUILD+-- Definitions using the Unboxed constraint from the Array type. These are to+-- make the Foldable instance possible though it is much slower (7x slower).+--+{-# INLINE_NORMAL _toStreamD_ #-}+_toStreamD_ :: forall m a. MonadIO m => Int -> Array a -> D.Stream m a+_toStreamD_ size Array{..} = D.Stream step arrStart++    where++    {-# INLINE_LATE step #-}+    step _ p | p == arrEnd = return D.Stop+    step _ p = liftIO $ do+        x <- peekAt p arrContents+        return $ D.Yield x (p + size)++{-+XXX Why isn't Unboxed implicit? This does not compile unless I use the Unboxed+contraint.+{-# INLINE_NORMAL _foldr #-}+_foldr :: forall a b. (a -> b -> b) -> b -> Array a -> b+_foldr f z arr =+    let !n = SIZE_OF(a)+    in unsafePerformIO $ D.foldr f z $ toStreamD_ n arr+-- | Note that the 'Foldable' instance is 7x slower than the direct+-- operations.+instance Foldable Array where+  foldr = _foldr+-}++#endif++-------------------------------------------------------------------------------+-- Semigroup and Monoid+-------------------------------------------------------------------------------++-- XXX Deprecate and remove the Semigroup and Monoid instances because of+-- potential misuse chances.++-- | This should not be used for combining many or N arrays as it would copy+-- the two arrays everytime to a new array. For coalescing multiple arrays use+-- 'fromChunksK' instead.+instance Unbox a => Semigroup (Array a) where+    arr1 <> arr2 = unsafePerformIO $ splice arr1 arr2++empty ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    Array a+empty = Array Unboxed.empty 0 0++{-# DEPRECATED nil "Please use empty instead." #-}+nil ::+#ifdef DEVBUILD+    Unbox a =>+#endif+    Array a+nil = empty++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
@@ -0,0 +1,399 @@+-- |+-- Module      : Streamly.Internal.Data.Binary.Parser+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Decode Haskell data types from byte streams.+--+-- It would be inefficient to use this to compose parsers for general algebraic+-- data types. For general deserialization of ADTs please use the Serialize+-- type class instances. The fastest way to deserialize byte streams+-- representing Haskell data types is to write them to arrays and deserialize+-- the array using the Serialize type class.++module Streamly.Internal.Data.Binary.Parser+    (+    -- * Type class+      FromBytes (..)++    -- * Decoders+    , unit+    , bool+    , ordering+    , eqWord8 -- XXX rename to word8Eq+    , word8+    , word16be+    , word16le+    , word32be+    , word32le+    , word64be+    , word64le+    , word64host+    , int8+    , int16be+    , int16le+    , int32be+    , int32le+    , int64be+    , int64le+    , float32be+    , float32le+    , double64be+    , double64le+    , charLatin1+    )+where++import Control.Monad.IO.Class (MonadIO)+import Data.Bits ((.|.), unsafeShiftL)+import Data.Char (chr)+import Data.Int (Int8, Int16, Int32, Int64)+import GHC.Float (castWord32ToFloat, castWord64ToDouble)+import Data.Word (Word8, Word16, Word32, Word64)+import Streamly.Internal.Data.Parser (Parser)+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))+import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))+import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Data.Array as A+    (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(..), 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 ()+-- types we have. Or when we have an array of units the array a concrete+-- length.++-- | A value of type '()' is encoded as @0@ in binary encoding.+--+-- @+-- 0 ==> ()+-- @+--+-- /Pre-release/+--+{-# INLINE unit #-}+unit :: Monad m => Parser Word8 m ()+unit = eqWord8 0 *> PR.fromPure ()++{-# INLINE word8ToBool #-}+word8ToBool :: Word8 -> Either String Bool+word8ToBool 0 = Right False+word8ToBool 1 = Right True+word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)++-- | A value of type 'Bool' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> False+-- 1 ==> True+-- @+--+-- /Pre-release/+--+{-# INLINE bool #-}+bool :: Monad m => Parser Word8 m Bool+bool = PR.either word8ToBool++{-# INLINE word8ToOrdering #-}+word8ToOrdering :: Word8 -> Either String Ordering+word8ToOrdering 0 = Right LT+word8ToOrdering 1 = Right EQ+word8ToOrdering 2 = Right GT+word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)++-- | A value of type 'Ordering' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> LT+-- 1 ==> EQ+-- 2 ==> GT+-- @+--+-- /Pre-release/+--+{-# INLINE ordering #-}+ordering :: Monad m => Parser Word8 m Ordering+ordering = PR.either word8ToOrdering++-- XXX should go in a Word8 parser module?+-- | Accept the input byte only if it is equal to the specified value.+--+-- /Pre-release/+--+{-# INLINE eqWord8 #-}+eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8+eqWord8 b = PR.satisfy (== b)++-- | Accept any byte.+--+-- /Pre-release/+--+{-# INLINE word8 #-}+word8 :: Monad m => Parser Word8 m Word8+word8 = PR.satisfy (const True)++-- | Big endian (MSB first) Word16+{-# INLINE word16beD #-}+word16beD :: Monad m => PRD.Parser Word8 m Word16+word16beD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial Nothing'++    step Nothing' a =+        -- XXX We can use a non-failing parser or a fold so that we do not+        -- have to buffer for backtracking which is inefficient.+        return $ PRD.SContinue 1 (Just' (fromIntegral a `unsafeShiftL` 8))+    step (Just' w) a =+        return $ PRD.SDone 1 (w .|. fromIntegral a)++    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).+--+-- /Pre-release/+--+{-# INLINE word16be #-}+word16be :: Monad m => Parser Word8 m Word16+word16be = word16beD++-- | Little endian (LSB first) Word16+{-# INLINE word16leD #-}+word16leD :: Monad m => PRD.Parser Word8 m Word16+word16leD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial Nothing'++    step Nothing' a =+        return $ PRD.SContinue 1 (Just' (fromIntegral a))+    step (Just' w) a =+        return $ PRD.SDone 1 (w .|. fromIntegral a `unsafeShiftL` 8)++    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).+--+-- /Pre-release/+--+{-# INLINE word16le #-}+word16le :: Monad m => Parser Word8 m Word16+word16le = word16leD++-- | Big endian (MSB first) Word32+{-# INLINE word32beD #-}+word32beD :: Monad m => PRD.Parser Word8 m Word32+word32beD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 24++    step (Tuple' w sh) a = return $+        if sh /= 0+        then+            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+             in PRD.SContinue 1 (Tuple' w1 (sh - 8))+        else PRD.SDone 1 (w .|. fromIntegral a)++    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).+--+-- /Pre-release/+--+{-# INLINE word32be #-}+word32be :: Monad m => Parser Word8 m Word32+word32be = word32beD++-- | Little endian (LSB first) Word32+{-# INLINE word32leD #-}+word32leD :: Monad m => PRD.Parser Word8 m Word32+word32leD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 0++    step (Tuple' w sh) a = return $+        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+         in if sh /= 24+            then PRD.SContinue 1 (Tuple' w1 (sh + 8))+            else PRD.SDone 1 w1++    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).+--+-- /Pre-release/+--+{-# INLINE word32le #-}+word32le :: Monad m => Parser Word8 m Word32+word32le = word32leD++-- | Big endian (MSB first) Word64+{-# INLINE word64beD #-}+word64beD :: Monad m => PRD.Parser Word8 m Word64+word64beD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 56++    step (Tuple' w sh) a = return $+        if sh /= 0+        then+            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+             in PRD.SContinue 1 (Tuple' w1 (sh - 8))+        else PRD.SDone 1 (w .|. fromIntegral a)++    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).+--+-- /Pre-release/+--+{-# INLINE word64be #-}+word64be :: Monad m => Parser Word8 m Word64+word64be = word64beD++-- | Little endian (LSB first) Word64+{-# INLINE word64leD #-}+word64leD :: Monad m => PRD.Parser Word8 m Word64+word64leD = PRD.Parser step initial extract++    where++    initial = return $ PRD.IPartial $ Tuple' 0 0++    step (Tuple' w sh) a = return $+        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)+         in if sh /= 56+            then PRD.SContinue 1 (Tuple' w1 (sh + 8))+            else PRD.SDone 1 w1++    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).+--+-- /Pre-release/+--+{-# INLINE word64le #-}+word64le :: Monad m => Parser Word8 m Word64+word64le = word64leD++{-# INLINE int8 #-}+int8 :: Monad m => Parser Word8 m Int8+int8 = fromIntegral <$> word8++-- | Parse two bytes as a 'Int16', the first byte is the MSB of the Int16 and+-- second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int16be #-}+int16be :: Monad m => Parser Word8 m Int16+int16be = fromIntegral <$> word16be++-- | Parse two bytes as a 'Int16', the first byte is the LSB of the Int16 and+-- second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE int16le #-}+int16le :: Monad m => Parser Word8 m Int16+int16le = fromIntegral <$> word16le++-- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int32be #-}+int32be :: Monad m => Parser Word8 m Int32+int32be = fromIntegral <$> word32be++-- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int32le #-}+int32le :: Monad m => Parser Word8 m Int32+int32le = fromIntegral <$> word32le++-- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int64be #-}+int64be :: Monad m => Parser Word8 m Int64+int64be = fromIntegral <$> word64be++-- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int64le #-}+int64le :: Monad m => Parser Word8 m Int64+int64le = fromIntegral <$> word64le++{-# INLINE float32be #-}+float32be :: MonadIO m => Parser Word8 m Float+float32be = castWord32ToFloat <$> word32be++{-# INLINE float32le #-}+float32le :: MonadIO m => Parser Word8 m Float+float32le = castWord32ToFloat <$> word32le++{-# INLINE double64be #-}+double64be :: MonadIO m => Parser Word8 m Double+double64be =  castWord64ToDouble <$> word64be++{-# INLINE double64le #-}+double64le :: MonadIO m => Parser Word8 m Double+double64le = castWord64ToDouble <$> word64le++-- | Accept any byte.+--+-- /Pre-release/+--+{-# INLINE charLatin1 #-}+charLatin1 :: Monad m => Parser Word8 m Char+charLatin1 = fmap (chr . fromIntegral) word8++-------------------------------------------------------------------------------+-- Host byte order+-------------------------------------------------------------------------------++-- | Parse eight bytes as a 'Word64' in the host byte order.+--+-- /Pre-release/+--+{-# INLINE word64host #-}+word64host :: MonadIO m => Parser Word8 m Word64+word64host =+    fmap (A.unsafeGetIndex 0 . A.unsafeCast) $ PR.takeEQ 8 (A.createOf 8)++-------------------------------------------------------------------------------+-- Type class+-------------------------------------------------------------------------------++class FromBytes a where+    -- | Decode a byte stream to a Haskell type.+    fromBytes :: Parser Word8 m a
+ src/Streamly/Internal/Data/Binary/Stream.hs view
@@ -0,0 +1,383 @@+-- |+-- Module      : Streamly.Internal.Data.Binary.Stream+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- Encode Haskell data types to byte streams.+--+-- The primary purpose of this module is to serialize primitive Haskell types+-- to streams for convenient byte by byte processing when such a need arises.+--+-- It would be inefficient to use this to build byte streams from algebraic+-- data types. For general serialization of ADTs please use the Serialize type+-- class instances. The fastest way to convert general Haskell types to byte+-- streams is to serialize them to an array and then stream the array.++-- XXX remove unit, bool, ordering, and the type class as well++module Streamly.Internal.Data.Binary.Stream+    (+    -- * Type class+      ToBytes (..)++    -- * Encoders+    , unit+    , bool+    , ordering+    , word8+    , word16be+    , word16le+    , word32be+    , word32le+    , word64be+    , word64le+    , word64host+    , int8+    , int16be+    , int16le+    , int32be+    , int32le+    , int64be+    , int64le+    , float32be+    , float32le+    , double64be+    , double64le+    , charLatin1+    , charUtf8+    )+where++#include "MachDeps.h"++import Data.Bits (shiftR)+import Data.Char (ord)+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Float (castDoubleToWord64, castFloatToWord32)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream (Step(..))+import Streamly.Internal.Unicode.Stream (readCharUtf8)++import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D++-- XXX Use StreamD directly?++-- | A value of type '()' is encoded as @0@ in binary encoding.+--+-- @+-- 0 ==> ()+-- @+--+-- /Pre-release/+--+{-# INLINE unit #-}+unit :: Applicative m => Stream m Word8+unit = Stream.fromPure 0++{-# INLINE boolToWord8 #-}+boolToWord8 :: Bool -> Word8+boolToWord8 False = 0+boolToWord8 True = 1++-- | A value of type 'Bool' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> False+-- 1 ==> True+-- @+--+-- /Pre-release/+--+{-# INLINE bool #-}+bool :: Applicative m => Bool -> Stream m Word8+bool = Stream.fromPure . boolToWord8++{-# INLINE orderingToWord8 #-}+orderingToWord8 :: Ordering -> Word8+orderingToWord8 LT = 0+orderingToWord8 EQ = 1+orderingToWord8 GT = 2++-- | A value of type 'Ordering' is encoded as follows in binary encoding.+--+-- @+-- 0 ==> LT+-- 1 ==> EQ+-- 2 ==> GT+-- @+--+-- /Pre-release/+--+{-# INLINE ordering #-}+ordering :: Applicative m => Ordering -> Stream m Word8+ordering = Stream.fromPure . orderingToWord8++-- | Stream a 'Word8'.+--+-- /Pre-release/+--+{-# INLINE word8 #-}+word8 :: Applicative m => Word8 -> Stream m Word8+word8 = Stream.fromPure++data W16State = W16B1 | W16B2 | W16Done++{-# INLINE word16beD #-}+word16beD :: Applicative m => Word16 -> D.Stream m Word8+word16beD w = D.Stream step W16B1++    where++    step _ W16B1 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16B2+    step _ W16B2 = pure $ Yield (fromIntegral w :: Word8) W16Done+    step _ W16Done = pure Stop++-- | Stream a 'Word16' as two bytes, the first byte is the MSB of the Word16+-- and second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word16be #-}+word16be :: Monad m => Word16 -> Stream m Word8+word16be = word16beD++-- | Little endian (LSB first) Word16+{-# INLINE word16leD #-}+word16leD :: Applicative m => Word16 -> D.Stream m Word8+word16leD w = D.Stream step W16B1++    where++    step _ W16B1 = pure $ Yield (fromIntegral w :: Word8) W16B2+    step _ W16B2 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16Done+    step _ W16Done = pure Stop++-- | Stream a 'Word16' as two bytes, the first byte is the LSB of the Word16+-- and second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE word16le #-}+word16le :: Monad m => Word16 -> Stream m Word8+word16le = word16leD++data W32State = W32B1 | W32B2 | W32B3 | W32B4 | W32Done++-- | Big endian (MSB first) Word32+{-# INLINE word32beD #-}+word32beD :: Applicative m => Word32 -> D.Stream m Word8+word32beD w = D.Stream step W32B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W32B1 = yield 24 W32B2+    step _ W32B2 = yield 16 W32B3+    step _ W32B3 = yield 8 W32B4+    step _ W32B4 = pure $ Yield (fromIntegral w :: Word8) W32Done+    step _ W32Done = pure Stop++-- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word32be #-}+word32be :: Monad m => Word32 -> Stream m Word8+word32be = word32beD++-- | Little endian (LSB first) Word32+{-# INLINE word32leD #-}+word32leD :: Applicative m => Word32 -> D.Stream m Word8+word32leD w = D.Stream step W32B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W32B1 = pure $ Yield (fromIntegral w :: Word8) W32B2+    step _ W32B2 = yield 8 W32B3+    step _ W32B3 = yield 16 W32B4+    step _ W32B4 = yield 24 W32Done+    step _ W32Done = pure Stop++-- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word32le #-}+word32le :: Monad m => Word32 -> Stream m Word8+word32le = word32leD++data W64State =+    W64B1 | W64B2 | W64B3 | W64B4 | W64B5 | W64B6 | W64B7 | W64B8 | W64Done++-- | Big endian (MSB first) Word64+{-# INLINE word64beD #-}+word64beD :: Applicative m => Word64 -> D.Stream m Word8+word64beD w = D.Stream step W64B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W64B1 = yield 56 W64B2+    step _ W64B2 = yield 48 W64B3+    step _ W64B3 = yield 40 W64B4+    step _ W64B4 = yield 32 W64B5+    step _ W64B5 = yield 24 W64B6+    step _ W64B6 = yield 16 W64B7+    step _ W64B7 = yield  8 W64B8+    step _ W64B8 = pure $ Yield (fromIntegral w :: Word8) W64Done+    step _ W64Done = pure Stop++-- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word64be #-}+word64be :: Monad m => Word64 -> Stream m Word8+word64be = word64beD++-- | Little endian (LSB first) Word64+{-# INLINE word64leD #-}+word64leD :: Applicative m => Word64 -> D.Stream m Word8+word64leD w = D.Stream step W64B1++    where++    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s++    step _ W64B1 = pure $ Yield (fromIntegral w :: Word8) W64B2+    step _ W64B2 = yield  8 W64B3+    step _ W64B3 = yield 16 W64B4+    step _ W64B4 = yield 24 W64B5+    step _ W64B5 = yield 32 W64B6+    step _ W64B6 = yield 40 W64B7+    step _ W64B7 = yield 48 W64B8+    step _ W64B8 = yield 56 W64Done+    step _ W64Done = pure Stop++-- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE word64le #-}+word64le :: Monad m => Word64 -> Stream m Word8+word64le = word64leD++{-# INLINE int8 #-}+int8 :: Applicative m => Int8 -> Stream m Word8+int8 i = word8 (fromIntegral i :: Word8)++-- | Stream a 'Int16' as two bytes, the first byte is the MSB of the Int16+-- and second byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int16be #-}+int16be :: Monad m => Int16 -> Stream m Word8+int16be i = word16be (fromIntegral i :: Word16)++-- | Stream a 'Int16' as two bytes, the first byte is the LSB of the Int16+-- and second byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE int16le #-}+int16le :: Monad m => Int16 -> Stream m Word8+int16le i = word16le (fromIntegral i :: Word16)++-- | Stream a 'Int32' as four bytes, the first byte is the MSB of the Int32+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int32be #-}+int32be :: Monad m => Int32 -> Stream m Word8+int32be i = word32be (fromIntegral i :: Word32)++{-# INLINE int32le #-}+int32le :: Monad m => Int32 -> Stream m Word8+int32le i = word32le (fromIntegral i :: Word32)++-- | Stream a 'Int64' as eight bytes, the first byte is the MSB of the Int64+-- and last byte is the LSB (big endian representation).+--+-- /Pre-release/+--+{-# INLINE int64be #-}+int64be :: Monad m => Int64 -> Stream m Word8+int64be i = word64be (fromIntegral i :: Word64)++-- | Stream a 'Int64' as eight bytes, the first byte is the LSB of the Int64+-- and last byte is the MSB (little endian representation).+--+-- /Pre-release/+--+{-# INLINE int64le #-}+int64le :: Monad m => Int64 -> Stream m Word8+int64le i = word64le (fromIntegral i :: Word64)++-- | Big endian (MSB first) Float+{-# INLINE float32be #-}+float32be :: Monad m => Float -> Stream m Word8+float32be = word32beD . castFloatToWord32++-- | Little endian (LSB first) Float+{-# INLINE float32le #-}+float32le :: Monad m => Float -> Stream m Word8+float32le = word32leD . castFloatToWord32++-- | Big endian (MSB first) Double+{-# INLINE double64be #-}+double64be :: Monad m => Double -> Stream m Word8+double64be = word64beD . castDoubleToWord64++-- | Little endian (LSB first) Double+{-# INLINE double64le #-}+double64le :: Monad m => Double -> Stream m Word8+double64le = word64leD . castDoubleToWord64++-- | Encode a Unicode character to stream of bytes in 0-255 range.+--+{-# INLINE charLatin1 #-}+charLatin1 :: Applicative m => Char -> Stream m Word8+charLatin1 = Stream.fromPure . fromIntegral . ord++{-# INLINE charUtf8 #-}+charUtf8 :: Monad m => Char -> Stream m Word8+charUtf8 = Stream.unfold readCharUtf8++-------------------------------------------------------------------------------+-- Host byte order+-------------------------------------------------------------------------------++-- | Stream a 'Word64' as eight bytes in the host byte order.+--+-- /Pre-release/+--+{-# INLINE word64host #-}+word64host :: Monad m => Word64 -> Stream m Word8+word64host =+#ifdef WORDS_BIGENDIAN+    word64be+#else+    word64le+#endif++-------------------------------------------------------------------------------+-- Type class+-------------------------------------------------------------------------------++class ToBytes a where+    -- | Convert a Haskell type to a byte stream.+    toBytes :: a -> Stream m Word8
src/Streamly/Internal/Data/Builder.hs view
@@ -16,7 +16,10 @@     ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif+import Data.Bifunctor (first)  ------------------------------------------------------------------------------ -- The Builder type@@ -27,16 +30,16 @@ -- or even a Fold. Unlike fold the step function is one-shot and not called in -- a loop. newtype Builder s m a =-  Builder (s -> m (s, a))+  Builder (s -> m (a, s))  -- | Maps a function on the output of the fold (the type @b@). instance Functor m => Functor (Builder s m) where     {-# INLINE fmap #-}-    fmap f (Builder step1) = Builder (fmap (fmap f) . step1)+    fmap f (Builder step1) = Builder (fmap (first f) . step1)  {-# INLINE fromPure #-} fromPure :: Applicative m => b -> Builder s m b-fromPure b = Builder (\s -> pure (s, b))+fromPure b = Builder (\s -> pure (b, s))  -- | Chain the actions and zip the outputs. {-# INLINE sequenceWith #-}@@ -47,9 +50,9 @@     where      step s = do-        (s1, x) <- stepL s-        (s2, y) <- stepR s1-        pure (s2, func x y)+        (x, s1) <- stepL s+        (y, s2) <- stepR s1+        pure (func x y, s2)  instance Monad m => Applicative (Builder a m) where     {-# INLINE pure #-}@@ -74,7 +77,7 @@         where          step s = do-            (s1, x) <- stepL s+            (x, s1) <- stepL s             let Builder stepR = f x-            (s2, y) <- stepR s1-            pure (s2, y)+            (y, s2) <- stepR s1+            pure (y, s2)
+ src/Streamly/Internal/Data/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,2598 +1,36 @@ {-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Fold--- Copyright   : (c) 2019 Composewell Technologies---               (c) 2013 Gabriel Gonzalez--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ See "Streamly.Data.Fold" for an overview and--- "Streamly.Internal.Data.Fold.Type" for design notes.--module Streamly.Internal.Data.Fold-    (-    -- * Imports-    -- $setup--    -- * Fold Type-      Step (..)-    , Fold (..)-    , Tee (..)--    -- * Constructors-    -- | Which constructor to use?-    ---    -- * @foldl*@: If the fold never terminates i.e. does not use the 'Done'-    -- constructor otherwise use the @foldt*@ variants.-    -- * @*M@: Use the @M@ suffix variants if any of the step, initial, or-    -- extract function is monadic, otherwise use the pure variants.-    ---    , foldl'-    , foldlM'-    , foldl1'-    , foldlM1'-    , foldt'-    , foldtM'-    , foldr'-    , foldrM'--    -- * Mappers-    -- | Monadic functions useful with mapM/lmapM on folds or streams.-    , tracing-    , trace--    -- * Folds--    -- ** Accumulators-    -- *** Semigroups and Monoids-    , sconcat-    , mconcat-    , foldMap-    , foldMapM--    -- *** Reducers-    , drain-    , drainMapM-    , the-    , length-    , lengthGeneric-    , mean-    , rollingHash-    , defaultSalt-    , rollingHashWithSalt-    , rollingHashFirstN-    -- , rollingHashLastN--    -- *** Saturating Reducers-    -- | 'product' terminates if it becomes 0. Other folds can theoretically-    -- saturate on bounded types, and therefore terminate, however, they will-    -- run forever on unbounded types like Integer/Double.-    , sum-    , product-    , maximumBy-    , maximum-    , minimumBy-    , minimum--    -- *** Collectors-    -- | Avoid using these folds in scalable or performance critical-    -- applications, they buffer all the input in GC memory which can be-    -- detrimental to performance if the input is large.-    , toList-    , toListRev-    -- $toListRev-    , toStream-    , toStreamRev-    , toStreamK-    , toStreamKRev-    , topBy-    , top-    , bottomBy-    , bottom--    -- *** Scanners-    -- | Stateful transformation of the elements. Useful in combination with-    -- the 'scanMaybe' combinator. For scanners the result of the fold is-    -- usually a transformation of the current element rather than an-    -- aggregation of all elements till now.-    , latest- -- , nthLast -- using Ring array-    , indexingWith-    , indexing-    , indexingRev-    , rollingMapM--    -- *** Filters-    -- | Useful in combination with the 'scanMaybe' combinator.-    , filtering-    , deleteBy-    , uniqBy-    , uniq-    , repeated-    , findIndices-    , elemIndices--    -- ** Terminating Folds-    -- *** Empty folds-    -- | Folds that return a result without consuming any input.-    , fromPure-    , fromEffect-    , fromRefold--    -- *** Singleton folds-    -- | Folds that terminate after consuming exactly one input element. All-    -- these can be implemented in terms of the 'maybe' fold.-    , one-    , null -- XXX not very useful and could be problematic, remove it?-    , satisfy-    , maybe--    -- *** Multi folds-    -- | Terminate after consuming one or more elements.-    , drainN-    -- , lastN-    -- , (!!)-    , indexGeneric-    , index-    , findM-    , find-    , lookup-    , findIndex-    , elemIndex-    , elem-    , notElem-    , all-    , any-    , and-    , or--    -- ** Trimmers-    -- | Useful in combination with the 'scanMaybe' combinator.-    , taking-    , dropping-    , takingEndByM-    , takingEndBy-    , takingEndByM_-    , takingEndBy_-    , droppingWhileM-    , droppingWhile-    , prune--    -- * Running A Fold-    , drive-    -- , breakStream--    -- * Building Incrementally-    , extractM-    , reduce-    , close-    , isClosed-    , snoc-    , snocl-    , snocM-    , snoclM--    , addOne-    , addStream--    -- * Combinators-    -- ** Utilities-    , with--    -- ** Transforming the Monad-    , morphInner-    , generalizeInner--    -- ** Mapping on output-    , rmapM--    -- ** Mapping on Input-    , transform-    , lmap-    --, lsequence-    , lmapM--    -- ** Sliding Window-    , slide2--    -- ** Scanning Input-    , scan-    , scanMany-    , postscan-    , indexed--    -- ** Zipping Input-    , zipStreamWithM-    , zipStream--    -- ** Filtering Input-    , catMaybes-    , mapMaybeM-    , mapMaybe-    , scanMaybe-    , filter-    , filterM-    , sampleFromthen--    -- Either streams-    , catLefts-    , catRights-    , catEithers--    {--    -- ** Insertion-    -- | Insertion adds more elements to the stream.--    , insertBy-    , intersperseM--    -- ** Reordering-    , reverse-    -}--    -- ** Trimming-    , take--    -- By elements-    , takeEndBy-    , takeEndBy_-    , takeEndBySeq-    , takeEndBySeq_-    {--    , drop-    , dropWhile-    , dropWhileM-    -}--    -- ** Serial Append-    , splitWith-    , split_-    -- , tail-    -- , init-    , splitAt -- spanN-    -- , splitIn -- sessionN--    -- ** Parallel Distribution-    , teeWith-    , tee-    , teeWithFst-    , teeWithMin-    , distribute-    -- , distributeFst-    -- , distributeMin--    -- ** Unzipping-    , unzip-    -- These two can be expressed using lmap/lmapM and unzip-    , unzipWith-    , unzipWithM-    , unzipWithFstM-    , unzipWithMinM--    -- ** Parallel Alternative-    , shortest-    , longest--    -- ** Partitioning-    , partitionByM-    , partitionByFstM-    , partitionByMinM-    , partitionBy-    , partition--    -- ** Splitting-    , many-    , manyPost-    , groupsOf-    , chunksBetween-    , refoldMany-    , refoldMany1-    , intersperseWithQuotes--    -- ** Nesting-    , unfoldMany-    , concatSequence-    , concatMap-    , duplicate-    , refold--    -- * Deprecated-    , foldr-    , drainBy-    , last-    , head-    , sequence-    , mapM-    , variance-    , stdDev-    , serialWith-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bifunctor (first)-import Data.Bits (shiftL, shiftR, (.|.), (.&.))-import Data.Either (isLeft, isRight, fromLeft, fromRight)-import Data.Int (Int64)-import Data.Proxy (Proxy(..))-import Data.Word (Word32)-import Foreign.Storable (Storable, peek)-import Streamly.Internal.Data.Array.Mut.Type (MutArray(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Pipe.Type (Pipe (..), PipeState(..))-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)--import qualified Prelude-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Fold.Window as FoldW-import qualified Streamly.Internal.Data.Pipe.Type as Pipe-import qualified Streamly.Internal.Data.Ring.Unboxed as Ring-import qualified Streamly.Internal.Data.Stream.StreamD.Type as StreamD--import Prelude hiding-       ( filter, foldl1, drop, dropWhile, take, takeWhile, zipWith-       , foldl, foldr, map, mapM_, sequence, all, any, sum, product, elem-       , notElem, maximum, minimum, head, last, tail, length, null-       , reverse, iterate, init, and, or, lookup, (!!)-       , scanl, scanl1, replicate, concatMap, mconcat, foldMap, unzip-       , span, splitAt, break, mapM, zip, maybe)-import Streamly.Internal.Data.Fold.Type-import Streamly.Internal.Data.Fold.Tee--#include "DocTestDataFold.hs"----------------------------------------------------------------------------------- Running----------------------------------------------------------------------------------- | Drive a fold using the supplied 'Stream', reducing the resulting--- expression strictly at each step.------ Definition:------ >>> drive = flip Stream.fold------ Example:------ >>> Fold.drive (Stream.enumerateFromTo 1 100) Fold.sum--- 5050----{-# INLINE drive #-}-drive :: Monad m => Stream m a -> Fold m a b -> m b-drive = flip StreamD.fold--{---- | Like 'drive' but also returns the remaining stream. The resulting stream--- would be 'Stream.nil' if the stream finished before the fold.------ Definition:------ >>> breakStream = flip Stream.foldBreak------ /CPS/----{-# INLINE breakStreamK #-}-breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a)-breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm)--    where--    f (b, str) = (b, Stream.fromStreamK str)--}---- | Append a stream to a fold to build the fold accumulator incrementally. We--- can repeatedly call 'addStream' on the same fold to continue building the--- fold and finally use 'drive' to finish the fold and extract the result. Also--- see the 'Streamly.Data.Fold.addOne' operation which is a singleton version--- of 'addStream'.------ Definitions:------ >>> addStream stream = Fold.drive stream . Fold.duplicate------ Example, build a list incrementally:------ >>> :{--- pure (Fold.toList :: Fold IO Int [Int])---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- [1,2,3,4]------ This can be used as an O(n) list append compared to the O(n^2) @++@ when--- used for incrementally building a list.------ Example, build a stream incrementally:------ >>> :{--- pure (Fold.toStream :: Fold IO Int (Stream Identity Int))---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- fromList [1,2,3,4]------ This can be used as an O(n) stream append compared to the O(n^2) @<>@ when--- used for incrementally building a stream.------ Example, build an array incrementally:------ >>> :{--- pure (Array.write :: Fold IO Int (Array Int))---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- fromList [1,2,3,4]------ Example, build an array stream incrementally:------ >>> :{--- let f :: Fold IO Int (Stream Identity (Array Int))---     f = Fold.groupsOf 2 (Array.writeN 3) Fold.toStream--- in pure f---     >>= Fold.addOne 1---     >>= Fold.addStream (Stream.enumerateFromTo 2 4)---     >>= Fold.drive Stream.nil---     >>= print--- :}--- fromList [fromList [1,2],fromList [3,4]]----addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)-addStream stream = drive stream . duplicate----------------------------------------------------------------------------------- Transformations on fold inputs----------------------------------------------------------------------------------- | Flatten the monadic output of a fold to pure output.----{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}-{-# INLINE sequence #-}-sequence :: Monad m => Fold m a (m b) -> Fold m a b-sequence = rmapM id---- | Map a monadic function on the output of a fold.----{-# DEPRECATED mapM "Use rmapM instead" #-}-{-# INLINE mapM #-}-mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-mapM = rmapM---- |--- >>> mapMaybeM f = Fold.lmapM f . Fold.catMaybes----{-# INLINE mapMaybeM #-}-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Fold m b r -> Fold m a r-mapMaybeM f = lmapM f . catMaybes---- | @mapMaybe f fold@ maps a 'Maybe' returning function @f@ on the input of--- the fold, filters out 'Nothing' elements, and return the values extracted--- from 'Just'.------ >>> mapMaybe f = Fold.lmap f . Fold.catMaybes--- >>> mapMaybe f = Fold.mapMaybeM (return . f)------ >>> f x = if even x then Just x else Nothing--- >>> fld = Fold.mapMaybe f Fold.toList--- >>> Stream.fold fld (Stream.enumerateFromTo 1 10)--- [2,4,6,8,10]----{-# INLINE mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r-mapMaybe f = lmap f . catMaybes----------------------------------------------------------------------------------- Transformations on fold inputs----------------------------------------------------------------------------------- | Apply a monadic function on the input and return the input.------ >>> Stream.fold (Fold.lmapM (Fold.tracing print) Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)--- 1--- 2------ /Pre-release/----{-# INLINE tracing #-}-tracing :: Monad m => (a -> m b) -> (a -> m a)-tracing f x = void (f x) >> return x---- | Apply a monadic function to each element flowing through and discard the--- results.------ >>> Stream.fold (Fold.trace print Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)--- 1--- 2------ >>> trace f = Fold.lmapM (Fold.tracing f)------ /Pre-release/-{-# INLINE trace #-}-trace :: Monad m => (a -> m b) -> Fold m a r -> Fold m a r-trace f = lmapM (tracing f)---- rename to lpipe?------ | Apply a transformation on a 'Fold' using a 'Pipe'.------ /Pre-release/-{-# INLINE transform #-}-transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c-transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =-    Fold step initial extract--    where--    initial = first (Tuple' pinitial) <$> finitial--    step (Tuple' ps fs) x = do-        r <- pstep1 ps x-        go fs r--        where--        -- XXX use SPEC?-        go acc (Pipe.Yield b (Consume ps')) = do-            acc' <- fstep acc b-            return-                $ case acc' of-                      Partial s -> Partial $ Tuple' ps' s-                      Done b2 -> Done b2-        go acc (Pipe.Yield b (Produce ps')) = do-            acc' <- fstep acc b-            r <- pstep2 ps'-            case acc' of-                Partial s -> go s r-                Done b2 -> return $ Done b2-        go acc (Pipe.Continue (Consume ps')) =-            return $ Partial $ Tuple' ps' acc-        go acc (Pipe.Continue (Produce ps')) = do-            r <- pstep2 ps'-            go acc r--    extract (Tuple' _ fs) = fextract fs--{-# INLINE scanWith #-}-scanWith :: Monad m => Bool -> Fold m a b -> Fold m b c -> Fold m a c-scanWith isMany (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract--    where--    {-# INLINE runStep #-}-    runStep actionL sR = do-        rL <- actionL-        case rL of-            Done bL -> do-                rR <- stepR sR bL-                case rR of-                    Partial sR1 ->-                        if isMany-                        then runStep initialL sR1-                        else Done <$> extractR sR1-                    Done bR -> return $ Done bR-            Partial sL -> do-                !b <- extractL sL-                rR <- stepR sR b-                return-                    $ case rR of-                        Partial sR1 -> Partial (sL, sR1)-                        Done bR -> Done bR--    initial = do-        r <- initialR-        case r of-            Partial sR -> runStep initialL sR-            Done b -> return $ Done b--    step (sL, sR) x = runStep (stepL sL x) sR--    extract = extractR . snd---- | Scan the input of a 'Fold' to change it in a stateful manner using another--- 'Fold'. The scan stops as soon as the fold terminates.------ /Pre-release/-{-# INLINE scan #-}-scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-scan = scanWith False---- XXX This does not fuse beacuse of the recursive step. Need to investigate.------ | Scan the input of a 'Fold' to change it in a stateful manner using another--- 'Fold'. The scan restarts with a fresh state if the fold terminates.------ /Pre-release/-{-# INLINE scanMany #-}-scanMany :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-scanMany = scanWith True----------------------------------------------------------------------------------- Filters----------------------------------------------------------------------------------- | Returns the latest element omitting the first occurrence that satisfies--- the given equality predicate.------ Example:------ >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.deleteBy (==) 3) input--- [1,3,5]----{-# INLINE_NORMAL deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Fold m a (Maybe a)-deleteBy eq x0 = fmap extract $ foldl' step (Tuple' False Nothing)--    where--    step (Tuple' False _) x =-        if eq x x0-        then Tuple' True Nothing-        else Tuple' False (Just x)-    step (Tuple' True _) x = Tuple' True (Just x)--    extract (Tuple' _ x) = x---- | Provide a sliding window of length 2 elements.------ See "Streamly.Internal.Data.Fold.Window".----{-# INLINE slide2 #-}-slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b-slide2 (Fold step1 initial1 extract1) = Fold step initial extract--    where--    initial =-        first (Tuple' Nothing) <$> initial1--    step (Tuple' prev s) cur =-        first (Tuple' (Just cur)) <$> step1 s (cur, prev)--    extract (Tuple' _ s) = extract1 s---- | Return the latest unique element using the supplied comparison function.--- Returns 'Nothing' if the current element is same as the last element--- otherwise returns 'Just'.------ Example, strip duplicate path separators:------ >>> input = Stream.fromList "//a//b"--- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.scanMaybe (Fold.uniqBy f) input--- "/a/b"------ Space: @O(1)@------ /Pre-release/----{-# INLINE uniqBy #-}-uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)-uniqBy eq = rollingMap f--    where--    f pre curr =-        case pre of-            Nothing -> Just curr-            Just x -> if x `eq` curr then Nothing else Just curr---- | See 'uniqBy'.------ Definition:------ >>> uniq = Fold.uniqBy (==)----{-# INLINE uniq #-}-uniq :: (Monad m, Eq a) => Fold m a (Maybe a)-uniq = uniqBy (==)---- | Strip all leading and trailing occurrences of an element passing a--- predicate and make all other consecutive occurrences uniq.------ >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)------ @--- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")--- "hello world!"------ @------ Space: @O(1)@------ /Unimplemented/-{-# INLINE prune #-}-prune ::-    -- (Monad m, Eq a) =>-    (a -> Bool) -> Fold m a (Maybe a)-prune = error "Not implemented yet!"---- | Emit only repeated elements, once.------ /Unimplemented/-repeated :: -- (Monad m, Eq a) =>-    Fold m a (Maybe a)-repeated = error "Not implemented yet!"----------------------------------------------------------------------------------- Left folds------------------------------------------------------------------------------------------------------------------------------------------------------------------ Run Effects----------------------------------------------------------------------------------- |--- Definitions:------ >>> drainMapM f = Fold.lmapM f Fold.drain--- >>> drainMapM f = Fold.foldMapM (void . f)------ Drain all input after passing it through a monadic function. This is the--- dual of mapM_ on stream producers.----{-# INLINE drainMapM #-}-drainMapM ::  Monad m => (a -> m b) -> Fold m a ()-drainMapM f = lmapM f drain--{-# DEPRECATED drainBy "Please use 'drainMapM' instead." #-}-{-# INLINE drainBy #-}-drainBy ::  Monad m => (a -> m b) -> Fold m a ()-drainBy = drainMapM---- | Returns the latest element of the input stream, if any.------ >>> latest = Fold.foldl1' (\_ x -> x)--- >>> latest = fmap getLast $ Fold.foldMap (Last . Just)----{-# INLINE latest #-}-latest :: Monad m => Fold m a (Maybe a)-latest = foldl1' (\_ x -> x)--{-# DEPRECATED last "Please use 'latest' instead." #-}-{-# INLINE last #-}-last :: Monad m => Fold m a (Maybe a)-last = latest---- | Terminates with 'Nothing' as soon as it finds an element different than--- the previous one, returns 'the' element if the entire input consists of the--- same element.----{-# INLINE the #-}-the :: (Monad m, Eq a) => Fold m a (Maybe a)-the = foldt' step initial id--    where--    initial = Partial Nothing--    step Nothing x = Partial (Just x)-    step old@(Just x0) x =-            if x0 == x-            then Partial old-            else Done Nothing----------------------------------------------------------------------------------- To Summary----------------------------------------------------------------------------------- | Like 'length', except with a more general 'Num' return value------ Definition:------ >>> lengthGeneric = fmap getSum $ Fold.foldMap (Sum . const  1)--- >>> lengthGeneric = Fold.foldl' (\n _ -> n + 1) 0------ /Pre-release/-{-# INLINE lengthGeneric #-}-lengthGeneric :: (Monad m, Num b) => Fold m a b-lengthGeneric = foldl' (\n _ -> n + 1) 0---- | Determine the length of the input stream.------ Definition:------ >>> length = Fold.lengthGeneric--- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)----{-# INLINE length #-}-length :: Monad m => Fold m a Int-length = lengthGeneric----- | Determine the sum of all elements of a stream of numbers. Returns additive--- identity (@0@) when the stream is empty. Note that this is not numerically--- stable for floating point numbers.------ >>> sum = FoldW.cumulative FoldW.sum------ Same as following but numerically stable:------ >>> sum = Fold.foldl' (+) 0--- >>> sum = fmap Data.Monoid.getSum $ Fold.foldMap Data.Monoid.Sum----{-# INLINE sum #-}-sum :: (Monad m, Num a) => Fold m a a-sum = FoldW.cumulative FoldW.sum---- | Determine the product of all elements of a stream of numbers. Returns--- multiplicative identity (@1@) when the stream is empty. The fold terminates--- when it encounters (@0@) in its input.------ Same as the following but terminates on multiplication by @0@:------ >>> product = fmap Data.Monoid.getProduct $ Fold.foldMap Data.Monoid.Product----{-# INLINE product #-}-product :: (Monad m, Num a, Eq a) => Fold m a a-product =  foldt' step (Partial 1) id--    where--    step x a =-        if a == 0-        then Done 0-        else Partial $ x * a----------------------------------------------------------------------------------- To Summary (Maybe)----------------------------------------------------------------------------------- | Determine the maximum element in a stream using the supplied comparison--- function.----{-# INLINE maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)-maximumBy cmp = foldl1' max'--    where--    max' x y =-        case cmp x y of-            GT -> x-            _ -> y---- | Determine the maximum element in a stream.------ Definitions:------ >>> maximum = Fold.maximumBy compare--- >>> maximum = Fold.foldl1' max------ Same as the following but without a default maximum. The 'Max' Monoid uses--- the 'minBound' as the default maximum:------ >>> maximum = fmap Data.Semigroup.getMax $ Fold.foldMap Data.Semigroup.Max----{-# INLINE maximum #-}-maximum :: (Monad m, Ord a) => Fold m a (Maybe a)-maximum = foldl1' max---- | Computes the minimum element with respect to the given comparison function----{-# INLINE minimumBy #-}-minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)-minimumBy cmp = foldl1' min'--    where--    min' x y =-        case cmp x y of-            GT -> y-            _ -> x---- | Determine the minimum element in a stream using the supplied comparison--- function.------ Definitions:------ >>> minimum = Fold.minimumBy compare--- >>> minimum = Fold.foldl1' min------ Same as the following but without a default minimum. The 'Min' Monoid uses the--- 'maxBound' as the default maximum:------ >>> maximum = fmap Data.Semigroup.getMin $ Fold.foldMap Data.Semigroup.Min----{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => Fold m a (Maybe a)-minimum = foldl1' min----------------------------------------------------------------------------------- To Summary (Statistical)----------------------------------------------------------------------------------- | Compute a numerically stable arithmetic mean of all elements in the input--- stream.----{-# INLINE mean #-}-mean :: (Monad m, Fractional a) => Fold m a a-mean = fmap done $ foldl' step begin--    where--    begin = Tuple' 0 0--    step (Tuple' x n) y =-        let n1 = n + 1-         in Tuple' (x + (y - x) / n1) n1--    done (Tuple' x _) = x---- | Compute a numerically stable (population) variance over all elements in--- the input stream.----{-# DEPRECATED variance "Use the streamly-statistics package instead" #-}-{-# INLINE variance #-}-variance :: (Monad m, Fractional a) => Fold m a a-variance = fmap done $ foldl' step begin--    where--    begin = Tuple3' 0 0 0--    step (Tuple3' n mean_ m2) x = Tuple3' n' mean' m2'--        where--        n' = n + 1-        mean' = (n * mean_ + x) / (n + 1)-        delta = x - mean_-        m2' = m2 + delta * delta * n / (n + 1)--    done (Tuple3' n _ m2) = m2 / n---- | Compute a numerically stable (population) standard deviation over all--- elements in the input stream.----{-# DEPRECATED stdDev "Use the streamly-statistics package instead" #-}-{-# INLINE stdDev #-}-stdDev :: (Monad m, Floating a) => Fold m a a-stdDev = sqrt <$> variance---- | Compute an 'Int' sized polynomial rolling hash------ > H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0------ Where @c1@, @c2@, @cn@ are the elements in the input stream and @k@ is a--- constant.------ This hash is often used in Rabin-Karp string search algorithm.------ See https://en.wikipedia.org/wiki/Rolling_hash----{-# INLINE rollingHashWithSalt #-}-rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64-rollingHashWithSalt = foldl' step--    where--    k = 2891336453 :: Int64--    step cksum a = cksum * k + fromIntegral (fromEnum a)---- | A default salt used in the implementation of 'rollingHash'.-{-# INLINE defaultSalt #-}-defaultSalt :: Int64-defaultSalt = -2578643520546668380---- | Compute an 'Int' sized polynomial rolling hash of a stream.------ >>> rollingHash = Fold.rollingHashWithSalt Fold.defaultSalt----{-# INLINE rollingHash #-}-rollingHash :: (Monad m, Enum a) => Fold m a Int64-rollingHash = rollingHashWithSalt defaultSalt---- | Compute an 'Int' sized polynomial rolling hash of the first n elements of--- a stream.------ >>> rollingHashFirstN n = Fold.take n Fold.rollingHash------ /Pre-release/-{-# INLINE rollingHashFirstN #-}-rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64-rollingHashFirstN n = take n rollingHash---- XXX Compare this with the implementation in Fold.Window, preferrably use the--- latter if performance is good.---- | Apply a function on every two successive elements of a stream. The first--- argument of the map function is the previous element and the second argument--- is the current element. When processing the very first element in the--- stream, the previous element is 'Nothing'.------ /Pre-release/----{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b-rollingMapM f = Fold step initial extract--    where--    -- XXX We need just a postscan. We do not need an initial result here.-    -- Or we can supply a default initial result as an argument to rollingMapM.-    initial = return $ Partial (Nothing, error "Empty stream")--    step (prev, _) cur = do-        x <- f prev cur-        return $ Partial (Just cur, x)--    extract = return . snd---- |--- >>> rollingMap f = Fold.rollingMapM (\x y -> return $ f x y)----{-# INLINE rollingMap #-}-rollingMap :: Monad m => (Maybe a -> a -> b) -> Fold m a b-rollingMap f = rollingMapM (\x y -> return $ f x y)----------------------------------------------------------------------------------- Monoidal left folds----------------------------------------------------------------------------------- | Semigroup concat. Append the elements of an input stream to a provided--- starting value.------ Definition:------ >>> sconcat = Fold.foldl' (<>)------ >>> semigroups = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10--- >>> Stream.fold (Fold.sconcat 10) semigroups--- Sum {getSum = 65}----{-# INLINE sconcat #-}-sconcat :: (Monad m, Semigroup a) => a -> Fold m a a-sconcat = foldl' (<>)---- | Monoid concat. Fold an input stream consisting of monoidal elements using--- 'mappend' and 'mempty'.------ Definition:------ >>> mconcat = Fold.sconcat mempty------ >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10--- >>> Stream.fold Fold.mconcat monoids--- Sum {getSum = 55}----{-# INLINE mconcat #-}-mconcat ::-    ( Monad m-    , Monoid a) => Fold m a a-mconcat = sconcat mempty---- |--- Definition:------ >>> foldMap f = Fold.lmap f Fold.mconcat------ Make a fold from a pure function that folds the output of the function--- using 'mappend' and 'mempty'.------ >>> sum = Fold.foldMap Data.Monoid.Sum--- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10--- Sum {getSum = 55}----{-# INLINE foldMap #-}-foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b-foldMap f = lmap f mconcat---- |--- Definition:------ >>> foldMapM f = Fold.lmapM f Fold.mconcat------ Make a fold from a monadic function that folds the output of the function--- using 'mappend' and 'mempty'.------ >>> sum = Fold.foldMapM (return . Data.Monoid.Sum)--- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10--- Sum {getSum = 55}----{-# INLINE foldMapM #-}-foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b-foldMapM act = foldlM' step (pure mempty)--    where--    step m a = do-        m' <- act a-        return $! mappend m m'----------------------------------------------------------------------------------- To Containers----------------------------------------------------------------------------------- $toListRev--- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is--- exactly the same as reversing the list after 'toListRev'.---- | Buffers the input stream to a list in the reverse order of the input.------ Definition:------ >>> toListRev = Fold.foldl' (flip (:)) []------ /Warning!/ working on large lists accumulated as buffers in memory could be--- very inefficient, consider using "Streamly.Array" instead.-------  xn : ... : x2 : x1 : []-{-# INLINE toListRev #-}-toListRev :: Monad m => Fold m a [a]-toListRev = foldl' (flip (:)) []----------------------------------------------------------------------------------- Partial Folds----------------------------------------------------------------------------------- | A fold that drains the first n elements of its input, running the effects--- and discarding the results.------ Definition:------ >>> drainN n = Fold.take n Fold.drain------ /Pre-release/-{-# INLINE drainN #-}-drainN :: Monad m => Int -> Fold m a ()-drainN n = take n drain----------------------------------------------------------------------------------- To Elements----------------------------------------------------------------------------------- | Like 'index', except with a more general 'Integral' argument------ /Pre-release/-{-# INLINE indexGeneric #-}-indexGeneric :: (Integral i, Monad m) => i -> Fold m a (Maybe a)-indexGeneric i = foldt' step (Partial 0) (const Nothing)--    where--    step j a =-        if i == j-        then Done $ Just a-        else Partial (j + 1)---- | Return the element at the given index.------ Definition:------ >>> index = Fold.indexGeneric----{-# INLINE index #-}-index :: Monad m => Int -> Fold m a (Maybe a)-index = indexGeneric---- | Consume a single input and transform it using the supplied 'Maybe'--- returning function.------ /Pre-release/----{-# INLINE maybe #-}-maybe :: Monad m => (a -> Maybe b) -> Fold m a (Maybe b)-maybe f = foldt' (const (Done . f)) (Partial Nothing) id---- | Consume a single element and return it if it passes the predicate else--- return 'Nothing'.------ Definition:------ >>> satisfy f = Fold.maybe (\a -> if f a then Just a else Nothing)------ /Pre-release/-{-# INLINE satisfy #-}-satisfy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-satisfy f = maybe (\a -> if f a then Just a else Nothing)-{--satisfy f = Fold step (return $ Partial ()) (const (return Nothing))--    where--    step () a = return $ Done $ if f a then Just a else Nothing--}---- Naming notes:------ "head" and "next" are two alternative names for the same API. head sounds--- apt in the context of lists but next sounds more apt in the context of--- streams where we think in terms of generating and consuming the next element--- rather than taking the head of some static/persistent structure.------ We also want to keep the nomenclature consistent across folds and parsers,--- "head" becomes even more unintuitive for parsers because there are two--- possible variants viz. peek and next.------ Also, the "head" fold creates confusion in situations like--- https://github.com/composewell/streamly/issues/1404 where intuitive--- expectation from head is to consume the entire stream and just give us the--- head. There we want to convey the notion that we consume one element from--- the stream and stop. The name "one" already being used in parsers for this--- purpose sounds more apt from this perspective.------ The source of confusion is perhaps due to the fact that some folds consume--- the entire stream and others terminate early. It may have been clearer if we--- had separate abstractions for the two use cases.---- XXX We can possibly use "head" for the purposes of reducing the entire--- stream to the head element i.e. take the head and drain the rest.---- | Take one element from the stream and stop.------ Definition:------ >>> one = Fold.maybe Just------ This is similar to the stream 'Stream.uncons' operation.----{-# INLINE one #-}-one :: Monad m => Fold m a (Maybe a)-one = maybe Just---- | Extract the first element of the stream, if any.------ >>> head = Fold.one----{-# DEPRECATED head "Please use \"one\" instead" #-}-{-# INLINE head #-}-head :: Monad m => Fold m a (Maybe a)-head = one---- | Returns the first element that satisfies the given predicate.------ /Pre-release/-{-# INLINE findM #-}-findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-findM predicate = Fold step (return $ Partial ()) (const $ return Nothing)--    where--    step () a =-        let f r =-                if r-                then Done (Just a)-                else Partial ()-         in f <$> predicate a---- | Returns the first element that satisfies the given predicate.----{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-find p = findM (return . p)---- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the--- first pair where the key equals the given value @a@.------ Definition:------ >>> lookup x = fmap snd <$> Fold.find ((== x) . fst)----{-# INLINE lookup #-}-lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)-lookup a0 = foldt' step (Partial ()) (const Nothing)--    where--    step () (a, b) =-        if a == a0-        then Done $ Just b-        else Partial ()---- | Returns the first index that satisfies the given predicate.----{-# INLINE findIndex #-}-findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)-findIndex predicate = foldt' step (Partial 0) (const Nothing)--    where--    step i a =-        if predicate a-        then Done $ Just i-        else Partial (i + 1)---- | Returns the index of the latest element if the element satisfies the given--- predicate.----{-# INLINE findIndices #-}-findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)-findIndices predicate =-    -- XXX implement by combining indexing and filtering scans-    fmap (either (const Nothing) Just) $ foldl' step (Left (-1))--    where--    step i a =-        if predicate a-        then Right (either id id i + 1)-        else Left (either id id i + 1)---- | Returns the index of the latest element if the element matches the given--- value.------ Definition:------ >>> elemIndices a = Fold.findIndices (== a)----{-# INLINE elemIndices #-}-elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)-elemIndices a = findIndices (== a)---- | Returns the first index where a given value is found in the stream.------ Definition:------ >>> elemIndex a = Fold.findIndex (== a)----{-# INLINE elemIndex #-}-elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)-elemIndex a = findIndex (== a)----------------------------------------------------------------------------------- To Boolean----------------------------------------------------------------------------------- Similar to 'eof' parser, but the fold consumes and discards an input element--- when not at eof. XXX Remove or Rename to "eof"?---- | Consume one element, return 'True' if successful else return 'False'. In--- other words, test if the input is empty or not.------ WARNING! It consumes one element if the stream is not empty. If that is not--- what you want please use the eof parser instead.------ Definition:------ >>> null = fmap isJust Fold.one----{-# INLINE null #-}-null :: Monad m => Fold m a Bool-null = foldt' (\() _ -> Done False) (Partial ()) (const True)---- | Returns 'True' if any element of the input satisfies the predicate.------ Definition:------ >>> any p = Fold.lmap p Fold.or------ Example:------ >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]--- True----{-# INLINE any #-}-any :: Monad m => (a -> Bool) -> Fold m a Bool-any predicate = foldt' step initial id--    where--    initial = Partial False--    step _ a =-        if predicate a-        then Done True-        else Partial False---- | Return 'True' if the given element is present in the stream.------ Definition:------ >>> elem a = Fold.any (== a)----{-# INLINE elem #-}-elem :: (Eq a, Monad m) => a -> Fold m a Bool-elem a = any (== a)---- | Returns 'True' if all elements of the input satisfy the predicate.------ Definition:------ >>> all p = Fold.lmap p Fold.and------ Example:------ >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]--- False----{-# INLINE all #-}-all :: Monad m => (a -> Bool) -> Fold m a Bool-all predicate = foldt' step initial id--    where--    initial = Partial True--    step _ a =-        if predicate a-        then Partial True-        else Done False---- | Returns 'True' if the given element is not present in the stream.------ Definition:------ >>> notElem a = Fold.all (/= a)----{-# INLINE notElem #-}-notElem :: (Eq a, Monad m) => a -> Fold m a Bool-notElem a = all (/= a)---- | Returns 'True' if all elements are 'True', 'False' otherwise------ Definition:------ >>> and = Fold.all (== True)----{-# INLINE and #-}-and :: Monad m => Fold m Bool Bool-and = all (== True)---- | Returns 'True' if any element is 'True', 'False' otherwise------ Definition:------ >>> or = Fold.any (== True)----{-# INLINE or #-}-or :: Monad m => Fold m Bool Bool-or = any (== True)----------------------------------------------------------------------------------- Grouping/Splitting------------------------------------------------------------------------------------------------------------------------------------------------------------------ Grouping without looking at elements------------------------------------------------------------------------------------------------------------------------------------------------------------------ Binary APIs----------------------------------------------------------------------------------- | @splitAt n f1 f2@ composes folds @f1@ and @f2@ such that first @n@--- elements of its input are consumed by fold @f1@ and the rest of the stream--- is consumed by fold @f2@.------ >>> let splitAt_ n xs = Stream.fold (Fold.splitAt n Fold.toList Fold.toList) $ Stream.fromList xs------ >>> splitAt_ 6 "Hello World!"--- ("Hello ","World!")------ >>> splitAt_ (-1) [1,2,3]--- ([],[1,2,3])------ >>> splitAt_ 0 [1,2,3]--- ([],[1,2,3])------ >>> splitAt_ 1 [1,2,3]--- ([1],[2,3])------ >>> splitAt_ 3 [1,2,3]--- ([1,2,3],[])------ >>> splitAt_ 4 [1,2,3]--- ([1,2,3],[])------ > splitAt n f1 f2 = Fold.splitWith (,) (Fold.take n f1) f2------ /Internal/--{-# INLINE splitAt #-}-splitAt-    :: Monad m-    => Int-    -> Fold m a b-    -> Fold m a c-    -> Fold m a (b, c)-splitAt n fld = splitWith (,) (take n fld)----------------------------------------------------------------------------------- Element Aware APIs-------------------------------------------------------------------------------------------------------------------------------------------------------------------- Binary APIs---------------------------------------------------------------------------------{-# INLINE takingEndByM #-}-takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-takingEndByM p = Fold step initial (return . toMaybe)--    where--    initial = return $ Partial Nothing'--    step _ a = do-        r <- p a-        return-            $ if r-              then Done $ Just a-              else Partial $ Just' a---- |------ >>> takingEndBy p = Fold.takingEndByM (return . p)----{-# INLINE takingEndBy #-}-takingEndBy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-takingEndBy p = takingEndByM (return . p)--{-# INLINE takingEndByM_ #-}-takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-takingEndByM_ p = Fold step initial (return . toMaybe)--    where--    initial = return $ Partial Nothing'--    step _ a = do-        r <- p a-        return-            $ if r-              then Done Nothing-              else Partial $ Just' a---- |------ >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)----{-# INLINE takingEndBy_ #-}-takingEndBy_ :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-takingEndBy_ p = takingEndByM_ (return . p)--{-# INLINE droppingWhileM #-}-droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)-droppingWhileM p = Fold step initial (return . toMaybe)--    where--    initial = return $ Partial Nothing'--    step Nothing' a = do-        r <- p a-        return-            $ Partial-            $ if r-              then Nothing'-              else Just' a-    step _ a = return $ Partial $ Just' a---- |--- >>> droppingWhile p = Fold.droppingWhileM (return . p)----{-# INLINE droppingWhile #-}-droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a)-droppingWhile p = droppingWhileM (return . p)---- Note: Keep this consistent with S.splitOn. In fact we should eliminate--- S.splitOn in favor of the fold.------ XXX Use Fold.many instead once it is fixed.--- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)---- | Like 'takeEndBy' but drops the element on which the predicate succeeds.------ Example:------ >>> input = Stream.fromList "hello\nthere\n"--- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList--- >>> Stream.fold line input--- "hello"------ >>> Stream.fold Fold.toList $ Stream.foldMany line input--- ["hello","there"]----{-# INLINE takeEndBy_ #-}-takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b--- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)-takeEndBy_ predicate (Fold fstep finitial fextract) =-    Fold step finitial fextract--    where--    step s a =-        if not (predicate a)-        then fstep s a-        else Done <$> fextract s---- Note:--- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)---- | Take the input, stop when the predicate succeeds taking the succeeding--- element as well.------ Example:------ >>> input = Stream.fromList "hello\nthere\n"--- >>> line = Fold.takeEndBy (== '\n') Fold.toList--- >>> Stream.fold line input--- "hello\n"------ >>> Stream.fold Fold.toList $ Stream.foldMany line input--- ["hello\n","there\n"]----{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b--- takeEndBy predicate = scanMaybe (takingEndBy predicate)-takeEndBy predicate (Fold fstep finitial fextract) =-    Fold step finitial fextract--    where--    step s a = do-        res <- fstep s a-        if not (predicate a)-        then return res-        else do-            case res of-                Partial s1 -> Done <$> fextract s1-                Done b -> return $ Done b----------------------------------------------------------------------------------- Binary splitting on a separator---------------------------------------------------------------------------------data SplitOnSeqState acc a rb rh w ck =-      SplitOnSeqEmpty !acc-    | SplitOnSeqSingle !acc !a-    | SplitOnSeqWord !acc !Int !w-    | SplitOnSeqWordLoop !acc !w-    | SplitOnSeqKR !acc !Int !rb !rh-    | SplitOnSeqKRLoop !acc !ck !rb !rh---- XXX Need to add tests for takeEndBySeq, we have tests for takeEndBySeq_ .---- | Continue taking the input until the input sequence matches the supplied--- sequence, taking the supplied sequence as well. If the pattern is empty this--- acts as an identity fold.------ >>> s = Stream.fromList "hello there. How are you?"--- >>> f = Fold.takeEndBySeq (Array.fromList "re") Fold.toList--- >>> Stream.fold f s--- "hello there"------ >>> Stream.fold Fold.toList $ Stream.foldMany f s--- ["hello there",". How are"," you?"]------ /Pre-release/-{-# INLINE takeEndBySeq #-}-takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>-       Array.Array a-    -> Fold m a b-    -> Fold m a b-takeEndBySeq patArr (Fold fstep finitial fextract) =-    Fold step initial extract--    where--    patLen = Array.length patArr--    initial = do-        res <- finitial-        case res of-            Partial acc-                | patLen == 0 ->-                    -- XXX Should we match nothing or everything on empty-                    -- pattern?-                    -- Done <$> fextract acc-                    return $ Partial $ SplitOnSeqEmpty acc-                | patLen == 1 -> do-                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr-                    return $ Partial $ SplitOnSeqSingle acc pat-                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->-                    return $ Partial $ SplitOnSeqWord acc 0 0-                | otherwise -> do-                    (rb, rhead) <- liftIO $ Ring.new patLen-                    return $ Partial $ SplitOnSeqKR acc 0 rb rhead-            Done b -> return $ Done b--    -- Word pattern related-    maxIndex = patLen - 1--    elemBits = SIZE_OF(a) * 8--    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    wordPat :: Word-    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    -- XXX Need to keep this cached across fold calls in foldmany-    -- XXX We may need refold to inject the cached state instead of-    -- initializing the state every time.-    -- XXX Allocation of ring buffer should also be done once-    patHash = Array.foldl' addCksum 0 patArr--    step (SplitOnSeqEmpty s) x = do-        res <- fstep s x-        case res of-            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1-            Done b -> return $ Done b-    step (SplitOnSeqSingle s pat) x = do-        res <- fstep s x-        case res of-            Partial s1-                | pat /= x -> return $ Partial $ SplitOnSeqSingle s1 pat-                | otherwise -> Done <$> fextract s1-            Done b -> return $ Done b-    step (SplitOnSeqWord s idx wrd) x = do-        res <- fstep s x-        let wrd1 = addToWord wrd x-        case res of-            Partial s1-                | idx == maxIndex -> do-                    if wrd1 .&. wordMask == wordPat-                    then Done <$> fextract s1-                    else return $ Partial $ SplitOnSeqWordLoop s1 wrd1-                | otherwise ->-                    return $ Partial $ SplitOnSeqWord s1 (idx + 1) wrd1-            Done b -> return $ Done b-    step (SplitOnSeqWordLoop s wrd) x = do-        res <- fstep s x-        let wrd1 = addToWord wrd x-        case res of-            Partial s1-                | wrd1 .&. wordMask == wordPat ->-                    Done <$> fextract s1-                | otherwise ->-                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1-            Done b -> return $ Done b-    step (SplitOnSeqKR s idx rb rh) x = do-        res <- fstep s x-        case res of-            Partial s1 -> do-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                if idx == maxIndex-                then do-                    let fld = Ring.unsafeFoldRing (Ring.ringBound rb)-                    let !ringHash = fld addCksum 0 rb-                    if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-                    then Done <$> fextract s1-                    else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1-                else-                    return $ Partial $ SplitOnSeqKR s1 (idx + 1) rb rh1-            Done b -> return $ Done b-    step (SplitOnSeqKRLoop s cksum rb rh) x = do-        res <- fstep s x-        case res of-            Partial s1 -> do-                old <- liftIO $ peek rh-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                let ringHash = deltaCksum cksum old x-                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-                then Done <$> fextract s1-                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1-            Done b -> return $ Done b--    extract state =-        let st =-                case state of-                    SplitOnSeqEmpty s -> s-                    SplitOnSeqSingle s _ -> s-                    SplitOnSeqWord s _ _ -> s-                    SplitOnSeqWordLoop s _ -> s-                    SplitOnSeqKR s _ _ _ -> s-                    SplitOnSeqKRLoop s _ _ _ -> s-         in fextract st---- | Like 'takeEndBySeq' but discards the matched sequence.------ /Pre-release/----{-# INLINE takeEndBySeq_ #-}-takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>-       Array.Array a-    -> Fold m a b-    -> Fold m a b-takeEndBySeq_ patArr (Fold fstep finitial fextract) =-    Fold step initial extract--    where--    patLen = Array.length patArr--    initial = do-        res <- finitial-        case res of-            Partial acc-                | patLen == 0 ->-                    -- XXX Should we match nothing or everything on empty-                    -- pattern?-                    -- Done <$> fextract acc-                    return $ Partial $ SplitOnSeqEmpty acc-                | patLen == 1 -> do-                    pat <- liftIO $ Array.unsafeIndexIO 0 patArr-                    return $ Partial $ SplitOnSeqSingle acc pat-                -- XXX Need to add tests for this case-                | SIZE_OF(a) * patLen <= sizeOf (Proxy :: Proxy Word) ->-                    return $ Partial $ SplitOnSeqWord acc 0 0-                | otherwise -> do-                    (rb, rhead) <- liftIO $ Ring.new patLen-                    return $ Partial $ SplitOnSeqKR acc 0 rb rhead-            Done b -> return $ Done b--    -- Word pattern related-    maxIndex = patLen - 1--    elemBits = SIZE_OF(a) * 8--    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    elemMask :: Word-    elemMask = (1 `shiftL` elemBits) - 1--    wordPat :: Word-    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    -- XXX Need to keep this cached across fold calls in foldMany-    -- XXX We may need refold to inject the cached state instead of-    -- initializing the state every time.-    -- XXX Allocation of ring buffer should also be done once-    patHash = Array.foldl' addCksum 0 patArr--    step (SplitOnSeqEmpty s) x = do-        res <- fstep s x-        case res of-            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1-            Done b -> return $ Done b-    step (SplitOnSeqSingle s pat) x = do-        if pat /= x-        then do-            res <- fstep s x-            case res of-                Partial s1 -> return $ Partial $ SplitOnSeqSingle s1 pat-                Done b -> return $ Done b-        else Done <$> fextract s-    step (SplitOnSeqWord s idx wrd) x = do-        let wrd1 = addToWord wrd x-        if idx == maxIndex-        then do-            if wrd1 .&. wordMask == wordPat-            then Done <$> fextract s-            else return $ Partial $ SplitOnSeqWordLoop s wrd1-        else return $ Partial $ SplitOnSeqWord s (idx + 1) wrd1-    step (SplitOnSeqWordLoop s wrd) x = do-        let wrd1 = addToWord wrd x-            old = (wordMask .&. wrd)-                    `shiftR` (elemBits * (patLen - 1))-        res <- fstep s (toEnum $ fromIntegral old)-        case res of-            Partial s1-                | wrd1 .&. wordMask == wordPat ->-                    Done <$> fextract s1-                | otherwise ->-                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1-            Done b -> return $ Done b-    step (SplitOnSeqKR s idx rb rh) x = do-        rh1 <- liftIO $ Ring.unsafeInsert rb rh x-        if idx == maxIndex-        then do-            let fld = Ring.unsafeFoldRing (Ring.ringBound rb)-            let !ringHash = fld addCksum 0 rb-            if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-            then Done <$> fextract s-            else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1-        else return $ Partial $ SplitOnSeqKR s (idx + 1) rb rh1-    step (SplitOnSeqKRLoop s cksum rb rh) x = do-        old <- liftIO $ peek rh-        res <- fstep s old-        case res of-            Partial s1 -> do-                rh1 <- liftIO $ Ring.unsafeInsert rb rh x-                let ringHash = deltaCksum cksum old x-                if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr-                then Done <$> fextract s1-                else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1-            Done b -> return $ Done b--    -- XXX extract should return backtrack count as well. If the fold-    -- terminates early inside extract, we may still have buffered data-    -- remaining which will be lost if we do not communicate that to the-    -- driver.-    extract state = do-        let consumeWord s n wrd = do-                if n == 0-                then fextract s-                else do-                    let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))-                    r <- fstep s (toEnum $ fromIntegral old)-                    case r of-                        Partial s1 -> consumeWord s1 (n - 1) wrd-                        Done b -> return b--        let consumeRing s n rb rh =-                if n == 0-                then fextract s-                else do-                    old <- liftIO $ peek rh-                    let rh1 = Ring.advance rb rh-                    r <- fstep s old-                    case r of-                        Partial s1 -> consumeRing s1 (n - 1) rb rh1-                        Done b -> return b--        case state of-            SplitOnSeqEmpty s -> fextract s-            SplitOnSeqSingle s _ -> fextract s-            SplitOnSeqWord s idx wrd -> consumeWord s idx wrd-            SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd-            SplitOnSeqKR s idx rb _ -> consumeRing s idx rb (Ring.startOf rb)-            SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh----------------------------------------------------------------------------------- Distributing------------------------------------------------------------------------------------- | Distribute one copy of the stream to each fold and zip the results.------ @---                 |-------Fold m a b--------|--- ---stream m a---|                         |---m (b,c)---                 |-------Fold m a c--------|--- @------  Definition:------ >>> tee = Fold.teeWith (,)------ Example:------ >>> t = Fold.tee Fold.sum Fold.length--- >>> Stream.fold t (Stream.enumerateFromTo 1.0 100.0)--- (5050.0,100)----{-# INLINE tee #-}-tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)-tee = teeWith (,)---- XXX use "List" instead of "[]"?, use Array for output to scale it to a large--- number of consumers? For polymorphic case a vector could be helpful. For--- Storables we can use arrays. Will need separate APIs for those.------ | Distribute one copy of the stream to each fold and collect the results in--- a container.------ @------                 |-------Fold m a b--------|--- ---stream m a---|                         |---m [b]---                 |-------Fold m a b--------|---                 |                         |---                            ...--- @------ >>> Stream.fold (Fold.distribute [Fold.sum, Fold.length]) (Stream.enumerateFromTo 1 5)--- [15,5]------ >>> distribute = Prelude.foldr (Fold.teeWith (:)) (Fold.fromPure [])------ This is the consumer side dual of the producer side 'sequence' operation.------ Stops when all the folds stop.----{-# INLINE distribute #-}-distribute :: Monad m => [Fold m a b] -> Fold m a [b]-distribute = Prelude.foldr (teeWith (:)) (fromPure [])----------------------------------------------------------------------------------- Partitioning---------------------------------------------------------------------------------{-# INLINE partitionByMUsing #-}-partitionByMUsing :: Monad m =>-       (  (x -> y -> (x, y))-       -> Fold m (Either b c) x-       -> Fold m (Either b c) y-       -> Fold m (Either b c) (x, y)-       )-    -> (a -> m (Either b c))-    -> Fold m b x-    -> Fold m c y-    -> Fold m a (x, y)-partitionByMUsing t f fld1 fld2 =-    let l = lmap (fromLeft undefined) fld1  -- :: Fold m (Either b c) x-        r = lmap (fromRight undefined) fld2 -- :: Fold m (Either b c) y-     in lmapM f (t (,) (filter isLeft l) (filter isRight r))---- | Partition the input over two folds using an 'Either' partitioning--- predicate.------ @------                                     |-------Fold b x--------|--- -----stream m a --> (Either b c)----|                       |----(x,y)---                                     |-------Fold c y--------|--- @------ Example, send input to either fold randomly:------ >>> :set -package random--- >>> import System.Random (randomIO)--- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a--- >>> f = Fold.partitionByM randomly Fold.length Fold.length--- >>> Stream.fold f (Stream.enumerateFromTo 1 100)--- ...------ Example, send input to the two folds in a proportion of 2:1:------ >>> :{--- proportionately m n = do---  ref <- newIORef $ cycle $ concat [replicate m Left, replicate n Right]---  return $ \a -> do---      r <- readIORef ref---      writeIORef ref $ tail r---      return $ Prelude.head r a--- :}------ >>> :{--- main = do---  g <- proportionately 2 1---  let f = Fold.partitionByM g Fold.length Fold.length---  r <- Stream.fold f (Stream.enumerateFromTo (1 :: Int) 100)---  print r--- :}------ >>> main--- (67,33)--------- This is the consumer side dual of the producer side 'mergeBy' operation.------ When one fold is done, any input meant for it is ignored until the other--- fold is also done.------ Stops when both the folds stop.------ /See also: 'partitionByFstM' and 'partitionByMinM'./------ /Pre-release/-{-# INLINE partitionByM #-}-partitionByM :: Monad m-    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByM = partitionByMUsing teeWith---- | Similar to 'partitionByM' but terminates when the first fold terminates.----{-# INLINE partitionByFstM #-}-partitionByFstM :: Monad m-    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByFstM = partitionByMUsing teeWithFst---- | Similar to 'partitionByM' but terminates when any fold terminates.----{-# INLINE partitionByMinM #-}-partitionByMinM :: Monad m =>-    (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionByMinM = partitionByMUsing teeWithMin---- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter--- makes the signature clearer as to which case belongs to which fold.--- XXX need to check the performance in both cases.---- | Same as 'partitionByM' but with a pure partition function.------ Example, count even and odd numbers in a stream:------ >>> :{---  let f = Fold.partitionBy (\n -> if even n then Left n else Right n)---                      (fmap (("Even " ++) . show) Fold.length)---                      (fmap (("Odd "  ++) . show) Fold.length)---   in Stream.fold f (Stream.enumerateFromTo 1 100)--- :}--- ("Even 50","Odd 50")------ /Pre-release/-{-# INLINE partitionBy #-}-partitionBy :: Monad m-    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-partitionBy f = partitionByM (return . f)---- | Compose two folds such that the combined fold accepts a stream of 'Either'--- and routes the 'Left' values to the first fold and 'Right' values to the--- second fold.------ Definition:------ >>> partition = Fold.partitionBy id----{-# INLINE partition #-}-partition :: Monad m-    => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)-partition = partitionBy id--{---- | Send one item to each fold in a round-robin fashion. This is the consumer--- side dual of producer side 'mergeN' operation.------ partitionN :: Monad m => [Fold m a b] -> Fold m a [b]--- partitionN fs = Fold step begin done--}----------------------------------------------------------------------------------- Unzipping---------------------------------------------------------------------------------{-# INLINE unzipWithMUsing #-}-unzipWithMUsing :: Monad m =>-       (  (x -> y -> (x, y))-       -> Fold m (b, c) x-       -> Fold m (b, c) y-       -> Fold m (b, c) (x, y)-       )-    -> (a -> m (b, c))-    -> Fold m b x-    -> Fold m c y-    -> Fold m a (x, y)-unzipWithMUsing t f fld1 fld2 =-    let f1 = lmap fst fld1  -- :: Fold m (b, c) b-        f2 = lmap snd fld2  -- :: Fold m (b, c) c-     in lmapM f (t (,) f1 f2)---- | Like 'unzipWith' but with a monadic splitter function.------ Definition:------ >>> unzipWithM k f1 f2 = Fold.lmapM k (Fold.unzip f1 f2)------ /Pre-release/-{-# INLINE unzipWithM #-}-unzipWithM :: Monad m-    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWithM = unzipWithMUsing teeWith---- | Similar to 'unzipWithM' but terminates when the first fold terminates.----{-# INLINE unzipWithFstM #-}-unzipWithFstM :: Monad m =>-    (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)-unzipWithFstM = unzipWithMUsing teeWithFst---- | Similar to 'unzipWithM' but terminates when any fold terminates.----{-# INLINE unzipWithMinM #-}-unzipWithMinM :: Monad m =>-    (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWithMinM = unzipWithMUsing teeWithMin---- | Split elements in the input stream into two parts using a pure splitter--- function, direct each part to a different fold and zip the results.------ Definitions:------ >>> unzipWith f = Fold.unzipWithM (return . f)--- >>> unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)------ This fold terminates when both the input folds terminate.------ /Pre-release/-{-# INLINE unzipWith #-}-unzipWith :: Monad m-    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)-unzipWith f = unzipWithM (return . f)---- | Send the elements of tuples in a stream of tuples through two different--- folds.------ @------                           |-------Fold m a x--------|--- ---------stream of (a,b)--|                         |----m (x,y)---                           |-------Fold m b y--------|------ @------ Definition:------ >>> unzip = Fold.unzipWith id------ This is the consumer side dual of the producer side 'zip' operation.----{-# INLINE unzip #-}-unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)-unzip = unzipWith id----------------------------------------------------------------------------------- Combining streams and folds - Zipping----------------------------------------------------------------------------------- XXX These can be implemented using the fold scan, using the stream as a--- state.--- XXX Stream Skip state cannot be efficiently handled in folds but can be--- handled in parsers using the Continue facility. See zipWithM in the Parser--- module.------ cmpBy, eqBy, isPrefixOf, isSubsequenceOf etc can be implemented using--- zipStream.---- | Zip a stream with the input of a fold using the supplied function.------ /Unimplemented/----{-# INLINE zipStreamWithM #-}-zipStreamWithM :: -- Monad m =>-    (a -> b -> m c) -> Stream m a -> Fold m c x -> Fold m b x-zipStreamWithM = undefined---- | Zip a stream with the input of a fold.------ >>> zip = Fold.zipStreamWithM (curry return)------ /Unimplemented/----{-# INLINE zipStream #-}-zipStream :: Monad m => Stream m a -> Fold m (a, b) x -> Fold m b x-zipStream = zipStreamWithM (curry return)---- | Pair each element of a fold input with its index, starting from index 0.----{-# INLINE indexingWith #-}-indexingWith :: Monad m => Int -> (Int -> Int) -> Fold m a (Maybe (Int, a))-indexingWith i f = fmap toMaybe $ foldl' step initial--    where--    initial = Nothing'--    step Nothing' a = Just' (i, a)-    step (Just' (n, _)) a = Just' (f n, a)---- |--- >>> indexing = Fold.indexingWith 0 (+ 1)----{-# INLINE indexing #-}-indexing :: Monad m => Fold m a (Maybe (Int, a))-indexing = indexingWith 0 (+ 1)---- |--- >>> indexingRev n = Fold.indexingWith n (subtract 1)----{-# INLINE indexingRev #-}-indexingRev :: Monad m => Int -> Fold m a (Maybe (Int, a))-indexingRev n = indexingWith n (subtract 1)---- | Pair each element of a fold input with its index, starting from index 0.------ >>> indexed = Fold.scanMaybe Fold.indexing----{-# INLINE indexed #-}-indexed :: Monad m => Fold m (Int, a) b -> Fold m a b-indexed = scanMaybe indexing---- | Change the predicate function of a Fold from @a -> b@ to accept an--- additional state input @(s, a) -> b@. Convenient to filter with an--- addiitonal index or time input.------ >>> filterWithIndex = Fold.with Fold.indexed Fold.filter------ @--- filterWithAbsTime = with timestamped filter--- filterWithRelTime = with timeIndexed filter--- @------ /Pre-release/-{-# INLINE with #-}-with ::-       (Fold m (s, a) b -> Fold m a b)-    -> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)-    -> (((s, a) -> c) -> Fold m a b -> Fold m a b)-with f comb g = f . comb g . lmap snd---- XXX Implement as a filter--- sampleFromthen :: Monad m => Int -> Int -> Fold m a (Maybe a)---- | @sampleFromthen offset stride@ samples the element at @offset@ index and--- then every element at strides of @stride@.----{-# INLINE sampleFromthen #-}-sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Fold m a b-sampleFromthen offset size =-    with indexed filter (\(i, _) -> (i + offset) `mod` size == 0)----------------------------------------------------------------------------------- Nesting----------------------------------------------------------------------------------- | @concatSequence f t@ applies folds from stream @t@ sequentially and--- collects the results using the fold @f@.------ /Unimplemented/----{-# INLINE concatSequence #-}-concatSequence ::-    -- IsStream t =>-    Fold m b c -> t (Fold m a b) -> Fold m a c-concatSequence _f _p = undefined---- | Group the input stream into groups of elements between @low@ and @high@.--- Collection starts in chunks of @low@ and then keeps doubling until we reach--- @high@. Each chunk is folded using the provided fold function.------ This could be useful, for example, when we are folding a stream of unknown--- size to a stream of arrays and we want to minimize the number of--- allocations.------ NOTE: this would be an application of "many" using a terminating fold.------ /Unimplemented/----{-# INLINE chunksBetween #-}-chunksBetween :: -- Monad m =>-       Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c-chunksBetween _low _high _f1 _f2 = undefined---- | A fold that buffers its input to a pure stream.------ /Warning!/ working on large streams accumulated as buffers in memory could--- be very inefficient, consider using "Streamly.Data.Array" instead.------ >>> toStream = fmap Stream.fromList Fold.toList------ /Pre-release/-{-# INLINE toStream #-}-toStream :: (Monad m, Monad n) => Fold m a (Stream n a)-toStream = fmap StreamD.fromList toList---- This is more efficient than 'toStream'. toStream is exactly the same as--- reversing the stream after toStreamRev.------ | Buffers the input stream to a pure stream in the reverse order of the--- input.------ >>> toStreamRev = fmap Stream.fromList Fold.toListRev------ /Warning!/ working on large streams accumulated as buffers in memory could--- be very inefficient, consider using "Streamly.Data.Array" instead.------ /Pre-release/----  xn : ... : x2 : x1 : []-{-# INLINE toStreamRev #-}-toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)-toStreamRev = fmap StreamD.fromList toListRev---- XXX This does not fuse. It contains a recursive step function. We will need--- a Skip input constructor in the fold type to make it fuse.------ | Unfold and flatten the input stream of a fold.------ @--- Stream.fold (unfoldMany u f) = Stream.fold f . Stream.unfoldMany u--- @------ /Pre-release/-{-# INLINE unfoldMany #-}-unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c-unfoldMany (Unfold ustep inject) (Fold fstep initial extract) =-    Fold consume initial extract--    where--    {-# INLINE produce #-}-    produce fs us = do-        ures <- ustep us-        case ures of-            StreamD.Yield b us1 -> do-                fres <- fstep fs b-                case fres of-                    Partial fs1 -> produce fs1 us1-                    -- XXX What to do with the remaining stream?-                    Done c -> return $ Done c-            StreamD.Skip us1 -> produce fs us1-            StreamD.Stop -> return $ Partial fs--    {-# INLINE_LATE consume #-}-    consume s a = inject a >>= produce s---- | Get the bottom most @n@ elements using the supplied comparison function.----{-# INLINE bottomBy #-}-bottomBy :: (MonadIO m, Unbox a) =>-       (a -> a -> Ordering)-    -> Int-    -> Fold m a (MutArray a)-bottomBy cmp n = Fold step initial extract--    where--    initial = do-        arr <- MA.newPinned n-        if n <= 0-        then return $ Done arr-        else return $ Partial (arr, 0)--    step (arr, i) x =-        if i < n-        then do-            arr' <- MA.snoc arr x-            MA.bubble cmp arr'-            return $ Partial (arr', i + 1)-        else do-            x1 <- MA.getIndexUnsafe (i - 1) arr-            case x `cmp` x1 of-                LT -> do-                    MA.putIndexUnsafe (i - 1) arr x-                    MA.bubble cmp arr-                    return $ Partial (arr, i)-                _ -> return $ Partial (arr, i)--    extract = return . fst---- | Get the top @n@ elements using the supplied comparison function.------ To get bottom n elements instead:------ >>> bottomBy cmp = Fold.topBy (flip cmp)------ Example:------ >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]--- >>> Stream.fold (Fold.topBy compare 3) stream >>= MutArray.toList--- [17,11,9]------ /Pre-release/----{-# INLINE topBy #-}-topBy :: (MonadIO m, Unbox a) =>-       (a -> a -> Ordering)-    -> Int-    -> Fold m a (MutArray a)-topBy cmp = bottomBy (flip cmp)---- | Fold the input stream to top n elements.------ Definition:------ >>> top = Fold.topBy compare------ >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]--- >>> Stream.fold (Fold.top 3) stream >>= MutArray.toList--- [17,11,9]------ /Pre-release/-{-# INLINE top #-}-top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)-top = bottomBy $ flip compare---- | Fold the input stream to bottom n elements.------ Definition:------ >>> bottom = Fold.bottomBy compare------ >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]--- >>> Stream.fold (Fold.bottom 3) stream >>= MutArray.toList--- [1,2,3]------ /Pre-release/-{-# INLINE bottom #-}-bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)-bottom = bottomBy compare----------------------------------------------------------------------------------- Interspersed parsing---------------------------------------------------------------------------------data IntersperseQState fs ps =-      IntersperseQUnquoted !fs !ps-    | IntersperseQQuoted !fs !ps-    | IntersperseQQuotedEsc !fs !ps---- Useful for parsing CSV with quoting and escaping-{-# INLINE intersperseWithQuotes #-}-intersperseWithQuotes :: (Monad m, Eq a) =>-    a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c-intersperseWithQuotes-    quote-    esc-    separator-    (Fold stepL initialL extractL)-    (Fold stepR initialR extractR) = Fold step initial extract--    where--    errMsg p status =-        error $ "intersperseWithQuotes: " ++ p ++ " parsing fold cannot "-                ++ status ++ " without input"--    {-# INLINE initL #-}-    initL mkState = do-        resL <- initialL-        case resL of-            Partial sL ->-                return $ Partial $ mkState sL-            Done _ ->-                errMsg "content" "succeed"--    initial = do-        res <- initialR-        case res of-            Partial sR -> initL (IntersperseQUnquoted sR)-            Done b -> return $ Done b--    {-# INLINE collect #-}-    collect nextS sR b = do-        res <- stepR sR b-        case res of-            Partial s ->-                initL (nextS s)-            Done c -> return (Done c)--    {-# INLINE process #-}-    process a sL sR nextState = do-        r <- stepL sL a-        case r of-            Partial s -> return $ Partial (nextState sR s)-            Done b -> collect nextState sR b--    {-# INLINE processQuoted #-}-    processQuoted a sL sR nextState = do-        r <- stepL sL a-        case r of-            Partial s -> return $ Partial (nextState sR s)-            Done _ -> error "Collecting fold finished inside quote"--    step (IntersperseQUnquoted sR sL) a-        | a == separator = do-            b <- extractL sL-            collect IntersperseQUnquoted sR b-        | a == quote = processQuoted a sL sR IntersperseQQuoted-        | otherwise = process a sL sR IntersperseQUnquoted--    step (IntersperseQQuoted sR sL) a-        | a == esc = processQuoted a sL sR IntersperseQQuotedEsc-        | a == quote = process a sL sR IntersperseQUnquoted-        | otherwise = processQuoted a sL sR IntersperseQQuoted--    step (IntersperseQQuotedEsc sR sL) a =-        processQuoted a sL sR IntersperseQQuoted--    extract (IntersperseQUnquoted sR _) = extractR sR-    extract (IntersperseQQuoted _ _) =-        error "intersperseWithQuotes: finished inside quote"-    extract (IntersperseQQuotedEsc _ _) =-        error "intersperseWithQuotes: finished inside quote, at escape char"+{-# OPTIONS_GHC -Wno-deprecations #-}+-- |+-- Module      : Streamly.Internal.Data.Fold+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- See "Streamly.Data.Fold" for an overview and+-- "Streamly.Internal.Data.Fold.Type" for design notes.++module Streamly.Internal.Data.Fold+    (+    -- * Imports+    -- $setup++      module Streamly.Internal.Data.Fold.Type+    , module Streamly.Internal.Data.Fold.Tee+    , module Streamly.Internal.Data.Fold.Combinators+    , module Streamly.Internal.Data.Fold.Container+    , module Streamly.Internal.Data.Fold.Window+    , 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++#include "DocTestDataFold.hs"
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@@ -6,7 +9,7 @@ -- Stability   : experimental -- Portability : GHC ----- Use "Streamly.Data.Parser.Chunked" instead.+-- Use "Streamly.Data.Parser" instead. -- -- Fold a stream of foreign arrays.  @Fold m a b@ in this module works -- on a stream of "Array a" and produces an output of type @b@.@@ -19,18 +22,19 @@ -- folds in Data.Fold to correctly work on an array stream as if it is an -- element stream. For example: ----- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Stream.Chunked as ArrayStream--- >>> import qualified Streamly.Internal.Data.Fold.Chunked as ChunkFold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Data.StreamK as StreamK+-- >> import qualified Streamly.Data.Fold as Fold+-- >> import qualified Streamly.Internal.Data.Array.Stream as ArrayStream+-- >> import qualified Streamly.Internal.Data.Fold.Chunked as ChunkFold+-- >> import qualified Streamly.Data.Stream as Stream+-- >> import qualified Streamly.Data.StreamK as StreamK ----- >>> f = ChunkFold.fromFold (Fold.take 7 Fold.toList)--- >>> s = Stream.chunksOf 5 $ Stream.fromList "hello world"--- >>> ArrayStream.runArrayFold f (StreamK.fromStream s)+-- >> f = ChunkFold.fromFold (Fold.take 7 Fold.toList)+-- >> s = Array.chunksOf 5 $ Stream.fromList "hello world"+-- >> ArrayStream.runArrayFold f (StreamK.fromStream s) -- Right "hello w" -- module Streamly.Internal.Data.Fold.Chunked+    {-# DEPRECATED "Please use Streamly.Data.Parser instead." #-}     (       ChunkFold (..) @@ -58,22 +62,22 @@  #include "ArrayMacros.h" +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Control.Exception (assert) import Control.Monad.IO.Class (MonadIO(..)) import Data.Bifunctor (first) import Data.Proxy (Proxy(..))-import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unbox)+import Streamly.Internal.Data.Unbox (Unbox(..)) import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Mut.Type (touch)-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Parser.ParserD (Initial(..), Step(..))+import Streamly.Internal.Data.Array (Array(..))+import Streamly.Internal.Data.Parser (Initial(..), Step(..), Final(..)) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..)) -import qualified Streamly.Internal.Data.Array as Array+import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD+import qualified Streamly.Internal.Data.Parser as ParserD import qualified Streamly.Internal.Data.Parser as Parser  import Prelude hiding (concatMap, take)@@ -102,8 +106,8 @@ {-# INLINE fromFold #-} fromFold :: forall m a b. (MonadIO m, Unbox a) =>     Fold.Fold m a b -> ChunkFold m a b-fromFold (Fold.Fold fstep finitial fextract) =-    ChunkFold (ParserD.Parser step initial (fmap (Done 0) . fextract))+fromFold (Fold.Fold fstep finitial _ ffinal) =+    ChunkFold (ParserD.Parser step initial extract)      where @@ -123,7 +127,7 @@             assert (cur == end) (return ())             return $ Partial 0 fs         goArray !_ !cur !fs = do-            x <- liftIO $ peekWith contents cur+            x <- liftIO $ peekAt cur contents             res <- fstep fs x             let elemSize = SIZE_OF(a)                 next = INDEX_NEXT(cur,a)@@ -133,6 +137,8 @@                 Fold.Partial fs1 ->                     goArray SPEC next fs1 +    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. --@@ -160,8 +166,7 @@             else return $ st (arrRem + n) fs1          goArray !_ !cur !fs = do-            x <- liftIO $ peekWith contents cur-            liftIO $ touch contents+            x <- liftIO $ peekAt cur contents             res <- step1 fs x             let elemSize = SIZE_OF(a)                 next = INDEX_NEXT(cur,a)@@ -173,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.@@ -315,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@@ -338,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@@ -354,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)@@ -364,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
@@ -0,0 +1,2383 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.Combinators+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- See "Streamly.Data.Fold" for an overview and+-- "Streamly.Internal.Data.Fold.Type" for design notes.++module Streamly.Internal.Data.Fold.Combinators+    (+    -- * Mappers+    -- | Monadic functions useful with mapM/lmapM on folds or streams.+      tracing+    , trace++    -- * Folds++    -- ** Accumulators+    -- *** Semigroups and Monoids+    , sconcat+    , mconcat+    , foldMap+    , foldMapM++    -- *** Reducers+    , drainMapM+    , the+    , mean+    , rollingHash+    , Scanl.defaultSalt+    , rollingHashWithSalt+    , rollingHashFirstN+    -- , rollingHashLastN++    -- *** Saturating Reducers+    -- | 'product' terminates if it becomes 0. Other folds can theoretically+    -- saturate on bounded types, and therefore terminate, however, they will+    -- run forever on unbounded types like Integer/Double.+    , sum+    , product+    , maximumBy+    , maximum+    , minimumBy+    , minimum+    , 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.+    , toStream+    , toStreamRev+    , topBy+    , top+    , bottomBy+    , bottom++    -- *** Scanners+    -- | Stateful transformation of the elements. Useful in combination with+    -- the 'scanMaybe' combinator. For scanners the result of the fold is+    -- usually a transformation of the current element rather than an+    -- aggregation of all elements till now.+ -- , nthLast -- using RingArray array+    , rollingMap+    , rollingMapM++    -- *** Filters++    -- XXX deprecate these in favor of corresponding scans++    -- | Useful in combination with the 'scanMaybe' combinator.+    , deleteBy+    , uniqBy+    , uniq+    , repeated+    , findIndices+    , elemIndices++    -- *** Singleton folds+    -- | Folds that terminate after consuming exactly one input element. All+    -- these can be implemented in terms of the 'maybe' fold.+    , one+    , null -- XXX not very useful and could be problematic, remove it?+    , satisfy+    , maybe++    -- *** Multi folds+    -- | Terminate after consuming one or more elements.+    , drainN+    -- , lastN+    -- , (!!)+    , genericIndex+    , index+    , findM+    , find+    , lookup+    , findIndex+    , elemIndex+    , elem+    , notElem+    , all+    , any+    , and+    , or++    -- ** Trimmers+    -- | Useful in combination with the 'scanMaybe' combinator.+    , takingEndByM+    , takingEndBy+    , takingEndByM_+    , takingEndBy_+    , droppingWhileM+    , droppingWhile+    , prune++    -- * Running A Fold+    , drive+    -- , breakStream++    -- * Building Incrementally+    , addStream++    -- * Combinators+    -- ** Utilities+    , with++    -- ** Sliding Window+    , slide2++    -- ** Scanning Input+    , 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+    , distributeScan+    -- , distributeFst+    -- , distributeMin++    -- ** Unzipping+    , unzip+    -- These two can be expressed using lmap/lmapM and unzip+    , unzipWith+    , unzipWithM+    , unzipWithFstM+    , unzipWithMinM++    -- ** Partitioning+    , partitionByM+    , partitionByFstM+    , partitionByMinM+    , partitionBy+    , partition++    -- ** Splitting+    , chunksBetween+    , intersperseWithQuotes++    -- ** Nesting+    , unfoldMany+    , concatSequence++    -- * Deprecated+    , drainBy+    , head+    , sequence+    , mapM+    , variance+    , stdDev+    , indexingWith+    , indexing+    , indexingRev+    )+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.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 (..))+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.Pipe.Type as Pipe+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+       ( Foldable(..), filter, drop, dropWhile, take, takeWhile, zipWith+       , map, mapM_, sequence, all, any+       , notElem, head, last, tail+       , reverse, iterate, init, and, or, lookup, (!!)+       , scanl, scanl1, replicate, concatMap, mconcat, unzip+       , span, splitAt, break, mapM, zip, maybe)+import Streamly.Internal.Data.Fold.Type++#include "DocTestDataFold.hs"++------------------------------------------------------------------------------+-- Running+------------------------------------------------------------------------------++-- | Drive a fold using the supplied 'Stream', reducing the resulting+-- expression strictly at each step.+--+-- Definition:+--+-- >>> drive = flip Stream.fold+--+-- Example:+--+-- >>> Fold.drive (Stream.enumerateFromTo 1 100) Fold.sum+-- 5050+--+{-# INLINE drive #-}+drive :: Monad m => Stream m a -> Fold m a b -> m b+drive = flip StreamD.fold++{-+-- | Like 'drive' but also returns the remaining stream. The resulting stream+-- would be 'Stream.nil' if the stream finished before the fold.+--+-- Definition:+--+-- >>> breakStream = flip Stream.foldBreak+--+-- /CPS/+--+{-# INLINE breakStreamK #-}+breakStreamK :: Monad m => StreamK m a -> Fold m a b -> m (b, StreamK m a)+breakStreamK strm fl = fmap f $ K.foldBreak fl (Stream.toStreamK strm)++    where++    f (b, str) = (b, Stream.fromStreamK str)+-}++-- | Append a stream to a fold to build the fold accumulator incrementally. We+-- can repeatedly call 'addStream' on the same fold to continue building the+-- fold and finally use 'drive' to finish the fold and extract the result. Also+-- see the 'Streamly.Data.Fold.addOne' operation which is a singleton version+-- of 'addStream'.+--+-- Definitions:+--+-- >>> addStream stream = Fold.drive stream . Fold.duplicate+--+-- Example, build a list incrementally:+--+-- >>> :{+-- pure (Fold.toList :: Fold IO Int [Int])+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- [1,2,3,4]+--+-- This can be used as an O(n) list append compared to the O(n^2) @++@ when+-- used for incrementally building a list.+--+-- Example, build a stream incrementally:+--+-- >>> :{+-- pure (Fold.toStream :: Fold IO Int (Stream Identity Int))+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- fromList [1,2,3,4]+--+-- This can be used as an O(n) stream append compared to the O(n^2) @<>@ when+-- used for incrementally building a stream.+--+-- Example, build an array incrementally:+--+-- >>> :{+-- pure (Array.create :: 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.createOf 3) Fold.toStream+-- in pure f+--     >>= Fold.addOne 1+--     >>= Fold.addStream (Stream.enumerateFromTo 2 4)+--     >>= Fold.drive Stream.nil+--     >>= print+-- :}+-- fromList [fromList [1,2],fromList [3,4]]+--+addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)+addStream stream = drive stream . duplicate++------------------------------------------------------------------------------+-- Transformations on fold inputs+------------------------------------------------------------------------------++-- | Flatten the monadic output of a fold to pure output.+--+{-# DEPRECATED sequence "Use \"rmapM id\" instead" #-}+{-# INLINE sequence #-}+sequence :: Monad m => Fold m a (m b) -> Fold m a b+sequence = rmapM id++-- | Map a monadic function on the output of a fold.+--+{-# DEPRECATED mapM "Use rmapM instead" #-}+{-# INLINE mapM #-}+mapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c+mapM = rmapM++-- |+-- >>> mapMaybeM f = Fold.lmapM f . Fold.catMaybes+--+{-# INLINE mapMaybeM #-}+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Fold m b r -> Fold m a r+mapMaybeM f = lmapM f . catMaybes++-- | @mapMaybe f fold@ maps a 'Maybe' returning function @f@ on the input of+-- the fold, filters out 'Nothing' elements, and return the values extracted+-- from 'Just'.+--+-- >>> mapMaybe f = Fold.lmap f . Fold.catMaybes+-- >>> mapMaybe f = Fold.mapMaybeM (return . f)+--+-- >>> f x = if even x then Just x else Nothing+-- >>> fld = Fold.mapMaybe f Fold.toList+-- >>> Stream.fold fld (Stream.enumerateFromTo 1 10)+-- [2,4,6,8,10]+--+{-# INLINE mapMaybe #-}+mapMaybe :: Monad m => (a -> Maybe b) -> Fold m b r -> Fold m a r+mapMaybe f = lmap f . catMaybes++------------------------------------------------------------------------------+-- Transformations on fold inputs+------------------------------------------------------------------------------++-- | Apply a monadic function on the input and return the input.+--+-- >>> Stream.fold (Fold.lmapM (Fold.tracing print) Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)+-- 1+-- 2+--+-- /Pre-release/+--+{-# INLINE tracing #-}+tracing :: Monad m => (a -> m b) -> (a -> m a)+tracing f x = void (f x) >> return x++-- | Apply a monadic function to each element flowing through and discard the+-- results.+--+-- >>> Stream.fold (Fold.trace print Fold.drain) $ (Stream.enumerateFromTo (1 :: Int) 2)+-- 1+-- 2+--+-- >>> trace f = Fold.lmapM (Fold.tracing f)+--+-- /Pre-release/+{-# INLINE trace #-}+trace :: Monad m => (a -> m b) -> Fold m a r -> Fold m a r+trace f = lmapM (tracing f)++-- | Attach a 'Pipe' on the input of a 'Fold'.+--+-- /Pre-release/+{-# 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' 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 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 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++------------------------------------------------------------------------------+-- 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.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 = fromScanl . Scanl.deleteBy eq++-- | Provide a sliding window of length 2 elements.+--+-- See "Streamly.Internal.Data.Fold.Window".+--+{-# INLINE slide2 #-}+slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b+slide2 (Fold step1 initial1 extract1 final1) = Fold step initial extract final++    where++    initial =+        first (Tuple' Nothing) <$> initial1++    step (Tuple' prev s) cur =+        first (Tuple' (Just cur)) <$> step1 s (cur, prev)++    extract (Tuple' _ s) = extract1 s++    final (Tuple' _ s) = final1 s++-- | Return the latest unique element using the supplied comparison function.+-- Returns 'Nothing' if the current element is same as the last element+-- otherwise returns 'Just'.+--+-- Example, strip duplicate path separators:+--+-- >>> input = Stream.fromList "//a//b"+-- >>> f x y = x == '/' && y == '/'+--+-- >> Stream.toList $ Stream.scanMaybe (Fold.uniqBy f) input+-- "/a/b"+--+-- Space: @O(1)@+--+-- /Pre-release/+--+{-# INLINE uniqBy #-}+uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)+uniqBy = fromScanl . Scanl.uniqBy++-- | See 'uniqBy'.+--+-- Definition:+--+-- >>> uniq = Fold.uniqBy (==)+--+{-# INLINE uniq #-}+uniq :: (Monad m, Eq a) => Fold m a (Maybe a)+uniq = fromScanl Scanl.uniq++-- | Strip all leading and trailing occurrences of an element passing a+-- predicate and make all other consecutive occurrences uniq.+--+-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)+--+-- @+-- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")+-- "hello world!"+--+-- @+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE prune #-}+prune ::+    -- (Monad m, Eq a) =>+    (a -> Bool) -> Fold m a (Maybe a)+prune = error "Not implemented yet!"++-- | Emit only repeated elements, once.+--+-- /Unimplemented/+repeated :: -- (Monad m, Eq a) =>+    Fold m a (Maybe a)+repeated = error "Not implemented yet!"++------------------------------------------------------------------------------+-- Left folds+------------------------------------------------------------------------------++------------------------------------------------------------------------------+-- Run Effects+------------------------------------------------------------------------------++-- |+-- Definitions:+--+-- >>> drainMapM f = Fold.lmapM f Fold.drain+-- >>> drainMapM f = Fold.foldMapM (void . f)+--+-- Drain all input after passing it through a monadic function. This is the+-- dual of mapM_ on stream producers.+--+{-# INLINE drainMapM #-}+drainMapM ::  Monad m => (a -> m b) -> Fold m a ()+drainMapM f = lmapM f drain++{-# DEPRECATED drainBy "Please use 'drainMapM' instead." #-}+{-# INLINE drainBy #-}+drainBy ::  Monad m => (a -> m b) -> Fold m a ()+drainBy = drainMapM++-- | 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 = fromScanl Scanl.the++------------------------------------------------------------------------------+-- 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 = Fold.fromScanl (Scanl.cumulativeScan Scanl.incrSum)+--+-- Same as following but numerically stable:+--+-- >>> sum = Fold.foldl' (+) 0+-- >>> sum = fmap Data.Monoid.getSum $ Fold.foldMap Data.Monoid.Sum+--+{-# INLINE sum #-}+sum :: (Monad m, Num a) => Fold m a a+sum = 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+-- when it encounters (@0@) in its input.+--+-- Same as the following but terminates on multiplication by @0@:+--+-- >>> product = fmap Data.Monoid.getProduct $ Fold.foldMap Data.Monoid.Product+--+{-# INLINE product #-}+product :: (Monad m, Num a, Eq a) => Fold m a a+product = fromScanl Scanl.product++------------------------------------------------------------------------------+-- To Summary (Maybe)+------------------------------------------------------------------------------++-- | Determine the maximum element in a stream using the supplied comparison+-- function.+--+{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)+maximumBy cmp = foldl1' max'++    where++    max' x y =+        case cmp x y of+            GT -> x+            _ -> y++-- | Determine the maximum element in a stream.+--+-- Definitions:+--+-- >>> maximum = Fold.maximumBy compare+-- >>> maximum = Fold.foldl1' max+--+-- Same as the following but without a default maximum. The 'Max' Monoid uses+-- the 'minBound' as the default maximum:+--+-- >>> maximum = fmap Data.Semigroup.getMax $ Fold.foldMap Data.Semigroup.Max+--+{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => Fold m a (Maybe a)+maximum = foldl1' max++-- | Computes the minimum element with respect to the given comparison function+--+{-# INLINE minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> Fold m a (Maybe a)+minimumBy cmp = foldl1' min'++    where++    min' x y =+        case cmp x y of+            GT -> y+            _ -> x++-- | Determine the minimum element in a stream using the supplied comparison+-- function.+--+-- Definitions:+--+-- >>> minimum = Fold.minimumBy compare+-- >>> minimum = Fold.foldl1' min+--+-- Same as the following but without a default minimum. The 'Min' Monoid uses the+-- 'maxBound' as the default maximum:+--+-- >>> maximum = fmap Data.Semigroup.getMin $ Fold.foldMap Data.Semigroup.Min+--+{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => Fold m a (Maybe a)+minimum = foldl1' min++{-# 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)+------------------------------------------------------------------------------++-- | Compute a numerically stable arithmetic mean of all elements in the input+-- stream.+--+{-# INLINE mean #-}+mean :: (Monad m, Fractional a) => Fold m a a+mean = fromScanl Scanl.mean++-- | Compute a numerically stable (population) variance over all elements in+-- the input stream.+--+{-# DEPRECATED variance "Use the streamly-statistics package instead" #-}+{-# INLINE variance #-}+variance :: (Monad m, Fractional a) => Fold m a a+variance = fmap done $ foldl' step begin++    where++    begin = Tuple3' 0 0 0++    step (Tuple3' n mean_ m2) x = Tuple3' n' mean' m2'++        where++        n' = n + 1+        mean' = (n * mean_ + x) / (n + 1)+        delta = x - mean_+        m2' = m2 + delta * delta * n / (n + 1)++    done (Tuple3' n _ m2) = m2 / n++-- | Compute a numerically stable (population) standard deviation over all+-- elements in the input stream.+--+{-# DEPRECATED stdDev "Use the streamly-statistics package instead" #-}+{-# INLINE stdDev #-}+stdDev :: (Monad m, Floating a) => Fold m a a+stdDev = sqrt <$> variance++-- | Compute an 'Int' sized polynomial rolling hash+--+-- > H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0+--+-- Where @c1@, @c2@, @cn@ are the elements in the input stream and @k@ is a+-- constant.+--+-- This hash is often used in Rabin-Karp string search algorithm.+--+-- See https://en.wikipedia.org/wiki/Rolling_hash+--+{-# INLINE rollingHashWithSalt #-}+rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64+rollingHashWithSalt = fromScanl . Scanl.rollingHashWithSalt++-- | Compute an 'Int' sized polynomial rolling hash of a stream.+--+-- >>> rollingHash = Fold.rollingHashWithSalt Fold.defaultSalt+--+{-# INLINE rollingHash #-}+rollingHash :: (Monad m, Enum a) => Fold m a Int64+rollingHash = fromScanl Scanl.rollingHash++-- | Compute an 'Int' sized polynomial rolling hash of the first n elements of+-- a stream.+--+-- >>> rollingHashFirstN n = Fold.take n Fold.rollingHash+--+-- /Pre-release/+{-# INLINE rollingHashFirstN #-}+rollingHashFirstN :: (Monad m, Enum a) => Int -> Fold m a Int64+rollingHashFirstN = fromScanl . Scanl.rollingHashFirstN++-- XXX Compare this with the implementation in Fold.Window, preferrably use the+-- latter if performance is good.++-- | Apply a function on every two successive elements of a stream. The first+-- argument of the map function is the previous element and the second argument+-- is the current element. When processing the very first element in the+-- stream, the previous element is 'Nothing'.+--+-- /Pre-release/+--+{-# INLINE rollingMapM #-}+rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b+rollingMapM = 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 = fromScanl . Scanl.rollingMap++------------------------------------------------------------------------------+-- Monoidal left folds+------------------------------------------------------------------------------++-- | Semigroup concat. Append the elements of an input stream to a provided+-- starting value.+--+-- Definition:+--+-- >>> sconcat = Fold.foldl' (<>)+--+-- >>> semigroups = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10+-- >>> Stream.fold (Fold.sconcat 10) semigroups+-- Sum {getSum = 65}+--+{-# INLINE sconcat #-}+sconcat :: (Monad m, Semigroup a) => a -> Fold m a a+sconcat = fromScanl . Scanl.sconcat++-- | Monoid concat. Fold an input stream consisting of monoidal elements using+-- 'mappend' and 'mempty'.+--+-- Definition:+--+-- >>> mconcat = Fold.sconcat mempty+--+-- >>> monoids = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10+-- >>> Stream.fold Fold.mconcat monoids+-- Sum {getSum = 55}+--+{-# INLINE mconcat #-}+mconcat ::+    ( Monad m+    , Monoid a) => Fold m a a+mconcat = fromScanl Scanl.mconcat++-- |+-- Definition:+--+-- >>> foldMap f = Fold.lmap f Fold.mconcat+--+-- Make a fold from a pure function that folds the output of the function+-- using 'mappend' and 'mempty'.+--+-- >>> sum = Fold.foldMap Data.Monoid.Sum+-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10+-- Sum {getSum = 55}+--+{-# INLINE foldMap #-}+foldMap :: (Monad m, Monoid b) => (a -> b) -> Fold m a b+foldMap = fromScanl . Scanl.foldMap++-- |+-- Definition:+--+-- >>> foldMapM f = Fold.lmapM f Fold.mconcat+--+-- Make a fold from a monadic function that folds the output of the function+-- using 'mappend' and 'mempty'.+--+-- >>> sum = Fold.foldMapM (return . Data.Monoid.Sum)+-- >>> Stream.fold sum $ Stream.enumerateFromTo 1 10+-- Sum {getSum = 55}+--+{-# INLINE foldMapM #-}+foldMapM ::  (Monad m, Monoid b) => (a -> m b) -> Fold m a b+foldMapM = fromScanl . Scanl.foldMapM++------------------------------------------------------------------------------+-- Partial Folds+------------------------------------------------------------------------------++-- | A fold that drains the first n elements of its input, running the effects+-- and discarding the results.+--+-- Definition:+--+-- >>> drainN n = Fold.take n Fold.drain+--+-- /Pre-release/+{-# INLINE drainN #-}+drainN :: Monad m => Int -> Fold m a ()+drainN = fromScanl . Scanl.drainN++------------------------------------------------------------------------------+-- To Elements+------------------------------------------------------------------------------++-- | Like 'index', except with a more general 'Integral' argument+--+-- /Pre-release/+{-# INLINE genericIndex #-}+genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)+genericIndex i = foldt' step (Partial 0) (const Nothing)++    where++    step j a =+        if i == j+        then Done $ Just a+        else Partial (j + 1)++-- | Return the element at the given index.+--+-- Definition:+--+-- >>> index = Fold.genericIndex+--+{-# INLINE index #-}+index :: Monad m => Int -> Fold 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) -> Fold m a (Maybe b)+maybe f = foldt' (const (Done . f)) (Partial Nothing) id++-- | Consume a single element and return it if it passes the predicate else+-- return 'Nothing'.+--+-- Definition:+--+-- >>> satisfy f = Fold.maybe (\a -> if f a then Just a else Nothing)+--+-- /Pre-release/+{-# INLINE satisfy #-}+satisfy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+satisfy f = maybe (\a -> if f a then Just a else Nothing)+{-+satisfy f = Fold step (return $ Partial ()) (const (return Nothing))++    where++    step () a = return $ Done $ if f a then Just a else Nothing+-}++-- Naming notes:+--+-- "head" and "next" are two alternative names for the same API. head sounds+-- apt in the context of lists but next sounds more apt in the context of+-- streams where we think in terms of generating and consuming the next element+-- rather than taking the head of some static/persistent structure.+--+-- We also want to keep the nomenclature consistent across folds and parsers,+-- "head" becomes even more unintuitive for parsers because there are two+-- possible variants viz. peek and next.+--+-- Also, the "head" fold creates confusion in situations like+-- https://github.com/composewell/streamly/issues/1404 where intuitive+-- expectation from head is to consume the entire stream and just give us the+-- head. There we want to convey the notion that we consume one element from+-- the stream and stop. The name "one" already being used in parsers for this+-- purpose sounds more apt from this perspective.+--+-- The source of confusion is perhaps due to the fact that some folds consume+-- the entire stream and others terminate early. It may have been clearer if we+-- had separate abstractions for the two use cases.++-- XXX We can possibly use "head" for the purposes of reducing the entire+-- stream to the head element i.e. take the head and drain the rest.++-- | Take one element from the stream and stop.+--+-- Definition:+--+-- >>> one = Fold.maybe Just+--+-- This is similar to the stream 'Stream.uncons' operation.+--+{-# INLINE one #-}+one :: Monad m => Fold m a (Maybe a)+one = maybe Just++-- | Extract the first element of the stream, if any.+--+-- >>> head = Fold.one+--+{-# DEPRECATED head "Please use \"one\" instead" #-}+{-# INLINE head #-}+head :: Monad m => Fold m a (Maybe a)+head = one++-- | Returns the first element that satisfies the given predicate.+--+-- /Pre-release/+{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+findM predicate =+    Fold step (return $ Partial ()) extract extract++    where++    step () a =+        let f r =+                if r+                then Done (Just a)+                else Partial ()+         in f <$> predicate a++    extract = const $ return Nothing++-- | Returns the first element that satisfies the given predicate.+--+{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+find p = findM (return . p)++-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the+-- first pair where the key equals the given value @a@.+--+-- Definition:+--+-- >>> lookup x = fmap snd <$> Fold.find ((== x) . fst)+--+{-# INLINE lookup #-}+lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)+lookup a0 = foldt' step (Partial ()) (const Nothing)++    where++    step () (a, b) =+        if a == a0+        then Done $ Just b+        else Partial ()++-- | Returns the first index that satisfies the given predicate.+--+{-# INLINE findIndex #-}+findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)+findIndex predicate = foldt' step (Partial 0) (const Nothing)++    where++    step i a =+        if predicate a+        then Done $ Just i+        else Partial (i + 1)++-- | Returns the index of the latest element if the element satisfies the given+-- predicate.+--+{-# INLINE findIndices #-}+findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)+findIndices = fromScanl . Scanl.findIndices++-- | Returns the index of the latest element if the element matches the given+-- value.+--+-- Definition:+--+-- >>> elemIndices a = Fold.findIndices (== a)+--+{-# INLINE elemIndices #-}+elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)+elemIndices = fromScanl . Scanl.elemIndices++-- | Returns the first index where a given value is found in the stream.+--+-- Definition:+--+-- >>> elemIndex a = Fold.findIndex (== a)+--+{-# INLINE elemIndex #-}+elemIndex :: (Eq a, Monad m) => a -> Fold m a (Maybe Int)+elemIndex a = findIndex (== a)++------------------------------------------------------------------------------+-- To Boolean+------------------------------------------------------------------------------++-- Similar to 'eof' parser, but the fold consumes and discards an input element+-- when not at eof. XXX Remove or Rename to "eof"?++-- | Consume one element, return 'True' if successful else return 'False'. In+-- other words, test if the input is empty or not.+--+-- WARNING! It consumes one element if the stream is not empty. If that is not+-- what you want please use the eof parser instead.+--+-- Definition:+--+-- >>> null = fmap isJust Fold.one+--+{-# INLINE null #-}+null :: Monad m => Fold m a Bool+null = foldt' (\() _ -> Done False) (Partial ()) (const True)++-- | Returns 'True' if any element of the input satisfies the predicate.+--+-- Definition:+--+-- >>> any p = Fold.lmap p Fold.or+--+-- Example:+--+-- >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]+-- True+--+{-# INLINE any #-}+any :: Monad m => (a -> Bool) -> Fold m a Bool+any predicate = foldt' step initial id++    where++    initial = Partial False++    step _ a =+        if predicate a+        then Done True+        else Partial False++-- | Return 'True' if the given element is present in the stream.+--+-- Definition:+--+-- >>> elem a = Fold.any (== a)+--+{-# INLINE elem #-}+elem :: (Eq a, Monad m) => a -> Fold m a Bool+elem a = any (== a)++-- | Returns 'True' if all elements of the input satisfy the predicate.+--+-- Definition:+--+-- >>> all p = Fold.lmap p Fold.and+--+-- Example:+--+-- >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]+-- False+--+{-# INLINE all #-}+all :: Monad m => (a -> Bool) -> Fold m a Bool+all predicate = foldt' step initial id++    where++    initial = Partial True++    step _ a =+        if predicate a+        then Partial True+        else Done False++-- | Returns 'True' if the given element is not present in the stream.+--+-- Definition:+--+-- >>> notElem a = Fold.all (/= a)+--+{-# INLINE notElem #-}+notElem :: (Eq a, Monad m) => a -> Fold m a Bool+notElem a = all (/= a)++-- | Returns 'True' if all elements are 'True', 'False' otherwise+--+-- Definition:+--+-- >>> and = Fold.all (== True)+--+{-# INLINE and #-}+and :: Monad m => Fold m Bool Bool+and = all id++-- | Returns 'True' if any element is 'True', 'False' otherwise+--+-- Definition:+--+-- >>> or = Fold.any (== True)+--+{-# INLINE or #-}+or :: Monad m => Fold m Bool Bool+or = any 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.fold (Fold.splitAt n Fold.toList Fold.toList) $ Stream.fromList xs+--+-- >>> splitAt_ 6 "Hello World!"+-- ("Hello ","World!")+--+-- >>> splitAt_ (-1) [1,2,3]+-- ([],[1,2,3])+--+-- >>> splitAt_ 0 [1,2,3]+-- ([],[1,2,3])+--+-- >>> splitAt_ 1 [1,2,3]+-- ([1],[2,3])+--+-- >>> splitAt_ 3 [1,2,3]+-- ([1,2,3],[])+--+-- >>> splitAt_ 4 [1,2,3]+-- ([1,2,3],[])+--+-- > splitAt n f1 f2 = Fold.splitWith (,) (Fold.take n f1) f2+--+-- /Internal/++{-# INLINE splitAt #-}+splitAt+    :: Monad m+    => Int+    -> Fold m a b+    -> Fold m a c+    -> Fold m a (b, c)+splitAt n fld = splitWith (,) (take n fld)++------------------------------------------------------------------------------+-- Element Aware APIs+------------------------------------------------------------------------------+--+------------------------------------------------------------------------------+-- Binary APIs+------------------------------------------------------------------------------++{-# INLINE takingEndByM #-}+takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+takingEndByM p = Fold step initial extract extract++    where++    initial = return $ Partial Nothing'++    step _ a = do+        r <- p a+        return+            $ if r+              then Done $ Just a+              else Partial $ Just' a++    extract = return . toMaybe++-- |+--+-- >>> takingEndBy p = Fold.takingEndByM (return . p)+--+{-# INLINE takingEndBy #-}+takingEndBy :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+takingEndBy p = takingEndByM (return . p)++{-# INLINE takingEndByM_ #-}+takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+takingEndByM_ p = Fold step initial extract extract++    where++    initial = return $ Partial Nothing'++    step _ a = do+        r <- p a+        return+            $ if r+              then Done Nothing+              else Partial $ Just' a++    extract = return . toMaybe++-- |+--+-- >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)+--+{-# INLINE takingEndBy_ #-}+takingEndBy_ :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+takingEndBy_ p = takingEndByM_ (return . p)++{-# INLINE droppingWhileM #-}+droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+droppingWhileM p = Fold step initial extract extract++    where++    initial = return $ Partial Nothing'++    step Nothing' a = do+        r <- p a+        return+            $ Partial+            $ if r+              then Nothing'+              else Just' a+    step _ a = return $ Partial $ Just' a++    extract = return . toMaybe++-- |+-- >>> droppingWhile p = Fold.droppingWhileM (return . p)+--+{-# INLINE droppingWhile #-}+droppingWhile :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+droppingWhile p = droppingWhileM (return . p)++------------------------------------------------------------------------------+-- Binary splitting on a separator+------------------------------------------------------------------------------++data SplitOnSeqState mba acc a rh w ck =+      SplitOnSeqEmpty !acc+    | SplitOnSeqSingle !acc !a+    | SplitOnSeqWord !acc !Int !w+    | SplitOnSeqWordLoop !acc !w+    | SplitOnSeqKR !acc !Int !mba+    | SplitOnSeqKRLoop !acc !ck !mba !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 "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"]+--+-- 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, Unbox a, Enum a, Eq a) =>+       Array.Array a+    -> Fold m a b+    -> Fold m a b+takeEndBySeq patArr (Fold fstep finitial fextract ffinal) =+    Fold step initial extract final++    where++    patLen = Array.length patArr+    patBytes = Array.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)++    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+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MA.emptyOf patLen+                    return $ Partial $ SplitOnSeqKR acc 0 mba+            Done b -> return $ Done b++    -- Word pattern related+    elemBits = SIZE_OF(a) * 8++    wordMask :: Word+    wordMask = (1 `shiftL` (elemBits * patLen)) - 1++    wordPat :: Word+    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr++    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)++    -- For Rabin-Karp search+    k = 2891336453 :: Word32+    coeff = k ^ patLen++    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)++    deltaCksum cksum old new =+        addCksum cksum new - coeff * fromIntegral (fromEnum old)++    -- XXX shall we use a random starting hash or 1 instead of 0?+    -- XXX Need to keep this cached across fold calls in foldmany+    -- XXX We may need refold to inject the cached state instead of+    -- initializing the state every time.+    -- XXX Allocation of ring buffer should also be done once+    patHash = Array.foldl' addCksum 0 patArr++    step (SplitOnSeqEmpty s) x = do+        res <- fstep s x+        case res of+            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1+            Done b -> return $ Done b+    step (SplitOnSeqSingle s pat) x = do+        res <- fstep s x+        case res of+            Partial s1+                | pat /= x -> return $ Partial $ SplitOnSeqSingle s1 pat+                | otherwise -> Done <$> ffinal s1+            Done b -> return $ Done b+    step (SplitOnSeqWord s idx wrd) x = do+        res <- fstep s x+        let wrd1 = addToWord wrd x+        case res of+            Partial s1+                | idx == maxIndex -> do+                    if wrd1 .&. wordMask == wordPat+                    then Done <$> ffinal s1+                    else return $ Partial $ SplitOnSeqWordLoop s1 wrd1+                | otherwise ->+                    return $ Partial $ SplitOnSeqWord s1 (idx + 1) wrd1+            Done b -> return $ Done b+    step (SplitOnSeqWordLoop s wrd) x = do+        res <- fstep s x+        let wrd1 = addToWord wrd x+        case res of+            Partial s1+                | wrd1 .&. wordMask == wordPat ->+                    Done <$> ffinal s1+                | otherwise ->+                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1+            Done b -> return $ Done b+    step (SplitOnSeqKR s offset mba) x = do+        res <- fstep s x+        case res of+            Partial s1 -> do+                liftIO $ pokeAt offset mba x+                if offset == maxOffset+                then do+                    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 mba 0+                else+                    return $ Partial $ SplitOnSeqKR s1 (offset + SIZE_OF(a)) mba+            Done b -> return $ Done b+    step (SplitOnSeqKRLoop s cksum mba offset) x = do+        res <- fstep s x+        case res of+            Partial s1 -> do+                let rb = RingArray+                        { ringContents = mba+                        , ringSize = patBytes+                        , ringHead = offset+                        }+                (rb1, old :: a) <- liftIO (RingArray.replace rb x)+                let ringHash = deltaCksum cksum old x+                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 mba 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.+--+-- >>> 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, Unbox a, Enum a, Eq a) =>+       Array.Array a+    -> Fold m a b+    -> Fold m a b+takeEndBySeq_ patArr (Fold fstep finitial fextract ffinal) =+    Fold step initial extract final++    where++    patLen = Array.length patArr+    patBytes = Array.byteLength patArr+    maxIndex = patLen - 1+    maxOffset = patBytes - SIZE_OF(a)++    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+                    (MutArray mba _ _ _) :: MutArray a <-+                        liftIO $ MA.emptyOf patLen+                    return $ Partial $ SplitOnSeqKR acc 0 mba+            Done b -> return $ Done b++    -- Word pattern related+    elemBits = SIZE_OF(a) * 8++    wordMask :: Word+    wordMask = (1 `shiftL` (elemBits * patLen)) - 1++    elemMask :: Word+    elemMask = (1 `shiftL` elemBits) - 1++    wordPat :: Word+    wordPat = wordMask .&. Array.foldl' addToWord 0 patArr++    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)++    -- For Rabin-Karp search+    k = 2891336453 :: Word32+    coeff = k ^ patLen++    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)++    deltaCksum cksum old new =+        addCksum cksum new - coeff * fromIntegral (fromEnum old)++    -- XXX shall we use a random starting hash or 1 instead of 0?+    -- XXX Need to keep this cached across fold calls in foldMany+    -- XXX We may need refold to inject the cached state instead of+    -- initializing the state every time.+    -- XXX Allocation of ring buffer should also be done once+    patHash = Array.foldl' addCksum 0 patArr++    step (SplitOnSeqEmpty s) x = do+        res <- fstep s x+        case res of+            Partial s1 -> return $ Partial $ SplitOnSeqEmpty s1+            Done b -> return $ Done b+    step (SplitOnSeqSingle s pat) x = do+        if pat /= x+        then do+            res <- fstep s x+            case res of+                Partial s1 -> return $ Partial $ SplitOnSeqSingle s1 pat+                Done b -> return $ Done b+        else Done <$> ffinal s+    step (SplitOnSeqWord s idx wrd) x = do+        let wrd1 = addToWord wrd x+        if idx == maxIndex+        then do+            if wrd1 .&. wordMask == wordPat+            then Done <$> ffinal s+            else return $ Partial $ SplitOnSeqWordLoop s wrd1+        else return $ Partial $ SplitOnSeqWord s (idx + 1) wrd1+    step (SplitOnSeqWordLoop s wrd) x = do+        let wrd1 = addToWord wrd x+            old = (wordMask .&. wrd)+                    `shiftR` (elemBits * (patLen - 1))+        res <- fstep s (toEnum $ fromIntegral old)+        case res of+            Partial s1+                | wrd1 .&. wordMask == wordPat ->+                    Done <$> ffinal s1+                | otherwise ->+                    return $ Partial $ SplitOnSeqWordLoop s1 wrd1+            Done b -> return $ Done b+    step (SplitOnSeqKR s offset mba) x = do+        liftIO $ pokeAt offset mba x+        if offset == maxOffset+        then do+            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 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+                let ringHash = deltaCksum cksum old x+                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 mba 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 consumeArray s end mba offset =+                if offset == end+                then fex s+                else do+                    old <- liftIO $ peekAt offset mba+                    r <- fstep s old+                    case r of+                        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 end mba -> consumeArray s end mba 0+            SplitOnSeqKRLoop s _ mba rh -> consumeRing s rh mba rh++    extract = extractFunc fextract++    final = extractFunc ffinal++------------------------------------------------------------------------------+-- Distributing+------------------------------------------------------------------------------+--+-- | Distribute one copy of the stream to each fold and zip the results.+--+-- @+--                 |-------Fold m a b--------|+-- ---stream m a---|                         |---m (b,c)+--                 |-------Fold m a c--------|+-- @+--+--  Definition:+--+-- >>> tee = Fold.teeWith (,)+--+-- Example:+--+-- >>> t = Fold.tee Fold.sum Fold.length+-- >>> Stream.fold t (Stream.enumerateFromTo 1.0 100.0)+-- (5050.0,100)+--+{-# INLINE tee #-}+tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)+tee = teeWith (,)++-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large+-- number of consumers? For polymorphic case a vector could be helpful. For+-- 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.+--+-- @+--+--                 |-------Fold m a b--------|+-- ---stream m a---|                         |---m [b]+--                 |-------Fold m a b--------|+--                 |                         |+--                            ...+-- @+--+-- >>> Stream.fold (Fold.distribute [Fold.sum, Fold.length]) (Stream.enumerateFromTo 1 5)+-- [15,5]+--+-- >>> distribute = Prelude.foldr (Fold.teeWith (:)) (Fold.fromPure [])+--+-- This is the consumer side dual of the producer side 'sequence' operation.+--+-- Stops when all the folds stop.+--+{-# INLINE distribute #-}+distribute :: Monad m => [Fold m a b] -> Fold m a [b]+distribute = Prelude.foldr (teeWith (:)) (fromPure [])++-- 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+------------------------------------------------------------------------------++{-# INLINE partitionByMUsing #-}+partitionByMUsing :: Monad m =>+       (  (x -> y -> (x, y))+       -> Fold m (Either b c) x+       -> Fold m (Either b c) y+       -> Fold m (Either b c) (x, y)+       )+    -> (a -> m (Either b c))+    -> Fold m b x+    -> Fold m c y+    -> Fold m a (x, y)+partitionByMUsing t f fld1 fld2 =+    let l = lmap (fromLeft undefined) fld1  -- :: Fold m (Either b c) x+        r = lmap (fromRight undefined) fld2 -- :: Fold m (Either b c) y+     in lmapM f (t (,) (filter isLeft l) (filter isRight r))++-- | Partition the input over two folds using an 'Either' partitioning+-- predicate.+--+-- @+--+--                                     |-------Fold b x--------|+-- -----stream m a --> (Either b c)----|                       |----(x,y)+--                                     |-------Fold c y--------|+-- @+--+-- Example, send input to either fold randomly:+--+-- >>> :set -package random+-- >>> import System.Random (randomIO)+-- >>> randomly a = randomIO >>= \x -> return $ if x then Left a else Right a+-- >>> f = Fold.partitionByM randomly Fold.length Fold.length+-- >>> Stream.fold f (Stream.enumerateFromTo 1 100)+-- ...+--+-- Example, send input to the two folds in a proportion of 2:1:+--+-- >>> :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 = Fold.partitionByM g Fold.length Fold.length+--  r <- Stream.fold f (Stream.enumerateFromTo (1 :: Int) 100)+--  print r+-- :}+--+-- >>> main+-- (67,33)+--+--+-- This is the consumer side dual of the producer side 'mergeBy' operation.+--+-- When one fold is done, any input meant for it is ignored until the other+-- fold is also done.+--+-- Stops when both the folds stop.+--+-- /See also: 'partitionByFstM' and 'partitionByMinM'./+--+-- /Pre-release/+{-# INLINE partitionByM #-}+partitionByM :: Monad m+    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionByM = partitionByMUsing teeWith++-- | Similar to 'partitionByM' but terminates when the first fold terminates.+--+{-# INLINE partitionByFstM #-}+partitionByFstM :: Monad m+    => (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionByFstM = partitionByMUsing teeWithFst++-- | Similar to 'partitionByM' but terminates when any fold terminates.+--+{-# INLINE partitionByMinM #-}+partitionByMinM :: Monad m =>+    (a -> m (Either b c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionByMinM = partitionByMUsing teeWithMin++-- Note: we could use (a -> Bool) instead of (a -> Either b c), but the latter+-- makes the signature clearer as to which case belongs to which fold.+-- XXX need to check the performance in both cases.++-- | Same as 'partitionByM' but with a pure partition function.+--+-- Example, count even and odd numbers in a stream:+--+-- >>> :{+--  let f = Fold.partitionBy (\n -> if even n then Left n else Right n)+--                      (fmap (("Even " ++) . show) Fold.length)+--                      (fmap (("Odd "  ++) . show) Fold.length)+--   in Stream.fold f (Stream.enumerateFromTo 1 100)+-- :}+-- ("Even 50","Odd 50")+--+-- /Pre-release/+{-# INLINE partitionBy #-}+partitionBy :: Monad m+    => (a -> Either b c) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+partitionBy f = partitionByM (return . f)++-- | Compose two folds such that the combined fold accepts a stream of 'Either'+-- and routes the 'Left' values to the first fold and 'Right' values to the+-- second fold.+--+-- Definition:+--+-- >>> partition = Fold.partitionBy id+--+{-# INLINE partition #-}+partition :: Monad m+    => Fold m b x -> Fold m c y -> Fold m (Either b c) (x, y)+partition = partitionBy id++{-+-- | Send one item to each fold in a round-robin fashion. This is the consumer+-- side dual of producer side 'mergeN' operation.+--+-- partitionN :: Monad m => [Fold m a b] -> Fold m a [b]+-- partitionN fs = Fold step begin done+-}++------------------------------------------------------------------------------+-- Unzipping+------------------------------------------------------------------------------++{-# INLINE unzipWithMUsing #-}+unzipWithMUsing :: Monad m =>+       (  (x -> y -> (x, y))+       -> Fold m (b, c) x+       -> Fold m (b, c) y+       -> Fold m (b, c) (x, y)+       )+    -> (a -> m (b, c))+    -> Fold m b x+    -> Fold m c y+    -> Fold m a (x, y)+unzipWithMUsing t f fld1 fld2 =+    let f1 = lmap fst fld1  -- :: Fold m (b, c) b+        f2 = lmap snd fld2  -- :: Fold m (b, c) c+     in lmapM f (t (,) f1 f2)++-- | Like 'unzipWith' but with a monadic splitter function.+--+-- Definition:+--+-- >>> unzipWithM k f1 f2 = Fold.lmapM k (Fold.unzip f1 f2)+--+-- /Pre-release/+{-# INLINE unzipWithM #-}+unzipWithM :: Monad m+    => (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+unzipWithM = unzipWithMUsing teeWith++-- | Similar to 'unzipWithM' but terminates when the first fold terminates.+--+{-# INLINE unzipWithFstM #-}+unzipWithFstM :: Monad m =>+    (a -> m (b, c)) -> Fold m b x -> Fold m c y -> Fold m a (x, y)+unzipWithFstM = unzipWithMUsing teeWithFst++-- | Similar to 'unzipWithM' but terminates when any fold terminates.+--+{-# INLINE unzipWithMinM #-}+unzipWithMinM :: Monad m =>+    (a -> m (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+unzipWithMinM = unzipWithMUsing teeWithMin++-- | Split elements in the input stream into two parts using a pure splitter+-- function, direct each part to a different fold and zip the results.+--+-- Definitions:+--+-- >>> unzipWith f = Fold.unzipWithM (return . f)+-- >>> unzipWith f fld1 fld2 = Fold.lmap f (Fold.unzip fld1 fld2)+--+-- This fold terminates when both the input folds terminate.+--+-- /Pre-release/+{-# INLINE unzipWith #-}+unzipWith :: Monad m+    => (a -> (b,c)) -> Fold m b x -> Fold m c y -> Fold m a (x,y)+unzipWith f = unzipWithM (return . f)++-- | Send the elements of tuples in a stream of tuples through two different+-- folds.+--+-- @+--+--                           |-------Fold m a x--------|+-- ---------stream of (a,b)--|                         |----m (x,y)+--                           |-------Fold m b y--------|+--+-- @+--+-- Definition:+--+-- >>> unzip = Fold.unzipWith id+--+-- This is the consumer side dual of the producer side 'zip' operation.+--+{-# INLINE unzip #-}+unzip :: Monad m => Fold m a x -> Fold m b y -> Fold m (a,b) (x,y)+unzip = unzipWith id++------------------------------------------------------------------------------+-- Combining streams and folds - Zipping+------------------------------------------------------------------------------++-- XXX These can be implemented using the fold scan, using the stream as a+-- state.+-- XXX Stream Skip state cannot be efficiently handled in folds but can be+-- handled in parsers using the Continue facility. See zipWithM in the Parser+-- module.+--+-- cmpBy, eqBy, isPrefixOf, isSubsequenceOf etc can be implemented using+-- zipStream.++-- | Zip a stream with the input of a fold using the supplied function.+--+-- /Unimplemented/+--+{-# INLINE zipStreamWithM #-}+zipStreamWithM :: -- Monad m =>+    (a -> b -> m c) -> Stream m a -> Fold m c x -> Fold m b x+zipStreamWithM = undefined++-- | Zip a stream with the input of a fold.+--+-- >>> zip = Fold.zipStreamWithM (curry return)+--+-- /Unimplemented/+--+{-# INLINE zipStream #-}+zipStream :: Monad m => Stream m a -> Fold m (a, b) x -> Fold m b x+zipStream = zipStreamWithM (curry return)++-- | Pair each element of a fold input with its index, starting from index 0.+--+{-# 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++    where++    initial = Nothing'++    step Nothing' a = Just' (i, a)+    step (Just' (n, _)) a = Just' (f n, a)++-- |+-- >> 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)+--+{-# 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.postscanlMaybe Scanl.indexing+--+{-# INLINE indexed #-}+indexed :: Monad m => Fold m (Int, a) b -> Fold m a b+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+-- addiitonal index or time input.+--+-- >>> filterWithIndex = Fold.with Fold.indexed Fold.filter+--+-- @+-- filterWithAbsTime = with timestamped filter+-- filterWithRelTime = with timeIndexed filter+-- @+--+-- /Pre-release/+{-# INLINE with #-}+with ::+       (Fold m (s, a) b -> Fold m a b)+    -> (((s, a) -> c) -> Fold m (s, a) b -> Fold m (s, a) b)+    -> (((s, a) -> c) -> Fold m a b -> Fold m a b)+with f comb g = f . comb g . lmap snd++-- XXX Implement as a filter+-- sampleFromthen :: Monad m => Int -> Int -> Fold m a (Maybe a)++-- | @sampleFromthen offset stride@ samples the element at @offset@ index and+-- then every element at strides of @stride@.+--+{-# INLINE sampleFromthen #-}+sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Fold m a b+sampleFromthen offset size =+    with indexed filter (\(i, _) -> (i + offset) `mod` size == 0)++------------------------------------------------------------------------------+-- Nesting+------------------------------------------------------------------------------++-- | @concatSequence f t@ applies folds from stream @t@ sequentially and+-- collects the results using the fold @f@.+--+-- /Unimplemented/+--+{-# INLINE concatSequence #-}+concatSequence ::+    -- IsStream t =>+    Fold m b c -> t (Fold m a b) -> Fold m a c+concatSequence _f _p = undefined++-- | Group the input stream into groups of elements between @low@ and @high@.+-- Collection starts in chunks of @low@ and then keeps doubling until we reach+-- @high@. Each chunk is folded using the provided fold function.+--+-- This could be useful, for example, when we are folding a stream of unknown+-- size to a stream of arrays and we want to minimize the number of+-- allocations.+--+-- NOTE: this would be an application of "many" using a terminating fold.+--+-- /Unimplemented/+--+{-# INLINE chunksBetween #-}+chunksBetween :: -- Monad m =>+       Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c+chunksBetween _low _high _f1 _f2 = undefined++-- | A fold that buffers its input to a pure stream.+--+-- /Warning!/ working on large streams accumulated as buffers in memory could+-- be very inefficient, consider using "Streamly.Data.Array" instead.+--+-- >>> toStream = fmap Stream.fromList Fold.toList+--+-- /Pre-release/+{-# INLINE toStream #-}+toStream :: (Monad m, Monad n) => Fold m a (Stream n a)+toStream = fromScanl Scanl.toStream++-- This is more efficient than 'toStream'. toStream is exactly the same as+-- reversing the stream after toStreamRev.+--+-- | Buffers the input stream to a pure stream in the reverse order of the+-- input.+--+-- >>> toStreamRev = fmap Stream.fromList Fold.toListRev+--+-- /Warning!/ working on large streams accumulated as buffers in memory could+-- be very inefficient, consider using "Streamly.Data.Array" instead.+--+-- /Pre-release/++--  xn : ... : x2 : x1 : []+{-# INLINE toStreamRev #-}+toStreamRev :: (Monad m, Monad n) => Fold m a (Stream n a)+toStreamRev = 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.+--+-- | Unfold and flatten the input stream of a fold.+--+-- @+-- Stream.fold (unfoldMany u f) = Stream.fold f . Stream.unfoldMany u+-- @+--+-- /Pre-release/+{-# INLINE unfoldMany #-}+unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c+unfoldMany (Unfold ustep inject) (Fold fstep initial extract final) =+    Fold consume initial extract final++    where++    {-# INLINE produce #-}+    produce fs us = do+        ures <- ustep us+        case ures of+            StreamD.Yield b us1 -> do+                fres <- fstep fs b+                case fres of+                    Partial fs1 -> produce fs1 us1+                    -- XXX What to do with the remaining stream?+                    Done c -> return $ Done c+            StreamD.Skip us1 -> produce fs us1+            StreamD.Stop -> return $ Partial fs++    {-# INLINE_LATE consume #-}+    consume s a = inject a >>= produce s++-- | Get the bottom most @n@ elements using the supplied comparison function.+--+{-# INLINE bottomBy #-}+bottomBy :: (MonadIO m, Unbox a) =>+       (a -> a -> Ordering)+    -> Int+    -> Fold m a (MutArray a)+bottomBy cmp = fromScanl . Scanl.bottomBy cmp++-- | Get the top @n@ elements using the supplied comparison function.+--+-- To get bottom n elements instead:+--+-- >>> bottomBy cmp = Fold.topBy (flip cmp)+--+-- Example:+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.fold (Fold.topBy compare 3) stream >>= MutArray.toList+-- [17,11,9]+--+-- /Pre-release/+--+{-# INLINE topBy #-}+topBy :: (MonadIO m, Unbox a) =>+       (a -> a -> Ordering)+    -> Int+    -> Fold m a (MutArray a)+topBy cmp = bottomBy (flip cmp)++-- | Fold the input stream to top n elements.+--+-- Definition:+--+-- >>> top = Fold.topBy compare+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.fold (Fold.top 3) stream >>= MutArray.toList+-- [17,11,9]+--+-- /Pre-release/+{-# INLINE top #-}+top :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)+top = fromScanl . Scanl.top++-- | Fold the input stream to bottom n elements.+--+-- Definition:+--+-- >>> bottom = Fold.bottomBy compare+--+-- >>> stream = Stream.fromList [2::Int,7,9,3,1,5,6,11,17]+-- >>> Stream.fold (Fold.bottom 3) stream >>= MutArray.toList+-- [1,2,3]+--+-- /Pre-release/+{-# INLINE bottom #-}+bottom :: (MonadIO m, Unbox a, Ord a) => Int -> Fold m a (MutArray a)+bottom = fromScanl . Scanl.bottom++------------------------------------------------------------------------------+-- Interspersed parsing+------------------------------------------------------------------------------++data IntersperseQState fs ps =+      IntersperseQUnquoted !fs !ps+    | IntersperseQQuoted !fs !ps+    | IntersperseQQuotedEsc !fs !ps++-- Useful for parsing CSV with quoting and escaping+{-# INLINE intersperseWithQuotes #-}+intersperseWithQuotes :: (Monad m, Eq a) =>+    a -> a -> a -> Fold m a b -> Fold m b c -> Fold m a c+intersperseWithQuotes+    quote+    esc+    separator+    (Fold stepL initialL _ finalL)+    (Fold stepR initialR extractR finalR) = Fold step initial extract final++    where++    errMsg p status =+        error $ "intersperseWithQuotes: " ++ p ++ " parsing fold cannot "+                ++ status ++ " without input"++    {-# INLINE initL #-}+    initL mkState = do+        resL <- initialL+        case resL of+            Partial sL ->+                return $ Partial $ mkState sL+            Done _ ->+                errMsg "content" "succeed"++    initial = do+        res <- initialR+        case res of+            Partial sR -> initL (IntersperseQUnquoted sR)+            Done b -> return $ Done b++    {-# INLINE collect #-}+    collect nextS sR b = do+        res <- stepR sR b+        case res of+            Partial s ->+                initL (nextS s)+            Done c -> return (Done c)++    {-# INLINE process #-}+    process a sL sR nextState = do+        r <- stepL sL a+        case r of+            Partial s -> return $ Partial (nextState sR s)+            Done b -> collect nextState sR b++    {-# INLINE processQuoted #-}+    processQuoted a sL sR nextState = do+        r <- stepL sL a+        case r of+            Partial s -> return $ Partial (nextState sR s)+            Done _ -> do+                _ <- finalR sR+                error "Collecting fold finished inside quote"++    step (IntersperseQUnquoted sR sL) a+        | a == separator = do+            b <- finalL sL+            collect IntersperseQUnquoted sR b+        | a == quote = processQuoted a sL sR IntersperseQQuoted+        | otherwise = process a sL sR IntersperseQUnquoted++    step (IntersperseQQuoted sR sL) a+        | a == esc = processQuoted a sL sR IntersperseQQuotedEsc+        | a == quote = process a sL sR IntersperseQUnquoted+        | otherwise = processQuoted a sL sR IntersperseQQuoted++    step (IntersperseQQuotedEsc sR sL) a =+        processQuoted a sL sR IntersperseQQuoted++    extract (IntersperseQUnquoted sR _) = extractR sR+    extract (IntersperseQQuoted _ _) =+        error "intersperseWithQuotes: finished inside quote"+    extract (IntersperseQQuotedEsc _ _) =+        error "intersperseWithQuotes: finished inside quote, at escape char"++    final (IntersperseQUnquoted sR sL) = finalL sL *> finalR sR+    final (IntersperseQQuoted sR sL) = do+        _ <- finalR sR+        _ <- finalL sL+        error "intersperseWithQuotes: finished inside quote"+    final (IntersperseQQuotedEsc sR sL) = do+        _ <- finalR sR+        _ <- finalL sL+        error "intersperseWithQuotes: finished inside quote, at escape char"
src/Streamly/Internal/Data/Fold/Container.hs view
@@ -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@@ -9,16 +17,13 @@  module Streamly.Internal.Data.Fold.Container     (-    -- * Imports-    -- $setup-     -- * Set operations       toSet     , toIntSet     , countDistinct     , countDistinctInt-    , nub-    , nubInt+    , nub -- XXX deprecate in favor of scan+    , nubInt -- XXX deprecate in favor of scan      -- * Map operations     , frequency@@ -27,18 +32,31 @@     -- | Direct values in the input stream to different folds using an n-ary     -- fold selector. 'demux' is a generalization of 'classify' (and     -- 'partition') where each key of the classifier can use a different fold.+    --+    -- 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+    -- | 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.     , demuxKvToContainer     , demuxKvToMap -    , demuxToContainer-    , demuxToContainerIO-    , demuxToMap-    , demuxToMapIO--    , demuxGeneric-    , demux-    , demuxGenericIO-    , demuxIO+    -- *** Scan of finished fold results+    -- | 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@@ -65,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 @@ -83,24 +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 (length)-import Streamly.Internal.Data.Fold+import Prelude hiding (Foldable(..))+import Streamly.Internal.Data.Fold.Type --- $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. --@@ -110,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'.@@ -121,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 @@ -131,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@@ -173,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@@ -186,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 @@ -209,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 @@ -245,25 +254,33 @@ -- -- 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)     -> (a -> m (Fold m a b))     -> Fold m a (m (f b), Maybe (Key f, b))-demuxGeneric getKey getFold = fmap extract $ foldlM' step initial+demuxGeneric getKey getFold =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where      initial = return $ Tuple' IsMap.mapEmpty Nothing      {-# INLINE runFold #-}-    runFold kv (Fold step1 initial1 extract1) (k, a) = do+    runFold kv (Fold step1 initial1 extract1 final1) (k, a) = do          res <- initial1          case res of             Partial s -> do@@ -271,10 +288,14 @@                 return                     $ case res1 of                         Partial _ ->-                            let fld = Fold step1 (return res1) extract1+                            let fld = Fold step1 (return res1) extract1 final1                              in Tuple' (IsMap.mapInsert k fld kv) Nothing                         Done b -> Tuple' (IsMap.mapDelete k kv) (Just (k, b))-            Done b -> return $ Tuple' kv (Just (k, b))+            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@@ -284,27 +305,177 @@                 runFold kv fld (k, a)             Just f -> runFold kv f (k, a) -    extract (Tuple' kv x) = (Prelude.mapM f kv, x)+    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)          where -        f (Fold _ i e) = do+        f (Fold _ i e _) = do             r <- i             case r of                 Partial s -> e s-                Done b -> return b+                _ -> error "demuxGeneric: unreachable code" --- | In a key value stream, fold values corresponding to each key with a key--- specific fold. The fold returns the fold result as the second component of--- the output tuple whenever a fold terminates. The first component of the--- tuple is a Map of in-progress folds. If a fold terminates, another--- instance of the fold is started upon receiving an input with that key.+    final (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f (Fold _ i _ fin) = do+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxGeneric: unreachable code"++-- 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+-- stream.+--+-- The first component of the output tuple is a key-value Map of in-progress+-- folds. The fold returns the fold result as the second component of the+-- output tuple whenever a fold terminates.+--+-- If a fold terminates, another instance of the fold is started upon receiving+-- an input with that key, @getFold@ is invoked again whenever the key is+-- encountered again.+-- -- This can be used to scan a stream and collect the results from the scan -- output. --+-- Since the fold generator function is monadic we can add folds dynamically.+-- For example, we can maintain a Map of keys to folds in an IORef and lookup+-- the fold from that corresponding to a key. This Map can be changed+-- dynamically, folds for new keys can be added or folds for old keys can be+-- deleted or modified.+--+-- Compare with 'classify', the fold in 'classify' is a static fold.+-- -- /Pre-release/ --+{-# DEPRECATED demux "Use demuxScan instead" #-} {-# INLINE demux #-} demux :: (Monad m, Ord k) =>        (a -> k)@@ -312,40 +483,66 @@     -> 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)     -> (a -> m (Fold m a b))     -> Fold m a (m (f b), Maybe (Key f, b))-demuxGenericIO getKey getFold = fmap extract $ foldlM' step initial+demuxGenericIO getKey getFold =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where      initial = return $ Tuple' IsMap.mapEmpty Nothing      {-# INLINE initFold #-}-    initFold kv (Fold step1 initial1 extract1) (k, a) = do+    initFold kv (Fold step1 initial1 extract1 final1) (k, a) = do          res <- initial1          case res of             Partial s -> do                 res1 <- step1 s a                 case res1 of                     Partial _ -> do-                        let fld = Fold step1 (return res1) extract1+                        -- 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) (k, a) = do+    runFold kv ref (Fold step1 initial1 extract1 final1) (k, a) = do          res <- initial1          case res of             Partial s -> do                 res1 <- step1 s a                 case res1 of                         Partial _ -> do-                            let fld = Fold step1 (return res1) extract1+                            let fld = Fold step1 (return res1) extract1 final1                             liftIO $ writeIORef ref fld                             return $ Tuple' kv Nothing                         Done b ->@@ -363,20 +560,192 @@                 f <- liftIO $ readIORef ref                 runFold kv ref f (k, a) -    extract (Tuple' kv x) = (Prelude.mapM f kv, x)+    extract (Tuple' kv x) = return (Prelude.mapM f kv, x)          where          f ref = do-            (Fold _ i e) <- liftIO $ readIORef ref+            Fold _ i e _ <- liftIO $ readIORef ref             r <- i             case r of                 Partial s -> e s-                Done b -> return b+                _ -> error "demuxGenericIO: unreachable code" +    final (Tuple' kv x) = return (Prelude.mapM f kv, x)++        where++        f ref = do+            Fold _ i _ fin <- liftIO $ readIORef ref+            r <- i+            case r of+                Partial s -> fin s+                _ -> error "demuxGenericIO: unreachable code"++-- | This is 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)@@ -384,6 +753,34 @@     -> 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 #-}+kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)+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)@@ -400,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)@@ -421,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) -- :}@@ -451,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  ------------------------------------------------------------------------------@@ -464,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@@ -471,8 +911,8 @@     -- for that use case. We return an action because we want it to be lazy so     -- that the downstream consumers can choose to process or discard it.     (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))-classifyGeneric f (Fold step1 initial1 extract1) =-    fmap extract $ foldlM' step initial+classifyGeneric f (Fold step1 initial1 extract1 final1) =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where @@ -509,8 +949,124 @@                             let kv1 = IsMap.mapDelete k kv                              in Tuple3' kv1 (Set.insert k set) (Just (k, b)) -    extract (Tuple3' kv _ x) = (Prelude.mapM extract1 kv, x)+    extract (Tuple3' kv _ x) = return (Prelude.mapM extract1 kv, x) +    final (Tuple3' kv set x) = return (IsMap.mapTraverseWithKey f1 kv, x)++        where++        f1 k s = do+            if Set.member k set+            -- 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@@ -520,22 +1076,38 @@ -- -- 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))-classifyGenericIO f (Fold step1 initial1 extract1) =-    fmap extract $ foldlM' step initial+classifyGenericIO f (Fold step1 initial1 extract1 final1) =+    Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final      where @@ -574,29 +1146,169 @@                          in return                                 $ Tuple3' kv1 (Set.insert k set) (Just (k, b)) -    extract (Tuple3' kv _ x) =-        (Prelude.mapM (\ref -> liftIO (readIORef ref) >>= extract1) kv, x)+    extract (Tuple3' kv _ x) = return (Prelude.mapM g kv, x) +        where++        g ref = liftIO (readIORef ref) >>= extract1++    final (Tuple3' kv set x) = return (IsMap.mapTraverseWithKey g kv, x)++        where++        g k ref = do+            s <- liftIO $ readIORef ref+            if Set.member k set+            then extract1 s+            else final1 s++-- 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 --- | Fold a key value stream to a key-value Map. If the same key appears--- multiple times, only the last value is retained.-{-# INLINE kvToMapOverwriteGeneric #-}-kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)-kvToMapOverwriteGeneric =-    foldl' (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty+{-# INLINE 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)@@ -610,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@@ -647,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)@@ -660,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
@@ -8,7 +8,7 @@ -- module Streamly.Internal.Data.Fold.Step     (-    -- * Types+    -- * Step Type       Step (..)      , mapMStep@@ -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.@@ -40,7 +52,7 @@     = Partial !s     | Done !b --- | 'first' maps over 'Partial' and 'second' maps over 'Done'.+-- | 'first' maps over the fold state and 'second' maps over the fold result. -- instance Bifunctor Step where     {-# INLINE bimap #-}
src/Streamly/Internal/Data/Fold/Tee.hs view
@@ -16,7 +16,9 @@     ) where +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)+#endif import Streamly.Internal.Data.Fold.Type (Fold)  import qualified Streamly.Internal.Data.Fold.Type as Fold@@ -77,7 +79,7 @@ -- | '<>' distributes the input to both the argument 'Tee's and combines their -- outputs using the 'Monoid' instance of the output type. ---instance (Semigroup b, Monoid b, Monad m) => Monoid (Tee m a b) where+instance (Monoid b, Monad m) => Monoid (Tee m a b) where     {-# INLINE mempty #-}     mempty = pure mempty
src/Streamly/Internal/Data/Fold/Type.hs view
@@ -126,6 +126,25 @@ -- or to not be able to use `take 0` if we have it. Also, applicative and -- monadic composition of folds would not be possible. --+-- == Cleanup Action+--+-- Fold may use other folds in the downstream pipeline. When a fold is done and+-- it wants to terminate it needs to wait for the downstream folds before it+-- returns. For example, if the downstream fold is an async fold we need to+-- wait for the async fold to finish and return the final result.+--+-- To be able to support this use case we need a cleanup action in the fold.+-- The fold gets finalized once the cleanup is called and we can use extract to+-- get the final state/result of the fold.+--+-- Similar to folds we may have a cleanup action in streams as well. Currently,+-- we rely on GC to cleanup the streams, if we use a cleanup action then we can+-- perform cleanup quickly. Also, similar to folds we can also have an+-- "initial" action in streams as well to generate the initial state. It could+-- decouple the initialization of the stream from the first element being+-- pulled. For example, you may want to start a timer at initialization rather+-- than at the first element pull of the stream.+-- -- == Terminating Folds with backtracking -- -- Consider the example of @takeWhile@ operation, it needs to inspect an@@ -191,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. --@@ -225,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@.: --@@ -238,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@@ -325,18 +344,16 @@ -- module Streamly.Internal.Data.Fold.Type     (-    -- * Imports-    -- $setup+      module Streamly.Internal.Data.Fold.Step -    -- * Types-      Step (..)+    -- * Fold Type     , Fold (..)      -- * Constructors     , foldl'     , foldlM'     , foldl1'-    , foldlM1'+    , foldl1M'     , foldt'     , foldtM'     , foldr'@@ -345,11 +362,18 @@     -- * Folds     , fromPure     , fromEffect+    -- XXX Do refold ops belong to Scanl or Fold?     , fromRefold+    , fromScanl     , drain     , toList+    , toListRev+    -- $toListRev     , toStreamK     , toStreamKRev+    , genericLength+    , length+    , latest      -- * Combinators @@ -359,7 +383,14 @@     -- ** Mapping Input     , lmap     , lmapM++    -- ** Scanning input     , postscan+    , scanl+    , scanlMany+    , postscanl+    , postscanlMaybe+    -- , runScan      -- ** Filtering     , catMaybes@@ -374,8 +405,13 @@     -- ** Trimming     , take     , taking+    , takeEndBy_+    , takeEndBy     , dropping +    -- ** Condition+    , ifThen+     -- ** Sequential application     , splitWith -- rename to "append"     , split_@@ -403,13 +439,13 @@     , longest      -- * Running A Fold-    , extractM     , reduce     , snoc     , addOne     , snocM     , snocl     , snoclM+    , finalM     , close     , isClosed @@ -420,26 +456,38 @@     -- * Deprecated     , foldr     , serialWith+    , foldlM1'+    , extractM+    , scan+    , scanMany+    , last     ) where  #include "inline.hs" +#if !MIN_VERSION_base(4,18,0) import Control.Applicative (liftA2)-import Control.Monad ((>=>))+#endif+import Control.Monad ((>=>), void) import Data.Bifunctor (Bifunctor(..)) import Data.Either (fromLeft, fromRight, isLeft, isRight) import Data.Functor.Identity (Identity(..)) import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep, chainStepM)-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.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.StreamK.Type as K+-- 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 (concatMap, filter, foldr, 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+ #include "DocTestDataFold.hs"  ------------------------------------------------------------------------------@@ -450,24 +498,89 @@ -- The type @b@ is the accumulator of the writer. That's the reason the -- default folds in various modules are called "write". --- | The type @Fold m a b@ having constructor @Fold step initial extract@--- represents a fold over an input stream of values of type @a@ to a final--- value of type @b@ in 'Monad' @m@.+-- An alternative to using an "extract" function is to use "Partial s b" style+-- partial value so that we always emit the output value and there is no need+-- to extract. Then extract can be used for cleanup purposes. But in this case+-- in some cases we may need a "Continue" constructor where an output value is+-- not available, this was implicit earlier. Also, "b" should be lazy here so+-- that we do not always compute it even if we do not need it. ----- The fold uses an intermediate state @s@ as accumulator, the type @s@ is--- internal to the specific fold definition. The initial value of the fold--- state @s@ is returned by @initial@. The @step@ function consumes an input--- and either returns the final result @b@ if the fold is done or the next--- intermediate state (see 'Step'). At any point the fold driver can extract--- the result from the intermediate state using the @extract@ function.+-- Partial s b  --> extract :: s -> b+-- Continue     --> extract :: s -> Maybe b --+-- But keeping 'b' lazy does not let the fold optimize well. It leads to+-- significant regressions in the key-value folds.+--+-- The "final" function complicates combinators that take other folds as+-- argument because we need to call their finalizers at right places. An+-- alternative to reduce this complexity where it is not required is to use a+-- separate type for bracketed folds but then we need to manage the complexity+-- of two different fold types.++-- The "final" function could be (s -> m (Step s b)), like in parsers so that+-- it can be called in a loop to drain the fold.++-- | The type @Fold m a b@ represents a consumer of an input stream of values+-- of type @a@ and returning a final value of type @b@ in 'Monad' @m@. The+-- constructor of a fold is @Fold step initial extract final@.+--+-- The fold uses an internal state of type @s@. The initial value of the state+-- @s@ is created by @initial@. This function is called once and only once+-- before the fold starts consuming input. Any resource allocation can be done+-- in this function.+--+-- The @step@ function is called on each input, it consumes an input and+-- returns the next intermediate state (see 'Step') or the final result @b@ if+-- the fold terminates.+--+-- 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@.+--+-- When implementing fold combinators, care should be taken to cleanup any+-- state of the argument folds held by the fold by calling the respective+-- @final@ at all exit points of the fold. Also, @final@ should not be called+-- more than once. Note that if a fold terminates by 'Done' constructor, there+-- is no state to cleanup.+-- -- NOTE: The constructor is not yet released, smart constructors are provided -- to create folds. -- data Fold m a b =-  -- | @Fold @ @ step @ @ initial @ @ extract@-  forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b)+  -- 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 ------------------------------------------------------------------------------@@ -476,7 +589,8 @@ -- {-# INLINE rmapM #-} rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c-rmapM f (Fold step initial extract) = Fold step1 initial1 (extract >=> f)+rmapM f (Fold step initial extract final) =+    Fold step1 initial1 (extract >=> f) (final >=> f)      where @@ -487,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. --@@ -502,11 +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+foldl' step = fromScanl . Scanl.mkScanl step  -- | Make a fold from a left fold style monadic step function and initial value -- of the accumulator.@@ -520,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+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.@@ -529,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 ------------------------------------------------------------------------------@@ -569,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 #-}@@ -590,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@@ -618,8 +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)+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.@@ -632,21 +784,21 @@ -- {-# INLINE foldtM' #-} foldtM' :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b-foldtM' = Fold+foldtM' step initial extract = Fold step initial extract extract  ------------------------------------------------------------------------------ -- Refold ------------------------------------------------------------------------------  -- 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. -- -- /Internal/ fromRefold :: Refold m c a b -> c -> Fold m a b fromRefold (Refold step inject extract) c =-    Fold step (inject c) extract+    Fold step (inject c) extract extract  ------------------------------------------------------------------------------ -- Basic Folds@@ -660,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@@ -672,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. --@@ -687,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. --@@ -697,8 +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:+--+-- >>> genericLength = fmap getSum $ Fold.foldMap (Sum . const  1)+-- >>> genericLength = Fold.foldl' (\n _ -> n + 1) 0+--+-- /Pre-release/+{-# 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.genericLength+-- >>> length = fmap getSum $ Fold.foldMap (Sum . const  1)+--+{-# INLINE length #-}+length :: Monad m => Fold m a Int+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 ------------------------------------------------------------------------------@@ -706,7 +918,8 @@ -- | Maps a function on the output of the fold (the type @b@). instance Functor m => Functor (Fold m a) where     {-# INLINE fmap #-}-    fmap f (Fold step1 initial1 extract) = Fold step initial (fmap2 f extract)+    fmap f (Fold step1 initial1 extract final) =+        Fold step initial (fmap2 f extract) (fmap2 f final)          where @@ -741,7 +954,7 @@ -- {-# INLINE fromPure #-} fromPure :: Applicative m => b -> Fold m a b-fromPure b = Fold undefined (pure $ Done b) pure+fromPure b = Fold undefined (pure $ Done b) pure pure  -- | Make a fold that yields the result of the supplied effectful action -- without consuming any further input.@@ -750,7 +963,7 @@ -- {-# INLINE fromEffect #-} fromEffect :: Applicative m => m b -> Fold m a b-fromEffect b = Fold undefined (Done <$> b) pure+fromEffect b = Fold undefined (Done <$> b) pure pure  {-# ANN type SeqFoldState Fuse #-} data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr@@ -775,16 +988,20 @@ -- complexity, because each composition adds a new branch that each subsequent -- fold's input element has to traverse, therefore, it cannot scale to a large -- number of compositions. After around 100 compositions the performance starts--- dipping rapidly compared to a CPS style implementation. When you need--- scaling use parser monad instead.+-- dipping rapidly compared to a CPS style implementation. --+-- For larger number of compositions you can convert the fold to a parser and+-- use ParserK.+-- -- /Time: O(n^2) where n is the number of compositions./ -- {-# INLINE splitWith #-} splitWith :: Monad m =>     (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-splitWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+splitWith func+    (Fold stepL initialL _ finalL)+    (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -801,13 +1018,18 @@     step (SeqFoldL st) a = runL (stepL st a)     step (SeqFoldR f st) a = runR (stepR st a) f -    extract (SeqFoldR f sR) = fmap f (extractR sR)-    extract (SeqFoldL sL) = do-        rL <- extractL sL+    -- XXX splitWith should not be used for scanning+    -- It would rarely make sense and resource tracking and cleanup would be+    -- expensive. especially when multiple splitWith are chained.+    extract _ = error "splitWith: cannot be used for scanning"++    final (SeqFoldR f sR) = fmap f (finalR sR)+    final (SeqFoldL sL) = do+        rL <- finalL sL         res <- initialR         fmap (func rL)             $ case res of-                Partial sR -> extractR sR+                Partial sR -> finalR sR                 Done rR -> return rR  {-# DEPRECATED serialWith "Please use \"splitWith\" instead" #-}@@ -827,8 +1049,8 @@ -- {-# INLINE split_ #-} split_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b-split_ (Fold stepL initialL _) (Fold stepR initialR extractR) =-    Fold step initial extract+split_ (Fold stepL initialL _ finalL) (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -851,11 +1073,16 @@         resR <- stepR st a         return $ first SeqFoldR_ resR -    extract (SeqFoldR_ sR) = extractR sR-    extract (SeqFoldL_ _) = do+    -- XXX split_ should not be used for scanning+    -- See splitWith for more details.+    extract _ = error "split_: cannot be used for scanning"++    final (SeqFoldR_ sR) = finalR sR+    final (SeqFoldL_ sL) = do+        _ <- finalL sL         res <- initialR         case res of-            Partial sR -> extractR sR+            Partial sR -> finalR sR             Done rR -> return rR  -- | 'Applicative' form of 'splitWith'. Split the input serially over two@@ -903,8 +1130,10 @@ -- {-# INLINE teeWith #-} teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c-teeWith f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+teeWith f+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -931,6 +1160,10 @@     extract (TeeLeft bR sL) = (`f` bR) <$> extractL sL     extract (TeeRight bL sR) = f bL <$> extractR sR +    final (TeeBoth sL sR) = f <$> finalL sL <*> finalR sR+    final (TeeLeft bR sL) = (`f` bR) <$> finalL sL+    final (TeeRight bL sR) = f bL <$> finalR sR+ {-# ANN type TeeFstState Fuse #-} data TeeFstState sL sR b     = TeeFstBoth !sL !sR@@ -943,8 +1176,10 @@ {-# INLINE teeWithFst #-} teeWithFst :: Monad m =>     (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d-teeWithFst f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+teeWithFst f+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -963,7 +1198,7 @@             Done bl -> do                 Done . f bl <$>                     case resR of-                        Partial sr -> extractR sr+                        Partial sr -> finalR sr                         Done br -> return br      initial = runBoth initialL initialR@@ -974,6 +1209,9 @@     extract (TeeFstBoth sL sR) = f <$> extractL sL <*> extractR sR     extract (TeeFstLeft bR sL) = (`f` bR) <$> extractL sL +    final (TeeFstBoth sL sR) = f <$> finalL sL <*> finalR sR+    final (TeeFstLeft bR sL) = (`f` bR) <$> finalL sL+ -- | Like 'teeWith' but terminates as soon as any one of the two folds -- terminates. --@@ -982,8 +1220,10 @@ {-# INLINE teeWithMin #-} teeWithMin :: Monad m =>     (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d-teeWithMin f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+teeWithMin f+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -995,12 +1235,12 @@             Partial sl -> do                 case resR of                     Partial sr -> return $ Partial $ Tuple' sl sr-                    Done br -> Done . (`f` br) <$> extractL sl+                    Done br -> Done . (`f` br) <$> finalL sl              Done bl -> do                 Done . f bl <$>                     case resR of-                        Partial sr -> extractR sr+                        Partial sr -> finalR sr                         Done br -> return br      initial = runBoth initialL initialR@@ -1009,6 +1249,8 @@      extract (Tuple' sL sR) = f <$> extractL sL <*> extractR sR +    final (Tuple' sL sR) = f <$> finalL sL <*> finalR sR+ -- | Shortest alternative. Apply both folds in parallel but choose the result -- from the one which consumed least input i.e. take the shortest succeeding -- fold.@@ -1020,8 +1262,8 @@ -- {-# INLINE shortest #-} shortest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)-shortest (Fold stepL initialL extractL) (Fold stepR initialR _) =-    Fold step initial extract+shortest (Fold stepL initialL extractL finalL) (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -1029,10 +1271,16 @@     runBoth actionL actionR = do         resL <- actionL         resR <- actionR-        return $-            case resL of-                Partial sL -> bimap (Tuple' sL) Right resR-                Done bL -> Done $ Left bL+        case resL of+            Partial sL ->+                case resR of+                    Partial sR -> return $ Partial $ Tuple' sL sR+                    Done bR -> finalL sL >> return (Done (Right bR))+            Done bL -> do+                case resR of+                    Partial sR -> void (finalR sR)+                    Done _ -> return ()+                return (Done (Left bL))      initial = runBoth initialL initialR @@ -1040,6 +1288,8 @@      extract (Tuple' sL _) = Left <$> extractL sL +    final (Tuple' sL sR) = Left <$> finalL sL <* finalR sR+ {-# ANN type LongestState Fuse #-} data LongestState sL sR     = LongestBoth !sL !sR@@ -1057,8 +1307,10 @@ -- {-# INLINE longest #-} longest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)-longest (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+longest+    (Fold stepL initialL _ finalL)+    (Fold stepR initialR _ finalR) =+    Fold step initial extract final      where @@ -1081,17 +1333,23 @@     step (LongestLeft sL) a = bimap LongestLeft Left <$> stepL sL a     step (LongestRight sR) a = bimap LongestRight Right <$> stepR sR a -    left sL = Left <$> extractL sL-    extract (LongestLeft sL) = left sL-    extract (LongestRight sR) = Right <$> extractR sR-    extract (LongestBoth sL _) = left sL+    -- XXX Scan with this may not make sense as we cannot determine the longest+    -- until one of them have exhausted.+    extract _ = error $ "longest: scan is not allowed as longest cannot be "+        ++ "determined until one fold has exhausted." -data ConcatMapState m sa a c-    = B !sa-    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c)+    final (LongestLeft sL) = Left <$> finalL sL+    final (LongestRight sR) = Right <$> finalR sR+    final (LongestBoth sL sR) = Left <$> finalL sL <* finalR sR +data ConcatMapState m sa a b c+    = B !sa (sa -> m b)+    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c) (s -> m c)+ -- | Map a 'Fold' returning function on the result of a 'Fold' and run the--- returned fold. This operation can be used to express data dependencies+-- 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@@ -1111,43 +1369,47 @@ -- {-# INLINE concatMap #-} concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c-concatMap f (Fold stepa initiala extracta) = Fold stepc initialc extractc+concatMap f (Fold stepa initiala _ finala) =+    Fold stepc initialc extractc finalc   where     initialc = do         r <- initiala         case r of-            Partial s -> return $ Partial (B s)+            Partial s -> return $ Partial (B s finala)             Done b -> initInnerFold (f b) -    stepc (B s) a = do+    stepc (B s fin) a = do         r <- stepa s a         case r of-            Partial s1 -> return $ Partial (B s1)+            Partial s1 -> return $ Partial (B s1 fin)             Done b -> initInnerFold (f b) -    stepc (C stepInner s extractInner) a = do+    stepc (C stepInner s extractInner fin) a = do         r <- stepInner s a         return $ case r of-            Partial sc -> Partial (C stepInner sc extractInner)+            Partial sc -> Partial (C stepInner sc extractInner fin)             Done c -> Done c -    extractc (B s) = do-        r <- extracta s-        initExtract (f r)-    extractc (C _ sInner extractInner) = extractInner sInner+    -- XXX Cannot use for scanning+    extractc _ = error "concatMap: cannot be used for scanning" -    initInnerFold (Fold step i e) = do+    initInnerFold (Fold step i e fin) = do         r <- i         return $ case r of-            Partial s -> Partial (C step s e)+            Partial s -> Partial (C step s e fin)             Done c -> Done c -    initExtract (Fold _ i e) = do+    initFinalize (Fold _ i _ fin) = do         r <- i         case r of-            Partial s -> e s+            Partial s -> fin s             Done c -> return c +    finalc (B s fin) = do+        r <- fin s+        initFinalize (f r)+    finalc (C _ sInner _ fin) = fin sInner+ ------------------------------------------------------------------------------ -- Mapping on input ------------------------------------------------------------------------------@@ -1166,7 +1428,7 @@ -- {-# INLINE lmap #-} lmap :: (a -> b) -> Fold m b r -> Fold m a r-lmap f (Fold step begin done) = Fold step' begin done+lmap f (Fold step begin done final) = Fold step' begin done final     where     step' x a = step x (f a) @@ -1174,20 +1436,27 @@ -- {-# INLINE lmapM #-} lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r-lmapM f (Fold step begin done) = Fold step' begin done+lmapM f (Fold step begin done final) = Fold step' begin done final     where     step' x a = f a >>= step x +------------------------------------------------------------------------------+-- 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 (Fold stepL initialL extractL) (Fold stepR initialR extractR) =-    Fold step initial extract+postscan+    (Fold stepL initialL extractL finalL)+    (Fold stepR initialR extractR finalR) =+    Fold step initial extract final      where @@ -1198,30 +1467,255 @@             Done bL -> do                 rR <- stepR sR bL                 case rR of-                    Partial sR1 -> Done <$> extractR sR1+                    Partial sR1 -> Done <$> finalR sR1                     Done bR -> return $ Done bR             Partial sL -> do                 !b <- extractL sL                 rR <- stepR sR b-                return-                    $ case rR of-                        Partial sR1 -> Partial (sL, sR1)-                        Done bR -> Done bR+                case rR of+                    Partial sR1 -> return $ Partial (sL, sR1)+                    Done bR -> finalL sL >> return (Done bR)      initial = do+        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++{-+{-# 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-        rL <- initialL         case r of-            Partial sR ->+            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 <$> extractR sR+                    Done _ -> Done <$> finalR sR                     Partial sL -> return $ Partial (sL, sR)             Done b -> return $ Done b +    -- XXX should use Tuple'     step (sL, sR) x = runStep (stepL sL x) sR +    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 ------------------------------------------------------------------------------@@ -1234,7 +1728,7 @@ -- {-# INLINE_NORMAL catMaybes #-} catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b-catMaybes (Fold step initial extract) = Fold step1 initial extract+catMaybes (Fold step initial extract final) = Fold step1 initial extract final      where @@ -1245,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)@@ -1267,14 +1762,13 @@ -- >>> 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) -- {-# INLINE filter #-} filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r -- filter p = scanMaybe (filtering p)-filter f (Fold step begin done) = Fold step' begin done+filter f (Fold step begin extract final) = Fold step' begin extract final     where     step' x a = if f a then step x a else return $ Partial x @@ -1285,7 +1779,7 @@ -- {-# INLINE filterM #-} filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r-filterM f (Fold step begin done) = Fold step' begin done+filterM f (Fold step begin extract final) = Fold step' begin extract final     where     step' x a = do       use <- f a@@ -1334,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.@@ -1374,7 +1843,7 @@ {-# INLINE take #-} take :: Monad m => Int -> Fold m a b -> Fold m a b -- take n = scanMaybe (taking n)-take n (Fold fstep finitial fextract) = Fold step initial extract+take n (Fold fstep finitial fextract ffinal) = Fold step initial extract final      where @@ -1386,7 +1855,7 @@                     s1 = Tuple'Fused i1 s                 if i1 < n                 then return $ Partial s1-                else Done <$> fextract s+                else Done <$> ffinal s             Done b -> return $ Done b      initial = finitial >>= next (-1)@@ -1395,6 +1864,100 @@      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 Fold.many instead once it is fixed.+-- > Stream.splitOnSuffix p f = Stream.foldMany (Fold.takeEndBy_ p f)++-- | Like 'takeEndBy' but drops the element on which the predicate succeeds.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Fold.takeEndBy_ (== '\n') Fold.toList+-- >>> Stream.fold line input+-- "hello"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany line input+-- ["hello","there"]+--+{-# INLINE takeEndBy_ #-}+takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)+takeEndBy_ predicate (Fold fstep finitial fextract ffinal) =+    Fold step finitial fextract ffinal++    where++    step s a =+        if not (predicate a)+        then fstep s a+        else Done <$> ffinal s++-- Note:+-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)++-- | Take the input, stop when the predicate succeeds taking the succeeding+-- element as well.+--+-- Example:+--+-- >>> input = Stream.fromList "hello\nthere\n"+-- >>> line = Fold.takeEndBy (== '\n') Fold.toList+-- >>> Stream.fold line input+-- "hello\n"+--+-- >>> Stream.fold Fold.toList $ Stream.foldMany line input+-- ["hello\n","there\n"]+--+{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b+-- takeEndBy predicate = scanMaybe (takingEndBy predicate)+takeEndBy predicate (Fold fstep finitial fextract ffinal) =+    Fold step finitial fextract ffinal++    where++    step s a = do+        res <- fstep s a+        if not (predicate a)+        then return res+        else do+            case res of+                Partial s1 -> Done <$> ffinal s1+                Done b -> return $ Done b++-- 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 ------------------------------------------------------------------------------@@ -1412,8 +1975,8 @@ -- /Pre-release/ {-# INLINE duplicate #-} duplicate :: Monad m => Fold m a b -> Fold m a (Fold m a b)-duplicate (Fold step1 initial1 extract1) =-    Fold step initial (\s -> pure $ Fold step1 (pure $ Partial s) extract1)+duplicate (Fold step1 initial1 extract1 final1) =+    Fold step initial extract final      where @@ -1421,6 +1984,11 @@      step s a = second fromPure <$> step1 s a +    -- Scanning may be problematic due to multiple finalizations.+    extract = error "duplicate: scanning may be problematic"++    final s = pure $ Fold step1 (pure $ Partial s) extract1 final1+ -- If there were a finalize/flushing action in the stream type that would be -- equivalent to running initialize in Fold. But we do not have a flushing -- action in streams.@@ -1432,9 +2000,9 @@ -- /Pre-release/ {-# INLINE reduce #-} reduce :: Monad m => Fold m a b -> m (Fold m a b)-reduce (Fold step initial extract) = do+reduce (Fold step initial extract final) = do     i <- initial-    return $ Fold step (return i) extract+    return $ Fold step (return i) extract final  -- This is the dual of Stream @cons@. @@ -1444,7 +2012,8 @@ -- /Pre-release/ {-# INLINE snoclM #-} snoclM :: Monad m => Fold m a b -> m a -> Fold m a b-snoclM (Fold fstep finitial fextract) action = Fold fstep initial fextract+snoclM (Fold fstep finitial fextract ffinal) action =+    Fold fstep initial fextract ffinal      where @@ -1464,14 +2033,15 @@ -- 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/ {-# INLINE snocl #-} snocl :: Monad m => Fold m a b -> a -> Fold m a b -- snocl f = snoclM f . return-snocl (Fold fstep finitial fextract) a = Fold fstep initial fextract+snocl (Fold fstep finitial fextract ffinal) a =+    Fold fstep initial fextract ffinal      where @@ -1491,12 +2061,12 @@ -- /Pre-release/ {-# INLINE snocM #-} snocM :: Monad m => Fold m a b -> m a -> m (Fold m a b)-snocM (Fold step initial extract) action = do+snocM (Fold step initial extract final) action = do     res <- initial     r <- case res of           Partial fs -> action >>= step fs           Done _ -> return res-    return $ Fold step (return r) extract+    return $ Fold step (return r) extract final  -- Definitions: --@@ -1515,12 +2085,12 @@ -- /Pre-release/ {-# INLINE snoc #-} snoc :: Monad m => Fold m a b -> a -> m (Fold m a b)-snoc (Fold step initial extract) a = do+snoc (Fold step initial extract final) a = do     res <- initial     r <- case res of           Partial fs -> step fs a           Done _ -> return res-    return $ Fold step (return r) extract+    return $ Fold step (return r) extract final  -- | Append a singleton value to the fold. --@@ -1540,31 +2110,48 @@ -- -- >>> extractM = Fold.drive Stream.nil --+-- /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.extractM Fold.toList+-- >>> Fold.finalM Fold.toList -- [] -- -- /Pre-release/-{-# INLINE extractM #-}-extractM :: Monad m => Fold m a b -> m b-extractM (Fold _ initial extract) = do+{-# INLINE finalM #-}+finalM :: Monad m => Fold m a b -> m b+finalM (Fold _ initial _ final) = do     res <- initial     case res of-          Partial fs -> extract fs+          Partial fs -> final fs           Done b -> return b  -- | Close a fold so that it does not accept any more input. {-# INLINE close #-} close :: Monad m => Fold m a b -> Fold m a b-close (Fold _ initial1 extract1) = Fold undefined initial undefined+close (Fold _ initial1 _ final1) =+    Fold undefined initial undefined undefined      where      initial = do         res <- initial1         case res of-              Partial s -> Done <$> extract1 s+              Partial s -> Done <$> final1 s               Done b -> return $ Done b  -- Corresponds to the null check for streams.@@ -1574,7 +2161,7 @@ -- /Pre-release/ {-# INLINE isClosed #-} isClosed :: Monad m => Fold m a b -> m Bool-isClosed (Fold _ initial _) = do+isClosed (Fold _ initial _ _) = do     res <- initial     return $ case res of           Partial _ -> False@@ -1608,8 +2195,10 @@ -- {-# INLINE many #-} many :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-many (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =-    Fold step initial extract+many+    (Fold sstep sinitial sextract sfinal)+    (Fold cstep cinitial cextract cfinal) =+    Fold step initial extract final      where @@ -1658,6 +2247,13 @@             Partial s -> cextract s             Done b -> return b +    final (ManyFirst ss cs) = sfinal ss *> cfinal cs+    final (ManyLoop ss cs) = do+        cres <- sfinal ss >>= cstep cs+        case cres of+            Partial s -> cfinal s+            Done b -> return b+ -- | Like many, but the "first" fold emits an output at the end even if no -- input is received. --@@ -1667,8 +2263,10 @@ -- {-# INLINE manyPost #-} manyPost :: Monad m => Fold m a b -> Fold m b c -> Fold m a c-manyPost (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =-    Fold step initial extract+manyPost+    (Fold sstep sinitial sextract sfinal)+    (Fold cstep cinitial cextract cfinal) =+    Fold step initial extract final      where @@ -1704,6 +2302,12 @@             Partial s -> cextract s             Done b -> return b +    final (Tuple' ss cs) = do+        cres <- sfinal ss >>= cstep cs+        case cres of+            Partial s -> cfinal s+            Done b -> return b+ -- | @groupsOf n split collect@ repeatedly applies the @split@ fold to chunks -- of @n@ items in the input stream and supplies the result to the @collect@ -- fold.@@ -1732,7 +2336,10 @@ -- {-# INLINE refoldMany #-} refoldMany :: Monad m => Fold m a b -> Refold m x b c -> Refold m x a c-refoldMany (Fold sstep sinitial sextract) (Refold cstep cinject cextract) =+refoldMany+    (Fold sstep sinitial sextract _sfinal)+    -- XXX We will need a "final" in refold as well+    (Refold cstep cinject cextract) =     Refold step inject extract      where@@ -1783,7 +2390,9 @@ -- /Internal/ {-# INLINE refoldMany1 #-} refoldMany1 :: Monad m => Refold m x a b -> Fold m b c -> Refold m x a c-refoldMany1 (Refold sstep sinject sextract) (Fold cstep cinitial cextract) =+refoldMany1+    (Refold sstep sinject sextract)+    (Fold cstep cinitial cextract _cfinal) =     Refold step inject extract      where@@ -1834,7 +2443,7 @@ {-# INLINE refold #-} refold :: Monad m => Refold m b a c -> Fold m a b -> Fold m a c refold (Refold step inject extract) f =-    Fold step (extractM f >>= inject) extract+    Fold step (extractM f >>= inject) extract extract  ------------------------------------------------------------------------------ -- morphInner@@ -1844,8 +2453,8 @@ -- -- /Pre-release/ morphInner :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b-morphInner f (Fold step initial extract) =-    Fold (\x a -> f $ step x a) (f initial) (f . extract)+morphInner f (Fold step initial extract final) =+    Fold (\x a -> f $ step x a) (f initial) (f . extract) (f . final)  -- | Adapt a pure fold to any monad. --
src/Streamly/Internal/Data/Fold/Window.hs view
@@ -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@@ -36,47 +40,46 @@     -- window folds by keeping the second element of the input tuple as     -- @Nothing@.     ---      lmap+      windowLmap     , cumulative -    , rollingMap-    , rollingMapM+    , windowRollingMap+    , windowRollingMapM      -- ** Sums-    , length-    , sum-    , sumInt-    , powerSum-    , powerSumFrac+    , windowLength+    , windowSum+    , windowSumInt+    , windowPowerSum+    , windowPowerSumFrac      -- ** Location-    , minimum-    , maximum-    , range-    , mean+    , windowMinimum+    , windowMaximum+    , windowRange+    , windowMean     ) where  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 qualified Streamly.Internal.Data.Fold.Type as Fold-import qualified Streamly.Internal.Data.Ring.Unboxed 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 FoldW--- >>> import qualified Streamly.Internal.Data.Ring.Unboxed as Ring--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import Prelude hiding (length, sum, minimum, maximum)+#include "ArrayMacros.h"+#include "DocTestDataFold.hs"  ------------------------------------------------------------------------------- -- Utilities@@ -85,11 +88,12 @@ -- | 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 lmap #-}-lmap :: (c -> a) -> Fold m (a, Maybe a) b -> Fold m (c, Maybe c) b-lmap f = Fold.lmap (bimap f (f <$>))+{-# INLINE windowLmap #-}+windowLmap :: (c -> a) -> Fold m (a, Maybe a) b -> Fold m (c, Maybe c) b+windowLmap f = Fold.lmap (bimap f (f <$>))  -- | Convert an incremental fold to a cumulative fold using the entire input -- stream as a single window.@@ -105,10 +109,10 @@  -- | Apply an effectful function on the latest and the oldest element of the -- window.-{-# INLINE rollingMapM #-}-rollingMapM :: Monad m =>+{-# INLINE windowRollingMapM #-}+windowRollingMapM :: Monad m =>     (Maybe a -> a -> m (Maybe b)) -> Fold m (a, Maybe a) (Maybe b)-rollingMapM f = Fold.foldlM' f1 initial+windowRollingMapM f = Fold.foldlM' f1 initial      where @@ -118,12 +122,12 @@  -- | Apply a pure function on the latest and the oldest element of the window. ----- >>> rollingMap f = FoldW.rollingMapM (\x y -> return $ f x y)+-- >>> windowRollingMap f = Fold.windowRollingMapM (\x y -> return $ f x y) ---{-# INLINE rollingMap #-}-rollingMap :: Monad m =>+{-# INLINE windowRollingMap #-}+windowRollingMap :: Monad m =>     (Maybe a -> a -> Maybe b) -> Fold m (a, Maybe a) (Maybe b)-rollingMap f = Fold.foldl' f1 initial+windowRollingMap f = Fold.foldl' f1 initial      where @@ -136,7 +140,7 @@ -------------------------------------------------------------------------------  -- XXX Overflow.---+ -- | The sum of all the elements in a rolling window. The input elements are -- required to be intergal numbers. --@@ -146,9 +150,9 @@ -- -- /Internal/ ---{-# INLINE sumInt #-}-sumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a-sumInt = Fold step initial extract+{-# INLINE windowSumInt #-}+windowSumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a+windowSumInt = Fold step initial extract extract      where @@ -164,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.@@ -180,9 +184,9 @@ -- -- /Time/: \(\mathcal{O}(n)\) ---{-# INLINE sum #-}-sum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a-sum = Fold step initial extract+{-# INLINE windowSum #-}+windowSum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a+windowSum = Fold step initial extract extract      where @@ -217,11 +221,11 @@ -- -- This is the \(0\)th power sum. ----- >>> length = powerSum 0+-- >>> length = Fold.windowPowerSum 0 ---{-# INLINE length #-}-length :: (Monad m, Num b) => Fold m (a, Maybe a) b-length = Fold.foldl' step 0+{-# INLINE windowLength #-}+windowLength :: (Monad m, Num b) => Fold m (a, Maybe a) b+windowLength = Fold.foldl' step 0      where @@ -232,29 +236,40 @@ -- -- \(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)\) -- -- /Time/: \(\mathcal{O}(n)\)-{-# INLINE powerSum #-}-powerSum :: (Monad m, Num a) => Int -> Fold m (a, Maybe a) a-powerSum k = lmap (^ k) sum+{-# INLINE windowPowerSum #-}+windowPowerSum :: (Monad m, Num a) => Int -> Fold m (a, Maybe a) a+windowPowerSum k = windowLmap (^ k) windowSum  -- | Like 'powerSum' but powers can be negative or fractional. This is slower -- than 'powerSum' for positive intergal powers. ----- >>> powerSumFrac p = lmap (** p) sum+-- >>> windowPowerSumFrac p = Fold.windowLmap (** p) Fold.windowSum ---{-# INLINE powerSumFrac #-}-powerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a-powerSumFrac p = lmap (** p) sum+{-# INLINE windowPowerSumFrac #-}+windowPowerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a+windowPowerSumFrac p = windowLmap (** p) windowSum  ------------------------------------------------------------------------------- -- Location ------------------------------------------------------------------------------- --- 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. --@@ -265,44 +280,40 @@ -- -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. ---{-# INLINE range #-}-range :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))-range n = Fold step initial extract+{-# INLINE windowRange #-}+windowRange :: 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-            x <- liftIO $ peek rh-            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. --@@ -316,9 +327,11 @@ -- -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. ---{-# INLINE minimum #-}-minimum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)-minimum n = fmap (fmap fst) $ range n+{-# INLINE windowMinimum #-}+windowMinimum :: (MonadIO m, 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. --@@ -329,9 +342,11 @@ -- -- /Time/: \(\mathcal{O}(n*w)\) where \(w\) is the window size. ---{-# INLINE maximum #-}-maximum :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe a)-maximum n = fmap (fmap snd) $ range n+{-# INLINE windowMaximum #-}+windowMaximum :: (MonadIO m, 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: --@@ -341,11 +356,11 @@ -- 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)\) -- -- /Time/: \(\mathcal{O}(n)\)-{-# INLINE mean #-}-mean :: forall m a. (Monad m, Fractional a) => Fold m (a, Maybe a) a-mean = Fold.teeWith (/) sum length+{-# INLINE windowMean #-}+windowMean :: forall m a. (Monad m, Fractional a) => Fold m (a, Maybe a) a+windowMean = Fold.teeWith (/) windowSum windowLength
src/Streamly/Internal/Data/IOFinalizer.hs view
@@ -66,6 +66,9 @@ -- never runs again.  Note, the finalizing action runs with async exceptions -- masked. --+-- If this function is called multiple times, the action is guaranteed to run+-- once and only once.+-- -- /Pre-release/ runIOFinalizer :: MonadIO m => IOFinalizer -> m () runIOFinalizer (IOFinalizer ref) = liftIO $ do@@ -83,9 +86,16 @@ -- | Run an action clearing the finalizer atomically wrt async exceptions. The -- action is run with async exceptions masked. --+-- This function can be called at most once after setting the finalizer. If the+-- finalizer is not set it is considered a bug.+-- -- /Pre-release/ clearingIOFinalizer :: MonadIO m => IOFinalizer -> IO a -> m a clearingIOFinalizer (IOFinalizer ref) action = do     liftIO $ mask_ $ do-        writeIORef ref Nothing-        action+        res <- readIORef ref+        case res of+            Just _ -> do+                writeIORef ref Nothing+                action+            Nothing -> error "clearingIOFinalizer: finalizer not set"
+ src/Streamly/Internal/Data/IORef.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,100 +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-    , toStreamD-    )-where--#include "inline.hs"--import Data.Proxy (Proxy(..))-import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Data.Unboxed-    ( MutableByteArray(..)-    , Unbox-    , sizeOf-    , peekWith-    , pokeWith-    , newUnpinnedBytes-    )--import qualified Streamly.Internal.Data.Stream.StreamD.Type as D---- | An 'IORef' holds a single 'Unbox'-able value.-newtype IORef a = IORef MutableByteArray---- | Create a new 'IORef'.------ /Pre-release/-{-# INLINE newIORef #-}-newIORef :: forall a. Unbox a => a -> IO (IORef a)-newIORef x = do-    var <- newUnpinnedBytes (sizeOf (Proxy :: Proxy a))-    pokeWith var 0 x-    return $ IORef var---- | Write a value to an 'IORef'.------ /Pre-release/-{-# INLINE writeIORef #-}-writeIORef :: Unbox a => IORef a -> a -> IO ()-writeIORef (IORef var) = pokeWith var 0---- | Read a value from an 'IORef'.------ /Pre-release/-{-# INLINE readIORef #-}-readIORef :: Unbox a => IORef a -> IO a-readIORef (IORef var) = peekWith var 0---- | 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.------ /Pre-release/-{-# INLINE_NORMAL toStreamD #-}-toStreamD :: (MonadIO m, Unbox a) => IORef a -> D.Stream m a-toStreamD 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@@ -28,6 +32,8 @@     mapDelete :: Key f -> f a -> f a     mapUnion :: f a -> f a -> f a     mapNull :: f a -> Bool+    mapTraverseWithKey ::+        Applicative t => (Key f -> a -> t b) -> f a -> t (f b)  instance Ord k => IsMap (Map k) where     type Key (Map k) = k@@ -39,6 +45,7 @@     mapDelete = Map.delete     mapUnion = Map.union     mapNull = Map.null+    mapTraverseWithKey = Map.traverseWithKey  instance IsMap IntMap.IntMap where     type Key IntMap.IntMap = Int@@ -50,3 +57,4 @@     mapDelete = IntMap.delete     mapUnion = IntMap.union     mapNull = IntMap.null+    mapTraverseWithKey = IntMap.traverseWithKey
− src/Streamly/Internal/Data/List.hs 
@@ -1,169 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.List--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Lists are just a special case of monadic streams. The stream type @Stream--- Identity a@ can be used as a replacement for @[a]@.  The 'List' type in this--- module is just a newtype wrapper around @Stream Identity@ for better type--- inference when using the 'OverloadedLists' GHC extension. @List a@ provides--- better performance compared to @[a]@. Standard list, string and list--- comprehension syntax can be used with the 'List' type by enabling--- 'OverloadedLists', 'OverloadedStrings' and 'MonadComprehensions' GHC--- extensions.  There would be a slight difference in the 'Show' and 'Read'--- strings of streamly list as compared to regular lists.------ Conversion to stream types is free, any stream combinator can be used on--- lists by converting them to streams.  However, for convenience, this module--- provides combinators that work directly on the 'List' type.--------- @--- List $ S.map (+ 1) $ toStream (1 \`Cons\` Nil)--- @------ To convert a 'List' to regular lists, you can use any of the following:------ * @toList . toStream@ and @toStream . fromList@--- * 'Data.Foldable.toList' from "Data.Foldable"--- * 'GHC.Exts.toList' and 'GHC.Exts.fromList' from 'IsList' in "GHC.Exts"------ If you have made use of 'Nil' and 'Cons' constructors in the code and you--- want to replace streamly lists with standard lists, all you need to do is--- import these definitions:------ @--- type List = []--- pattern Nil <- [] where Nil = []--- pattern Cons x xs = x : xs--- infixr 5 `Cons`--- {-\# COMPLETE Cons, Nil #-}--- @------ See <src/docs/streamly-vs-lists.md> for more details and--- <src/test/PureStreams.hs> for comprehensive usage examples.----module Streamly.Internal.Data.List-    (-    List (Nil, Cons)--    , toStream-    , fromStream--    -- XXX we may want to use rebindable syntax for variants instead of using-    -- different types (applicative do and apWith).-    , ZipList (..)-    , fromZipList-    , toZipList-    )-where--import Control.Arrow (second)-import Data.Functor.Identity (Identity, runIdentity)-import GHC.Exts (IsList(..), IsString(..))-import Streamly.Internal.Data.Stream.Cross (CrossStream(..))-import Streamly.Internal.Data.Stream.Type (Stream)-import Streamly.Internal.Data.Stream.Zip (ZipStream(..))-import Text.Read (readPrec)--import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.Type as Stream---- XXX Rename to PureStream.---- | @List a@ is a replacement for @[a]@.------ /Pre-release/-newtype List a = List { toCrossStream :: CrossStream Identity a }-    deriving-    ( Eq, Ord-    , Semigroup, Monoid, Functor, Foldable-    , Applicative, Traversable, Monad, IsList)--toStream :: List a -> Stream Identity a-toStream = unCrossStream . toCrossStream--fromStream :: Stream Identity a -> List a-fromStream xs = List (CrossStream xs)--instance (a ~ Char) => IsString (List a) where-    {-# INLINE fromString #-}-    fromString = List . fromList--instance Show a => Show (List a) where-    show (List x) = show $ unCrossStream x--instance Read a => Read (List a) where-    readPrec = fromStream <$> readPrec----------------------------------------------------------------------------------- Patterns----------------------------------------------------------------------------------- Note: When using the OverloadedLists extension we should be able to pattern--- match using the regular list contructors. OverloadedLists uses 'toList' to--- perform the pattern match, it should not be too bad as it works lazily in--- the Identity monad. We need these patterns only when not using that--- extension.---- | An empty list constructor and pattern that matches an empty 'List'.--- Corresponds to '[]' for Haskell lists.----pattern Nil :: List a-pattern Nil <- (runIdentity . K.null . Stream.toStreamK . toStream -> True)--    where--    Nil = List $ CrossStream (Stream.fromStreamK K.nil)--infixr 5 `Cons`---- | A list constructor and pattern that deconstructs a 'List' into its head--- and tail. Corresponds to ':' for Haskell lists.----pattern Cons :: a -> List a -> List a-pattern Cons x xs <--    (fmap (second (List . CrossStream . Stream.fromStreamK))-        . runIdentity . K.uncons . Stream.toStreamK . toStream-            -> Just (x, xs)-    )--    where--    Cons x xs = List $ CrossStream $ Stream.cons x (toStream xs)--{-# COMPLETE Nil, Cons #-}----------------------------------------------------------------------------------- ZipList----------------------------------------------------------------------------------- | Just like 'List' except that it has a zipping 'Applicative' instance--- and no 'Monad' instance.----newtype ZipList a = ZipList { toZipStream :: ZipStream Identity a }-    deriving-    ( Show, Read, Eq, Ord-    , Semigroup, Monoid, Functor, Foldable-    , Applicative, Traversable, IsList-    )--instance (a ~ Char) => IsString (ZipList a) where-    {-# INLINE fromString #-}-    fromString = ZipList . fromList---- | Convert a 'ZipList' to a regular 'List'----fromZipList :: ZipList a -> List a-fromZipList (ZipList zs) = List $ CrossStream (unZipStream zs)---- | Convert a regular 'List' to a 'ZipList'----toZipList :: List a -> ZipList a-toZipList = ZipList . ZipStream . toStream
+ src/Streamly/Internal/Data/MutArray.hs view
@@ -0,0 +1,425 @@+-- |+-- Module      : Streamly.Internal.Data.MutArray+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- 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+    , 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+    , 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.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)+import Streamly.Internal.Data.MutArray.Type++-- | 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 indexerFromLen #-}+indexerFromLen, sliceIndexerFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (MutArray a) (Int, Int)+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.mapM (uncurry mkSlice) . Unfold.carry+        $ Unfold.lmap fromThenTo Unfold.enumerateFromThenTo+RENAME(sliceIndexerFromLen,indexerFromLen)++{-# 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 = 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 splitterFromLen #-}+splitterFromLen, slicerFromLen :: forall m a. (Monad m, Unbox a)+    => Int -- ^ from index+    -> Int -- ^ length of the slice+    -> Unfold m (MutArray a) (MutArray a)+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 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 = 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+-------------------------------------------------------------------------------++-- | @compactLE 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.+{-# 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.+compactMax = compactLeAs Unpinned+-- The parser version turns out to be a little bit slower.+-- compactLE n = Stream.catRights . Stream.parseManyD (pCompactLE n)++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)+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+    | Splitting s arr+    | Yielding arr (SplitState s arr)+    | Finishing++-- | Split a stream of arrays on a given separator byte, dropping the separator+-- and coalescing all the arrays between two separators into a single array.+--+{-# INLINE_NORMAL _compactSepByByteCustom #-}+_compactSepByByteCustom+    :: MonadIO m+    => Word8+    -> Stream m (MutArray Word8)+    -> Stream m (MutArray Word8)+_compactSepByByteCustom byte (Stream.Stream step state) =+    Stream.Stream step' (Initial state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Initial st) = do+        r <- step gst st+        case r of+            Stream.Yield arr s -> do+                (arr1, marr2) <- breakEndByWord8_ byte arr+                return $ case marr2 of+                    Nothing   -> Stream.Skip (Buffering s arr1)+                    Just arr2 -> Stream.Skip (Yielding arr1 (Splitting s arr2))+            Stream.Skip s -> return $ Stream.Skip (Initial s)+            Stream.Stop -> return Stream.Stop++    step' gst (Buffering st buf) = do+        r <- step gst st+        case r of+            Stream.Yield arr s -> do+                (arr1, marr2) <- breakEndByWord8_ byte arr+                -- XXX Use spliceExp instead and then rightSize?+                buf1 <- splice buf arr1+                return $ case marr2 of+                    Nothing -> Stream.Skip (Buffering s buf1)+                    Just x -> Stream.Skip (Yielding buf1 (Splitting s x))+            Stream.Skip s -> return $ Stream.Skip (Buffering s buf)+            Stream.Stop -> return $+                if byteLength buf == 0+                then Stream.Stop+                else Stream.Skip (Yielding buf Finishing)++    step' _ (Splitting st buf) = do+        (arr1, marr2) <- breakEndByWord8_ byte buf+        return $ case marr2 of+                Nothing -> Stream.Skip $ Buffering st arr1+                Just arr2 -> Stream.Skip $ Yielding arr1 (Splitting st arr2)++    step' _ (Yielding arr next) = return $ Stream.Yield arr next+    step' _ Finishing = return Stream.Stop++-- 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 compactSepByByte_ #-}+compactSepByByte_, compactOnByte+    :: (MonadIO m)+    => Word8+    -> Stream m (MutArray Word8)+    -> Stream m (MutArray Word8)+-- XXX compare perf of custom vs idiomatic version+-- compactOnByte = _compactOnByteCustom+-- XXX use spliceExp and rightSize?+compactSepByByte_ byte = Stream.splitInnerBy (breakEndByWord8_ byte) splice++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)+compactEndByByte_ byte =+        -- XXX use spliceExp and rightSize?+        Stream.splitInnerBySuffix+            (\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
@@ -0,0 +1,981 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module      : Streamly.Internal.Data.MutArray.Generic+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.MutArray.Generic+(+    -- * Type+    -- $arrayNotes+      MutArray (..)++    -- * Constructing and Writing+    -- ** Construction+    , nil++    -- ** Utils+    , initializeOfFilledUpto++    -- *** Uninitialized Arrays+    , emptyOf+    -- , newArrayWith++    -- *** From streams+    , unsafeCreateOf+    , createOf+    , createWith -- createOfMin/createMin/createGE?+    , create+    , fromStreamN+    , fromStream+    , fromPureStream++    -- , writeRevN+    -- , writeRev++    -- ** From containers+    , fromListN+    , fromList++    -- * Random writes+    , putIndex+    , 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++    -- * Growing and Shrinking+    -- Arrays grow only at the end, though it is possible to grow on both sides+    -- and therefore have a cons as well as snoc. But that will require two+    -- bounds in the array representation.++    -- ** Reallocation+    , realloc+    , uninit++    -- ** Appending elements+    , snocWith+    , snoc+    -- , snocLinear+    -- , snocMay+    , unsafeSnoc++    -- ** Appending streams+    -- , writeAppendNUnsafe+    -- , writeAppendN+    -- , writeAppendWith+    -- , writeAppend++    -- ** Truncation+    -- These are not the same as slicing the array at the beginning, they may+    -- reduce the length as well as the capacity of the array.+    -- , truncateWith+    -- , truncate+    -- , truncateExp++    -- * Eliminating and Reading++    -- ** Unfolds+    , reader+    -- , readerRev+    , producerWith -- experimental+    , producer -- experimental++    -- ** To containers+    , read+    , readRev+    , toStreamK+    -- , toStreamKRev+    , toList++    -- ** Random reads+    , getIndex+    , unsafeGetIndex+    , unsafeGetIndexWith+    -- , getIndices+    -- , getFromThenTo+    -- , getIndexRev++    -- * Size+    , length++    -- * In-place Mutation Algorithms+    , dropAround+    -- , reverse+    -- , permute+    -- , partitionBy+    -- , shuffleBy+    -- , divideBy+    -- , mergeBy++    -- * Folding+    -- , foldl'+    -- , foldr+    , cmp+    , eq++    -- * Arrays of arrays+    --  We can add dimensionality parameter to the array type to get+    --  multidimensional arrays. Multidimensional arrays would just be a+    --  convenience wrapper on top of single dimensional arrays.++    -- | Operations dealing with multiple arrays, streams of arrays or+    -- multidimensional array representations.++    -- ** Construct from streams+    , chunksOf+    -- , arrayStreamKFromStreamD+    -- , writeChunks++    -- ** Eliminate to streams+    -- , flattenArrays+    -- , flattenArraysRev+    -- , fromArrayStreamK++    -- ** Construct from arrays+    -- get chunks without copying+    , unsafeSliceOffLen+    , sliceOffLen+    -- , getSlicesFromLenN+    -- , splitAt -- XXX should be able to express using sliceOffLen+    -- , breakOn++    -- ** Appending arrays+    -- , spliceCopy+    -- , spliceWith+    -- , splice+    -- , spliceExp+    , 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)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import GHC.Base+    ( MutableArray#+    , RealWorld+    , copyMutableArray#+    , newArray#+    , readArray#+    , writeArray#+    )+import GHC.IO (IO(..))+import GHC.Int (Int(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Producer.Type (Producer (..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))+import Streamly.Internal.Data.Stream.Type (Stream)+import Streamly.Internal.Data.SVar.Type (adaptState)++import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.Stream.Generate as D+import qualified Streamly.Internal.Data.Stream.Lift as D+import qualified Streamly.Internal.Data.StreamK.Type as K++import Prelude hiding (read, length, replicate)++#include "DocTestDataMutArrayGeneric.hs"++-------------------------------------------------------------------------------+-- MutArray Data Type+-------------------------------------------------------------------------------++data MutArray a =+    MutArray+        { arrContents# :: MutableArray# RealWorld a+          -- ^ The internal contents of the array representing the entire array.++        , arrStart :: {-# UNPACK #-}!Int+          -- ^ The starting index of this slice.++        , arrEnd :: {-# UNPACK #-}!Int+          -- ^ The index after the last initialized index.++        , arrBound :: {-# UNPACK #-}!Int+          -- ^ The first invalid index.+        }++{-# INLINE bottomElement #-}+bottomElement :: a+bottomElement =+    error+        $ unwords+              [ funcName+              , "This is the bottom element of the array."+              , "This is a place holder and should never be reached!"+              ]++    where++    funcName = "Streamly.Internal.Data.MutArray.Generic.bottomElement:"++-- XXX Would be nice if GHC can provide something like newUninitializedArray# so+-- that we do not have to write undefined or error in the whole array.++{-# 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 = initializeOfFilledUpto n 0 bottomElement++{-# DEPRECATED new "Please use emptyOf instead." #-}+{-# INLINE new #-}+new :: MonadIO m => Int -> m (MutArray a)+new = emptyOf++-- XXX This could be pure?++-- |+-- Definition:+--+-- >>> nil = MutArray.emptyOf 0+{-# INLINE nil #-}+nil :: MonadIO m => m (MutArray a)+nil = new 0++-------------------------------------------------------------------------------+-- Random writes+-------------------------------------------------------------------------------++-- | Write the given element to the given index of the 'MutableArray#'. Does not+-- check if the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE putIndexUnderlying #-}+putIndexUnderlying :: MonadIO m => Int -> MutableArray# RealWorld a -> a -> m ()+putIndexUnderlying n _arrContents# x =+    liftIO+        $ IO+        $ \s# ->+              case n of+                  I# n# ->+                      let s1# = writeArray# _arrContents# n# x s#+                       in (# s1#, () #)++-- | Write the given element to the given index of the array. Does not check if+-- the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE 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 =+    error $ label ++ ": invalid array index " ++ show i++-- | /O(1)/ Write the given element at the given index in the array.+-- Performs in-place mutation of the array.+--+-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))+--+-- /Pre-release/+{-# INLINE putIndex #-}+putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()+putIndex i arr 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+-- error if any index is out of bounds.+--+-- /Pre-release/+{-# INLINE putIndices #-}+putIndices :: MonadIO m+    => MutArray a -> Fold m (Int, a) ()+putIndices arr = FL.foldlM' step (return ())++    where++    step () (i, x) = putIndex i arr x++-- | Modify a given index of an array using a modifier function without checking+-- the bounds.+--+-- Unsafe because it does not check the bounds of the array.+--+-- /Pre-release/+unsafeModifyIndex, modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+unsafeModifyIndex i MutArray {..} f = do+    liftIO+        $ IO+        $ \s# ->+              case i + arrStart of+                  I# n# ->+                      case readArray# arrContents# n# s# of+                          (# s1#, a #) ->+                              let (a1, b) = f a+                                  s2# = writeArray# arrContents# n# a1 s1#+                               in (# s2#, b #)++-- | Modify a given index of an array using a modifier function.+--+-- /Pre-release/+modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndex i arr f = do+    if i >= 0 && i < length arr+    then unsafeModifyIndex i arr f+    else invalidIndex "modifyIndex" i++-------------------------------------------------------------------------------+-- Resizing+-------------------------------------------------------------------------------++-- | Reallocates the array according to the new size. This is a safe function+-- that always creates a new array and copies the old array into the new one.+-- If the reallocated size is less than the original array it results in a+-- truncated version of the original array.+--+realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)+realloc n arr = do+    arr1 <- new n+    let !newLen@(I# newLen#) = min n (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 {arrEnd = newEnd, arrBound = newBound} #)++reallocWith ::+       MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)+reallocWith label sizer reqSize arr = do+    let oldSize = length arr+        newSize = sizer oldSize+        safeSize = max newSize (oldSize + reqSize)+    assert (newSize >= oldSize + reqSize || error badSize) (return ())+    realloc safeSize arr++    where++    badSize = concat+        [ label+        , ": new array size is less than required size "+        , show reqSize+        , ". Please check the sizing function passed."+        ]++-------------------------------------------------------------------------------+-- Snoc+-------------------------------------------------------------------------------++-- XXX Not sure of the behavior of writeArray# if we specify an index which is+-- out of bounds. This comment should be rewritten based on that.+-- | Really really unsafe, appends the element into the first array, may+-- cause silent data corruption or if you are lucky a segfault if the index+-- is out of bounds.+--+-- /Internal/+{-# INLINE 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+    unsafeSnoc arr1 x++-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of+-- the array increases by 1.+--+-- If there is no reserved space available in @arr@ it is reallocated to a size+-- in bytes determined by the @sizer oldSize@ function, where @oldSize@ is the+-- original size of the array.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- /Pre-release/+{-# INLINE snocWith #-}+snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+snocWith sizer arr@MutArray {..} x = do+    if arrEnd < arrBound+    then unsafeSnoc arr x+    else snocWithRealloc sizer arr x++-- XXX round it to next power of 2.++-- | The array is mutated to append an additional element to it. If there is no+-- reserved space available in the array then it is reallocated to double the+-- original size.+--+-- This is useful to reduce allocations when appending unknown number of+-- elements.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- >>> snoc = MutArray.snocWith (* 2)+--+-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.+--+-- /Pre-release/+{-# INLINE snoc #-}+snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+snoc = snocWith (* 2)++-- | Make the uninitialized memory in the array available for use extending it+-- by the supplied length beyond the current length of the array. The array may+-- be reallocated.+--+{-# INLINE uninit #-}+uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)+uninit arr@MutArray{..} len =+    if arrEnd + len <= arrBound+    then return $ arr {arrEnd = arrEnd + len}+    else realloc (length arr + len) arr++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- | Return the element at the specified index without checking the bounds from+-- a @MutableArray# RealWorld@.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE unsafeGetIndexWith #-}+unsafeGetIndexWith, getIndexUnsafeWith :: MonadIO m => MutableArray# RealWorld a -> Int -> m a+unsafeGetIndexWith _arrContents# n =+    liftIO+        $ IO+        $ \s# ->+              let !(I# i#) = n+               in readArray# _arrContents# i# s#++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE_NORMAL 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 =+    if i >= 0 && i < length arr+    then Just <$> unsafeGetIndex i arr+    else return Nothing++-------------------------------------------------------------------------------+-- Subarrays+-------------------------------------------------------------------------------++-- XXX We can also get immutable slices.++-- | /O(1)/ Slice an array in constant time.+--+-- Unsafe: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE unsafeSliceOffLen #-}+unsafeSliceOffLen, getSliceUnsafe+    :: Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+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 sliceOffLen #-}+sliceOffLen, getSlice+    :: Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+sliceOffLen index len arr@MutArray{..} =+    if index >= 0 && len >= 0 && index + len <= length arr+    then arr {arrStart = newStart, arrEnd = newEnd}+    else error+             $ "sliceOffLen: invalid slice, index "+             ++ show index ++ " length " ++ show len+    where+    newStart = arrStart + index+    newEnd = newStart + len++-------------------------------------------------------------------------------+-- to Lists and streams+-------------------------------------------------------------------------------++-- XXX Maybe faster to create a list explicitly instead of mapM, if list fusion+-- does not work well.++-- | Convert an 'Array' into a list.+--+-- /Pre-release/+{-# INLINE toList #-}+toList :: MonadIO m => MutArray a -> m [a]+toList arr = mapM (`unsafeGetIndex` arr) [0 .. (length arr - 1)]++-- | Generates a stream from the elements of a @MutArray@.+--+-- >>> read = Stream.unfold MutArray.reader+--+{-# INLINE_NORMAL read #-}+read :: MonadIO m => MutArray a -> D.Stream m a+read arr =+    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 = K.unfoldrM step 0++    where++    arrLen = length arr+    step i+        | i == arrLen = return Nothing+        | otherwise = do+            x <- unsafeGetIndex i arr+            return $ Just (x, i + 1)++{-# INLINE_NORMAL readRev #-}+readRev :: MonadIO m => MutArray a -> D.Stream m a+readRev arr =+    D.mapM (`unsafeGetIndex` arr)+        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0+    where+    arrLen = length arr++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- XXX deduplicate this across unboxed array and this module?++-- | The default chunk size by which the array creation routines increase the+-- size of the array when the array is grown linearly.+arrayChunkSize :: Int+arrayChunkSize = 1024++-- | Like '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.+--+-- /Pre-release/+{-# INLINE_NORMAL unsafeCreateOf #-}+unsafeCreateOf :: MonadIO m => Int -> Fold m a (MutArray a)+unsafeCreateOf n = Fold step initial return return++    where++    initial = FL.Partial <$> new (max n 0)++    step arr x = FL.Partial <$> unsafeSnoc arr x++{-# DEPRECATED writeNUnsafe "Please use unsafeCreateOf instead." #-}+{-# INLINE writeNUnsafe #-}+writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+writeNUnsafe = unsafeCreateOf++-- | @createOf n@ folds a maximum of @n@ elements from the input stream to an+-- 'Array'.+--+-- >>> createOf n = Fold.take n (MutArray.unsafeCreateOf n)+--+-- /Pre-release/+{-# INLINE_NORMAL createOf #-}+createOf :: MonadIO m => Int -> Fold m a (MutArray a)+createOf n = FL.take n $ unsafeCreateOf n++{-# DEPRECATED writeN "Please use createOf instead." #-}+{-# INLINE writeN #-}+writeN :: MonadIO m => Int -> Fold m a (MutArray a)+writeN = createOf++-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.pinnedNew n)+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)++-- | @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./+--+-- /Pre-release/+{-# INLINE_NORMAL createWith #-}+createWith :: MonadIO m => Int -> Fold m a (MutArray a)+-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (pinnedNew n)+createWith elemCount = FL.rmapM extract $ FL.foldlM' step initial++    where++    initial = do+        when (elemCount < 0) $ error "createWith: elemCount is negative"+        new elemCount++    step arr@(MutArray _ start end bound) x+        | end == bound = do+        let oldSize = end - start+            newSize = max (oldSize * 2) 1+        arr1 <- realloc newSize arr+        unsafeSnoc arr1 x+    step arr x = unsafeSnoc arr x++    -- extract = rightSize+    extract = return++{-# DEPRECATED writeWith "Please use createWith instead." #-}+{-# INLINE writeWith #-}+writeWith :: MonadIO m => 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 'arrayChunkSize' bytes+-- rounded up to the element size.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE create #-}+create :: MonadIO m => Fold m a (MutArray a)+create = writeWith arrayChunkSize++{-# DEPRECATED write "Please use create instead." #-}+{-# INLINE write #-}+write :: MonadIO m => Fold m a (MutArray a)+write = create++-- | Create a 'MutArray' from the first @n@ elements of a stream. The+-- array is allocated to size @n@, if the stream terminates before @n@+-- elements then the array may hold less than @n@ elements.+--+{-# INLINE fromStreamN #-}+fromStreamN :: MonadIO m => Int -> Stream m a -> m (MutArray a)+fromStreamN n = D.fold (writeN n)++{-# INLINE fromStream #-}+fromStream :: MonadIO m => Stream m a -> m (MutArray a)+fromStream = D.fold write++{-# INLINABLE fromListN #-}+fromListN :: MonadIO m => Int -> [a] -> m (MutArray a)+fromListN n xs = fromStreamN n $ D.fromList xs++{-# INLINABLE fromList #-}+fromList :: MonadIO m => [a] -> m (MutArray a)+fromList xs = fromStream $ D.fromList xs++{-# INLINABLE fromPureStream #-}+fromPureStream :: MonadIO m => Stream Identity a -> m (MutArray a)+fromPureStream xs =+    D.fold write $ D.morphInner (return . runIdentity) xs++-------------------------------------------------------------------------------+-- Chunking+-------------------------------------------------------------------------------++data GroupState s a start end bound+    = GroupStart s+    | GroupBuffer s (MutableArray# RealWorld a) start end bound+    | GroupYield+          (MutableArray# RealWorld a)+          start+          end+          bound+          (GroupState s a start end bound)+    | GroupFinish++-- | @chunksOf n stream@ groups the input stream into a stream of+-- arrays of size n.+--+-- @chunksOf n = foldMany (MutArray.writeN n)@+--+-- /Pre-release/+{-# INLINE_NORMAL chunksOf #-}+chunksOf :: forall m a. MonadIO m+    => Int -> D.Stream m a -> D.Stream m (MutArray a)+-- XXX the idiomatic implementation leads to large regression in the D.reverse'+-- benchmark. It seems it has difficulty producing optimized code when+-- converting to StreamK. Investigate GHC optimizations.+-- chunksOf n = D.foldMany (writeN n)+chunksOf n (D.Stream step state) =+    D.Stream step' (GroupStart state)++    where++    -- start is always 0+    -- end and len are always equal++    {-# INLINE_LATE step' #-}+    step' _ (GroupStart st) = do+        when (n <= 0) $+            -- XXX we can pass the module string from the higher level API+            error $ "Streamly.Internal.Data.Array.Generic.Mut.Type.chunksOf: "+                    ++ "the size of arrays [" ++ show n+                    ++ "] must be a natural number"+        (MutArray contents start end bound :: MutArray a) <- new n+        return $ D.Skip (GroupBuffer st contents start end bound)++    step' gst (GroupBuffer st contents start end bound) = do+        r <- step (adaptState gst) st+        case r of+            D.Yield x s -> do+                putIndexUnderlying end contents x+                let end1 = end + 1+                return $+                    if end1 >= bound+                    then D.Skip+                            (GroupYield+                                contents start end1 bound (GroupStart s))+                    else D.Skip (GroupBuffer s contents start end1 bound)+            D.Skip s ->+                return $ D.Skip (GroupBuffer s contents start end bound)+            D.Stop ->+                return+                    $ D.Skip (GroupYield contents start end bound GroupFinish)++    step' _ (GroupYield contents start end bound next) =+         return $ D.Yield (MutArray contents start end bound) next++    step' _ GroupFinish = return D.Stop++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producerWith #-}+producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a+producerWith liftio = Producer step inject extract++    where++    {-# INLINE inject #-}+    inject arr = return (arr, 0)++    {-# INLINE extract #-}+    extract (arr, i) =+        return $ arr {arrStart = arrStart arr + i}++    {-# INLINE_LATE step #-}+    step (arr, i)+        | i == length arr = return D.Stop+    step (arr, i) = do+        x <- liftio $ unsafeGetIndex i arr+        return $ D.Yield x (arr, i + 1)++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producer #-}+producer :: MonadIO m => Producer m (MutArray a) a+producer = producerWith liftIO++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: MonadIO m => Unfold m (MutArray a) a+reader = Producer.simplify producer++--------------------------------------------------------------------------------+-- Appending arrays+--------------------------------------------------------------------------------++-- | Put a sub range of a source array into a subrange of a destination array.+-- This is not safe as it does not check the bounds.+{-# INLINE unsafePutSlice #-}+unsafePutSlice, putSliceUnsafe :: MonadIO m =>+    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+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+    let arrS# = arrContents# src+        arrD# = arrContents# dst+    IO $ \s# -> (# copyMutableArray#+                    arrS# srcStart# arrD# dstStart# len# s#+                , () #)++{-# INLINE clone #-}+clone :: MonadIO m => MutArray a -> m (MutArray a)+clone src = do+    let len = length src+    dst <- new len+    unsafePutSlice src 0 dst 0 len+    return dst++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++{-# INLINE length #-}+length :: MutArray a -> Int+length arr = arrEnd arr - arrStart arr++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Compare the length of the arrays. If the length is equal, compare the+-- lexicographical ordering of two underlying byte arrays otherwise return the+-- result of length comparison.+--+-- /Pre-release/+{-# INLINE cmp #-}+cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering+cmp a1 a2 =+    case compare lenA1 lenA2 of+        EQ -> loop (lenA1 - 1)+        x -> return x++    where++    lenA1 = length a1+    lenA2 = length a2++    loop i+        | i < 0 = return EQ+        | otherwise = do+            v1 <- unsafeGetIndex i a1+            v2 <- unsafeGetIndex i a2+            case compare v1 v2 of+                EQ -> loop (i - 1)+                x -> return x++{-# INLINE eq #-}+eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool+eq a1 a2 =+    if lenA1 == lenA2+    then loop (lenA1 - 1)+    else return False++    where++    lenA1 = length a1+    lenA2 = length a2++    loop i+        | i < 0 = return True+        | otherwise = do+            v1 <- unsafeGetIndex i a1+            v2 <- unsafeGetIndex i a2+            if v1 == v2+            then loop (i - 1)+            else return False++{-# 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+    then nil+    else do+        indexL <- getIndexL 0 -- first predicate failing index+        if indexL == 0 && indexR == lastIndex+        then return arr+        else+           let newLen = indexR - indexL + 1+            in return $ unsafeSliceOffLen indexL newLen arr++    where++    getIndexR idx+        | idx < 0 = return idx+        | otherwise = do+            r <- unsafeGetIndex idx arr+            if p r+            then getIndexR (idx - 1)+            else return idx++    getIndexL idx = do+        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/Lib.c view
@@ -0,0 +1,15 @@+#include <string.h>++// Find the char "c" starting from "dst+off" and up to "len" chars from+// it, returns the index of the character found, considering dst + off+// as the base pointer. If index is greater than or equal to len the+// char is not found.+size_t memchr_index(const void *dst, size_t off, int c, size_t len) {+    void *p = memchr ((char *)dst + off, c, len);++    if (p) {+        return (size_t) (p - dst - off);+    } else {+        return len;+    }+}
+ src/Streamly/Internal/Data/MutArray/Stream.hs view
@@ -0,0 +1,146 @@+{-# OPTIONS_GHC -Wno-deprecations #-}+-- |+-- Module      : Streamly.Internal.Data.MutArray.Stream+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Combinators to efficiently manipulate streams of mutable arrays.+--+-- We can either push these in the MutArray module with a "chunks" prefix or+-- keep this as a separate module and release it.+--+module Streamly.Internal.Data.MutArray.Stream+{-# DEPRECATED "Please use \"Streamly.Internal.Data.MutArray\" instead." #-}+    (+    -- * Generation+      MArray.chunksOf+    , MArray.pinnedChunksOf+    , MArray.writeChunks -- chunksWrite?+    , MArray.splitOn -- chunksSplitOn++    -- * Compaction+    , packArraysChunksOf+    , MArray.SpliceState (..)+    , lpackArraysChunksOf+    , compact -- chunksCompact+    , compactLE+    , compactEQ+    , compactGE++    -- * Elimination+    , MArray.flattenArrays -- chunksConcat+    , MArray.flattenArraysRev -- chunksConcatRev+    , MArray.fromArrayStreamK -- chunksCoalesce+    )+where++import Control.Monad.IO.Class (MonadIO(..))+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.Data.MutArray.Type (MutArray(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Parser (ParseError)+import Streamly.Internal.Data.Stream.Type (Stream)++import qualified Streamly.Internal.Data.MutArray as MArray+import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Parser as ParserD+import qualified Streamly.Internal.Data.Stream as D++-------------------------------------------------------------------------------+-- Compact+-------------------------------------------------------------------------------++-- XXX This can be removed once compactLEFold/compactLE are implemented.+--+-- | This mutates the first array (if it has space) to append values from the+-- second one. This would work for immutable arrays as well because an+-- immutable array never has space so a new array is allocated instead of+-- mutating it.+--+-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size. Note that if a single array is bigger than the+-- specified size we do not split it to fit. When we coalesce multiple arrays+-- if the size would exceed the specified size we do not coalesce therefore the+-- actual array size may be less than the specified chunk size.+--+-- @since 0.7.0+{-# INLINE packArraysChunksOf #-}+packArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> D.Stream m (MutArray a) -> D.Stream m (MutArray a)+packArraysChunksOf = MArray.compactLE++-- XXX Remove this once compactLEFold is implemented+-- lpackArraysChunksOf = Fold.many compactLEFold+--+{-# INLINE lpackArraysChunksOf #-}+lpackArraysChunksOf :: (MonadIO m, Unbox a)+    => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()+lpackArraysChunksOf = MArray.lCompactGE++-- XXX Same as compactLE, to be removed once that is implemented.+--+-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size in bytes.+--+-- /Internal/+{-# INLINE compact #-}+compact :: (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compact = packArraysChunksOf++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size. Note that if a single array is bigger than the+-- specified size we do not split it to fit. When we coalesce multiple arrays+-- if the size would exceed the specified size we do not coalesce therefore the+-- actual array size may be less than the specified chunk size.+--+-- /Internal/+{-# INLINE compactLEParserD #-}+compactLEParserD ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> ParserD.Parser (MutArray a) m (MutArray a)+compactLEParserD = MArray.pCompactLE++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- minimum specified size. Note that if all the arrays in the stream together+-- are smaller than the specified size the resulting array will be smaller than+-- the specified size. When we coalesce multiple arrays if the size would exceed+-- the specified size we stop coalescing further.+--+-- /Internal/+{-# INLINE compactGEFold #-}+compactGEFold ::+       forall m a. (MonadIO m, Unbox a)+    => Int -> FL.Fold m (MutArray a) (MutArray a)+compactGEFold = MArray.fCompactGE++-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a+-- maximum specified size in bytes.+--+-- /Internal/+compactLE :: (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (Either ParseError (MutArray a))+compactLE n = D.parseManyD (compactLEParserD n)++-- | Like 'compactLE' but generates arrays of exactly equal to the size+-- specified except for the last array in the stream which could be shorter.+--+-- /Unimplemented/+{-# INLINE compactEQ #-}+compactEQ :: -- (MonadIO m, Unbox a) =>+    Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactEQ _n _xs = undefined+    -- IsStream.fromStreamD $ D.foldMany (compactEQFold n) (IsStream.toStreamD xs)++-- | Like 'compactLE' but generates arrays of size greater than or equal to the+-- specified except for the last array in the stream which could be shorter.+--+-- /Internal/+{-# INLINE compactGE #-}+compactGE ::+       (MonadIO m, Unbox a)+    => Int -> Stream m (MutArray a) -> Stream m (MutArray a)+compactGE n = D.foldMany (compactGEFold n)
+ src/Streamly/Internal/Data/MutArray/Type.hs view
@@ -0,0 +1,4221 @@+{-# LANGUAGE CPP #-}+{-# 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
@@ -0,0 +1,241 @@+-- This is required as all the instances in this module are orphan instances.+{-# OPTIONS_GHC -fno-warn-orphans #-}++-- |+-- Module      : Streamly.Internal.Data.MutByteArray+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--++module Streamly.Internal.Data.MutByteArray+    (+    -- * MutByteArray+      module Streamly.Internal.Data.MutByteArray.Type+    -- * Unbox+    , module Streamly.Internal.Data.Unbox+    , module Streamly.Internal.Data.Unbox.TH+    -- * Serialize+    , module Streamly.Internal.Data.Serialize.Type+    -- * Serialize TH+    , module Streamly.Internal.Data.Serialize.TH+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Proxy (Proxy(..))+import Streamly.Internal.Data.Array (Array(..))+import GHC.Exts (Int(..), sizeofByteArray#, unsafeCoerce#)+import GHC.Word (Word8)++#if __GLASGOW_HASKELL__ >= 900+import GHC.Num.Integer (Integer(..))+#else+import GHC.Integer.GMP.Internals (Integer(..), BigNat(..))+#endif++import Streamly.Internal.Data.MutByteArray.Type+import Streamly.Internal.Data.Serialize.TH+import Streamly.Internal.Data.Serialize.Type+import Streamly.Internal.Data.Unbox+import Streamly.Internal.Data.Unbox.TH++--------------------------------------------------------------------------------+-- Common instances+--------------------------------------------------------------------------------++-- Note+-- ====+--+-- Even a non-functional change such as changing the order of constructors will+-- change the instance derivation.+--+-- This will not pose a problem if both, encode, and decode are done by the same+-- version of the application. There *might* be a problem if version that+-- encodes differs from the version that decodes.+--+-- We need to add some compatibility tests using different versions of+-- dependencies.+--+-- Although such chages for the most basic types won't happen we need to detect+-- if it ever happens.+--+-- Should we worry about these kind of changes and this kind of compatibility?+-- This is a problem for all types of derivations that depend on the order of+-- constructors, for example, Enum.++-- Note on Windows build+-- =====================+--+-- On Windows, having template haskell splices here fail the build with the+-- following error:+--+-- @+-- addLibrarySearchPath: C:\...  (Win32 error 3): The system cannot find the path specified.+-- @+--+-- The error might be irrelavant but having these splices triggers it. We should+-- either fix the problem or avoid the use to template haskell splices in this+-- file.+--+-- Similar issue: https://github.com/haskell/cabal/issues/4741++-- $(Serialize.deriveSerialize ''Maybe)+instance Serialize a => Serialize (Maybe a) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc x =+        case x of+            Nothing -> acc + 1+            Just field0 -> addSizeTo (acc + 1) field0++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset arr endOffset = do+        (i0, tag) <- deserializeAt initialOffset arr endOffset+        case tag :: Word8 of+            0 -> pure (i0, Nothing)+            1 -> do (i1, a0) <- deserializeAt i0 arr endOffset+                    pure (i1, Just a0)+            _ -> error "Found invalid tag while peeking (Maybe a)"++    {-# INLINE serializeAt #-}+    serializeAt initialOffset arr val =+        case val of+            Nothing -> serializeAt initialOffset arr (0 :: Word8)+            Just field0 -> do+                i0 <- serializeAt initialOffset arr (1 :: Word8)+                serializeAt i0 arr field0++-- $(Serialize.deriveSerialize ''Either)+instance (Serialize a, Serialize b) => Serialize (Either a b) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc x =+        case x of+            Left field0 -> addSizeTo (acc + 1) field0+            Right field0 -> addSizeTo (acc + 1) field0++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset arr endOffset = do+        (i0, tag) <- deserializeAt initialOffset arr endOffset+        case tag :: Word8 of+            0 -> do (i1, a0) <- deserializeAt i0 arr endOffset+                    pure (i1, Left a0)+            1 -> do (i1, a0) <- deserializeAt i0 arr endOffset+                    pure (i1, Right a0)+            _ -> error "Found invalid tag while peeking (Either a b)"++    {-# INLINE serializeAt #-}+    serializeAt initialOffset arr val =+        case val of+            Left field0 -> do+                i0 <- serializeAt initialOffset arr (0 :: Word8)+                serializeAt i0 arr field0+            Right field0 -> do+                i0 <- serializeAt initialOffset arr (1 :: Word8)+                serializeAt i0 arr field0++instance Serialize (Proxy a) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc _ = acc + 1++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset _ _ = pure (initialOffset + 1, Proxy)++    {-# INLINE serializeAt #-}+    serializeAt initialOffset _ _ = pure (initialOffset + 1)++--------------------------------------------------------------------------------+-- Integer+--------------------------------------------------------------------------------++data LiftedInteger+    = LIS Int+    | LIP (Array Word)+    | LIN (Array Word)++-- $(Serialize.deriveSerialize ''LiftedInteger)+instance Serialize LiftedInteger where++    {-# INLINE addSizeTo #-}+    addSizeTo acc x =+        case x of+            LIS field0 -> addSizeTo (acc + 1) field0+            LIP field0 -> addSizeTo (acc + 1) field0+            LIN field0 -> addSizeTo (acc + 1) field0++    {-# INLINE deserializeAt #-}+    deserializeAt initialOffset arr endOffset = do+        (i0, tag) <- deserializeAt initialOffset arr endOffset+        case tag :: Word8 of+            0 -> do (i1, a0) <- deserializeAt i0 arr endOffset+                    pure (i1, LIS a0)+            1 -> do (i1, a0) <- deserializeAt i0 arr endOffset+                    pure (i1, LIP a0)+            2 -> do (i1, a0) <- deserializeAt i0 arr endOffset+                    pure (i1, LIN a0)+            _ -> error "Found invalid tag while peeking (LiftedInteger)"++    {-# INLINE serializeAt #-}+    serializeAt initialOffset arr val =+        case val of+            LIS field0 -> do+                i0 <- serializeAt initialOffset arr (0 :: Word8)+                serializeAt i0 arr field0+            LIP field0 -> do+                i0 <- serializeAt initialOffset arr (1 :: Word8)+                serializeAt i0 arr field0+            LIN field0 -> do+                i0 <- serializeAt initialOffset arr (2 :: Word8)+                serializeAt i0 arr field0++#if __GLASGOW_HASKELL__ >= 900++{-# INLINE liftInteger #-}+liftInteger :: Integer -> LiftedInteger+liftInteger (IS x) = LIS (I# x)+liftInteger (IP x) =+    LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))+liftInteger (IN x) =+    LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))++{-# INLINE unliftInteger #-}+unliftInteger :: LiftedInteger -> Integer+unliftInteger (LIS (I# x)) = IS x+unliftInteger (LIP (Array (MutByteArray x) _ _)) = IP (unsafeCoerce# x)+unliftInteger (LIN (Array (MutByteArray x) _ _)) = IN (unsafeCoerce# x)++#else++{-# INLINE liftInteger #-}+liftInteger :: Integer -> LiftedInteger+liftInteger (S# x) = LIS (I# x)+liftInteger (Jp# (BN# x)) =+    LIP (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))+liftInteger (Jn# (BN# x)) =+    LIN (Array (MutByteArray (unsafeCoerce# x)) 0 (I# (sizeofByteArray# x)))++{-# INLINE unliftInteger #-}+unliftInteger :: LiftedInteger -> Integer+unliftInteger (LIS (I# x)) = S# x+unliftInteger (LIP (Array (MutByteArray x) _ _)) =+    Jp# (BN# (unsafeCoerce# x))+unliftInteger (LIN (Array (MutByteArray x) _ _)) =+    Jn# (BN# (unsafeCoerce# x))++#endif++instance Serialize Integer where+    {-# INLINE addSizeTo #-}+    addSizeTo i a = addSizeTo i (liftInteger a)++    {-# INLINE deserializeAt #-}+    deserializeAt off arr end =+        fmap unliftInteger <$> deserializeAt off arr end++    {-# INLINE serializeAt #-}+    serializeAt off arr val = serializeAt off arr (liftInteger val)
+ src/Streamly/Internal/Data/MutByteArray/Type.hs view
@@ -0,0 +1,447 @@+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE UnliftedFFITypes #-}++-- |+-- Module      : Streamly.Internal.Data.MutByteArray.Type+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.MutByteArray.Type+    (+    -- ** MutByteArray+      MutByteArray(..)+    , getMutByteArray#++    -- ** Helpers+    , touch++    -- ** Pinning+    , PinnedState(..)+    , isPinned+    , pin+    , unpin++    -- ** Allocation+    , empty+    , newAs+    , new+    , new'+    , reallocSliceAs++    -- ** Access+    , 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+--------------------------------------------------------------------------------++data PinnedState+    = Pinned+    | Unpinned deriving (Show, Eq)++-- XXX can use UnliftedNewtypes++-- | A lifted mutable byte array type wrapping @MutableByteArray# RealWorld@.+-- This is a low level array used to back high level unboxed arrays and+-- serialized data.+data MutByteArray = MutByteArray (MutableByteArray# RealWorld)++{-# DEPRECATED MutableByteArray "Please use MutByteArray instead" #-}+type MutableByteArray = MutByteArray++{-# INLINE getMutByteArray# #-}+getMutableByteArray#, getMutByteArray# :: MutByteArray -> MutableByteArray# RealWorld+getMutByteArray# (MutByteArray mbarr) = mbarr++-- | Return the size of the array in bytes.+{-# INLINE length #-}+sizeOfMutableByteArray, length :: MutByteArray -> IO Int+length (MutByteArray arr) =+    IO $ \s ->+        case getSizeofMutableByteArray# arr s of+            (# s1, i #) -> (# s1, I# i #)++{-# INLINE touch #-}+touch :: MutByteArray -> IO ()+touch (MutByteArray contents) =+    IO $ \s -> case touch# contents s of s' -> (# s', () #)++-- XXX Some functions in this module are "IO" and others are "m", we need to+-- make it consistent.++-- | 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 arr0 f = do+    arr <- liftIO $ pin arr0+    let !ptr = Ptr (byteArrayContents#+                     (unsafeCoerce# (getMutByteArray# arr)))+    r <- f ptr+    liftIO $ touch arr+    return r++{-# DEPRECATED asPtrUnsafe "Pin the array and then use unsafeAsPtr." #-}+{-# INLINE asPtrUnsafe #-}+asPtrUnsafe :: MonadIO m => MutByteArray -> (Ptr a -> m b) -> m b+asPtrUnsafe = unsafePinnedAsPtr++-- | 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 -> 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# (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.+    touch arr+    return r++--------------------------------------------------------------------------------+-- Creation+--------------------------------------------------------------------------------++{-# NOINLINE empty #-}+empty :: MutByteArray+empty = unsafePerformIO $ new 0++{-# DEPRECATED nil "Please use empty instead" #-}+nil :: MutByteArray+nil = empty++-- 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 ->+    case newByteArray# 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 =+  errorWithoutStackTrace "pinnedNewAlignedBytes: size must be >= 0"+pinnedNewAlignedBytes (I# nbytes) (I# align) = IO $ \s ->+    case newAlignedPinnedByteArray# nbytes align s of+        (# s', mbarr# #) ->+           let c = MutByteArray mbarr#+            in (# s', c #)++{-# INLINE 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+-------------------------------------------------------------------------------++-- 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+    -> MutByteArray+    -> Int+    -> Int+    -> m ()+unsafePutSlice src srcStartBytes dst dstStartBytes lenBytes = liftIO $ do+#ifdef DEBUG+    srcLen <- length src+    dstLen <- length dst+    when (srcLen - srcStartBytes < lenBytes)+        $ error $ "unsafePutSlice: src overflow: start" ++ show srcStartBytes+            ++ " end " ++ show srcLen ++ " len " ++ show lenBytes+    when (dstLen - dstStartBytes < lenBytes)+        $ 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# = 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 unsafeCloneSliceAs #-}+cloneSliceUnsafeAs, unsafeCloneSliceAs :: MonadIO m =>+    PinnedState -> Int -> Int -> MutByteArray -> m MutByteArray+unsafeCloneSliceAs ps srcOff srcLen src =+    liftIO $ do+        mba <- newAs ps srcLen+        unsafePutSlice src srcOff mba 0 srcLen+        return mba++-- | @unsafeCloneSlice offset len arr@ clones a slice of the supplied array+-- starting at the given offset and equal to the given length.+{-# INLINE unsafeCloneSlice #-}+cloneSliceUnsafe, unsafeCloneSlice :: MonadIO m => Int -> Int -> MutByteArray -> m MutByteArray+unsafeCloneSlice = unsafeCloneSliceAs Unpinned++-- | @unsafePinnedCloneSlice offset len arr@+{-# INLINE unsafePinnedCloneSlice #-}+pinnedCloneSliceUnsafe, unsafePinnedCloneSlice :: MonadIO m =>+    Int -> Int -> MutByteArray -> m MutByteArray+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+-------------------------------------------------------------------------------++-- | Return 'True' if the array is allocated in pinned memory.+{-# INLINE isPinned #-}+isPinned :: MutByteArray -> Bool+isPinned (MutByteArray arr#) =+    let pinnedInt = I# (isMutableByteArrayPinned# arr#)+     in pinnedInt /= 0+++{-# INLINE cloneMutableArrayWith# #-}+cloneMutableArrayWith#+    :: (Int# -> State# RealWorld -> (# State# RealWorld+                                     , MutableByteArray# RealWorld #))+    -> MutableByteArray# RealWorld+    -> State# RealWorld+    -> (# State# RealWorld, MutableByteArray# RealWorld #)+cloneMutableArrayWith# alloc# arr# s# =+    case getSizeofMutableByteArray# arr# s# of+        (# s1#, i# #) ->+            case alloc# i# s1# of+                (# s2#, arr1# #) ->+                    case copyMutableByteArray# arr# 0# arr1# 0# i# s2# of+                        s3# -> (# s3#, arr1# #)++-- | Return a copy of the array in pinned memory if unpinned, else return the+-- original array.+{-# INLINE pin #-}+pin :: MutByteArray -> IO MutByteArray+pin arr@(MutByteArray marr#) =+    if isPinned arr+    then return arr+    else+#ifdef DEBUG+      do+        -- XXX dump stack trace+        trace ("pin: Copying array") (return ())+#endif+        IO+             $ \s# ->+                   case cloneMutableArrayWith# newPinnedByteArray# marr# s# of+                       (# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)++-- | Return a copy of the array in unpinned memory if pinned, else return the+-- original array.+{-# INLINE unpin #-}+unpin :: MutByteArray -> IO MutByteArray+unpin arr@(MutByteArray marr#) =+    if not (isPinned arr)+    then return arr+    else+#ifdef DEBUG+      do+        -- XXX dump stack trace+        trace ("unpin: Copying array") (return ())+#endif+        IO+             $ \s# ->+                   case cloneMutableArrayWith# newByteArray# marr# s# of+                       (# s1#, marr1# #) -> (# s1#, MutByteArray marr1# #)++--------------------------------------------------------------------------------+-- 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,14 +1,3639 @@--- |--- Module      : Streamly.Internal.Data.Parser--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Parser-    ( module Streamly.Internal.Data.Parser.ParserD-    )-where--import Streamly.Internal.Data.Parser.ParserD+{-# LANGUAGE CPP #-}+{-# 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,+-- parser @recover@ is run until it stops and then we start repeating the+-- parser @collect@ again. The parser fails if the recovery parser fails.+--+-- For example, this can be used to find a key frame in a video stream after an+-- error.+--+-- /Unimplemented/+--+{-# INLINE manyThen #-}+manyThen :: -- (Foldable t, Monad m) =>+    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+manyThen _parser _recover _f = undefined++-------------------------------------------------------------------------------+-- Repeated Alternatives+-------------------------------------------------------------------------------++-- | Keep trying a parser up to a maximum of @n@ failures.  When the parser+-- fails the input consumed till now is dropped and the new instance is tried+-- on the fresh input.+--+-- /Unimplemented/+--+{-# INLINE retryMaxTotal #-}+retryMaxTotal :: -- (Monad m) =>+    Int -> Parser a m b -> Fold m b c -> Parser a m c+retryMaxTotal _n _p _f  = undefined++-- | Like 'retryMaxTotal' but aborts after @n@ successive failures.+--+-- /Unimplemented/+--+{-# INLINE retryMaxSuccessive #-}+retryMaxSuccessive :: -- (Monad m) =>+    Int -> Parser a m b -> Fold m b c -> Parser a m c+retryMaxSuccessive _n _p _f = undefined++-- | Keep trying a parser until it succeeds.  When the parser fails the input+-- consumed till now is dropped and the new instance is tried on the fresh+-- input.+--+-- /Unimplemented/+--+{-# INLINE retry #-}+retry :: -- (Monad m) =>+    Parser a m b -> Parser a m b+retry _p = undefined
− src/Streamly/Internal/Data/Parser/ParserD.hs 
@@ -1,3629 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Parser.ParserD--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Parser.ParserD-    (-    -- * Setup-    -- $setup--    -- * Types-      Parser (..)-    , ParseError (..)-    , Step (..)-    , Initial (..)--    -- * Downgrade to Fold-    , toFold--    -- First order parsers-    -- * Accumulators-    , fromFold-    , fromFoldMaybe-    , fromPure-    , fromEffect-    , die-    , dieM--    -- * Map on input-    , lmap-    , lmapM-    , postscan-    , filter--    -- * Map on output-    , rmapM--    -- * Element parsers-    , peek--    -- All of these can be expressed in terms of either-    , one-    , oneEq-    , oneNotEq-    , oneOf-    , noneOf-    , eof-    , satisfy-    , maybe-    , either--    -- * Sequence parsers (tokenizers)-    ---    -- | Parsers chained in series, if one parser terminates the composition-    -- terminates. Currently we are using folds to collect the output of the-    -- parsers but we can use Parsers instead of folds to make the composition-    -- more powerful. For example, we can do:-    ---    -- takeEndByOrMax cond n p = takeEndBy cond (take n p)-    -- takeEndByBetween cond m n p = takeEndBy cond (takeBetween m n p)-    -- takeWhileBetween cond m n p = takeWhile cond (takeBetween m n p)-    , lookAhead--    -- ** By length-    -- | Grab a sequence of input elements without inspecting them-    , takeBetween-    -- , take -- takeBetween 0 n-    , takeEQ -- takeBetween n n-    , takeGE -- takeBetween n maxBound-    -- , takeGE1 -- take1 -- takeBetween 1 n-    , takeP--    -- Grab a sequence of input elements by inspecting them-    -- ** Exact match-    , listEq-    , listEqBy-    , streamEqBy-    , subsequenceBy--    -- ** By predicate-    , takeWhile-    , takeWhileP-    , takeWhile1-    , dropWhile--    -- ** Separated by elements-    -- | Separator could be in prefix postion ('takeStartBy'), or suffix-    -- position ('takeEndBy'). See 'deintercalate', 'sepBy' etc for infix-    -- separator parsing, also see 'intersperseQuotedBy' fold.--    -- These can be implemented modularly with refolds, using takeWhile and-    -- satisfy.-    , takeEndBy-    , takeEndBy_-    , takeEndByEsc-    -- , takeEndByEsc_-    , takeStartBy-    , takeStartBy_-    , takeEitherSepBy-    , wordBy--    -- ** Grouped by element comparison-    , groupBy-    , groupByRolling-    , groupByRollingEither--    -- ** Framed by elements-    -- | Also see 'intersperseQuotedBy' fold.-    -- Framed by a one or more ocurrences of a separator around a word like-    -- spaces or quotes. No nesting.-    , wordFramedBy -- XXX Remove this? Covered by wordWithQuotes?-    , wordWithQuotes-    , wordKeepQuotes-    , wordProcessQuotes--    -- Framed by separate start and end characters, potentially nested.-    -- blockWithQuotes allows quotes inside a block. However,-    -- takeFramedByGeneric can be used to express takeStartBy, takeEndBy and-    -- block with escaping.-    -- , takeFramedBy-    , takeFramedBy_-    , takeFramedByEsc_-    , takeFramedByGeneric-    , blockWithQuotes--    -- Matching strings-    -- , prefixOf -- match any prefix of a given string-    -- , suffixOf -- match any suffix of a given string-    -- , infixOf -- match any substring of a given string--    -- ** Spanning-    , span-    , spanBy-    , spanByRolling--    -- Second order parsers (parsers using parsers)-    -- * Binary Combinators--    -- ** Sequential Applicative-    , splitWith-    , split_--    {--    -- ** Parallel Applicatives-    , teeWith-    , teeWithFst-    , teeWithMin-    -- , teeTill -- like manyTill but parallel-    -}--    -- ** Sequential Alternative-    , alt--    {--    -- ** Parallel Alternatives-    , shortest-    , longest-    -- , fastest-    -}--    -- * N-ary Combinators-    -- ** Sequential Collection-    , sequence-    , concatMap--    -- ** Sequential Repetition-    , count-    , countBetween-    -- , countBetweenTill-    , manyP-    , many-    , some--    -- ** Interleaved Repetition-    -- Use two folds, run a primary parser, its rejected values go to the-    -- secondary parser.-    , deintercalate-    , deintercalate1-    , deintercalateAll-    -- , deintercalatePrefix-    -- , deintercalateSuffix--    -- *** Special cases-    -- | TODO: traditional implmentations of these may be of limited use. For-    -- example, consider parsing lines separated by @\\r\\n@. The main parser-    -- will have to detect and exclude the sequence @\\r\\n@ anyway so that we-    -- can apply the "sep" parser.-    ---    -- We can instead implement these as special cases of deintercalate.-    ---    -- @-    -- , endBy-    -- , sepEndBy-    -- , beginBy-    -- , sepBeginBy-    -- , sepAroundBy-    -- @-    , sepBy1-    , sepBy-    , sepByAll--    , manyTillP-    , manyTill-    , manyThen--    -- -- * Distribution-    ---    -- A simple and stupid impl would be to just convert the stream to an array-    -- and give the array reference to all consumers. The array can be grown on-    -- demand by any consumer and truncated when nonbody needs it.-    ---    -- -- ** Distribute to collection-    -- -- ** Distribute to repetition--    -- ** Interleaved collection-    -- |-    ---    -- 1. Round robin-    -- 2. Priority based-    , roundRobin--    -- -- ** Interleaved repetition-    -- repeat one parser and when it fails run an error recovery parser-    -- e.g. to find a key frame in the stream after an error--    -- ** Collection of Alternatives-    -- | Unimplemented-    ---    -- @-    -- , shortestN-    -- , longestN-    -- , fastestN -- first N successful in time-    -- , choiceN  -- first N successful in position-    -- @-    -- , choice   -- first successful in position--    -- ** Repeated Alternatives-    , retryMaxTotal-    , retryMaxSuccessive-    , retry--    -- ** Zipping Input-    , zipWithM-    , zip-    , indexed-    , makeIndexFilter-    , sampleFromthen--     -- * Deprecated-    , next-    )-where--#include "inline.hs"-#include "assert.hs"--import Control.Monad (when)-import Data.Bifunctor (first)-import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.SVar.Type (defState)-import Streamly.Internal.Data.Either.Strict (Either'(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)--import qualified Data.Foldable as Foldable-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D--import Prelude hiding-       (any, all, take, takeWhile, sequence, concatMap, maybe, either, span-       , zip, filter, dropWhile)--- import Streamly.Internal.Data.Parser.ParserD.Tee-import Streamly.Internal.Data.Parser.ParserD.Type--#include "DocTestDataParser.hs"------------------------------------------------------------------------------------ Downgrade a parser to a Fold------------------------------------------------------------------------------------ | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the--- parser fails or tries to backtrack.------ This can be useful in combinators that accept a Fold and we know that a--- Parser cannot fail or failure exception is acceptable as there is no way to--- recover.------ /Pre-release/----{-# INLINE toFold #-}-toFold :: Monad m => Parser a m b -> Fold m a b-toFold (Parser pstep pinitial pextract) = Fold step initial extract--    where--    initial = do-        r <- pinitial-        case r of-            IPartial s -> return $ FL.Partial s-            IDone b -> return $ FL.Done b-            IError err ->-                error $ "toFold: parser throws error in initial" ++ err--    perror n = error $ "toFold: parser backtracks in Partial: " ++ show n-    cerror n = error $ "toFold: parser backtracks in Continue: " ++ show n-    derror n = error $ "toFold: parser backtracks in Done: " ++ show n-    eerror err = error $ "toFold: parser throws error: " ++ err--    step st a = do-        r <- pstep st a-        case r of-            Partial 0 s -> return $ FL.Partial s-            Continue 0 s -> return $ FL.Partial s-            Done 0 b -> return $ FL.Done b-            Partial n _ -> perror n-            Continue n _ -> cerror n-            Done n _ -> derror n-            Error err -> eerror err--    extract st = do-        r <- pextract st-        case r of-            Done 0 b -> return b-            Partial n _ -> perror n-            Continue n _ -> cerror n-            Done n _ -> derror n-            Error err -> eerror err------------------------------------------------------------------------------------ Upgrade folds to parses------------------------------------------------------------------------------------ | Make a 'Parser' from a 'Fold'. This parser sends all of its input to the--- fold.----{-# INLINE fromFold #-}-fromFold :: Monad m => Fold m a b -> Parser a m b-fromFold (Fold fstep finitial fextract) = Parser step initial extract--    where--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s1 -> IPartial s1-                  FL.Done b -> IDone b--    step s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 s1-                  FL.Done b -> Done 0 b--    extract = fmap (Done 0) . fextract---- | Convert a Maybe returning fold to an error returning parser. The first--- argument is the error message that the parser would return when the fold--- returns Nothing.------ /Pre-release/----{-# INLINE fromFoldMaybe #-}-fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b-fromFoldMaybe errMsg (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s1 -> IPartial s1-                  FL.Done b ->-                        case b of-                            Just x -> IDone x-                            Nothing -> IError errMsg--    step s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 s1-                  FL.Done b ->-                        case b of-                            Just x -> Done 0 x-                            Nothing -> Error errMsg--    extract s = do-        res <- fextract s-        case res of-            Just x -> return $ Done 0 x-            Nothing -> return $ Error errMsg------------------------------------------------------------------------------------ Failing Parsers------------------------------------------------------------------------------------ | Peek the head element of a stream, without consuming it. Fails if it--- encounters end of input.------ >>> Stream.parse ((,) <$> Parser.peek <*> Parser.satisfy (> 0)) $ Stream.fromList [1]--- Right (1,1)------ @--- peek = lookAhead (satisfy True)--- @----{-# INLINE peek #-}-peek :: Monad m => Parser a m a-peek = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $ Done 1 a--    extract () = return $ Error "peek: end of input"---- | Succeeds if we are at the end of input, fails otherwise.------ >>> Stream.parse ((,) <$> Parser.satisfy (> 0) <*> Parser.eof) $ Stream.fromList [1]--- Right (1,())----{-# INLINE eof #-}-eof :: Monad m => Parser a m ()-eof = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () _ = return $ Error "eof: not at end of input"--    extract () = return $ Done 0 ()---- | Return the next element of the input. Returns 'Nothing'--- on end of input. Also known as 'head'.------ /Pre-release/----{-# DEPRECATED next "Please use \"fromFold Fold.one\" instead" #-}-{-# INLINE next #-}-next :: Monad m => Parser a m (Maybe a)-next = Parser step initial extract--  where--  initial = pure $ IPartial ()--  step () a = pure $ Done 0 (Just a)--  extract () = pure $ Done 0 Nothing---- | Map an 'Either' returning function on the next element in the stream.  If--- the function returns 'Left err', the parser fails with the error message--- @err@ otherwise returns the 'Right' value.------ /Pre-release/----{-# INLINE either #-}-either :: Monad m => (a -> Either String b) -> Parser a m b-either f = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        case f a of-            Right b -> Done 0 b-            Left err -> Error err--    extract () = return $ Error "end of input"---- | Map a 'Maybe' returning function on the next element in the stream. The--- parser fails if the function returns 'Nothing' otherwise returns the 'Just'--- value.------ >>> toEither = Maybe.maybe (Left "maybe: predicate failed") Right--- >>> maybe f = Parser.either (toEither . f)------ >>> maybe f = Parser.fromFoldMaybe "maybe: predicate failed" (Fold.maybe f)------ /Pre-release/----{-# INLINE maybe #-}-maybe :: Monad m => (a -> Maybe b) -> Parser a m b--- maybe f = either (Maybe.maybe (Left "maybe: predicate failed") Right . f)-maybe parserF = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        case parserF a of-            Just b -> Done 0 b-            Nothing -> Error "maybe: predicate failed"--    extract () = return $ Error "maybe: end of input"---- | Returns the next element if it passes the predicate, fails otherwise.------ >>> Stream.parse (Parser.satisfy (== 1)) $ Stream.fromList [1,0,1]--- Right 1------ >>> toMaybe f x = if f x then Just x else Nothing--- >>> satisfy f = Parser.maybe (toMaybe f)----{-# INLINE satisfy #-}-satisfy :: Monad m => (a -> Bool) -> Parser a m a--- satisfy predicate = maybe (\a -> if predicate a then Just a else Nothing)-satisfy predicate = Parser step initial extract--    where--    initial = return $ IPartial ()--    step () a = return $-        if predicate a-        then Done 0 a-        else Error "satisfy: predicate failed"--    extract () = return $ Error "satisfy: end of input"---- | Consume one element from the head of the stream.  Fails if it encounters--- end of input.------ >>> one = Parser.satisfy $ const True----{-# INLINE one #-}-one :: Monad m => Parser a m a-one = satisfy $ const True---- Alternate names: "only", "onlyThis".---- | Match a specific element.------ >>> oneEq x = Parser.satisfy (== x)----{-# INLINE oneEq #-}-oneEq :: (Monad m, Eq a) => a -> Parser a m a-oneEq x = satisfy (== x)---- Alternate names: "exclude", "notThis".---- | Match anything other than the supplied element.------ >>> oneNotEq x = Parser.satisfy (/= x)----{-# INLINE oneNotEq #-}-oneNotEq :: (Monad m, Eq a) => a -> Parser a m a-oneNotEq x = satisfy (/= x)---- | Match any one of the elements in the supplied list.------ >>> oneOf xs = Parser.satisfy (`Foldable.elem` xs)------ When performance matters a pattern matching predicate could be more--- efficient than a 'Foldable' datatype:------ @--- let p x =---    case x of---       'a' -> True---       'e' -> True---        _  -> False--- in satisfy p--- @------ GHC may use a binary search instead of linear search in the list.--- Alternatively, you can also use an array instead of list for storage and--- search.----{-# INLINE oneOf #-}-oneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a-oneOf xs = satisfy (`Foldable.elem` xs)---- | See performance notes in 'oneOf'.------ >>> noneOf xs = Parser.satisfy (`Foldable.notElem` xs)----{-# INLINE noneOf #-}-noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a-noneOf xs = satisfy (`Foldable.notElem` xs)------------------------------------------------------------------------------------ Taking elements------------------------------------------------------------------------------------ Required to fuse "take" with "many" in "chunksOf", for ghc-9.x-{-# ANN type Tuple'Fused Fuse #-}-data Tuple'Fused a b = Tuple'Fused !a !b deriving Show---- | @takeBetween m n@ takes a minimum of @m@ and a maximum of @n@ input--- elements and folds them using the supplied fold.------ Stops after @n@ elements.--- Fails if the stream ends before @m@ elements could be taken.------ Examples: ------- @--- >>> :{---   takeBetween' low high ls = Stream.parse prsr (Stream.fromList ls)---     where prsr = Parser.takeBetween low high Fold.toList--- :}------ @------ >>> takeBetween' 2 4 [1, 2, 3, 4, 5]--- Right [1,2,3,4]------ >>> takeBetween' 2 4 [1, 2]--- Right [1,2]------ >>> takeBetween' 2 4 [1]--- Left (ParseError "takeBetween: Expecting alteast 2 elements, got 1")------ >>> takeBetween' 0 0 [1, 2]--- Right []------ >>> takeBetween' 0 1 []--- Right []------ @takeBetween@ is the most general take operation, other take operations can--- be defined in terms of takeBetween. For example:------ >>> take n = Parser.takeBetween 0 n--- >>> takeEQ n = Parser.takeBetween n n--- >>> takeGE n = Parser.takeBetween n maxBound------ /Pre-release/----{-# INLINE takeBetween #-}-takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b-takeBetween low high (Fold fstep finitial fextract) =--    Parser step initial (extract streamErr)--    where--    streamErr i =-           "takeBetween: Expecting alteast " ++ show low-        ++ " elements, got " ++ show i--    invalidRange =-        "takeBetween: lower bound - " ++ show low-            ++ " is greater than higher bound - " ++ show high--    foldErr :: Int -> String-    foldErr i =-        "takeBetween: the collecting fold terminated after"-            ++ " consuming" ++ show i ++ " elements"-            ++ " minimum" ++ show low ++ " elements needed"--    -- Exactly the same as snext except different constructors, we can possibly-    -- deduplicate the two.-    {-# INLINE inext #-}-    inext i res =-        let i1 = i + 1-        in case res of-            FL.Partial s -> do-                let s1 = Tuple'Fused i1 s-                if i1 < high-                -- XXX ideally this should be a Continue instead-                then return $ IPartial s1-                else iextract foldErr s1-            FL.Done b ->-                return-                    $ if i1 >= low-                      then IDone b-                      else IError (foldErr i1)--    initial = do-        when (low >= 0 && high >= 0 && low > high)-            $ error invalidRange--        finitial >>= inext (-1)--    -- Keep the impl same as inext-    {-# INLINE snext #-}-    snext i res =-        let i1 = i + 1-        in case res of-            FL.Partial s -> do-                let s1 = Tuple'Fused i1 s-                if i1 < high-                then return $ Continue 0 s1-                else extract foldErr s1-            FL.Done b ->-                return-                    $ if i1 >= low-                      then Done 0 b-                      else Error (foldErr i1)--    step (Tuple'Fused i s) a = fstep s a >>= snext i--    extract f (Tuple'Fused i s)-        | i >= low && i <= high = fmap (Done 0) (fextract s)-        | otherwise = return $ Error (f i)--    -- XXX Need to make Initial return type Step to deduplicate this-    iextract f (Tuple'Fused i s)-        | i >= low && i <= high = fmap IDone (fextract s)-        | otherwise = return $ IError (f i)---- | Stops after taking exactly @n@ input elements.------ * Stops - after consuming @n@ elements.--- * Fails - if the stream or the collecting fold ends before it can collect---           exactly @n@ elements.------ >>> Stream.parse (Parser.takeEQ 2 Fold.toList) $ Stream.fromList [1,0,1]--- Right [1,0]------ >>> Stream.parse (Parser.takeEQ 4 Fold.toList) $ Stream.fromList [1,0,1]--- Left (ParseError "takeEQ: Expecting exactly 4 elements, input terminated on 3")----{-# INLINE takeEQ #-}-takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b-takeEQ n (Fold fstep finitial fextract) = Parser step initial extract--    where--    initial = do-        res <- finitial-        case res of-            FL.Partial s ->-                if n > 0-                then return $ IPartial $ Tuple'Fused 1 s-                else fmap IDone (fextract s)-            FL.Done b -> return $-                if n > 0-                then IError-                         $ "takeEQ: Expecting exactly " ++ show n-                             ++ " elements, fold terminated without"-                             ++ " consuming any elements"-                else IDone b--    step (Tuple'Fused i1 r) a = do-        res <- fstep r a-        if n > i1-        then-            return-                $ case res of-                    FL.Partial s -> Continue 0 $ Tuple'Fused (i1 + 1) s-                    FL.Done _ ->-                        Error-                            $ "takeEQ: Expecting exactly " ++ show n-                                ++ " elements, fold terminated on " ++ show i1-        else-            -- assert (n == i1)-            Done 0-                <$> case res of-                        FL.Partial s -> fextract s-                        FL.Done b -> return b--    extract (Tuple'Fused i _) =-        -- Using the count "i" in the message below causes large performance-        -- regression unless we use Fuse annotation on Tuple.-        return-            $ Error-            $ "takeEQ: Expecting exactly " ++ show n-                ++ " elements, input terminated on " ++ show (i - 1)--{-# ANN type TakeGEState Fuse #-}-data TakeGEState s =-      TakeGELT !Int !s-    | TakeGEGE !s---- | Take at least @n@ input elements, but can collect more.------ * Stops - when the collecting fold stops.--- * Fails - if the stream or the collecting fold ends before producing @n@---           elements.------ >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1]--- Left (ParseError "takeGE: Expecting at least 4 elements, input terminated on 3")------ >>> Stream.parse (Parser.takeGE 4 Fold.toList) $ Stream.fromList [1,0,1,0,1]--- Right [1,0,1,0,1]------ /Pre-release/----{-# INLINE takeGE #-}-takeGE :: Monad m => Int -> Fold m a b -> Parser a m b-takeGE n (Fold fstep finitial fextract) = Parser step initial extract--    where--    initial = do-        res <- finitial-        case res of-            FL.Partial s ->-                if n > 0-                then return $ IPartial $ TakeGELT 1 s-                else return $ IPartial $ TakeGEGE s-            FL.Done b -> return $-                if n > 0-                then IError-                         $ "takeGE: Expecting at least " ++ show n-                             ++ " elements, fold terminated without"-                             ++ " consuming any elements"-                else IDone b--    step (TakeGELT i1 r) a = do-        res <- fstep r a-        if n > i1-        then-            return-                $ case res of-                      FL.Partial s -> Continue 0 $ TakeGELT (i1 + 1) s-                      FL.Done _ ->-                        Error-                            $ "takeGE: Expecting at least " ++ show n-                                ++ " elements, fold terminated on " ++ show i1-        else-            -- assert (n <= i1)-            return-                $ case res of-                      FL.Partial s -> Partial 0 $ TakeGEGE s-                      FL.Done b -> Done 0 b-    step (TakeGEGE r) a = do-        res <- fstep r a-        return-            $ case res of-                  FL.Partial s -> Partial 0 $ TakeGEGE s-                  FL.Done b -> Done 0 b--    extract (TakeGELT i _) =-        return-            $ Error-            $ "takeGE: Expecting at least " ++ show n-                ++ " elements, input terminated on " ++ show (i - 1)-    extract (TakeGEGE r) = fmap (Done 0) $ fextract r------------------------------------------------------------------------------------ Conditional splitting------------------------------------------------------------------------------------ XXX We should perhaps use only takeWhileP and rename it to takeWhile.---- | Like 'takeWhile' but uses a 'Parser' instead of a 'Fold' to collect the--- input. The combinator stops when the condition fails or if the collecting--- parser stops.------ Other interesting parsers can be implemented in terms of this parser:------ >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)--- >>> takeWhileBetween cond m n p = Parser.takeWhileP cond (Parser.takeBetween m n p)------ Stops: when the condition fails or the collecting parser stops.--- Fails: when the collecting parser fails.------ /Pre-release/----{-# INLINE takeWhileP #-}-takeWhileP :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b-takeWhileP predicate (Parser pstep pinitial pextract) =-    Parser step pinitial pextract--    where--    step s a =-        if predicate a-        then pstep s a-        else do-            r <- pextract s-            -- XXX need a map on count-            case r of-                Error err -> return $ Error err-                Done n s1 -> return $ Done (n + 1) s1-                Partial _ _ -> error "Bug: takeWhileP: Partial in extract"-                Continue n s1 -> return $ Continue (n + 1) s1---- | Collect stream elements until an element fails the predicate. The element--- on which the predicate fails is returned back to the input stream.------ * Stops - when the predicate fails or the collecting fold stops.--- * Fails - never.------ >>> Stream.parse (Parser.takeWhile (== 0) Fold.toList) $ Stream.fromList [0,0,1,0,1]--- Right [0,0]------ >>> takeWhile cond f = Parser.takeWhileP cond (Parser.fromFold f)------ We can implement a @breakOn@ using 'takeWhile':------ @--- breakOn p = takeWhile (not p)--- @----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b--- takeWhile cond f = takeWhileP cond (fromFold f)-takeWhile predicate (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return $ case res of-            FL.Partial s -> IPartial s-            FL.Done b -> IDone b--    step s a =-        if predicate a-        then do-            fres <- fstep s a-            return-                $ case fres of-                      FL.Partial s1 -> Partial 0 s1-                      FL.Done b -> Done 0 b-        else Done 1 <$> fextract s--    extract s = fmap (Done 0) (fextract s)--{---- XXX This may not be composable because of the b argument. We can instead--- return a "Reparse b a m b" so that those can be composed.-{-# INLINE takeWhile1X #-}-takeWhile1 :: Monad m => b -> (a -> Bool) -> Refold m b a b -> Parser a m b--- We can implement this using satisfy and takeWhile. We can use "satisfy--- p", fold the result with the refold and then use the "takeWhile p" and--- fold that using the refold.-takeWhile1 acc cond f = undefined--}---- | Like 'takeWhile' but takes at least one element otherwise fails.------ >>> takeWhile1 cond p = Parser.takeWhileP cond (Parser.takeBetween 1 maxBound p)----{-# INLINE takeWhile1 #-}-takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b--- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)-takeWhile1 predicate (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return $ case res of-            FL.Partial s -> IPartial (Left' s)-            FL.Done _ ->-                IError-                    $ "takeWhile1: fold terminated without consuming:"-                          ++ " any element"--    {-# INLINE process #-}-    process s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 (Right' s1)-                  FL.Done b -> Done 0 b--    step (Left' s) a =-        if predicate a-        then process s a-        else return $ Error "takeWhile1: predicate failed on first element"-    step (Right' s) a =-        if predicate a-        then process s a-        else do-            b <- fextract s-            return $ Done 1 b--    extract (Left' _) = return $ Error "takeWhile1: end of input"-    extract (Right' s) = fmap (Done 0) (fextract s)---- | Drain the input as long as the predicate succeeds, running the effects and--- discarding the results.------ This is also called @skipWhile@ in some parsing libraries.------ >>> dropWhile p = Parser.takeWhile p Fold.drain----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Parser a m ()-dropWhile p = takeWhile p FL.drain------------------------------------------------------------------------------------ Separators----------------------------------------------------------------------------------{-# ANN type FramedEscState Fuse #-}-data FramedEscState s =-    FrameEscInit !s | FrameEscGo !s !Int | FrameEscEsc !s !Int---- XXX We can remove Maybe from esc-{-# INLINE takeFramedByGeneric #-}-takeFramedByGeneric :: Monad m =>-       Maybe (a -> Bool) -- is escape char?-    -> Maybe (a -> Bool) -- is frame begin?-    -> Maybe (a -> Bool) -- is frame end?-    -> Fold m a b-    -> Parser a m b-takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (FrameEscInit s)-                FL.Done _ ->-                    error "takeFramedByGeneric: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)-                FL.Done b -> Done 0 b--    {-# INLINE processNoEsc #-}-    processNoEsc s a n =-        case end of-            Just isEnd ->-                case begin of-                    Just isBegin ->-                        -- takeFramedBy case-                        if isEnd a-                        then-                            if n == 0-                            then Done 0 <$> fextract s-                            else process s a (n - 1)-                        else-                            let n1 = if isBegin a then n + 1 else n-                             in process s a n1-                    Nothing -> -- takeEndBy case-                        if isEnd a-                        then Done 0 <$> fextract s-                        else process s a n-            Nothing -> -- takeStartBy case-                case begin of-                    Just isBegin ->-                        if isBegin a-                        then Done 0 <$> fextract s-                        else process s a n-                    Nothing ->-                        error $ "takeFramedByGeneric: "-                            ++ "Both begin and end frame predicate missing"--    {-# INLINE processCheckEsc #-}-    processCheckEsc s a n =-        case esc of-            Just isEsc ->-                if isEsc a-                then return $ Partial 0 $ FrameEscEsc s n-                else processNoEsc s a n-            Nothing -> processNoEsc s a n--    step (FrameEscInit s) a =-        case begin of-            Just isBegin ->-                if isBegin a-                then return $ Partial 0 (FrameEscGo s 0)-                else return $ Error "takeFramedByGeneric: missing frame start"-            Nothing ->-                case end of-                    Just isEnd ->-                        if isEnd a-                        then Done 0 <$> fextract s-                        else processCheckEsc s a 0-                    Nothing ->-                        error "Both begin and end frame predicate missing"-    step (FrameEscGo s n) a = processCheckEsc s a n-    step (FrameEscEsc s n) a = process s a n--    err = return . Error--    extract (FrameEscInit _) =-        err "takeFramedByGeneric: empty token"-    extract (FrameEscGo s _) =-        case begin of-            Just _ ->-                case end of-                    Nothing -> fmap (Done 0) $ fextract s-                    Just _ -> err "takeFramedByGeneric: missing frame end"-            Nothing -> err "takeFramedByGeneric: missing closing frame"-    extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"--data BlockParseState s =-      BlockInit !s-    | BlockUnquoted !Int !s-    | BlockQuoted !Int !s-    | BlockQuotedEsc !Int !s---- Blocks can be of different types e.g. {} or (). We only parse from the--- perspective of the outermost block type. The nesting of that block are--- checked. Any other block types nested inside it are opaque to us and can be--- parsed when the contents of the block are parsed.---- XXX Put a limit on nest level to keep the API safe.---- | Parse a block enclosed within open, close brackets. Block contents may be--- quoted, brackets inside quotes are ignored. Quoting characters can be used--- within quotes if escaped. A block can have a nested block inside it.------ Quote begin and end chars are the same. Block brackets and quote chars must--- not overlap. Block start and end brackets must be different for nesting--- blocks within blocks.------ >>> p = Parser.blockWithQuotes (== '\\') (== '"') '{' '}' Fold.toList--- >>> Stream.parse p $ Stream.fromList "{msg: \"hello world\"}"--- Right "msg: \"hello world\""----{-# INLINE blockWithQuotes #-}-blockWithQuotes :: (Monad m, Eq a) =>-       (a -> Bool)  -- ^ escape char-    -> (a -> Bool)  -- ^ quote char, to quote inside brackets-    -> a  -- ^ Block opening bracket-    -> a  -- ^ Block closing bracket-    -> Fold m a b-    -> Parser a m b-blockWithQuotes isEsc isQuote bopen bclose-    (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (BlockInit s)-                FL.Done _ ->-                    error "blockWithQuotes: fold finished without input"--    {-# INLINE process #-}-    process s a nextState = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (nextState s1)-                FL.Done b -> Done 0 b--    step (BlockInit s) a =-        return-            $ if a == bopen-              then Continue 0 $ BlockUnquoted 1 s-              else Error "blockWithQuotes: missing block start"-    step (BlockUnquoted level s) a-        | a == bopen = process s a (BlockUnquoted (level + 1))-        | a == bclose =-            if level == 1-            then fmap (Done 0) (fextract s)-            else process s a (BlockUnquoted (level - 1))-        | isQuote a = process s a (BlockQuoted level)-        | otherwise = process s a (BlockUnquoted level)-    step (BlockQuoted level s) a-        | isEsc a = process s a (BlockQuotedEsc level)-        | otherwise =-            if isQuote a-            then process s a (BlockUnquoted level)-            else process s a (BlockQuoted level)-    step (BlockQuotedEsc level s) a = process s a (BlockQuoted level)--    err = return . Error--    extract (BlockInit s) = fmap (Done 0) $ fextract s-    extract (BlockUnquoted level _) =-        err $ "blockWithQuotes: finished at block nest level " ++ show level-    extract (BlockQuoted level _) =-        err $ "blockWithQuotes: finished, inside an unfinished quote, "-            ++ "at block nest level " ++ show level-    extract (BlockQuotedEsc level _) =-        err $ "blockWithQuotes: finished, inside an unfinished quote, "-            ++ "after an escape char, at block nest level " ++ show level---- | @takeEndBy cond parser@ parses a token that ends by a separator chosen by--- the supplied predicate. The separator is also taken with the token.------ This can be combined with other parsers to implement other interesting--- parsers as follows:------ >>> takeEndByLE cond n p = Parser.takeEndBy cond (Parser.fromFold $ Fold.take n p)--- >>> takeEndByBetween cond m n p = Parser.takeEndBy cond (Parser.takeBetween m n p)------ >>> takeEndBy = Parser.takeEndByEsc (const False)------ See also "Streamly.Data.Fold.takeEndBy". Unlike the fold, the collecting--- parser in the takeEndBy parser can decide whether to fail or not if the--- stream does not end with separator.------ /Pre-release/----{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b--- takeEndBy = takeEndByEsc (const False)-takeEndBy cond (Parser pstep pinitial pextract) =--    Parser step initial pextract--    where--    initial = pinitial--    step s a = do-        res <- pstep s a-        if not (cond a)-        then return res-        else extractStep pextract res---- | Like 'takeEndBy' but the separator elements can be escaped using an--- escape char determined by the first predicate. The escape characters are--- removed.------ /pre-release/-{-# INLINE takeEndByEsc #-}-takeEndByEsc :: Monad m =>-    (a -> Bool) -> (a -> Bool) -> Parser a m b -> Parser a m b-takeEndByEsc isEsc isSep (Parser pstep pinitial pextract) =--    Parser step initial extract--    where--    initial = first Left' <$> pinitial--    step (Left' s) a = do-        if isEsc a-        then return $ Partial 0 $ Right' s-        else do-            res <- pstep s a-            if not (isSep a)-            then return $ first Left' res-            else fmap (first Left') $ extractStep pextract res--    step (Right' s) a = do-        res <- pstep s a-        return $ first Left' res--    extract (Left' s) = fmap (first Left') $ pextract s-    extract (Right' _) =-        return $ Error "takeEndByEsc: trailing escape"---- | Like 'takeEndBy' but the separator is dropped.------ See also "Streamly.Data.Fold.takeEndBy_".------ /Pre-release/----{-# INLINE takeEndBy_ #-}-takeEndBy_ :: (a -> Bool) -> Parser a m b -> Parser a m b-{--takeEndBy_ isEnd p =-    takeFramedByGeneric Nothing Nothing (Just isEnd) (toFold p)--}-takeEndBy_ cond (Parser pstep pinitial pextract) =--    Parser step pinitial pextract--    where--    step s a =-        if cond a-        then pextract s-        else pstep s a---- | Take either the separator or the token. Separator is a Left value and--- token is Right value.------ /Unimplemented/-{-# INLINE takeEitherSepBy #-}-takeEitherSepBy :: -- Monad m =>-    (a -> Bool) -> Fold m (Either a b) c -> Parser a m c-takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond---- | Parse a token that starts with an element chosen by the predicate.  The--- parser fails if the input does not start with the selected element.------ * Stops - when the predicate succeeds in non-leading position.--- * Fails - when the predicate fails in the leading position.------ >>> splitWithPrefix p f = Stream.parseMany (Parser.takeStartBy p f)------ Examples: ------- >>> p = Parser.takeStartBy (== ',') Fold.toList--- >>> leadingComma = Stream.parse p . Stream.fromList--- >>> leadingComma "a,b"--- Left (ParseError "takeStartBy: missing frame start")--- ...--- >>> leadingComma ",,"--- Right ","--- >>> leadingComma ",a,b"--- Right ",a"--- >>> leadingComma ""--- Right ""------ /Pre-release/----{-# INLINE takeStartBy #-}-takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b-takeStartBy cond (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (Left' s)-                FL.Done _ -> IError "takeStartBy: fold done without input"--    {-# INLINE process #-}-    process s a = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Partial 0 (Right' s1)-                FL.Done b -> Done 0 b--    step (Left' s) a =-        if cond a-        then process s a-        else return $ Error "takeStartBy: missing frame start"-    step (Right' s) a =-        if not (cond a)-        then process s a-        else Done 1 <$> fextract s--    extract (Left' s) = fmap (Done 0) $ fextract s-    extract (Right' s) = fmap (Done 0) $ fextract s---- | Like 'takeStartBy' but drops the separator.------ >>> takeStartBy_ isBegin = Parser.takeFramedByGeneric Nothing (Just isBegin) Nothing----{-# INLINE takeStartBy_ #-}-takeStartBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b-takeStartBy_ isBegin = takeFramedByGeneric Nothing (Just isBegin) Nothing---- | @takeFramedByEsc_ isEsc isBegin isEnd fold@ parses a token framed using a--- begin and end predicate, and an escape character. The frame begin and end--- characters lose their special meaning if preceded by the escape character.------ Nested frames are allowed if begin and end markers are different, nested--- frames must be balanced unless escaped, nested frame markers are emitted as--- it is.------ For example,------ >>> p = Parser.takeFramedByEsc_ (== '\\') (== '{') (== '}') Fold.toList--- >>> Stream.parse p $ Stream.fromList "{hello}"--- Right "hello"--- >>> Stream.parse p $ Stream.fromList "{hello {world}}"--- Right "hello {world}"--- >>> Stream.parse p $ Stream.fromList "{hello \\{world}"--- Right "hello {world"--- >>> Stream.parse p $ Stream.fromList "{hello {world}"--- Left (ParseError "takeFramedByEsc_: missing frame end")------ /Pre-release/-{-# INLINE takeFramedByEsc_ #-}-takeFramedByEsc_ :: Monad m =>-    (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b--- takeFramedByEsc_ isEsc isEnd p =---    takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)-takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (FrameEscInit s)-                FL.Done _ ->-                    error "takeFramedByEsc_: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (FrameEscGo s1 n)-                FL.Done b -> Done 0 b--    step (FrameEscInit s) a =-        if isBegin a-        then return $ Partial 0 (FrameEscGo s 0)-        else return $ Error "takeFramedByEsc_: missing frame start"-    step (FrameEscGo s n) a =-        if isEsc a-        then return $ Partial 0 $ FrameEscEsc s n-        else do-            if not (isEnd a)-            then-                let n1 = if isBegin a then n + 1 else n-                 in process s a n1-            else-                if n == 0-                then Done 0 <$> fextract s-                else process s a (n - 1)-    step (FrameEscEsc s n) a = process s a n--    err = return . Error--    extract (FrameEscInit _) = err "takeFramedByEsc_: empty token"-    extract (FrameEscGo _ _) = err "takeFramedByEsc_: missing frame end"-    extract (FrameEscEsc _ _) = err "takeFramedByEsc_: trailing escape"--data FramedState s = FrameInit !s | FrameGo !s Int---- | @takeFramedBy_ isBegin isEnd fold@ parses a token framed by a begin and an--- end predicate.------ >>> takeFramedBy_ = Parser.takeFramedByEsc_ (const False)----{-# INLINE takeFramedBy_ #-}-takeFramedBy_ :: Monad m =>-    (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b--- takeFramedBy_ isBegin isEnd =---    takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)-takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =--    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (FrameInit s)-                FL.Done _ ->-                    error "takeFramedBy_: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (FrameGo s1 n)-                FL.Done b -> Done 0 b--    step (FrameInit s) a =-        if isBegin a-        then return $ Continue 0 (FrameGo s 0)-        else return $ Error "takeFramedBy_: missing frame start"-    step (FrameGo s n) a-        | not (isEnd a) =-            let n1 = if isBegin a then n + 1 else n-             in process s a n1-        | n == 0 = Done 0 <$> fextract s-        | otherwise = process s a (n - 1)--    err = return . Error--    extract (FrameInit _) = err "takeFramedBy_: empty token"-    extract (FrameGo _ _) = err "takeFramedBy_: missing frame end"------------------------------------------------------------------------------------ Grouping and words----------------------------------------------------------------------------------data WordByState s b = WBLeft !s | WBWord !s | WBRight !b---- Note we can also get words using something like:--- sepBy FL.toList (takeWhile (not . p) Fold.toList) (dropWhile p)------ But that won't be as efficient and ergonomic.---- | Like 'splitOn' but strips leading, trailing, and repeated separators.--- Therefore, @".a..b."@ having '.' as the separator would be parsed as--- @["a","b"]@.  In other words, its like parsing words from whitespace--- separated text.------ * Stops - when it finds a word separator after a non-word element--- * Fails - never.------ >>> wordBy = Parser.wordFramedBy (const False) (const False) (const False)------ @--- S.wordsBy pred f = S.parseMany (PR.wordBy pred f)--- @----{-# INLINE wordBy #-}-wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b-wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract--    where--    {-# INLINE worder #-}-    worder s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Partial s1 -> Partial 0 $ WBWord s1-                  FL.Done b -> Done 0 b--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s -> IPartial $ WBLeft s-                  FL.Done b -> IDone b--    step (WBLeft s) a =-        if not (predicate a)-        then worder s a-        else return $ Partial 0 $ WBLeft s-    step (WBWord s) a =-        if not (predicate a)-        then worder s a-        else do-            b <- fextract s-            return $ Partial 0 $ WBRight b-    step (WBRight b) a =-        return-            $ if not (predicate a)-              then Done 1 b-              else Partial 0 $ WBRight b--    extract (WBLeft s) = fmap (Done 0) $ fextract s-    extract (WBWord s) = fmap (Done 0) $ fextract s-    extract (WBRight b) = return (Done 0 b)--data WordFramedState s b =-      WordFramedSkipPre !s-    | WordFramedWord !s !Int-    | WordFramedEsc !s !Int-    | WordFramedSkipPost !b---- | Like 'wordBy' but treats anything inside a pair of quotes as a single--- word, the quotes can be escaped by an escape character.  Recursive quotes--- are possible if quote begin and end characters are different, quotes must be--- balanced. Outermost quotes are stripped.------ >>> braces = Parser.wordFramedBy (== '\\') (== '{') (== '}') isSpace Fold.toList--- >>> Stream.parse braces $ Stream.fromList "{ab} cd"--- Right "ab"--- >>> Stream.parse braces $ Stream.fromList "{ab}{cd}"--- Right "abcd"--- >>> Stream.parse braces $ Stream.fromList "a{b} cd"--- Right "ab"--- >>> Stream.parse braces $ Stream.fromList "a{{b}} cd"--- Right "a{b}"------ >>> quotes = Parser.wordFramedBy (== '\\') (== '"') (== '"') isSpace Fold.toList--- >>> Stream.parse quotes $ Stream.fromList "\"a\"\"b\""--- Right "ab"----{-# INLINE wordFramedBy #-}-wordFramedBy :: Monad m =>-       (a -> Bool)  -- ^ Matches escape elem?-    -> (a -> Bool)  -- ^ Matches left quote?-    -> (a -> Bool)  -- ^ matches right quote?-    -> (a -> Bool)  -- ^ matches word separator?-    -> Fold m a b-    -> Parser a m b-wordFramedBy isEsc isBegin isEnd isSep-    (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (WordFramedSkipPre s)-                FL.Done _ ->-                    error "wordFramedBy: fold done without input"--    {-# INLINE process #-}-    process s a n = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (WordFramedWord s1 n)-                FL.Done b -> Done 0 b--    step (WordFramedSkipPre s) a-        | isEsc a = return $ Continue 0 $ WordFramedEsc s 0-        | isSep a = return $ Partial 0 $ WordFramedSkipPre s-        | isBegin a = return $ Continue 0 $ WordFramedWord s 1-        | isEnd a =-            return $ Error "wordFramedBy: missing frame start"-        | otherwise = process s a 0-    step (WordFramedWord s n) a-        | isEsc a = return $ Continue 0 $ WordFramedEsc s n-        | n == 0 && isSep a = do-            b <- fextract s-            return $ Partial 0 $ WordFramedSkipPost b-        | otherwise = do-            -- We need to use different order for checking begin and end for-            -- the n == 0 and n == 1 case so that when the begin and end-            -- character is the same we treat the one after begin as end.-            if n == 0-            then-               -- Need to check isBegin first-               if isBegin a-               then return $ Continue 0 $ WordFramedWord s 1-               else if isEnd a-                    then return $ Error "wordFramedBy: missing frame start"-                    else process s a n-            else-               -- Need to check isEnd first-                if isEnd a-                then-                   if n == 1-                   then return $ Continue 0 $ WordFramedWord s 0-                   else process s a (n - 1)-                else if isBegin a-                     then process s a (n + 1)-                     else process s a n-    step (WordFramedEsc s n) a = process s a n-    step (WordFramedSkipPost b) a =-        return-            $ if not (isSep a)-              then Done 1 b-              else Partial 0 $ WordFramedSkipPost b--    err = return . Error--    extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s-    extract (WordFramedWord s n) =-        if n == 0-        then fmap (Done 0) $ fextract s-        else err "wordFramedBy: missing frame end"-    extract (WordFramedEsc _ _) =-        err "wordFramedBy: trailing escape"-    extract (WordFramedSkipPost b) = return (Done 0 b)--data WordQuotedState s b a =-      WordQuotedSkipPre !s-    | WordUnquotedWord !s-    | WordQuotedWord !s !Int !a !a-    | WordUnquotedEsc !s-    | WordQuotedEsc !s !Int !a !a-    | WordQuotedSkipPost !b---- | Quote and bracket aware word splitting with escaping. Like 'wordBy' but--- word separators within specified quotes or brackets are ignored. Quotes and--- escape characters can be processed. If the end quote is different from the--- start quote it is called a bracket. The following quoting rules apply:------ * In an unquoted string a character may be preceded by an escape character.--- The escape character is removed and the character following it is treated--- literally with no special meaning e.g. e.g. h\ e\ l\ l\ o is a single word,--- \n is same as n.--- * Any part of the word can be placed within quotes. Inside quotes all--- characters are treated literally with no special meaning. Quoting character--- itself cannot be used within quotes unless escape processing within quotes--- is applied to allow it.--- * Optionally escape processing for quoted part can be specified. Escape--- character has no special meaning inside quotes unless it is followed by a--- character that has a escape translation specified, in that case the escape--- character is removed, and the specified translation is applied to the--- character following it. This can be used to escape the quoting character--- itself within quotes.--- * There can be multiple quoting characters, when a quote starts, all other--- quoting characters within that quote lose any special meaning until the--- quote is closed.--- * A starting quote char without an ending char generates a parse error. An--- ending bracket char without a corresponding bracket begin is ignored.--- * Brackets can be nested.------ We should note that unquoted and quoted escape processing are different. In--- unquoted part escape character is always removed. In quoted part it is--- removed only if followed by a special meaning character. This is consistent--- with how shell performs escape processing.---- Examples of quotes - "double quotes", 'single quotes', (parens), {braces},--- ((nested) brackets).------ Example:------ >>> :{--- >>> q x =--- >>>     case x of--- >>>         '"' -> Just x--- >>>         '\'' -> Just x--- >>>         _ -> Nothing--- >>> :}------ >>> p = Parser.wordKeepQuotes (== '\\') q isSpace Fold.toList--- >>> Stream.parse p $ Stream.fromList "a\"b'c\";'d\"e'f ghi"--- Right "a\"b'c\";'d\"e'f"------ Note that outer quotes and backslashes from the input string are consumed by--- Haskell, therefore, the actual input string passed to the parser is:--- a"b'c";'d"e'f ghi------ Similarly, when printing, double quotes are escaped by Haskell.------ Limitations:------ Shell like quote processing can be performed by using quote char specific--- escape processing, single quotes with no escapes, and double quotes with--- escapes.------ JSON string processing can also be achieved except the "\uXXXX" style--- escaping for Unicode characters.----{-# INLINE wordWithQuotes #-}-wordWithQuotes :: (Monad m, Eq a) =>-       Bool            -- ^ Retain the quotes and escape chars in the output-    -> (a -> a -> Maybe a)  -- ^ quote char -> escaped char -> translated char-    -> a               -- ^ Matches an escape elem?-    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.-    -> (a -> Bool)     -- ^ Matches a word separator?-    -> Fold m a b-    -> Parser a m b-wordWithQuotes keepQuotes tr escChar toRight isSep-    (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Can be used to generate parse error for a bracket end without a bracket-    -- begin.-    isInvalid = const False--    isEsc = (== escChar)--    initial =  do-        res <- finitial-        return $-            case res of-                FL.Partial s -> IPartial (WordQuotedSkipPre s)-                FL.Done _ ->-                    error "wordKeepQuotes: fold done without input"--    {-# INLINE processQuoted #-}-    processQuoted s a n ql qr = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (WordQuotedWord s1 n ql qr)-                FL.Done b -> Done 0 b--    {-# INLINE processUnquoted #-}-    processUnquoted s a = do-        res <- fstep s a-        return-            $ case res of-                FL.Partial s1 -> Continue 0 (WordUnquotedWord s1)-                FL.Done b -> Done 0 b--    step (WordQuotedSkipPre s) a-        | isEsc a = return $ Continue 0 $ WordUnquotedEsc s-        | isSep a = return $ Partial 0 $ WordQuotedSkipPre s-        | otherwise =-            case toRight a of-                Just qr ->-                  if keepQuotes-                  then processQuoted s a 1 a qr-                  else return $ Continue 0 $ WordQuotedWord s 1 a qr-                Nothing-                    | isInvalid a ->-                        return $ Error "wordKeepQuotes: invalid unquoted char"-                    | otherwise -> processUnquoted s a-    step (WordUnquotedWord s) a-        | isEsc a = return $ Continue 0 $ WordUnquotedEsc s-        | isSep a = do-            b <- fextract s-            return $ Partial 0 $ WordQuotedSkipPost b-        | otherwise = do-            case toRight a of-                Just qr ->-                    if keepQuotes-                    then processQuoted s a 1 a qr-                    else return $ Continue 0 $ WordQuotedWord s 1 a qr-                Nothing ->-                    if isInvalid a-                    then return $ Error "wordKeepQuotes: invalid unquoted char"-                    else processUnquoted s a-    step (WordQuotedWord s n ql qr) a-        | isEsc a = return $ Continue 0 $ WordQuotedEsc s n ql qr-        {--        -- XXX Will this ever occur? Will n ever be 0?-        | n == 0 && isSep a = do-            b <- fextract s-            return $ Partial 0 $ WordQuotedSkipPost b-        -}-        | otherwise = do-                if a == qr-                then-                   if n == 1-                   then if keepQuotes-                        then processUnquoted s a-                        else return $ Continue 0 $ WordUnquotedWord s-                   else processQuoted s a (n - 1) ql qr-                else if a == ql-                     then processQuoted s a (n + 1) ql qr-                     else processQuoted s a n ql qr-    step (WordUnquotedEsc s) a = processUnquoted s a-    step (WordQuotedEsc s n ql qr) a =-        case tr ql a of-            Nothing -> do-                res <- fstep s escChar-                case res of-                    FL.Partial s1 -> processQuoted s1 a n ql qr-                    FL.Done b -> return $ Done 0 b-            Just x -> processQuoted s x n ql qr-    step (WordQuotedSkipPost b) a =-        return-            $ if not (isSep a)-              then Done 1 b-              else Partial 0 $ WordQuotedSkipPost b--    err = return . Error--    extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s-    extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s-    extract (WordQuotedWord s n _ _) =-        if n == 0-        then fmap (Done 0) $ fextract s-        else err "wordWithQuotes: missing frame end"-    extract WordQuotedEsc {} =-        err "wordWithQuotes: trailing escape"-    extract (WordUnquotedEsc _) =-        err "wordWithQuotes: trailing escape"-    extract (WordQuotedSkipPost b) = return (Done 0 b)---- | 'wordWithQuotes' without processing the quotes and escape function--- supplied to escape the quote char within a quote. Can be used to parse words--- keeping the quotes and escapes intact.------ >>> wordKeepQuotes = Parser.wordWithQuotes True (\_ _ -> Nothing)----{-# INLINE wordKeepQuotes #-}-wordKeepQuotes :: (Monad m, Eq a) =>-       a               -- ^ Escape char-    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.-    -> (a -> Bool)     -- ^ Matches a word separator?-    -> Fold m a b-    -> Parser a m b-wordKeepQuotes =-    -- Escape the quote char itself-    wordWithQuotes True (\q x -> if q == x then Just x else Nothing)---- See the "Quoting Rules" section in the "bash" manual page for a primer on--- how quotes are used by shells.---- | 'wordWithQuotes' with quote processing applied and escape function--- supplied to escape the quote char within a quote. Can be ysed to parse words--- and processing the quoting and escaping at the same time.------ >>> wordProcessQuotes = Parser.wordWithQuotes False (\_ _ -> Nothing)----{-# INLINE wordProcessQuotes #-}-wordProcessQuotes :: (Monad m, Eq a) =>-        a              -- ^ Escape char-    -> (a -> Maybe a)  -- ^ If left quote, return right quote, else Nothing.-    -> (a -> Bool)     -- ^ Matches a word separator?-    -> Fold m a b-    -> Parser a m b-wordProcessQuotes =-    -- Escape the quote char itself-    wordWithQuotes False (\q x -> if q == x then Just x else Nothing)--{-# ANN type GroupByState Fuse #-}-data GroupByState a s-    = GroupByInit !s-    | GroupByGrouping !a !s---- | Given an input stream @[a,b,c,...]@ and a comparison function @cmp@, the--- parser assigns the element @a@ to the first group, then if @a \`cmp` b@ is--- 'True' @b@ is also assigned to the same group.  If @a \`cmp` c@ is 'True'--- then @c@ is also assigned to the same group and so on. When the comparison--- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and--- the result of the fold is the result of the parser.------ * Stops - when the comparison fails.--- * Fails - never.------ >>> :{---  runGroupsBy eq =---      Stream.fold Fold.toList---          . Stream.parseMany (Parser.groupBy eq Fold.toList)---          . Stream.fromList--- :}------ >>> runGroupsBy (<) []--- []------ >>> runGroupsBy (<) [1]--- [Right [1]]------ >>> runGroupsBy (<) [3, 5, 4, 1, 2, 0]--- [Right [3,5,4],Right [1,2],Right [0]]----{-# INLINE groupBy #-}-groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b-groupBy eq (Fold fstep finitial fextract) = Parser step initial extract--    where--    {-# INLINE grouper #-}-    grouper s a0 a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Done b -> Done 0 b-                  FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s -> IPartial $ GroupByInit s-                  FL.Done b -> IDone b--    step (GroupByInit s) a = grouper s a a-    step (GroupByGrouping a0 s) a =-        if eq a0 a-        then grouper s a0 a-        else Done 1 <$> fextract s--    extract (GroupByInit s) = fmap (Done 0) $ fextract s-    extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s---- | Unlike 'groupBy' this combinator performs a rolling comparison of two--- successive elements in the input stream.  Assuming the input stream--- is @[a,b,c,...]@ and the comparison function is @cmp@, the parser--- first assigns the element @a@ to the first group, then if @a \`cmp` b@ is--- 'True' @b@ is also assigned to the same group.  If @b \`cmp` c@ is 'True'--- then @c@ is also assigned to the same group and so on. When the comparison--- fails the parser is terminated. Each group is folded using the 'Fold' @f@ and--- the result of the fold is the result of the parser.------ * Stops - when the comparison fails.--- * Fails - never.------ >>> :{---  runGroupsByRolling eq =---      Stream.fold Fold.toList---          . Stream.parseMany (Parser.groupByRolling eq Fold.toList)---          . Stream.fromList--- :}------ >>> runGroupsByRolling (<) []--- []------ >>> runGroupsByRolling (<) [1]--- [Right [1]]------ >>> runGroupsByRolling (<) [3, 5, 4, 1, 2, 0]--- [Right [3,5],Right [4],Right [1,2],Right [0]]------ /Pre-release/----{-# INLINE groupByRolling #-}-groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b-groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract--    where--    {-# INLINE grouper #-}-    grouper s a = do-        res <- fstep s a-        return-            $ case res of-                  FL.Done b -> Done 0 b-                  FL.Partial s1 -> Partial 0 (GroupByGrouping a s1)--    initial = do-        res <- finitial-        return-            $ case res of-                  FL.Partial s -> IPartial $ GroupByInit s-                  FL.Done b -> IDone b--    step (GroupByInit s) a = grouper s a-    step (GroupByGrouping a0 s) a =-        if eq a0 a-        then grouper s a-        else Done 1 <$> fextract s--    extract (GroupByInit s) = fmap (Done 0) $ fextract s-    extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s--{-# ANN type GroupByStatePair Fuse #-}-data GroupByStatePair a s1 s2-    = GroupByInitPair !s1 !s2-    | GroupByGroupingPair !a !s1 !s2-    | GroupByGroupingPairL !a !s1 !s2-    | GroupByGroupingPairR !a !s1 !s2---- | Like 'groupByRolling', but if the predicate is 'True' then collects using--- the first fold as long as the predicate holds 'True', if the predicate is--- 'False' collects using the second fold as long as it remains 'False'.--- Returns 'Left' for the first case and 'Right' for the second case.------ For example, if we want to detect sorted sequences in a stream, both--- ascending and descending cases we can use 'groupByRollingEither (<=)--- Fold.toList Fold.toList'.------ /Pre-release/-{-# INLINE groupByRollingEither #-}-groupByRollingEither :: Monad m =>-    (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)-groupByRollingEither-    eq-    (Fold fstep1 finitial1 fextract1)-    (Fold fstep2 finitial2 fextract2) = Parser step initial extract--    where--    {-# INLINE grouper #-}-    grouper s1 s2 a = do-        return $ Continue 0 (GroupByGroupingPair a s1 s2)--    {-# INLINE grouperL2 #-}-    grouperL2 s1 s2 a = do-        res <- fstep1 s1 a-        return-            $ case res of-                FL.Done b -> Done 0 (Left b)-                FL.Partial s11 -> Partial 0 (GroupByGroupingPairL a s11 s2)--    {-# INLINE grouperL #-}-    grouperL s1 s2 a0 a = do-        res <- fstep1 s1 a0-        case res of-            FL.Done b -> return $ Done 0 (Left b)-            FL.Partial s11 -> grouperL2 s11 s2 a--    {-# INLINE grouperR2 #-}-    grouperR2 s1 s2 a = do-        res <- fstep2 s2 a-        return-            $ case res of-                FL.Done b -> Done 0 (Right b)-                FL.Partial s21 -> Partial 0 (GroupByGroupingPairR a s1 s21)--    {-# INLINE grouperR #-}-    grouperR s1 s2 a0 a = do-        res <- fstep2 s2 a0-        case res of-            FL.Done b -> return $ Done 0 (Right b)-            FL.Partial s21 -> grouperR2 s1 s21 a--    initial = do-        res1 <- finitial1-        res2 <- finitial2-        return-            $ case res1 of-                FL.Partial s1 ->-                    case res2 of-                        FL.Partial s2 -> IPartial $ GroupByInitPair s1 s2-                        FL.Done b -> IDone (Right b)-                FL.Done b -> IDone (Left b)--    step (GroupByInitPair s1 s2) a = grouper s1 s2 a--    step (GroupByGroupingPair a0 s1 s2) a =-        if not (eq a0 a)-        then grouperL s1 s2 a0 a-        else grouperR s1 s2 a0 a--    step (GroupByGroupingPairL a0 s1 s2) a =-        if not (eq a0 a)-        then grouperL2 s1 s2 a-        else Done 1 . Left <$> fextract1 s1--    step (GroupByGroupingPairR a0 s1 s2) a =-        if eq a0 a-        then grouperR2 s1 s2 a-        else Done 1 . Right <$> fextract2 s2--    extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1-    extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1-    extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2-    extract (GroupByGroupingPair a s1 _) = do-                res <- fstep1 s1 a-                case res of-                    FL.Done b -> return $ Done 0 (Left b)-                    FL.Partial s11 -> Done 0 . Left <$> fextract1 s11---- XXX use an Unfold instead of a list?--- XXX custom combinators for matching list, array and stream?--- XXX rename to listBy?---- | Match the given sequence of elements using the given comparison function.--- Returns the original sequence if successful.------ Definition:------ >>> listEqBy cmp xs = Parser.streamEqBy cmp (Stream.fromList xs) *> Parser.fromPure xs------ Examples:------ >>> Stream.parse (Parser.listEqBy (==) "string") $ Stream.fromList "string"--- Right "string"------ >>> Stream.parse (Parser.listEqBy (==) "mismatch") $ Stream.fromList "match"--- Left (ParseError "streamEqBy: mismtach occurred")----{-# INLINE listEqBy #-}-listEqBy :: Monad m => (a -> a -> Bool) -> [a] -> Parser a m [a]-listEqBy cmp xs = streamEqByInternal cmp (D.fromList xs) *> fromPure xs-{--listEqBy cmp str = Parser step initial extract--    where--    -- XXX Should return IDone in initial for [] case-    initial = return $ IPartial str--    step [] _ = return $ Done 0 str-    step [x] a =-        return-            $ if x `cmp` a-              then Done 0 str-              else Error "listEqBy: failed, yet to match the last element"-    step (x:xs) a =-        return-            $ if x `cmp` a-              then Continue 0 xs-              else Error-                       $ "listEqBy: failed, yet to match "-                       ++ show (length xs + 1) ++ " elements"--    extract xs =-        return-            $ Error-            $ "listEqBy: end of input, yet to match "-            ++ show (length xs) ++ " elements"--}--{-# INLINE streamEqByInternal #-}-streamEqByInternal :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()-streamEqByInternal cmp (D.Stream sstep state) = Parser step initial extract--    where--    initial = do-        r <- sstep defState state-        case r of-            D.Yield x s -> return $ IPartial (Just' x, s)-            D.Stop -> return $ IDone ()-            -- Need Skip/Continue in initial to loop right here-            D.Skip s -> return $ IPartial (Nothing', s)--    step (Just' x, st) a =-        if x `cmp` a-          then do-            r <- sstep defState st-            return-                $ case r of-                    D.Yield x1 s -> Continue 0 (Just' x1, s)-                    D.Stop -> Done 0 ()-                    D.Skip s -> Continue 1 (Nothing', s)-          else return $ Error "streamEqBy: mismtach occurred"-    step (Nothing', st) a = do-        r <- sstep defState st-        return-            $ case r of-                D.Yield x s -> do-                    if x `cmp` a-                    then Continue 0 (Nothing', s)-                    else Error "streamEqBy: mismatch occurred"-                D.Stop -> Done 1 ()-                D.Skip s -> Continue 1 (Nothing', s)--    extract _ = return $ Error "streamEqBy: end of input"---- | Like 'listEqBy' but uses a stream instead of a list and does not return--- the stream.----{-# INLINE streamEqBy #-}-streamEqBy :: Monad m => (a -> a -> Bool) -> D.Stream m a -> Parser a m ()--- XXX Somehow composing this with "*>" is much faster on the microbenchmark.--- Need to investigate why.-streamEqBy cmp stream = streamEqByInternal cmp stream *> fromPure ()---- Rename to "list".--- | Match the input sequence with the supplied list and return it if--- successful.------ >>> listEq = Parser.listEqBy (==)----{-# INLINE listEq #-}-listEq :: (Monad m, Eq a) => [a] -> Parser a m [a]-listEq = listEqBy (==)---- | Match if the input stream is a subsequence of the argument stream i.e. all--- the elements of the input stream occur, in order, in the argument stream.--- The elements do not have to occur consecutively. A sequence is considered a--- subsequence of itself.-{-# INLINE subsequenceBy #-}-subsequenceBy :: -- Monad m =>-    (a -> a -> Bool) -> Stream m a -> Parser a m ()-subsequenceBy = undefined--{---- Should go in Data.Parser.Regex in streamly package so that it can depend on--- regex backends.-{-# INLINE regexPosix #-}-regexPosix :: -- Monad m =>-    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))-regexPosix = undefined--{-# INLINE regexPCRE #-}-regexPCRE :: -- Monad m =>-    Regex -> Parser m a (Maybe (Array (MatchOffset, MatchLength)))-regexPCRE = undefined--}------------------------------------------------------------------------------------ Transformations on input------------------------------------------------------------------------------------ Initial needs a "Continue" constructor to implement scans on parsers. As a--- parser can always return a Continue in initial when we feed the fold's--- initial result to it. We can work this around for postscan by introducing an--- initial state and calling "initial" only on the first input.---- | Stateful scan on the input of a parser using a Fold.------ /Unimplemented/----{-# INLINE postscan #-}-postscan :: -- Monad m =>-    Fold m a b -> Parser b m c -> Parser a m c-postscan = undefined--{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x-zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        fres <- finitial-        case fres of-            FL.Partial fs -> do-                r <- sstep defState state-                case r of-                    D.Yield x s -> return $ IPartial (Just' x, s, fs)-                    D.Stop -> do-                        x <- fextract fs-                        return $ IDone x-                    -- Need Skip/Continue in initial to loop right here-                    D.Skip s -> return $ IPartial (Nothing', s, fs)-            FL.Done x -> return $ IDone x--    step (Just' a, st, fs) b = do-        c <- zf a b-        fres <- fstep fs c-        case fres of-            FL.Partial fs1 -> do-                r <- sstep defState st-                case r of-                    D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)-                    D.Stop -> do-                        x <- fextract fs1-                        return $ Done 0 x-                    D.Skip s -> return $ Continue 1 (Nothing', s, fs1)-            FL.Done x -> return $ Done 0 x-    step (Nothing', st, fs) b = do-        r <- sstep defState st-        case r of-                D.Yield a s -> do-                    c <- zf a b-                    fres <- fstep fs c-                    case fres of-                        FL.Partial fs1 ->-                            return $ Continue 0 (Nothing', s, fs1)-                        FL.Done x -> return $ Done 0 x-                D.Stop -> do-                    x <- fextract fs-                    return $ Done 1 x-                D.Skip s -> return $ Continue 1 (Nothing', s, fs)--    extract _ = return $ Error "zipWithM: end of input"---- | Zip the input of a fold with a stream.------ /Pre-release/----{-# INLINE zip #-}-zip :: Monad m => D.Stream m a -> Fold m (a, b) x -> Parser b m x-zip = zipWithM (curry return)---- | Pair each element of a fold input with its index, starting from index 0.------ /Pre-release/-{-# INLINE indexed #-}-indexed :: forall m a b. Monad m => Fold m (Int, a) b -> Parser a m b-indexed = zip (D.enumerateFromIntegral 0 :: D.Stream m Int)---- | @makeIndexFilter indexer filter predicate@ generates a fold filtering--- function using a fold indexing function that attaches an index to each input--- element and a filtering function that filters using @(index, element) ->--- Bool) as predicate.------ For example:------ @--- filterWithIndex = makeIndexFilter indexed filter--- filterWithAbsTime = makeIndexFilter timestamped filter--- filterWithRelTime = makeIndexFilter timeIndexed filter--- @------ /Pre-release/-{-# INLINE makeIndexFilter #-}-makeIndexFilter ::-       (Fold m (s, a) b -> Parser a m b)-    -> (((s, a) -> Bool) -> Fold m (s, a) b -> Fold m (s, a) b)-    -> (((s, a) -> Bool) -> Fold m a b -> Parser a m b)-makeIndexFilter f comb g = f . comb g . FL.lmap snd---- | @sampleFromthen offset stride@ samples the element at @offset@ index and--- then every element at strides of @stride@.------ /Pre-release/-{-# INLINE sampleFromthen #-}-sampleFromthen :: Monad m => Int -> Int -> Fold m a b -> Parser a m b-sampleFromthen offset size =-    makeIndexFilter indexed FL.filter (\(i, _) -> (i + offset) `mod` size == 0)-------------------------------------------------------------------------------------- Spanning------------------------------------------------------------------------------------- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the--- input as long as the predicate @p@ is 'True'.  @f2@ consumes the rest of the--- input.------ @--- > let span_ p xs = Stream.parse (Parser.span p Fold.toList Fold.toList) $ Stream.fromList xs------ > span_ (< 1) [1,2,3]--- ([],[1,2,3])------ > span_ (< 2) [1,2,3]--- ([1],[2,3])------ > span_ (< 4) [1,2,3]--- ([1,2,3],[])------ @------ /Pre-release/-{-# INLINE span #-}-span :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)-span p f1 f2 = noErrorUnsafeSplitWith (,) (takeWhile p f1) (fromFold f2)---- | Break the input stream into two groups, the first group takes the input as--- long as the predicate applied to the first element of the stream and next--- input element holds 'True', the second group takes the rest of the input.------ /Pre-release/----{-# INLINE spanBy #-}-spanBy ::-       Monad m-    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)-spanBy eq f1 f2 = noErrorUnsafeSplitWith (,) (groupBy eq f1) (fromFold f2)---- | Like 'spanBy' but applies the predicate in a rolling fashion i.e.--- predicate is applied to the previous and the next input elements.------ /Pre-release/-{-# INLINE spanByRolling #-}-spanByRolling ::-       Monad m-    => (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (b, c)-spanByRolling eq f1 f2 =-    noErrorUnsafeSplitWith (,) (groupByRolling eq f1) (fromFold f2)------------------------------------------------------------------------------------ nested parsers------------------------------------------------------------------------------------ | Takes at-most @n@ input elements.------ * Stops - when the collecting parser stops.--- * Fails - when the collecting parser fails.------ >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 2 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]--- Right [1,2]------ >>> Stream.parse (Parser.takeP 4 (Parser.takeEQ 5 Fold.toList)) $ Stream.fromList [1, 2, 3, 4, 5]--- Left (ParseError "takeEQ: Expecting exactly 5 elements, input terminated on 4")------ /Internal/-{-# INLINE takeP #-}-takeP :: Monad m => Int -> Parser a m b -> Parser a m b-takeP lim (Parser pstep pinitial pextract) = Parser step initial extract--    where--    initial = do-        res <- pinitial-        case res of-            IPartial s ->-                if lim > 0-                then return $ IPartial $ Tuple' 0 s-                else iextract s-            IDone b -> return $ IDone b-            IError e -> return $ IError e--    step (Tuple' cnt r) a = do-        assertM(cnt < lim)-        res <- pstep r a-        let cnt1 = cnt + 1-        case res of-            Partial 0 s -> do-                assertM(cnt1 >= 0)-                if cnt1 < lim-                then return $ Partial 0 $ Tuple' cnt1 s-                else do-                    r1 <- pextract s-                    return $ case r1 of-                        Done n b -> Done n b-                        Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)-                        Error err -> Error err-                        Partial _ _ -> error "takeP: Partial in extract"--            Continue 0 s -> do-                assertM(cnt1 >= 0)-                if cnt1 < lim-                then return $ Continue 0 $ Tuple' cnt1 s-                else do-                    r1 <- pextract s-                    return $ case r1 of-                        Done n b -> Done n b-                        Continue n s1 -> Continue n (Tuple' (cnt1 - n) s1)-                        Error err -> Error err-                        Partial _ _ -> error "takeP: Partial in extract"-            Partial n s -> do-                let taken = cnt1 - n-                assertM(taken >= 0)-                return $ Partial n $ Tuple' taken s-            Continue n s -> do-                let taken = cnt1 - n-                assertM(taken >= 0)-                return $ Continue n $ Tuple' taken s-            Done n b -> return $ Done n b-            Error str -> return $ Error str--    extract (Tuple' cnt r) = do-        r1 <- pextract r-        return $ case r1 of-            Done n b -> Done n b-            Continue n s1 -> Continue n (Tuple' (cnt - n) s1)-            Error err -> Error err-            Partial _ _ -> error "takeP: Partial in extract"--    -- XXX Need to make the Initial type Step to remove this-    iextract s = do-        r <- pextract s-        return $ case r of-            Done _ b -> IDone b-            Error err -> IError err-            _ -> error "Bug: takeP invalid state in initial"---- | Run a parser without consuming the input.----{-# INLINE lookAhead #-}-lookAhead :: Monad m => Parser a m b -> Parser a m b-lookAhead (Parser step1 initial1 _) = Parser step initial extract--    where--    initial = do-        res <- initial1-        return $ case res of-            IPartial s -> IPartial (Tuple'Fused 0 s)-            IDone b -> IDone b-            IError e -> IError e--    step (Tuple'Fused cnt st) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        return-            $ case r of-                  Partial n s -> Continue n (Tuple'Fused (cnt1 - n) s)-                  Continue n s -> Continue n (Tuple'Fused (cnt1 - n) s)-                  Done _ b -> Done cnt1 b-                  Error err -> Error err--    -- XXX returning an error let's us backtrack.  To implement it in a way so-    -- that it terminates on eof without an error then we need a way to-    -- backtrack on eof, that will require extract to return 'Step' type.-    extract (Tuple'Fused n _) =-        return-            $ Error-            $ "lookAhead: end of input after consuming "-            ++ show n ++ " elements"------------------------------------------------------------------------------------ Interleaving-------------------------------------------------------------------------------------- To deinterleave we can chain two parsers one behind the other. The input is--- given to the first parser and the input definitively rejected by the first--- parser is given to the second parser.------ We can either have the parsers themselves buffer the input or use the shared--- global buffer to hold it until none of the parsers need it. When the first--- parser returns Skip (i.e. rewind) we let the second parser consume the--- rejected input and when it is done we move the cursor forward to the first--- parser again. This will require a "move forward" command as well.------ To implement grep we can use three parsers, one to find the pattern, one--- to store the context behind the pattern and one to store the context in--- front of the pattern. When a match occurs we need to emit the accumulator of--- all the three parsers. One parser can count the line numbers to provide the--- line number info.--{-# ANN type DeintercalateAllState Fuse #-}-data DeintercalateAllState fs sp ss =-      DeintercalateAllInitL !fs-    | DeintercalateAllL !fs !sp-    | DeintercalateAllInitR !fs-    | DeintercalateAllR !fs !ss---- XXX rename this to intercalate---- Having deintercalateAll for accepting or rejecting entire input could be--- useful. For example, in case of JSON parsing we get an entire block of--- key-value pairs which we need to verify. This version may be simpler, more--- efficient. We could implement this as a stream operation like parseMany.------ XXX Also, it may be a good idea to provide a parse driver for a fold. For--- example, in case of csv parsing as we are feeding a line to a fold we can--- parse it.---- | Like 'deintercalate' but the entire input must satisfy the pattern--- otherwise the parser fails. This is many times faster than deintercalate.------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.deintercalateAll p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Right []--- >>> Stream.parse p $ Stream.fromList "1"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Left (ParseError "takeWhile1: end of input")--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]----{-# INLINE deintercalateAll #-}-deintercalateAll :: Monad m =>-       Parser a m x-    -> Parser a m y-    -> Fold m (Either x y) z-    -> Parser a m z-deintercalateAll-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "deintercalate: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> return $ IPartial $ DeintercalateAllInitL fs-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepL #-}-    runStepL fs sL a = do-        r <- stepL sL a-        case r of-            Partial n s -> return $ Partial n (DeintercalateAllL fs s)-            Continue n s -> return $ Continue n (DeintercalateAllL fs s)-            Done n b ->-                processL (fstep fs (Left b)) n DeintercalateAllInitR-            Error err -> return $ Error err--    {-# INLINE processR #-}-    processR foldAction n = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> do-                res <- initialL-                case res of-                    IPartial ps -> return $ Partial n (DeintercalateAllL fs1 ps)-                    IDone _ -> errMsg "left" "succeed"-                    IError _ -> errMsg "left" "fail"-            FL.Done c -> return $ Done n c--    {-# INLINE runStepR #-}-    runStepR fs sR a = do-        r <- stepR sR a-        case r of-            Partial n s -> return $ Partial n (DeintercalateAllR fs s)-            Continue n s -> return $ Continue n (DeintercalateAllR fs s)-            Done n b -> processR (fstep fs (Right b)) n-            Error err -> return $ Error err--    step (DeintercalateAllInitL fs) a = do-        res <- initialL-        case res of-            IPartial s -> runStepL fs s a-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"-    step (DeintercalateAllL fs sL) a = runStepL fs sL a-    step (DeintercalateAllInitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (DeintercalateAllR fs sR) a = runStepR fs sR a--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)-    extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateAllL fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs (Left b)-            Error err -> return $ Error err-            Continue n s -> return $ Continue n (DeintercalateAllL fs s)-            Partial _ _ -> error "Partial in extract"-    extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateAllR _ _) =-        return $ Error "deintercalateAll: input ended at 'Right' value"--{-# ANN type DeintercalateState Fuse #-}-data DeintercalateState b fs sp ss =-      DeintercalateInitL !fs-    | DeintercalateL !Int !fs !sp-    | DeintercalateInitR !fs-    | DeintercalateR !Int !fs !ss-    | DeintercalateRL !Int !b !fs !sp---- XXX Add tests that the next character that we take after running a parser is--- correct. Especially for the parsers that maintain a count. In the stream--- finished case (extract) as well as not finished case.---- | Apply two parsers alternately to an input stream. The input stream is--- considered an interleaving of two patterns. The two parsers represent the--- two patterns. Parsing starts at the first parser and stops at the first--- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty--- input or single parse of the first parser is accepted.------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.deintercalate p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Right []--- >>> Stream.parse p $ Stream.fromList "1"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]----{-# INLINE deintercalate #-}-deintercalate :: Monad m =>-       Parser a m x-    -> Parser a m y-    -> Fold m (Either x y) z-    -> Parser a m z-deintercalate-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "deintercalate: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> return $ IPartial $ DeintercalateInitL fs-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepL #-}-    runStepL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (DeintercalateL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs (Left b)) n DeintercalateInitR-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE processR #-}-    processR cnt b fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (DeintercalateRL cnt b fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)-            Done n b -> processR (cnt1 - n) b fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (DeintercalateInitL fs) a = do-        res <- initialL-        case res of-            IPartial s -> runStepL 0 fs s a-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"-    step (DeintercalateL cnt fs sL) a = runStepL cnt fs sL a-    step (DeintercalateInitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (DeintercalateR cnt fs sR) a = runStepR cnt fs sR a-    step (DeintercalateRL cnt bR fs sL) a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)-            Continue n s -> return $ Continue n (DeintercalateRL (cnt1 - n) bR fs s)-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> do-                        fres <- fstep fs1 (Left bL)-                        case fres of-                            FL.Partial fs2 ->-                                return $ Partial n (DeintercalateInitR fs2)-                            FL.Done c -> return $ Done n c-                    -- XXX We could have the fold accept pairs of (bR, bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs (Left b)-            Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs-    extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs-    extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs-    extract (DeintercalateRL cnt bR fs sL) = do-        r <- extractL sL-        case r of-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> extractResult n fs1 (Left bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs--{-# ANN type Deintercalate1State Fuse #-}-data Deintercalate1State b fs sp ss =-      Deintercalate1InitL !Int !fs !sp-    | Deintercalate1InitR !fs-    | Deintercalate1R !Int !fs !ss-    | Deintercalate1RL !Int !b !fs !sp---- | Apply two parsers alternately to an input stream. The input stream is--- considered an interleaving of two patterns. The two parsers represent the--- two patterns. Parsing starts at the first parser and stops at the first--- parser. It can be used to parse a infix style pattern e.g. p1 p2 p1 . Empty--- input or single parse of the first parser is accepted.------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.deintercalate1 p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Left (ParseError "takeWhile1: end of input")--- >>> Stream.parse p $ Stream.fromList "1"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right [Left "1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right [Left "1",Right '+',Left "2",Right '+',Left "3"]----{-# INLINE deintercalate1 #-}-deintercalate1 :: Monad m =>-       Parser a m x-    -> Parser a m y-    -> Fold m (Either x y) z-    -> Parser a m z-deintercalate1-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "deintercalate: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> do-                pres <- initialL-                case pres of-                    IPartial s -> return $ IPartial $ Deintercalate1InitL 0 fs s-                    IDone _ -> errMsg "left" "succeed"-                    IError _ -> errMsg "left" "fail"-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepInitL #-}-    runStepInitL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (Deintercalate1InitL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs (Left b)) n Deintercalate1InitR-            Error err -> return $ Error err--    {-# INLINE processR #-}-    processR cnt b fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (Deintercalate1RL cnt b fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)-            Done n b -> processR (cnt1 - n) b fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a-    step (Deintercalate1InitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (Deintercalate1R cnt fs sR) a = runStepR cnt fs sR a-    step (Deintercalate1RL cnt bR fs sL) a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)-            Continue n s -> return $ Continue n (Deintercalate1RL (cnt1 - n) bR fs s)-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> do-                        fres <- fstep fs1 (Left bL)-                        case fres of-                            FL.Partial fs2 ->-                                return $ Partial n (Deintercalate1InitR fs2)-                            FL.Done c -> return $ Done n c-                    -- XXX We could have the fold accept pairs of (bR, bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (Deintercalate1InitL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs (Left b)-            Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error err -> return $ Error err-    extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs-    extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs-    extract (Deintercalate1RL cnt bR fs sL) = do-        r <- extractL sL-        case r of-            Done n bL -> do-                res <- fstep fs (Right bR)-                case res of-                    FL.Partial fs1 -> extractResult n fs1 (Left bL)-                    FL.Done _ -> error "Fold terminated consuming partial input"-            Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs--{-# ANN type SepByState Fuse #-}-data SepByState fs sp ss =-      SepByInitL !fs-    | SepByL !Int !fs !sp-    | SepByInitR !fs-    | SepByR !Int !fs !ss---- | Apply two parsers alternately to an input stream. Parsing starts at the--- first parser and stops at the first parser. The output of the first parser--- is emiited and the output of the second parser is discarded. It can be used--- to parse a infix style pattern e.g. p1 p2 p1 . Empty input or single parse--- of the first parser is accepted.------ Definitions:------ >>> sepBy p1 p2 f = Parser.deintercalate p1 p2 (Fold.catLefts f)--- >>> sepBy p1 p2 f = Parser.sepBy1 p1 p2 f <|> Parser.fromEffect (Fold.extractM f)------ Examples:------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.sepBy p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Right []--- >>> Stream.parse p $ Stream.fromList "1"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right ["1","2","3"]----{-# INLINE sepBy #-}-sepBy :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c--- This has similar performance as the custom impl below.--- sepBy p1 p2 f = deintercalate p1 p2 (FL.catLefts f)-sepBy-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "sepBy: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> return $ IPartial $ SepByInitL fs-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepL #-}-    runStepL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (SepByL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepByL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs b) n SepByInitR-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE processR #-}-    processR cnt fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (SepByL cnt fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (SepByR (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)-            Done n _ -> processR (cnt1 - n) fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (SepByInitL fs) a = do-        res <- initialL-        case res of-            IPartial s -> runStepL 0 fs s a-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"-    step (SepByL cnt fs sL) a = runStepL cnt fs sL a-    step (SepByInitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (SepByR cnt fs sR) a = runStepR cnt fs sR a--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (SepByInitL fs) = fmap (Done 0) $ fextract fs-    extract (SepByL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs b-            Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs-    extract (SepByInitR fs) = fmap (Done 0) $ fextract fs-    extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs---- | Non-backtracking version of sepBy. Several times faster.-{-# INLINE sepByAll #-}-sepByAll :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-sepByAll p1 p2 f = deintercalateAll p1 p2 (FL.catLefts f)---- XXX This can be implemented using refold, parse one and then continue--- collecting the rest in that.--{-# ANN type SepBy1State Fuse #-}-data SepBy1State fs sp ss =-      SepBy1InitL !Int !fs sp-    | SepBy1L !Int !fs !sp-    | SepBy1InitR !fs-    | SepBy1R !Int !fs !ss--{--{-# INLINE sepBy1 #-}-sepBy1 :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-sepBy1 p sep sink = do-    x <- p-    f <- fromEffect $ FL.reduce sink-    f1 <- fromEffect $ FL.snoc f x-    many (sep >> p) f1--}---- | Like 'sepBy' but requires at least one successful parse.------ Definition:------ >>> sepBy1 p1 p2 f = Parser.deintercalate1 p1 p2 (Fold.catLefts f)------ Examples:------ >>> p1 = Parser.takeWhile1 (not . (== '+')) Fold.toList--- >>> p2 = Parser.satisfy (== '+')--- >>> p = Parser.sepBy1 p1 p2 Fold.toList--- >>> Stream.parse p $ Stream.fromList ""--- Left (ParseError "takeWhile1: end of input")--- >>> Stream.parse p $ Stream.fromList "1"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+"--- Right ["1"]--- >>> Stream.parse p $ Stream.fromList "1+2+3"--- Right ["1","2","3"]----{-# INLINE sepBy1 #-}-sepBy1 :: Monad m =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-sepBy1-    (Parser stepL initialL extractL)-    (Parser stepR initialR _)-    (Fold fstep finitial fextract) = Parser step initial extract--    where--    errMsg p status =-        error $ "sepBy: " ++ p ++ " parser cannot "-                ++ status ++ " without input"--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> do-                pres <- initialL-                case pres of-                    IPartial s -> return $ IPartial $ SepBy1InitL 0 fs s-                    IDone _ -> errMsg "left" "succeed"-                    IError _ -> errMsg "left" "fail"-            FL.Done c -> return $ IDone c--    {-# INLINE processL #-}-    processL foldAction n nextState = do-        fres <- foldAction-        case fres of-            FL.Partial fs1 -> return $ Partial n (nextState fs1)-            FL.Done c -> return $ Done n c--    {-# INLINE runStepInitL #-}-    runStepInitL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepBy1InitL (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs b) n SepBy1InitR-            Error err -> return $ Error err--    {-# INLINE runStepL #-}-    runStepL cnt fs sL a = do-        let cnt1 = cnt + 1-        r <- stepL sL a-        case r of-            Partial n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepBy1L (cnt1 - n) fs s)-            Done n b ->-                processL (fstep fs b) n SepBy1InitR-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    {-# INLINE processR #-}-    processR cnt fs n = do-        res <- initialL-        case res of-            IPartial ps -> return $ Continue n (SepBy1L cnt fs ps)-            IDone _ -> errMsg "left" "succeed"-            IError _ -> errMsg "left" "fail"--    {-# INLINE runStepR #-}-    runStepR cnt fs sR a = do-        let cnt1 = cnt + 1-        r <- stepR sR a-        case r of-            Partial n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)-            Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)-            Done n _ -> processR (cnt1 - n) fs n-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a-    step (SepBy1L cnt fs sL) a = runStepL cnt fs sL a-    step (SepBy1InitR fs) a = do-        res <- initialR-        case res of-            IPartial s -> runStepR 0 fs s a-            IDone _ -> errMsg "right" "succeed"-            IError _ -> errMsg "right" "fail"-    step (SepBy1R cnt fs sR) a = runStepR cnt fs sR a--    {-# INLINE extractResult #-}-    extractResult n fs r = do-        res <- fstep fs r-        case res of-            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-            FL.Done c -> return (Done n c)--    extract (SepBy1InitL cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs b-            Continue n s -> return $ Continue n (SepBy1InitL (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error err -> return $ Error err-    extract (SepBy1L cnt fs sL) = do-        r <- extractL sL-        case r of-            Done n b -> extractResult n fs b-            Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)-            Partial _ _ -> error "Partial in extract"-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs-    extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs-    extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs------------------------------------------------------------------------------------ Interleaving a collection of parsers-------------------------------------------------------------------------------------- | Apply a collection of parsers to an input stream in a round robin fashion.--- Each parser is applied until it stops and then we repeat starting with the--- the first parser again.------ /Unimplemented/----{-# INLINE roundRobin #-}-roundRobin :: -- (Foldable t, Monad m) =>-    t (Parser a m b) -> Fold m b c -> Parser a m c-roundRobin _ps _f = undefined------------------------------------------------------------------------------------ Sequential Collection------------------------------------------------------------------------------------ | @sequence f p@ collects sequential parses of parsers in a--- serial stream @p@ using the fold @f@. Fails if the input ends or any--- of the parsers fail.------ /Pre-release/----{-# INLINE sequence #-}-sequence :: Monad m =>-    D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c-sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    initial = do-        fres <- finitial-        case fres of-            FL.Partial fs -> return $ IPartial (Nothing', sstate, fs)-            FL.Done c -> return $ IDone c--    -- state does not contain any parser-    -- yield a new parser from the stream-    step (Nothing', ss, fs) _ = do-        sres <- sstep defState ss-        case sres of-            D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)-            D.Stop -> do-                c <- fextract fs-                return $ Done 1 c-            D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)--    -- state holds a parser that may or may not have been-    -- initialized. pinit holds the initial parser state-    -- or modified parser state respectively-    step (Just' (Parser pstep pinit pextr), ss, fs) a = do-        ps <- pinit-        case ps of-            IPartial ps1 -> do-                pres <- pstep ps1 a-                case pres of-                    Partial n ps2 ->-                        let newP =-                              Just' $ Parser pstep (return $ IPartial ps2) pextr-                        in return $ Partial n (newP, ss, fs)-                    Continue n ps2 ->-                        let newP =-                              Just' $ Parser pstep (return $ IPartial ps2) pextr-                        in return $ Continue n (newP, ss, fs)-                    Done n b -> do-                        fres <- fstep fs b-                        case fres of-                            FL.Partial fs1 ->-                                return $ Partial n (Nothing', ss, fs1)-                            FL.Done c -> return $ Done n c-                    Error msg -> return $ Error msg-            IDone b -> do-                fres <- fstep fs b-                case fres of-                    FL.Partial fs1 ->-                        return $ Partial 1 (Nothing', ss, fs1)-                    FL.Done c -> return $ Done 1 c-            IError err -> return $ Error err--    extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs-    extract (Just' (Parser pstep pinit pextr), ss, fs) = do-        ps <- pinit-        case ps of-            IPartial ps1 ->  do-                r <- pextr ps1-                case r of-                    Done n b -> do-                        res <- fstep fs b-                        case res of-                            FL.Partial fs1 -> fmap (Done n) $ fextract fs1-                            FL.Done c -> return (Done n c)-                    Error err -> return $ Error err-                    Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)-                    Partial _ _ -> error "Partial in extract"-            IDone b -> do-                fres <- fstep fs b-                case fres of-                    FL.Partial fs1 -> fmap (Done 0) $ fextract fs1-                    FL.Done c -> return (Done 0 c)-            IError err -> return $ Error err------------------------------------------------------------------------------------ Alternative Collection----------------------------------------------------------------------------------{---- | @choice parsers@ applies the @parsers@ in order and returns the first--- successful parse.------ This is same as 'asum' but more efficient.------ /Broken/----{-# INLINE choice #-}-choice :: (MonadCatch m, Foldable t) => t (Parser a m b) -> Parser a m b-choice = foldl1 shortest--}------------------------------------------------------------------------------------ Sequential Repetition------------------------------------------------------------------------------------ | Like 'many' but uses a 'Parser' instead of a 'Fold' to collect the--- results. Parsing stops or fails if the collecting parser stops or fails.------ /Unimplemented/----{-# INLINE manyP #-}-manyP :: -- MonadCatch m =>-    Parser a m b -> Parser b m c -> Parser a m c-manyP _p _f = undefined---- | Collect zero or more parses. Apply the supplied parser repeatedly on the--- input stream and push the parse results to a downstream fold.------  Stops: when the downstream fold stops or the parser fails.---  Fails: never, produces zero or more results.------ >>> many = Parser.countBetween 0 maxBound------ Compare with 'Control.Applicative.many'.----{-# INLINE many #-}-many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-many = splitMany--- many = countBetween 0 maxBound---- Note: many1 would perhaps be a better name for this and consistent with--- other names like takeWhile1. But we retain the name "some" for--- compatibility.---- | Collect one or more parses. Apply the supplied parser repeatedly on the--- input stream and push the parse results to a downstream fold.------  Stops: when the downstream fold stops or the parser fails.---  Fails: if it stops without producing a single result.------ >>> some p f = Parser.manyP p (Parser.takeGE 1 f)--- >>> some = Parser.countBetween 1 maxBound------ Compare with 'Control.Applicative.some'.----{-# INLINE some #-}-some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-some = splitSome--- some p f = manyP p (takeGE 1 f)--- some = countBetween 1 maxBound---- | @countBetween m n f p@ collects between @m@ and @n@ sequential parses of--- parser @p@ using the fold @f@. Stop after collecting @n@ results. Fails if--- the input ends or the parser fails before @m@ results are collected.------ >>> countBetween m n p f = Parser.manyP p (Parser.takeBetween m n f)------ /Unimplemented/----{-# INLINE countBetween #-}-countBetween :: -- MonadCatch m =>-    Int -> Int -> Parser a m b -> Fold m b c -> Parser a m c-countBetween _m _n _p = undefined--- countBetween m n p f = manyP p (takeBetween m n f)---- | @count n f p@ collects exactly @n@ sequential parses of parser @p@ using--- the fold @f@.  Fails if the input ends or the parser fails before @n@--- results are collected.------ >>> count n = Parser.countBetween n n--- >>> count n p f = Parser.manyP p (Parser.takeEQ n f)------ /Unimplemented/----{-# INLINE count #-}-count :: -- MonadCatch m =>-    Int -> Parser a m b -> Fold m b c -> Parser a m c-count n = countBetween n n--- count n p f = manyP p (takeEQ n f)---- | Like 'manyTill' but uses a 'Parser' to collect the results instead of a--- 'Fold'.  Parsing stops or fails if the collecting parser stops or fails.------ We can implemnent parsers like the following using 'manyTillP':------ @--- countBetweenTill m n f p = manyTillP (takeBetween m n f) p--- @------ /Unimplemented/----{-# INLINE manyTillP #-}-manyTillP :: -- Monad m =>-    Parser a m b -> Parser a m x -> Parser b m c -> Parser a m c-manyTillP _p1 _p2 _f = undefined-    -- D.toParserK $ D.manyTillP (D.fromParserK p1) (D.fromParserK p2) f--{-# ANN type ManyTillState Fuse #-}-data ManyTillState fs sr sl-    = ManyTillR !Int !fs !sr-    | ManyTillL !fs !sl---- | @manyTill chunking test f@ tries the parser @test@ on the input, if @test@--- fails it backtracks and tries @chunking@, after @chunking@ succeeds @test@ is--- tried again and so on. The parser stops when @test@ succeeds.  The output of--- @test@ is discarded and the output of @chunking@ is accumulated by the--- supplied fold. The parser fails if @chunking@ fails.------ Stops when the fold @f@ stops.----{-# INLINE manyTill #-}-manyTill :: Monad m-    => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-manyTill (Parser stepL initialL extractL)-         (Parser stepR initialR _)-         (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution: Mutual recursion--    scrutL fs p c d e = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ c (ManyTillL fs sl)-            IDone bl -> do-                fr <- fstep fs bl-                case fr of-                    FL.Partial fs1 -> scrutR fs1 p c d e-                    FL.Done fb -> return $ d fb-            IError err -> return $ e err--    scrutR fs p c d e = do-        resR <- initialR-        case resR of-            IPartial sr -> return $ p (ManyTillR 0 fs sr)-            IDone _ -> d <$> fextract fs-            IError _ -> scrutL fs p c d e--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> scrutR fs IPartial IPartial IDone IError-            FL.Done b -> return $ IDone b--    step (ManyTillR cnt fs st) a = do-        r <- stepR st a-        case r of-            Partial n s -> return $ Partial n (ManyTillR 0 fs s)-            Continue n s -> do-                assertM(cnt + 1 - n >= 0)-                return $ Continue n (ManyTillR (cnt + 1 - n) fs s)-            Done n _ -> do-                b <- fextract fs-                return $ Done n b-            Error _ -> do-                resL <- initialL-                case resL of-                    IPartial sl ->-                        return $ Continue (cnt + 1) (ManyTillL fs sl)-                    IDone bl -> do-                        fr <- fstep fs bl-                        let cnt1 = cnt + 1-                        case fr of-                            FL.Partial fs1 ->-                                scrutR-                                    fs1-                                    (Partial cnt1)-                                    (Continue cnt1)-                                    (Done cnt1)-                                    Error-                            FL.Done fb -> return $ Done cnt1 fb-                    IError err -> return $ Error err-    step (ManyTillL fs st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (ManyTillL fs s)-            Continue n s -> return $ Continue n (ManyTillL fs s)-            Done n b -> do-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s ->-                        scrutR s (Partial n) (Continue n) (Done n) Error-                    FL.Done b1 -> return $ Done n b1-            Error err -> return $ Error err--    extract (ManyTillL fs sR) = do-        res <- extractL sR-        case res of-            Done n b -> do-                r <- fstep fs b-                case r of-                    FL.Partial fs1 -> fmap (Done n) $ fextract fs1-                    FL.Done c -> return (Done n c)-            Error err -> return $ Error err-            Continue n s -> return $ Continue n (ManyTillL fs s)-            Partial _ _ -> error "Partial in extract"-    extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs---- | @manyThen f collect recover@ repeats the parser @collect@ on the input and--- collects the output in the supplied fold. If the the parser @collect@ fails,--- parser @recover@ is run until it stops and then we start repeating the--- parser @collect@ again. The parser fails if the recovery parser fails.------ For example, this can be used to find a key frame in a video stream after an--- error.------ /Unimplemented/----{-# INLINE manyThen #-}-manyThen :: -- (Foldable t, Monad m) =>-    Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c-manyThen _parser _recover _f = undefined------------------------------------------------------------------------------------ Repeated Alternatives------------------------------------------------------------------------------------ | Keep trying a parser up to a maximum of @n@ failures.  When the parser--- fails the input consumed till now is dropped and the new instance is tried--- on the fresh input.------ /Unimplemented/----{-# INLINE retryMaxTotal #-}-retryMaxTotal :: -- (Monad m) =>-    Int -> Parser a m b -> Fold m b c -> Parser a m c-retryMaxTotal _n _p _f  = undefined---- | Like 'retryMaxTotal' but aborts after @n@ successive failures.------ /Unimplemented/----{-# INLINE retryMaxSuccessive #-}-retryMaxSuccessive :: -- (Monad m) =>-    Int -> Parser a m b -> Fold m b c -> Parser a m c-retryMaxSuccessive _n _p _f = undefined---- | Keep trying a parser until it succeeds.  When the parser fails the input--- consumed till now is dropped and the new instance is tried on the fresh--- input.------ /Unimplemented/----{-# INLINE retry #-}-retry :: -- (Monad m) =>-    Parser a m b -> Parser a m b-retry _p = undefined
− src/Streamly/Internal/Data/Parser/ParserD/Tee.hs 
@@ -1,617 +0,0 @@-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}--#include "inline.hs"---- |--- Module      : Streamly.Internal.Data.Parser.ParserD.Tee--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Parallel parsers. Distributing the input to multiple parsers at the same--- time.------ For simplicity, we are using code where a particular state is unreachable--- but it is not prevented by types.  Somehow uni-pattern match using "let"--- produces better optimized code compared to using @case@ match and using--- explicit error messages in unreachable cases.------ There seem to be no way to silence individual warnings so we use a global--- incomplete uni-pattern match warning suppression option for the file.--- Disabling the warning for other code as well  has the potential to mask off--- some legit warnings, therefore, we have segregated only the code that uses--- uni-pattern matches in this module.--module Streamly.Internal.Data.Parser.ParserD.Tee-    (-    {--    -- Parallel zipped-      teeWith-    , teeWithFst-    , teeWithMin--    -- Parallel alternatives-    , shortest-    , longest-    -}-    )-where--{--import Control.Exception (assert)-import Control.Monad.Catch (MonadCatch, try)-import Prelude-       hiding (any, all, takeWhile)--import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Parser.ParserD.Type-       (Initial(..), Parser(..), Step(..), ParseError)------------------------------------------------------------------------------------ Distribute input to two parsers and collect both results------------------------------------------------------------------------------------ When the input stream is distributed to two parsers, both the parsers can--- backtrack independently. Therefore, we need separate buffer state for each--- parser.------ ParserK------ We can keep the state of each parser in the zipper and pass around that--- zipper to the parsers. Each parser can consume from the zipper and then pass--- around the zipper to the other parser.------ ParserD------ In the approach we have taken here, the driver pushes one element at a time--- to the tee and each of the parsers in the tee may buffer it independently--- for backtracking. So they do not need to depend on the original stream--- source for individual parser backtracking. Problem arises when both the--- parsers backtrack and they do not need any input from the driver rather they--- must consume from their buffers. For such situation we may need a--- "Continue" style driver command from the tee so that the driver runs--- the tee without providing it any input. Or we may need a local driver loop--- until new input is to be demanded from the input stream.------ When the tee errors out or stops, the tee driver may have to backtrack by--- the specified amount (or the tee must return the leftover input). Therefore,--- the tee driver also has to buffer, this leads to triple buffering.------ When the tee stops we need to determine the backtracking amount from the--- leftover of both the parsers. Since both the parsers may have consumed--- different lengths of the stream we consider the maximum of the two as--- consumed.----  -- XXX We can use Initial instead of StepState-{-# ANN type StepState Fuse #-}-data StepState s a = StepState s | StepResult a---- | State of the pair of parsers in a tee composition--- Note: strictness annotation is important for fusing the constructors-{-# ANN type TeeState Fuse #-}-data TeeState sL sR x a b =--- @TeePair (past buffer, parser state, future-buffer1, future-buffer2) ...@-    TeePair !([x], StepState sL a, [x], [x]) !([x], StepState sR b, [x], [x])--{-# ANN type Res Fuse #-}-data Res = Yld Int | Stp Int | Skp | Err String---- | See 'Streamly.Internal.Data.Parser.teeWith'.------ /Broken/----{-# INLINE teeWith #-}-teeWith :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError err -> IError err-            IDone bl ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult bl, [], [])-                                            ([], StepState sr, [], [])-                     IDone br -> IDone $ zf bl br-                     IError err -> IError err-            IError err -> IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- XXX This is currently broken, even though both the parsers need to-    -- consume from their buffers after backtracking the driver would still be-    -- pushing more input to the buffers.-    ---    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n s ->-                let src0 = Prelude.take n buf1-                    src  = Prelude.reverse src0-                    state = ([], StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Yld n))-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Yld n1, Stp n2) -> Partial (min n1 n2) next-            (Stp n1, Yld n2) -> Partial (min n1 n2) next-            (Stp n1, Stp n2) ->-                -- Uni-pattern match results in better optimized code compared-                -- to a case match.-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in Done (min n1 n2) (zf rL rR)-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult rR, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        -- XXX If the unused count of this stream is lower than the unused-        -- count of the stopped stream, only then this will be correct. We need-        -- to fix the other case. We need to keep incrementing the unused count-        -- of the stopped stream and take the min of the two.-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n (zf rL rR)-            Skp -> Continue 0 next-            Err err -> Error err--    step (TeePair l@(_, StepResult rL, _, _)-                    (bufR, StepState sR, inpR1, inpR2)) x = do-        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        -- XXX If the unused count of this stream is lower than the unused-        -- count of the stopped stream, only then this will be correct. We need-        -- to fix the other case. We need to keep incrementing the unused count-        -- of the stopped stream and take the min of the two.-        return $ case stR of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rR, _, _) = r-                 in Done n (zf rL rR)-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                rL <- extractL sL-                rR <- extractR sR-                return $ zf rL rR-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                rL <- extractL sL-                return $ zf rL rR-            TeePair (_, StepResult  rL, _, _) (_, StepState sR, _, _) -> do-                rR <- extractR sR-                return $ zf rL rR-            TeePair (_, StepResult rL, _, _) (_, StepResult rR, _, _) ->-                return $ zf rL rR---- | See 'Streamly.Internal.Data.Parser.teeWithFst'.------ /Broken/----{-# INLINE teeWithFst #-}-teeWithFst :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-teeWithFst zf (Parser stepL initialL extractL)-              (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        case resL of-            IPartial sl ->-                return $ case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError err -> IError err-            IDone bl ->-                case resR of-                     IPartial sr -> IDone . zf bl <$> extractR sr-                     IDone br -> return $ IDone $ zf bl br-                     IError err -> return $ IError err-            IError err -> return $ IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        case (stL,stR) of-            -- XXX what if the first parser returns an unused count which is-            -- more than the second parser's unused count? It does not make-            -- sense for the second parser to consume more than the first-            -- parser. We reset the input cursor based on the first parser.-            -- Error out if the second one has consumed more then the first?-            (Stp n1, Stp _) ->-                -- Uni-pattern match results in better optimized code compared-                -- to a case match.-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in return $ Done n1 (zf rL rR)-            (Stp n1, Yld _) ->-                let (_, StepResult rL, _, _) = l-                    (_, StepState  ssR, _, _) = r-                 in do-                    rR <- extractR ssR-                    return $ Done n1 (zf rL rR)-            (Yld n1, Yld n2) -> return $ Partial (min n1 n2) next-            (Yld n1, Stp n2) -> return $ Partial (min n1 n2) next-            (Err err, _) -> return $ Error err-            (_, Err err) -> return $ Error err-            _ -> return $ Continue 0 next--    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult rR, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        -- XXX If the unused count of this stream is lower than the unused-        -- count of the stopped stream, only then this will be correct. We need-        -- to fix the other case. We need to keep incrementing the unused count-        -- of the stopped stream and take the min of the two.-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n (zf rL rR)-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                rL <- extractL sL-                rR <- extractR sR-                return $ zf rL rR-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                rL <- extractL sL-                return $ zf rL rR-            _ -> error "unreachable"---- | See 'Streamly.Internal.Data.Parser.teeWithMin'.------ /Unimplemented/----{-# INLINE teeWithMin #-}-teeWithMin ::-    -- Monad m =>-    (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-teeWithMin = undefined------------------------------------------------------------------------------------ Distribute input to two parsers and choose one result------------------------------------------------------------------------------------ | See 'Streamly.Internal.Data.Parser.shortest'.------ /Broken/----{-# INLINE shortest #-}-shortest :: Monad m => Parser x m a -> Parser x m a -> Parser x m a-shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =-    Parser step initial extract--    where--    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IDone br-                     IError err -> IError err-            IDone bl -> IDone bl-            IError errL ->-                case resR of-                     IPartial _ -> IError errL-                     IDone br -> IDone br-                     IError errR -> IError errR--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    -- XXX Even if a parse finished earlier it may not be shortest if the other-    -- parser finishes later but returns a lot of unconsumed input. Our current-    -- criterion of shortest is whichever parse decided to stop earlier.-    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Stp n1, _) ->-                let (_, StepResult rL, _, _) = l-                 in Done n1 rL-            (_, Stp n2) ->-                let (_, StepResult rR, _, _) = r-                 in Done n2 rR-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        case st of-            TeePair (_, StepState sL, _, _) _ -> extractL sL-            _ -> error "unreachable"---- | See 'Streamly.Internal.Data.Parser.longest'.------ /Broken/----{-# INLINE longest #-}-longest :: MonadCatch m => Parser x m a -> Parser x m a -> Parser x m a-longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where---    {-# INLINE_LATE initial #-}-    initial = do-        resL <- initialL-        resR <- initialR-        return $ case resL of-            IPartial sl ->-                case resR of-                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])-                                                       ([], StepState sr, [], [])-                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])-                                                    ([], StepResult br, [], [])-                     IError _ ->-                         IPartial $ TeePair ([], StepState sl, [], [])-                                            ([], StepResult undefined, [], [])-            IDone bl ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult bl, [], [])-                                            ([], StepState sr, [], [])-                     IDone _ -> IDone bl-                     IError _ -> IDone bl-            IError _ ->-                case resR of-                     IPartial sr ->-                         IPartial $ TeePair ([], StepResult undefined, [], [])-                                            ([], StepState sr, [], [])-                     IDone br -> IDone br-                     IError err -> IError err--    {-# INLINE consume #-}-    consume buf inp1 inp2 stp st y = do-        let (x, inp11, inp21) =-                case inp1 of-                    [] -> (y, [], [])-                    z : [] -> (z, reverse (x:inp2), [])-                    z : zs -> (z, zs, x:inp2)-        r <- stp st x-        let buf1 = x:buf-        return (buf1, r, inp11, inp21)--    -- consume one input item and return the next state of the fold-    {-# INLINE useStream #-}-    useStream buf inp1 inp2 stp st y = do-        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y-        case r of-            Partial 0 s ->-                let state = ([], StepState s, inp11, inp21)-                 in return (state, Yld 0)-            Partial n _ -> return (undefined, Yld n) -- Not implemented-            Done n b ->-                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)-                 in assert (n <= length buf1) (return (state, Stp n))-            -- Continue 0 s -> (buf1, Right s, inp11, inp21)-            Continue n s ->-                let (src0, buf2) = splitAt n buf1-                    src  = Prelude.reverse src0-                    state = (buf2, StepState s, src ++ inp11, inp21)-                 in assert (n <= length buf1) (return (state, Skp))-            Error err -> return (undefined, Err err)--    {-# INLINE_LATE step #-}-    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                  (bufR, StepState sR, inpR1, inpR2)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case (stL,stR) of-            (Yld n1, Yld n2) -> Partial (min n1 n2) next-            (Yld n1, Stp n2) -> Partial (min n1 n2) next-            (Stp n1, Yld n2) -> Partial (min n1 n2) next-            (Stp n1, Stp n2) ->-                let (_, StepResult rL, _, _) = l-                    (_, StepResult rR, _, _) = r-                 in Done (max n1 n2) (if n1 >= n2 then rL else rR)-            (Err err, _) -> Error err-            (_, Err err) -> Error err-            _ -> Continue 0 next--    -- XXX the parser that finishes last may not be the longest because it may-    -- return a lot of unused input which makes it shorter. Our current-    -- criterion of deciding longest is based on whoever decides to finish-    -- last and not whoever consumed more input.-    ---    -- To actually know who made more progress we need to keep an account of-    -- how many items are unconsumed since the last yield.-    ---    step (TeePair (bufL, StepState sL, inpL1, inpL2)-                r@(_, StepResult _, _, _)) x = do-        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x-        let next = TeePair l r-        return $ case stL of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rL, _, _) = l-                 in Done n rL-            Skp -> Continue 0 next-            Err err -> Error err--    step (TeePair l@(_, StepResult _, _, _)-                    (bufR, StepState sR, inpR1, inpR2)) x = do-        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x-        let next = TeePair l r-        return $ case stR of-            Yld n -> Partial n next-            Stp n ->-                let (_, StepResult rR, _, _) = r-                 in Done n rR-            Skp -> Continue 0 next-            Err err -> Error err--    step _ _ = undefined--    {-# INLINE_LATE extract #-}-    extract st =-        -- XXX When results are partial we may not be able to precisely compare-        -- which parser has made more progress till now.  One way to do that is-        -- to figure out the actually consumed input up to the last yield.-        ---        case st of-            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do-                r <- try $ extractL sL-                case r of-                    Left (_ :: ParseError) -> extractR sR-                    Right b -> return b-            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do-                r <- try $ extractL sL-                case r of-                    Left (_ :: ParseError) -> return rR-                    Right b -> return b-            TeePair (_, StepResult rL, _, _) (_, StepState sR, _, _) -> do-                r <- try $ extractR sR-                case r of-                    Left (_ :: ParseError) -> return rL-                    Right b -> return b-            TeePair (_, StepResult _, _, _) (_, StepResult _, _, _) ->-                error "unreachable"--}
− src/Streamly/Internal/Data/Parser/ParserD/Type.hs 
@@ -1,1429 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Parser.ParserD.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Streaming and backtracking parsers.------ Parsers just extend folds.  Please read the 'Fold' design notes in--- "Streamly.Internal.Data.Fold.Type" for background on the design.------ = Parser Design------ The 'Parser' type or a parsing fold is a generalization of the 'Fold' type.--- The 'Fold' type /always/ succeeds on each input. Therefore, it does not need--- to buffer the input. In contrast, a 'Parser' may fail and backtrack to--- replay the input again to explore another branch of the parser. Therefore,--- it needs to buffer the input. Therefore, a 'Parser' is a fold with some--- additional requirements.  To summarize, unlike a 'Fold', a 'Parser':------ 1. may not generate a new value of the accumulator on every input, it may--- generate a new accumulator only after consuming multiple input elements--- (e.g. takeEQ).--- 2. on success may return some unconsumed input (e.g. takeWhile)--- 3. may fail and return all input without consuming it (e.g. satisfy)--- 4. backtrack and start inspecting the past input again (e.g. alt)------ These use cases require buffering and replaying of input.  To facilitate--- this, the step function of the 'Fold' is augmented to return the next state--- of the fold along with a command tag using a 'Step' functor, the tag tells--- the fold driver to manipulate the future input as the parser wishes. The--- 'Step' functor provides the following commands to the fold driver--- corresponding to the use cases outlined in the previous para:------ 1. 'Continue': buffer the current input and optionally go back to a previous---    position in the stream--- 2. 'Partial': buffer the current input and optionally go back to a previous---    position in the stream, drop the buffer before that position.--- 3. 'Done': parser succeeded, returns how much input was leftover--- 4. 'Error': indicates that the parser has failed without a result------ = How a Parser Works?------ A parser is just like a fold, it keeps consuming inputs from the stream and--- accumulating them in an accumulator. The accumulator of the parser could be--- a singleton value or it could be a collection of values e.g. a list.------ The parser may build a new output value from multiple input items. When it--- consumes an input item but needs more input to build a complete output item--- it uses @Continue 0 s@, yielding the intermediate state @s@ and asking the--- driver to provide more input.  When the parser determines that a new output--- value is complete it can use a @Done n b@ to terminate the parser with @n@--- items of input unused and the final value of the accumulator returned as--- @b@. If at any time the parser determines that the parse has failed it can--- return @Error err@.------ A parser building a collection of values (e.g. a list) can use the @Partial@--- constructor whenever a new item in the output collection is generated. If a--- parser building a collection of values has yielded at least one value then--- it is considered successful and cannot fail after that. In the current--- implementation, this is not automatically enforced, there is a rule that the--- parser MUST use only @Done@ for termination after the first @Partial@, it--- cannot use @Error@. It may be possible to change the implementation so that--- this rule is not required, but there may be some performance cost to it.------ 'Streamly.Internal.Data.Parser.takeWhile' and--- 'Streamly.Internal.Data.Parser.some' combinators are good examples of--- efficient implementations using all features of this representation.  It is--- possible to idiomatically build a collection of parsed items using a--- singleton parser and @Alternative@ instance instead of using a--- multi-yield parser.  However, this implementation is amenable to stream--- fusion and can therefore be much faster.------ = Error Handling------ When a parser's @step@ function is invoked it may terminate by either a--- 'Done' or an 'Error' return value. In an 'Alternative' composition an error--- return can make the composed parser backtrack and try another parser.------ If the stream stops before a parser could terminate then we use the--- @extract@ function of the parser to retrieve the last yielded value of the--- parser. If the parser has yielded at least one value then @extract@ MUST--- return a value without throwing an error, otherwise it uses the 'ParseError'--- exception to throw an error.------ We chose the exception throwing mechanism for @extract@ instead of using an--- explicit error return via an 'Either' type for keeping the interface simple--- as most of the time we do not need to catch the error in intermediate--- layers. Note that we cannot use exception throwing mechanism in @step@--- function because of performance reasons. 'Error' constructor in that case--- allows loop fusion and better performance.------ = Optimizing backtracking------ == Applicative Composition------ If a parser once returned 'Partial' it can never fail after that. This is--- used to reduce the buffering. A 'Partial' results in dropping the buffer and--- we cannot backtrack before that point.------ Parsers can be composed using an Alternative, if we are in an alternative--- composition we may have to backtrack to try the other branch.  When we--- compose two parsers using applicative @f <$> p1 <*> p2@ we can return a--- 'Partial' result only after both the parsers have succeeded. While running--- @p1@ we have to ensure that the input is not dropped until we have run @p2@,--- therefore we have to return a Continue instead of a Partial.------ However, if we know they both cannot fail then we know that the composed--- parser can never fail.  For this reason we should have "backtracking folds"--- as a separate type so that we can compose them in an efficient manner. In p1--- itself we can drop the buffer as soon as a 'Partial' result arrives. In--- fact, there is no Alternative composition for folds because they cannot--- fail.------ == Alternative Composition------ In @p1 <|> p2@ as soon as the parser p1 returns 'Partial' we know that it--- will not fail and we can immediately drop the buffer.------ If we are not using the parser in an alternative composition we can--- downgrade the parser to a backtracking fold and use the "backtracking--- fold"'s applicative for more efficient implementation. To downgrade we can--- translate the "Error" of parser to an exception.  This gives us best of both--- worlds, the applicative as well as alternative would have optimal--- backtracking buffer.------ The "many" for parsers would be different than "many" for folds. In case of--- folds an error would be propagated. In case of parsers the error would be--- ignored.------ = Implementation Approach------ Backtracking folds have an issue with tee style composition because each--- fold can backtrack independently, we will need independent buffers. Though--- this may be possible to implement it may not be efficient especially for--- folds that do not backtrack at all. Three types are possible, optimized for--- different use cases:------ * Non-backtracking folds: efficient Tee--- * Backtracking folds: efficient applicative--- * Parsers: alternative------ Downgrade parsers to backtracking folds for applicative used without--- alternative.  Upgrade backtracking folds to parsers when we have to use them--- as the last alternative.------ = Future Work------ It may make sense to move "takeWhile" type of parsers, which cannot fail but--- need some lookahead, to splitting folds.  This will allow such combinators--- to be accepted where we need an unfailing "Fold" type.------ Based on application requirements it should be possible to design even a--- richer interface to manipulate the input stream/buffer. For example, we--- could randomly seek into the stream in the forward or reverse directions or--- we can even seek to the end or from the end or seek from the beginning.------ We can distribute and scan/parse a stream using both folds and parsers and--- merge the resulting streams using different merge strategies (e.g.--- interleaving or serial).------ == Naming------ As far as possible, try that the names of the combinators in this module are--- consistent with:------ * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>--- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>--- * <http://hackage.haskell.org/package/megaparsec megaparsec>--- * <http://hackage.haskell.org/package/attoparsec attoparsec>--- * <http://hackage.haskell.org/package/parsec parsec>--module Streamly.Internal.Data.Parser.ParserD.Type-    (-    -- * Setup-    -- $setup--    -- * Types-      Initial (..)-    , Step (..)-    , extractStep-    , bimapOverrideCount-    , Parser (..)-    , ParseError (..)-    , rmapM--    -- * Constructors--    , fromPure-    , fromEffect-    , splitWith-    , split_--    , die-    , dieM-    , splitSome -- parseSome?-    , splitMany -- parseMany?-    , splitManyPost-    , alt-    , concatMap--    -- * Input transformation-    , lmap-    , lmapM-    , filter--    , noErrorUnsafeSplitWith-    , noErrorUnsafeSplit_-    , noErrorUnsafeConcatMap-    )-where--#include "inline.hs"-#include "assert.hs"--import Control.Applicative (Alternative(..), liftA2)-import Control.Exception (Exception(..))--- import Control.Monad (MonadPlus(..), (>=>))-import Control.Monad ((>=>))-import Control.Monad.IO.Class (MonadIO, liftIO)-import Data.Bifunctor (Bifunctor(..))-import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Fold.Type (Fold(..), toList)--import qualified Control.Monad.Fail as Fail-import qualified Streamly.Internal.Data.Fold.Type as FL--import Prelude hiding (concatMap, filter)--#include "DocTestDataParser.hs"---- XXX The only differences between Initial and Step types are:------ * There are no backtracking counts in Initial--- * Continue and Partial are the same. Ideally Partial should mean that an--- empty result is valid and can be extracted; and Continue should mean that--- empty would result in an error on extraction. We can possibly distinguish--- the two cases.------ If we ignore the backtracking counts we can represent the Initial type using--- Step itself. That will also simplify the implementation of various parsers--- where the processing in intiial is just a sepcial case of step, see--- takeBetween for example.---- | The type of a 'Parser''s initial action.------ /Internal/----{-# ANN type Initial Fuse #-}-data Initial s b-    = IPartial !s   -- ^ Wait for step function to be called with state @s@.-    | IDone !b      -- ^ Return a result right away without an input.-    | IError !String -- ^ Return an error right away without an input.---- | @first@ maps on 'IPartial' and @second@ maps on 'IDone'.------ /Internal/----instance Bifunctor Initial where-    {-# INLINE bimap #-}-    bimap f _ (IPartial a) = IPartial (f a)-    bimap _ g (IDone b) = IDone (g b)-    bimap _ _ (IError err) = IError err---- | Maps a function over the result held by 'IDone'.------ >>> fmap = second------ /Internal/----instance Functor (Initial s) where-    {-# INLINE fmap #-}-    fmap = second---- We can simplify the Step type as follows:------ Partial Int (Either s (s, b)) -- Left continue, right partial result--- Done Int (Either String b)------ In this case Error may also have a "leftover" return. This means that after--- several successful partial results the last segment parsing failed and we--- are returning the leftover of that. The driver may choose to restart from--- the last segment where this parser failed or from the beginning.------ Folds can only return the right values. Parsers can also return lefts.---- | The return type of a 'Parser' step.------ The parse operation feeds the input stream to the parser one element at a--- time, representing a parse 'Step'. The parser may or may not consume the--- item and returns a result. If the result is 'Partial' we can either extract--- the result or feed more input to the parser. If the result is 'Continue', we--- must feed more input in order to get a result. If the parser returns 'Done'--- then the parser can no longer take any more input.------ If the result is 'Continue', the parse operation retains the input in a--- backtracking buffer, in case the parser may ask to backtrack in future.--- Whenever a 'Partial n' result is returned we first backtrack by @n@ elements--- in the input and then release any remaining backtracking buffer. Similarly,--- 'Continue n' backtracks to @n@ elements before the current position and--- starts feeding the input from that point for future invocations of the--- parser.------ If parser is not yet done, we can use the @extract@ operation on the @state@--- of the parser to extract a result. If the parser has not yet yielded a--- result, the operation fails with a 'ParseError' exception. If the parser--- yielded a 'Partial' result in the past the last partial result is returned.--- Therefore, if a parser yields a partial result once it cannot fail later on.------ The parser can never backtrack beyond the position where the last partial--- result left it at. The parser must ensure that the backtrack position is--- always after that.------ /Pre-release/----{-# ANN type Step Fuse #-}-data Step s b =-        Partial !Int !s-    -- ^ @Partial count state@. The following hold on Partial result:-    ---    -- 1. @extract@ on @state@ would succeed and give a result.-    -- 2. Input stream position is reset to @current position - count@.-    -- 3. All input before the new position is dropped. The parser can-    -- never backtrack beyond this position.--    | Continue !Int !s-    -- ^ @Continue count state@. The following hold on a Continue result:-    ---    -- 1. If there was a 'Partial' result in past, @extract@ on @state@ would-    -- give that result as 'Done' otherwise it may return 'Error' or-    -- 'Continue'.-    -- 2. Input stream position is reset to @current position - count@.-    -- 3. the input is retained in a backtrack buffer.--    | Done !Int !b-    -- ^ Done with leftover input count and result.-    ---    -- @Done count result@ means the parser has finished, it will accept no-    -- more input, last @count@ elements from the input are unused and the-    -- result of the parser is in @result@.--    | Error !String-    -- ^ Parser failed without generating any output.-    ---    -- The parsing operation may backtrack to the beginning and try another-    -- alternative.---- | Map first function over the state and second over the result.-instance Bifunctor Step where-    {-# INLINE bimap #-}-    bimap f g step =-        case step of-            Partial n s -> Partial n (f s)-            Continue n s -> Continue n (f s)-            Done n b -> Done n (g b)-            Error err -> Error err---- | Bimap discarding the count, and using the supplied count instead.-bimapOverrideCount :: Int -> (s -> s1) -> (b -> b1) -> Step s b -> Step s1 b1-bimapOverrideCount n f g step =-    case step of-        Partial _ s -> Partial n (f s)-        Continue _ s -> Continue n (f s)-        Done _ b -> Done n (g b)-        Error err -> Error err---- | fmap = second-instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap = second--{-# INLINE assertStepCount #-}-assertStepCount :: Int -> Step s b -> Step s b-assertStepCount i step =-    case step of-        Partial n _ -> assert (i == n) step-        Continue n _ -> assert (i == n) step-        Done n _ -> assert (i == n) step-        Error _ -> step---- | Map an extract function over the state of Step----{-# INLINE extractStep #-}-extractStep :: Monad m => (s -> m (Step s1 b)) -> Step s b -> m (Step s1 b)-extractStep f res =-    case res of-        Partial n s1 -> assertStepCount n <$> f s1-        Done n b -> return $ Done n b-        Continue n s1 -> assertStepCount n <$> f s1-        Error err -> return $ Error err---- | Map a monadic function over the result @b@ in @Step s b@.------ /Internal/-{-# INLINE mapMStep #-}-mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)-mapMStep f res =-    case res of-        Partial n s -> pure $ Partial n s-        Done n b -> Done n <$> f b-        Continue n s -> pure $ Continue n s-        Error err -> pure $ Error err---- | A parser is a fold that can fail and is represented as @Parser step--- initial extract@. Before we drive a parser we call the @initial@ action to--- retrieve the initial state of the fold. The parser driver invokes @step@--- with the state returned by the previous step and the next input element. It--- results into a new state and a command to the driver represented by 'Step'--- type. The driver keeps invoking the step function until it stops or fails.--- At any point of time the driver can call @extract@ to inspect the result of--- the fold. If the parser hits the end of input 'extract' is called.--- It may result in an error or an output value.------ /Pre-release/----data Parser a m b =-    forall s. Parser-        (s -> a -> m (Step s b))-        -- Initial cannot return "Partial/Done n" or "Continue". Continue 0 is-        -- same as Partial 0. In other words it cannot backtrack.-        (m (Initial s b))-        -- Extract can only return Partial or Continue n. In other words it can-        -- only backtrack or return partial result/error. But we do not return-        -- result in Partial, therefore, we have to use Done instead of Partial.-        (s -> m (Step s b))---- | This exception is used when a parser ultimately fails, the user of the--- parser is intimated via this exception.------ /Pre-release/----newtype ParseError = ParseError String-    deriving Show--instance Exception ParseError where-    displayException (ParseError err) = err--instance Functor m => Functor (Parser a m) where-    {-# INLINE fmap #-}-    fmap f (Parser step1 initial1 extract) =-        Parser step initial (fmap3 f extract)--        where--        initial = fmap2 f initial1-        step s b = fmap2 f (step1 s b)-        fmap2 g = fmap (fmap g)-        fmap3 g = fmap2 (fmap g)----------------------------------------------------------------------------------- Mapping on the output----------------------------------------------------------------------------------- | @rmapM f parser@ maps the monadic function @f@ on the output of the parser.------ >>> rmap = fmap-{-# INLINE rmapM #-}-rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c-rmapM f (Parser step initial extract) =-    Parser step1 initial1 (extract >=> mapMStep f)--    where--    initial1 = do-        res <- initial-        -- this is mapM f over result-        case res of-            IPartial x -> return $ IPartial x-            IDone a -> IDone <$> f a-            IError err -> return $ IError err-    step1 s a = step s a >>= mapMStep f---- | A parser that always yields a pure value without consuming any input.----{-# INLINE_NORMAL fromPure #-}-fromPure :: Monad m => b -> Parser a m b-fromPure b = Parser undefined (pure $ IDone b) undefined---- | A parser that always yields the result of an effectful action without--- consuming any input.----{-# INLINE fromEffect #-}-fromEffect :: Monad m => m b -> Parser a m b-fromEffect b = Parser undefined (IDone <$> b) undefined------------------------------------------------------------------------------------ Sequential applicative----------------------------------------------------------------------------------{-# ANN type SeqParseState Fuse #-}-data SeqParseState sl f sr = SeqParseL !sl | SeqParseR !f !sr---- Note: this implementation of splitWith is fast because of stream fusion but--- has quadratic time complexity, because each composition adds a new branch--- that each subsequent parse's input element has to go through, therefore, it--- cannot scale to a large number of compositions. After around 100--- compositions the performance starts dipping rapidly beyond a CPS style--- unfused implementation.------ Note: This is a parsing dual of appending streams using--- 'Streamly.Data.Stream.append', it splits the streams using two parsers and--- zips the results.---- | Sequential parser application.------ Apply two parsers sequentially to an input stream. The first parser runs and--- processes the input, the remaining input is then passed to the second--- parser. If both parsers succeed, their outputs are combined using the--- supplied function. If either parser fails, the operation fails.------ This implementation is strict in the second argument, therefore, the--- following will fail:------ >>> Stream.parse (Parser.splitWith const (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]--- *** Exception: Prelude.undefined--- ...------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions.--- As a thumb rule use it for less than 8 compositions, use ParserK otherwise.------ Below are some common idioms that can be expressed using 'splitWith' and--- other parser primitives:------ >>> span p f1 f2 = Parser.splitWith (,) (Parser.takeWhile p f1) (Parser.fromFold f2)--- >>> spanBy eq f1 f2 = Parser.splitWith (,) (Parser.groupBy eq f1) (Parser.fromFold f2)------ /Pre-release/----{-# INLINE splitWith #-}-splitWith :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-splitWith func (Parser stepL initialL extractL)-               (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        -- XXX We can use bimap here if we make this a Step type-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqParseL sl-            IDone bl -> do-                resR <- initialR-                -- XXX We can use bimap here if we make this a Step type-                return $ case resR of-                    IPartial sr -> IPartial $ SeqParseR (func bl) sr-                    IDone br -> IDone (func bl br)-                    IError err -> IError err-            IError err -> return $ IError err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqParseL st) a = do-        -- Important: Please do not use Applicative here. See-        -- https://github.com/composewell/streamly/issues/1033 and the problem-        -- defined in split_ for more info.-        -- XXX Use bimap-        resL <- stepL st a-        case resL of-            -- Note: We need to buffer the input for a possible Alternative-            -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to-            -- backtrack and start running p3. So we need to keep the input-            -- buffered until we know that the applicative cannot fail.-            Partial n s -> return $ Continue n (SeqParseL s)-            Continue n s -> return $ Continue n (SeqParseL s)-            Done n b -> do-                -- XXX Use bimap if we make this a Step type-                -- fmap (bimap (SeqParseR (func b)) (func b)) initialR-                initR <- initialR-                return $ case initR of-                   IPartial sr -> Continue n $ SeqParseR (func b) sr-                   IDone br -> Done n (func b br)-                   IError err -> Error err-            Error err -> return $ Error err--    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)--    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)-    extract (SeqParseL sL) = do-        -- XXX Use bimap here-        rL <- extractL sL-        case rL of-            Done n bL -> do-                -- XXX Use bimap here if we use Step type in Initial-                iR <- initialR-                case iR of-                    IPartial sR -> do-                        fmap-                            (bimap (SeqParseR (func bL)) (func bL))-                            (extractR sR)-                    IDone bR -> return $ Done n $ func bL bR-                    IError err -> return $ Error err-            Error err -> return $ Error err-            Partial _ _ -> error "Bug: splitWith extract 'Partial'"-            Continue n s -> return $ Continue n (SeqParseL s)------------------------------------------------------------------------------------ Sequential applicative for backtracking folds------------------------------------------------------------------------------------ XXX Create a newtype for nonfailing parsers and downgrade the parser to that--- type before this operation and then upgrade.------ We can do an inspection testing to reject unwanted constructors at compile--- time.------ We can use the compiler to automatically annotate accumulators, terminating--- folds, non-failing parsers and failing parsers.---- | Works correctly only if both the parsers are guaranteed to never fail.-{-# INLINE noErrorUnsafeSplitWith #-}-noErrorUnsafeSplitWith :: Monad m-    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c-noErrorUnsafeSplitWith func (Parser stepL initialL extractL)-               (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    errMsg e = error $ "noErrorUnsafeSplitWith: unreachable: " ++ e--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqParseL sl-            IDone bl -> do-                resR <- initialR-                return $ bimap (SeqParseR (func bl)) (func bl) resR-            IError err -> errMsg err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqParseL st) a = do-        r <- stepL st a-        case r of-            -- Assume that the parser can never fail, therefore, we do not-            -- need to keep the input for backtracking.-            Partial n s -> return $ Partial n (SeqParseL s)-            Continue n s -> return $ Continue n (SeqParseL s)-            Done n b -> do-                res <- initialR-                return-                    $ case res of-                          IPartial sr -> Partial n $ SeqParseR (func b) sr-                          IDone br -> Done n (func b br)-                          IError err -> errMsg err-            Error err -> errMsg err--    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)--    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)--    extract (SeqParseL sL) = do-        rL <- extractL sL-        case rL of-            Done n bL -> do-                iR <- initialR-                case iR of-                    IPartial sR -> do-                        rR <- extractR sR-                        return-                            $ bimapOverrideCount-                                n (SeqParseR (func bL)) (func bL) rR-                    IDone bR -> return $ Done n $ func bL bR-                    IError err -> errMsg err-            Error err -> errMsg err-            Partial _ _ -> errMsg "Partial"-            Continue n s -> return $ Continue n (SeqParseL s)--{-# ANN type SeqAState Fuse #-}-data SeqAState sl sr = SeqAL !sl | SeqAR !sr---- This turns out to be slightly faster than splitWith---- | Sequential parser application ignoring the output of the first parser.--- Apply two parsers sequentially to an input stream.  The input is provided to--- the first parser, when it is done the remaining input is provided to the--- second parser. The output of the parser is the output of the second parser.--- The operation fails if any of the parsers fail.------ This implementation is strict in the second argument, therefore, the--- following will fail:------ >>> Stream.parse (Parser.split_ (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]--- *** Exception: Prelude.undefined--- ...------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions.--- As a thumb rule use it for less than 8 compositions, use ParserK otherwise.------ /Pre-release/----{-# INLINE split_ #-}-split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b-split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqAL sl-            IDone _ -> do-                resR <- initialR-                return $ first SeqAR resR-            IError err -> return $ IError err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqAL st) a = do-        -- Important: Do not use Applicative here. Applicative somehow caused-        -- the right action to run many times, not sure why though.-        resL <- stepL st a-        case resL of-            -- Note: this leads to buffering even if we are not in an-            -- Alternative composition.-            Partial n s -> return $ Continue n (SeqAL s)-            Continue n s -> return $ Continue n (SeqAL s)-            Done n _ -> do-                initR <- initialR-                return $ case initR of-                    IPartial s -> Continue n (SeqAR s)-                    IDone b -> Done n b-                    IError err -> Error err-            Error err -> return $ Error err--    step (SeqAR st) a = first SeqAR <$> stepR st a--    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)-    extract (SeqAL sL) = do-        rL <- extractL sL-        case rL of-            Done n _ -> do-                iR <- initialR-                -- XXX For initial we can have a bimap with leftover.-                case iR of-                    IPartial sR ->-                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)-                    IDone bR -> return $ Done n bR-                    IError err -> return $ Error err-            Error err -> return $ Error err-            Partial _ _ -> error "split_: Partial"-            Continue n s -> return $ Continue n (SeqAL s)---- For backtracking folds-{-# INLINE noErrorUnsafeSplit_ #-}-noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b-noErrorUnsafeSplit_-    (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    errMsg e = error $ "noErrorUnsafeSplit_: unreachable: " ++ e--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ SeqAL sl-            IDone _ -> do-                resR <- initialR-                return $ first SeqAR resR-            IError err -> errMsg err--    -- Note: For the composed parse to terminate, the left parser has to be-    -- a terminating parser returning a Done at some point.-    step (SeqAL st) a = do-        -- Important: Please do not use Applicative here. Applicative somehow-        -- caused the next action to run many times in the "tar" parsing code,-        -- not sure why though.-        resL <- stepL st a-        case resL of-            Partial n s -> return $ Partial n (SeqAL s)-            Continue n s -> return $ Continue n (SeqAL s)-            Done n _ -> do-                initR <- initialR-                return $ case initR of-                    IPartial s -> Partial n (SeqAR s)-                    IDone b -> Done n b-                    IError err -> errMsg err-            Error err -> errMsg err--    step (SeqAR st) a = first SeqAR <$> stepR st a--    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)-    extract (SeqAL sL) = do-        rL <- extractL sL-        case rL of-            Done n _ -> do-                iR <- initialR-                case iR of-                    IPartial sR -> do-                        fmap (bimapOverrideCount n SeqAR id) (extractR sR)-                    IDone bR -> return $ Done n bR-                    IError err -> errMsg err-            Error err -> errMsg err-            Partial _ _ -> error "split_: Partial"-            Continue n s -> return $ Continue n (SeqAL s)---- | 'Applicative' form of 'splitWith'.-instance Monad m => Applicative (Parser a m) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = splitWith id--    {-# INLINE (*>) #-}-    (*>) = split_--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)------------------------------------------------------------------------------------ Sequential Alternative----------------------------------------------------------------------------------{-# ANN type AltParseState Fuse #-}-data AltParseState sl sr = AltParseL !Int !sl | AltParseR !sr---- Note: this implementation of alt is fast because of stream fusion but has--- quadratic time complexity, because each composition adds a new branch that--- each subsequent alternative's input element has to go through, therefore, it--- cannot scale to a large number of compositions---- | Sequential alternative. The input is first passed to the first parser, and--- if it succeeds, the result is returned. However, if the first parser fails,--- the parser driver backtracks and tries the same input on the second parser,--- returning the result if it succeeds.------ Note: This implementation is not lazy in the second argument. The following--- will fail:------ >> Stream.parse (Parser.satisfy (> 0) `Parser.alt` undefined) $ Stream.fromList [1..10]--- *** Exception: Prelude.undefined------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions.--- As a thumb rule use it for less than 8 compositions, use ParserK otherwise.------ /Time Complexity:/ O(n^2) where n is the number of compositions.------ /Pre-release/----{-# INLINE alt #-}-alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a-alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =-    Parser step initial extract--    where--    initial = do-        resL <- initialL-        case resL of-            IPartial sl -> return $ IPartial $ AltParseL 0 sl-            IDone bl -> return $ IDone bl-            IError _ -> do-                resR <- initialR-                return $ case resR of-                    IPartial sr -> IPartial $ AltParseR sr-                    IDone br -> IDone br-                    IError err -> IError err--    -- Once a parser yields at least one value it cannot fail.  This-    -- restriction helps us make backtracking more efficient, as we do not need-    -- to keep the consumed items buffered after a yield. Note that we do not-    -- enforce this and if a misbehaving parser does not honor this then we can-    -- get unexpected results. XXX Can we detect and flag this?-    step (AltParseL cnt st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (AltParseL 0 s)-            Continue n s -> do-                assertM(cnt + 1 - n >= 0)-                return $ Continue n (AltParseL (cnt + 1 - n) s)-            Done n b -> return $ Done n b-            Error _ -> do-                res <- initialR-                return-                    $ case res of-                          IPartial rR -> Continue (cnt + 1) (AltParseR rR)-                          IDone b -> Done (cnt + 1) b-                          IError err -> Error err--    step (AltParseR st) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n (AltParseR s)-            Continue n s -> Continue n (AltParseR s)-            Done n b -> Done n b-            Error err -> Error err--    extract (AltParseR sR) = fmap (first AltParseR) (extractR sR)--    extract (AltParseL cnt sL) = do-        rL <- extractL sL-        case rL of-            Done n b -> return $ Done n b-            Error _ -> do-                res <- initialR-                return-                    $ case res of-                          IPartial rR -> Continue cnt (AltParseR rR)-                          IDone b -> Done cnt b-                          IError err -> Error err-            Partial _ _ -> error "Bug: alt: extractL 'Partial'"-            Continue n s -> do-                assertM(n == cnt)-                return $ Continue n (AltParseL 0 s)--{-# ANN type Fused3 Fuse #-}-data Fused3 a b c = Fused3 !a !b !c---- | See documentation of 'Streamly.Internal.Data.Parser.many'.------ /Pre-release/----{-# INLINE splitMany #-}-splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution! There is mutual recursion here, inlining the right functions is-    -- important.--    handleCollect partial done fres =-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ partial $ Fused3 ps 0 fs-                    IDone pb ->-                        runCollectorWith (handleCollect partial done) fs pb-                    IError _ -> done <$> fextract fs-            FL.Done fb -> return $ done fb--    runCollectorWith cont fs pb = fstep fs pb >>= cont--    -- See notes in Fold.many for the reason why the parser must be initialized-    -- right away instead of on first input.-    initial = finitial >>= handleCollect IPartial IDone--    {-# INLINE step #-}-    step (Fused3 st cnt fs) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt xs--    extract (Fused3 _ 0 fs) = fmap (Done 0) (fextract fs)-    extract (Fused3 s cnt fs) = do-        r <- extract1 s-        case r of-            Error _ -> fmap (Done cnt) (fextract fs)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitMany: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 fs))---- | Like splitMany, but inner fold emits an output at the end even if no input--- is received.------ /Internal/----{-# INLINE splitManyPost #-}-splitManyPost :: Monad m =>  Parser a m b -> Fold m b c -> Parser a m c-splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution! There is mutual recursion here, inlining the right functions is-    -- important.--    handleCollect partial done fres =-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ partial $ Fused3 ps 0 fs-                    IDone pb ->-                        runCollectorWith (handleCollect partial done) fs pb-                    IError _ -> done <$> fextract fs-            FL.Done fb -> return $ done fb--    runCollectorWith cont fs pb = fstep fs pb >>= cont--    initial = finitial >>= handleCollect IPartial IDone--    {-# INLINE step #-}-    step (Fused3 st cnt fs) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) fs)-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> do-                xs <- fextract fs-                return $ Done cnt1 xs--    extract (Fused3 s cnt fs) = do-        r <- extract1 s-        case r of-            Error _ -> fmap (Done cnt) (fextract fs)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitMany: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 fs))---- | See documentation of 'Streamly.Internal.Data.Parser.some'.------ /Pre-release/----{-# INLINE splitSome #-}-splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c-splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =-    Parser step initial extract--    where--    -- Caution! There is mutual recursion here, inlining the right functions is-    -- important.--    handleCollect partial done fres =-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ partial $ Fused3 ps 0 $ Right fs-                    IDone pb ->-                        runCollectorWith (handleCollect partial done) fs pb-                    IError _ -> done <$> fextract fs-            FL.Done fb -> return $ done fb--    runCollectorWith cont fs pb = fstep fs pb >>= cont--    initial = do-        fres <- finitial-        case fres of-            FL.Partial fs -> do-                pres <- initial1-                case pres of-                    IPartial ps -> return $ IPartial $ Fused3 ps 0 $ Left fs-                    IDone pb ->-                        runCollectorWith (handleCollect IPartial IDone) fs pb-                    IError err -> return $ IError err-            FL.Done _ ->-                return-                    $ IError-                    $ "splitSome: The collecting fold terminated without"-                          ++ " consuming any elements."--    {-# INLINE step #-}-    step (Fused3 st cnt (Left fs)) a = do-        r <- step1 st a-        -- In the Left state, count is used only for the assert-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) (Left fs))-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) (Left fs))-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error err -> return $ Error err-    step (Fused3 st cnt (Right fs)) a = do-        r <- step1 st a-        let cnt1 = cnt + 1-        case r of-            Partial n s -> do-                assertM(cnt1 - n >= 0)-                return $ Partial n (Fused3 s (cnt1 - n) (Right fs))-            Continue n s -> do-                assertM(cnt1 - n >= 0)-                return $ Continue n (Fused3 s (cnt1 - n) (Right fs))-            Done n b -> do-                assertM(cnt1 - n >= 0)-                fstep fs b >>= handleCollect (Partial n) (Done n)-            Error _ -> Done cnt1 <$> fextract fs--    extract (Fused3 s cnt (Left fs)) = do-        r <- extract1 s-        case r of-            Error err -> return (Error err)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitSome: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 (Left fs)))-    extract (Fused3 s cnt (Right fs)) = do-        r <- extract1 s-        case r of-            Error _ -> fmap (Done cnt) (fextract fs)-            Done n b -> do-                assertM(n <= cnt)-                fs1 <- fstep fs b-                case fs1 of-                    FL.Partial s1 -> fmap (Done n) (fextract s1)-                    FL.Done b1 -> return (Done n b1)-            Partial _ _ -> error "splitSome: Partial in extract"-            Continue n s1 -> do-                assertM(n == cnt)-                return (Continue n (Fused3 s1 0 (Right fs)))---- | A parser that always fails with an error message without consuming--- any input.----{-# INLINE_NORMAL die #-}-die :: Monad m => String -> Parser a m b-die err = Parser undefined (pure (IError err)) undefined---- | A parser that always fails with an effectful error message and without--- consuming any input.------ /Pre-release/----{-# INLINE dieM #-}-dieM :: Monad m => m String -> Parser a m b-dieM err = Parser undefined (IError <$> err) undefined---- Note: The default implementations of "some" and "many" loop infinitely--- because of the strict pattern match on both the arguments in applicative and--- alternative. With the direct style parser type we cannot use the mutually--- recursive definitions of "some" and "many".------ Note: With the direct style parser type, the list in "some" and "many" is--- accumulated strictly, it cannot be consumed lazily.---- | Sequential alternative. The input is first passed to the first parser, and--- if it succeeds, the result is returned. However, if the first parser fails,--- the parser driver backtracks and tries the same input on the second parser,--- returning the result if it succeeds.------ Note: The implementation of '<|>' is not lazy in the second--- argument. The following code will fail:------ >>> Stream.parse (Parser.satisfy (> 0) <|> undefined) $ Stream.fromList [1..10]--- *** Exception: Prelude.undefined--- ...------ WARNING! this is not suitable for large scale use. As a thumb rule stream--- fusion works well for less than 8 compositions of this operation, otherwise--- consider using 'ParserK'. Do not use recursive parser implementations based--- on this Alternative instance.--instance Monad m => Alternative (Parser a m) where-    {-# INLINE empty #-}-    empty = die "empty"--    {-# INLINE (<|>) #-}-    (<|>) = alt--    {-# INLINE many #-}-    many = flip splitMany toList--    {-# INLINE some #-}-    some = flip splitSome toList--{-# ANN type ConcatParseState Fuse #-}-data ConcatParseState sl m a b =-      ConcatParseL !sl-    | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Step s b))---- | Map a 'Parser' returning function on the result of a 'Parser'.------ /Pre-release/----{-# INLINE concatMap #-}-concatMap :: Monad m =>-    (b -> Parser a m c) -> Parser a m b -> Parser a m c-concatMap func (Parser stepL initialL extractL) = Parser step initial extract--    where--    {-# INLINE initializeR #-}-    initializeR (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR-            IDone br -> IDone br-            IError err -> IError err--    initial = do-        res <- initialL-        case res of-            IPartial s -> return $ IPartial $ ConcatParseL s-            IDone b -> initializeR (func b)-            IError err -> return $ IError err--    {-# INLINE initializeRL #-}-    initializeRL n (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> Continue n $ ConcatParseR stepR sr extractR-            IDone br -> Done n br-            IError err -> Error err--    step (ConcatParseL st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Continue n (ConcatParseL s)-            Continue n s -> return $ Continue n (ConcatParseL s)-            Done n b -> initializeRL n (func b)-            Error err -> return $ Error err--    step (ConcatParseR stepR st extractR) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n $ ConcatParseR stepR s extractR-            Continue n s -> Continue n $ ConcatParseR stepR s extractR-            Done n b -> Done n b-            Error err -> Error err--    {-# INLINE extractP #-}-    extractP n (Parser stepR initialR extractR) = do-        res <- initialR-        case res of-            IPartial s ->-                fmap-                    (first (\s1 -> ConcatParseR stepR s1 extractR))-                    (extractR s)-            IDone b -> return (Done n b)-            IError err -> return $ Error err--    extract (ConcatParseR stepR s extractR) =-        fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)-    extract (ConcatParseL sL) = do-        rL <- extractL sL-        case rL of-            Error err -> return $ Error err-            Done n b -> extractP n $ func b-            Partial _ _ -> error "concatMap: extract Partial"-            Continue n s -> return $ Continue n (ConcatParseL s)--{-# INLINE noErrorUnsafeConcatMap #-}-noErrorUnsafeConcatMap :: Monad m =>-    (b -> Parser a m c) -> Parser a m b -> Parser a m c-noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =-    Parser step initial extract--    where--    {-# INLINE initializeR #-}-    initializeR (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR-            IDone br -> IDone br-            IError err -> IError err--    initial = do-        res <- initialL-        case res of-            IPartial s -> return $ IPartial $ ConcatParseL s-            IDone b -> initializeR (func b)-            IError err -> return $ IError err--    {-# INLINE initializeRL #-}-    initializeRL n (Parser stepR initialR extractR) = do-        resR <- initialR-        return $ case resR of-            IPartial sr -> Partial n $ ConcatParseR stepR sr extractR-            IDone br -> Done n br-            IError err -> Error err--    step (ConcatParseL st) a = do-        r <- stepL st a-        case r of-            Partial n s -> return $ Partial n (ConcatParseL s)-            Continue n s -> return $ Continue n (ConcatParseL s)-            Done n b -> initializeRL n (func b)-            Error err -> return $ Error err--    step (ConcatParseR stepR st extractR) a = do-        r <- stepR st a-        return $ case r of-            Partial n s -> Partial n $ ConcatParseR stepR s extractR-            Continue n s -> Continue n $ ConcatParseR stepR s extractR-            Done n b -> Done n b-            Error err -> Error err--    {-# INLINE extractP #-}-    extractP n (Parser stepR initialR extractR) = do-        res <- initialR-        case res of-            IPartial s ->-                fmap-                    (first (\s1 -> ConcatParseR stepR s1 extractR))-                    (extractR s)-            IDone b -> return (Done n b)-            IError err -> return $ Error err--    extract (ConcatParseR stepR s extractR) =-        fmap (first (\s1 -> ConcatParseR stepR s1 extractR)) (extractR s)-    extract (ConcatParseL sL) = do-        rL <- extractL sL-        case rL of-            Error err -> return $ Error err-            Done n b -> extractP n $ func b-            Partial _ _ -> error "concatMap: extract Partial"-            Continue n s -> return $ Continue n (ConcatParseL s)---- Note: The monad instance has quadratic performance complexity. It works fine--- for small number of compositions but for a scalable implementation we need a--- CPS version.---- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.------ Although this implementation allows stream fusion, it has quadratic--- complexity, making it suitable only for a small number of compositions. As a--- thumb rule use it for less than 8 compositions, use 'ParserK' otherwise.----instance Monad m => Monad (Parser a m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--    {-# INLINE (>>) #-}-    (>>) = (*>)--instance Monad m => Fail.MonadFail (Parser a m) where-    {-# INLINE fail #-}-    fail = die--{---- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.----instance Monad m => MonadPlus (Parser a m) where-    {-# INLINE mzero #-}-    mzero = die "mzero"--    {-# INLINE mplus #-}-    mplus = alt--}--instance (Monad m, MonadIO m) => MonadIO (Parser a m) where-    {-# INLINE liftIO #-}-    liftIO = fromEffect . liftIO----------------------------------------------------------------------------------- Mapping on input----------------------------------------------------------------------------------- | @lmap f parser@ maps the function @f@ on the input of the parser.------ >>> Stream.parse (Parser.lmap (\x -> x * x) (Parser.fromFold Fold.sum)) (Stream.enumerateFromTo 1 100)--- Right 338350------ > lmap = Parser.lmapM return----{-# INLINE lmap #-}-lmap :: (a -> b) -> Parser b m r -> Parser a m r-lmap f (Parser step begin done) = Parser step1 begin done--    where--    step1 x a = step x (f a)---- | @lmapM f parser@ maps the monadic function @f@ on the input of the parser.----{-# INLINE lmapM #-}-lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r-lmapM f (Parser step begin done) = Parser step1 begin done--    where--    step1 x a = f a >>= step x---- | Include only those elements that pass a predicate.------ >>> Stream.parse (Parser.filter (> 5) (Parser.fromFold Fold.sum)) $ Stream.fromList [1..10]--- Right 40----{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b-filter f (Parser step initial extract) = Parser step1 initial extract--    where--    step1 x a = if f a then step x a else return $ Partial 0 x
− src/Streamly/Internal/Data/Parser/ParserK/Type.hs 
@@ -1,545 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Parser.ParserK.Type--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ CPS style implementation of parsers.------ The CPS representation allows linear performance for Applicative, sequence,--- Monad, Alternative, and choice operations compared to the quadratic--- complexity of the corresponding direct style operations. However, direct--- style operations allow fusion with ~10x better performance than CPS.------ The direct style representation does not allow for recursive definitions of--- "some" and "many" whereas CPS allows that.------ 'Applicative' and 'Control.Applicative.Alternative' type class based--- combinators from the--- <http://hackage.haskell.org/package/parser-combinators parser-combinators>--- package can also be used with the 'ParserK' type.--module Streamly.Internal.Data.Parser.ParserK.Type-    (-      Step (..)-    , Input (..)-    , ParseResult (..)-    , ParserK (..)-    , fromParser-    -- , toParser-    , fromPure-    , fromEffect-    , die-    )-where--#include "ArrayMacros.h"-#include "assert.hs"-#include "inline.hs"--import Control.Applicative (Alternative(..), liftA2)-import Control.Monad (MonadPlus(..), ap)-import Control.Monad.IO.Class (MonadIO, liftIO)--- import Control.Monad.Trans.Class (MonadTrans(lift))-import Data.Proxy (Proxy(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Unboxed (peekWith, sizeOf, Unbox)-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Control.Monad.Fail as Fail-import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Parser.ParserD.Type as ParserD--data Input a = None | Chunk {-# UNPACK #-} !(Array a)---- | The intermediate result of running a parser step. The parser driver may--- stop with a final result, pause with a continuation to resume, or fail with--- an error.------ See ParserD docs. This is the same as the ParserD Step except that it uses a--- continuation in Partial and Continue constructors instead of a state in case--- of ParserD.------ /Pre-release/----data Step a m r =-    -- The Int is the current stream position index wrt to the start of the-    -- array.-      Done !Int r-      -- XXX we can use a "resume" and a "stop" continuations instead of Maybe.-      -- measure if that works any better.-      -- Array a -> m (Step a m r), m (Step a m r)-    | Partial !Int (Input a -> m (Step a m r))-    | Continue !Int (Input a -> m (Step a m r))-    | Error !Int String--instance Functor m => Functor (Step a m) where-    fmap f (Done n r) = Done n (f r)-    fmap f (Partial n k) = Partial n (fmap (fmap f) . k)-    fmap f (Continue n k) = Continue n (fmap (fmap f) . k)-    fmap _ (Error n e) = Error n e---- Note: Passing position index separately instead of passing it with the--- result causes huge regression in expression parsing becnhmarks.---- | The parser's result.------ Int is the position index into the current input array. Could be negative.--- Cannot be beyond the input array max bound.------ /Pre-release/----data ParseResult b =-      Success !Int !b      -- Position index, result-    | Failure !Int !String -- Position index, error---- | Map a function over 'Success'.-instance Functor ParseResult where-    fmap f (Success n b) = Success n (f b)-    fmap _ (Failure n e) = Failure n e---- XXX Change the type to the shape (a -> m r -> m r) -> (m r -> m r) -> m r------ The parse continuation would be: Array a -> m (Step a m r) -> m (Step a m r)--- The extract continuation would be: m (Step a m r) -> m (Step a m r)------ Use Step itself in place of ParseResult.---- | A continuation passing style parser representation. A continuation of--- 'Step's, each step passes a state and a parse result to the next 'Step'. The--- resulting 'Step' may carry a continuation that consumes input 'a' and--- results in another 'Step'. Essentially, the continuation may either consume--- input without a result or return a result with no further input to be--- consumed.----newtype ParserK a m b = MkParser-    { runParser :: forall r.-           -- Using "Input" in runParser is not necessary but it avoids making-           -- one more function call to get the input. This could be helpful-           -- for cases where we process just one element per call.-           ---           -- Do not eta reduce the applications of this continuation.-           ---           (ParseResult b -> Int -> Input a -> m (Step a m r))-           -- XXX Maintain and pass the original position in the stream. that-           -- way we can also report better errors. Use a Context structure for-           -- passing the state.--           -- Stream position index wrt to the current input array start. If-           -- negative then backtracking is required before using the array.-           -- The parser should use "Continue -n" in this case if it needs to-           -- consume input. Negative value cannot be beyond the current-           -- backtrack buffer. Positive value cannot be beyond array length.-           -- If the parser needs to advance beyond the array length it should-           -- use "Continue +n".-        -> Int-           -- used elem count, a count of elements consumed by the parser. If-           -- an Alternative fails we need to backtrack by this amount.-        -> Int-           -- The second argument is the used count as described above. The-           -- current input position is carried as part of 'Success'-           -- constructor of 'ParseResult'.-           -- XXX Use Array a, determine eof by using a nil array-        -> Input a-        -> m (Step a m r)-    }------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ XXX rewrite this using ParserD, expose rmapM from ParserD.--- | Maps a function over the output of the parser.----instance Functor m => Functor (ParserK a m) where-    {-# INLINE fmap #-}-    fmap f parser = MkParser $ \k n st arr ->-        let k1 res = k (fmap f res)-         in runParser parser k1 n st arr------------------------------------------------------------------------------------ Sequential applicative------------------------------------------------------------------------------------ This is the dual of stream "fromPure".------ | A parser that always yields a pure value without consuming any input.------ /Pre-release/----{-# INLINE fromPure #-}-fromPure :: b -> ParserK a m b-fromPure b = MkParser $ \k n st arr -> k (Success n b) st arr---- | See 'Streamly.Internal.Data.Parser.fromEffect'.------ /Pre-release/----{-# INLINE fromEffect #-}-fromEffect :: Monad m => m b -> ParserK a m b-fromEffect eff =-    MkParser $ \k n st arr -> eff >>= \b -> k (Success n b) st arr---- | 'Applicative' form of 'Streamly.Internal.Data.Parser.splitWith'. Note that--- this operation does not fuse, use 'Streamly.Internal.Data.Parser.splitWith'--- when fusion is important.----instance Monad m => Applicative (ParserK a m) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = ap--    {-# INLINE (*>) #-}-    p1 *> p2 = MkParser $ \k n st arr ->-        let k1 (Success n1 _) s input = runParser p2 k n1 s input-            k1 (Failure n1 e) s input = k (Failure n1 e) s input-        in runParser p1 k1 n st arr--    {-# INLINE (<*) #-}-    p1 <* p2 = MkParser $ \k n st arr ->-        let k1 (Success n1 b) s1 input =-                let k2 (Success n2 _) s2 input2  = k (Success n2 b) s2 input2-                    k2 (Failure n2 e) s2 input2  = k (Failure n2 e) s2 input2-                in runParser p2 k2 n1 s1 input-            k1 (Failure n1 e) s1 input = k (Failure n1 e) s1 input-        in runParser p1 k1 n st arr--    {-# INLINE liftA2 #-}-    liftA2 f p = (<*>) (fmap f p)------------------------------------------------------------------------------------ Monad------------------------------------------------------------------------------------ This is the dual of "nil".------ | A parser that always fails with an error message without consuming--- any input.------ /Pre-release/----{-# INLINE die #-}-die :: String -> ParserK a m b-die err = MkParser (\k n st arr -> k (Failure n err) st arr)---- | Monad composition can be used for lookbehind parsers, we can make the--- future parses depend on the previously parsed values.------ If we have to parse "a9" or "9a" but not "99" or "aa" we can use the--- following parser:------ @--- backtracking :: MonadCatch m => PR.Parser Char m String--- backtracking =---     sequence [PR.satisfy isDigit, PR.satisfy isAlpha]---     '<|>'---     sequence [PR.satisfy isAlpha, PR.satisfy isDigit]--- @------ We know that if the first parse resulted in a digit at the first place then--- the second parse is going to fail.  However, we waste that information and--- parse the first character again in the second parse only to know that it is--- not an alphabetic char.  By using lookbehind in a 'Monad' composition we can--- avoid redundant work:------ @--- data DigitOrAlpha = Digit Char | Alpha Char------ lookbehind :: MonadCatch m => PR.Parser Char m String--- lookbehind = do---     x1 \<-    Digit '<$>' PR.satisfy isDigit---          '<|>' Alpha '<$>' PR.satisfy isAlpha------     -- Note: the parse depends on what we parsed already---     x2 <- case x1 of---         Digit _ -> PR.satisfy isAlpha---         Alpha _ -> PR.satisfy isDigit------     return $ case x1 of---         Digit x -> [x,x2]---         Alpha x -> [x,x2]--- @------ See also 'Streamly.Internal.Data.Parser.concatMap'. This monad instance--- does not fuse, use 'Streamly.Internal.Data.Parser.concatMap' when you need--- fusion.----instance Monad m => Monad (ParserK a m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    p >>= f = MkParser $ \k n st arr ->-        let k1 (Success n1 b) s1 inp = runParser (f b) k n1 s1 inp-            k1 (Failure n1 e) s1 inp = k (Failure n1 e) s1 inp-         in runParser p k1 n st arr--    {-# INLINE (>>) #-}-    (>>) = (*>)--#if !(MIN_VERSION_base(4,13,0))-    -- This is redefined instead of just being Fail.fail to be-    -- compatible with base 4.8.-    {-# INLINE fail #-}-    fail = die-#endif-instance Monad m => Fail.MonadFail (ParserK a m) where-    {-# INLINE fail #-}-    fail = die--instance MonadIO m => MonadIO (ParserK a m) where-    {-# INLINE liftIO #-}-    liftIO = fromEffect . liftIO------------------------------------------------------------------------------------ Alternative------------------------------------------------------------------------------------ | 'Alternative' form of 'Streamly.Internal.Data.Parser.alt'. Backtrack and--- run the second parser if the first one fails.------ The "some" and "many" operations of alternative accumulate results in a pure--- list which is not scalable and streaming. Instead use--- 'Streamly.Internal.Data.Parser.some' and--- 'Streamly.Internal.Data.Parser.many' for fusible operations with composable--- accumulation of results.------ See also 'Streamly.Internal.Data.Parser.alt'. This 'Alternative' instance--- does not fuse, use 'Streamly.Internal.Data.Parser.alt' when you need--- fusion.----instance Monad m => Alternative (ParserK a m) where-    {-# INLINE empty #-}-    empty = die "empty"--    {-# INLINE (<|>) #-}-    p1 <|> p2 = MkParser $ \k n _ arr ->-        let-            k1 (Failure pos _) used input = runParser p2 k (pos - used) 0 input-            k1 success _ input = k success 0 input-        in runParser p1 k1 n 0 arr--    -- some and many are implemented here instead of using default definitions-    -- so that we can use INLINE on them. It gives 50% performance improvement.--    {-# INLINE many #-}-    many v = many_v--        where--        many_v = some_v <|> pure []-        some_v = (:) <$> v <*> many_v--    {-# INLINE some #-}-    some v = some_v--        where--        many_v = some_v <|> pure []-        some_v = (:) <$> v <*> many_v---- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as--- '<|>', it selects the first succeeding parser.----instance Monad m => MonadPlus (ParserK a m) where-    {-# INLINE mzero #-}-    mzero = die "mzero"--    {-# INLINE mplus #-}-    mplus = (<|>)--{--instance MonadTrans (ParserK a) where-    {-# INLINE lift #-}-    lift = fromEffect--}------------------------------------------------------------------------------------ Convert ParserD to ParserK----------------------------------------------------------------------------------{-# INLINE parseDToK #-}-parseDToK-    :: forall m a s b r. (Monad m, Unbox a)-    => (s -> a -> m (ParserD.Step s b))-    -> m (ParserD.Initial s b)-    -> (s -> m (ParserD.Step s b))-    -> (ParseResult b -> Int -> Input a -> m (Step a m r))-    -> Int-    -> Int-    -> Input a-    -> m (Step a m r)-parseDToK pstep initial extract cont !offset0 !usedCount !input = do-    res <- initial-    case res of-        ParserD.IPartial pst -> do-            case input of-                Chunk arr -> parseContChunk usedCount offset0 pst arr-                None -> parseContNothing usedCount pst-        ParserD.IDone b -> cont (Success offset0 b) usedCount input-        ParserD.IError err -> cont (Failure offset0 err) usedCount input--    where--    -- XXX We can maintain an absolute position instead of relative that will-    -- help in reporting of error location in the stream.-    {-# NOINLINE parseContChunk #-}-    parseContChunk !count !offset !state arr@(Array contents start end) = do-         if offset >= 0-         then go SPEC (start + offset * SIZE_OF(a)) state-         else return $ Continue offset (parseCont count state)--        where--        {-# INLINE onDone #-}-        onDone n b =-            assert (n <= Array.length arr)-                (cont (Success n b) (count + n - offset) (Chunk arr))--        {-# INLINE callParseCont #-}-        callParseCont constr n pst1 =-            assert (n < 0 || n >= Array.length arr)-                (return $ constr n (parseCont (count + n - offset) pst1))--        {-# INLINE onPartial #-}-        onPartial = callParseCont Partial--        {-# INLINE onContinue #-}-        onContinue = callParseCont Continue--        {-# INLINE onError #-}-        onError n err =-            cont (Failure n err) (count + n - offset) (Chunk arr)--        {-# INLINE onBack #-}-        onBack offset1 elemSize constr pst = do-            let pos = offset1 - start-             in if pos >= 0-                then go SPEC offset1 pst-                else constr (pos `div` elemSize) pst--        -- Note: div may be expensive but the alternative is to maintain an element-        -- offset in addition to a byte offset or just the element offset and use-        -- multiplication to get the byte offset every time, both these options-        -- turned out to be more expensive than using div.-        go !_ !cur !pst | cur >= end =-            onContinue ((end - start) `div` SIZE_OF(a))  pst-        go !_ !cur !pst = do-            let !x = unsafeInlineIO $ peekWith contents cur-            pRes <- pstep pst x-            let elemSize = SIZE_OF(a)-                next = INDEX_NEXT(cur,a)-                back n = next - n * elemSize-                curOff = (cur - start) `div` elemSize-                nextOff = (next - start) `div` elemSize-            -- The "n" here is stream position index wrt the array start, and-            -- not the backtrack count as returned by byte stream parsers.-            case pRes of-                ParserD.Done 0 b ->-                    onDone nextOff b-                ParserD.Done 1 b ->-                    onDone curOff b-                ParserD.Done n b ->-                    onDone ((back n - start) `div` elemSize) b-                ParserD.Partial 0 pst1 ->-                    go SPEC next pst1-                ParserD.Partial 1 pst1 ->-                    go SPEC cur pst1-                ParserD.Partial n pst1 ->-                    onBack (back n) elemSize onPartial pst1-                ParserD.Continue 0 pst1 ->-                    go SPEC next pst1-                ParserD.Continue 1 pst1 ->-                    go SPEC cur pst1-                ParserD.Continue n pst1 ->-                    onBack (back n) elemSize onContinue pst1-                ParserD.Error err ->-                    onError curOff err--    {-# NOINLINE parseContNothing #-}-    parseContNothing !count !pst = do-        r <- extract pst-        case r of-            -- IMPORTANT: the n here is from the byte stream parser, that means-            -- it is the backtrack element count and not the stream position-            -- index into the current input array.-            ParserD.Done n b ->-                assert (n >= 0)-                    (cont (Success (- n) b) (count - n) None)-            ParserD.Continue n pst1 ->-                assert (n >= 0)-                    (return $ Continue (- n) (parseCont (count - n) pst1))-            ParserD.Error err ->-                -- XXX It is called only when there is no input arr. So using 0-                -- as the position is correct?-                cont (Failure 0 err) count None-            ParserD.Partial _ _ -> error "Bug: parseDToK Partial unreachable"--    -- XXX Maybe we can use two separate continuations instead of using-    -- Just/Nothing cases here. That may help in avoiding the parseContJust-    -- function call.-    {-# INLINE parseCont #-}-    parseCont !cnt !pst (Chunk arr) = parseContChunk cnt 0 pst arr-    parseCont !cnt !pst None = parseContNothing cnt pst---- | Convert a raw byte 'Parser' to a chunked 'ParserK'.------ /Pre-release/----{-# INLINE_LATE fromParser #-}-fromParser :: (Monad m, Unbox a) => ParserD.Parser a m b -> ParserK a m b-fromParser (ParserD.Parser step initial extract) =-    MkParser $ parseDToK step initial extract--{------------------------------------------------------------------------------------ Convert CPS style 'Parser' to direct style 'D.Parser'------------------------------------------------------------------------------------ | A continuation to extract the result when a CPS parser is done.-{-# INLINE parserDone #-}-parserDone :: Monad m => ParseResult b -> Int -> Input a -> m (Step a m b)-parserDone (Success n b) _ None = return $ Done n b-parserDone (Failure n e) _ None = return $ Error n e-parserDone _ _ _ = error "Bug: toParser: called with input"---- | Convert a CPS style 'ParserK' to a direct style 'ParserD.Parser'.------ /Pre-release/----{-# INLINE_LATE toParser #-}-toParser :: Monad m => ParserK a m b -> ParserD.Parser a m b-toParser parser = ParserD.Parser step initial extract--    where--    initial = pure (ParserD.IPartial (\x -> runParser parser 0 0 x parserDone))--    step cont a = do-        r <- cont (Single a)-        return $ case r of-            Done n b -> ParserD.Done n b-            Error _ e -> ParserD.Error e-            Partial n cont1 -> ParserD.Partial n cont1-            Continue n cont1 -> ParserD.Continue n cont1--    extract cont = do-        r <- cont None-        case r of-            Done n b -> return $ ParserD.Done n b-            Error _ e -> return $ ParserD.Error e-            Partial _ cont1 -> extract cont1-            Continue n cont1 -> return $ ParserD.Continue n cont1--#ifndef DISABLE_FUSION-{-# RULES "fromParser/toParser fusion" [2]-    forall s. toParser (fromParser s) = s #-}-{-# RULES "toParser/fromParser fusion" [2]-    forall s. fromParser (toParser s) = s #-}-#endif--}
+ src/Streamly/Internal/Data/Parser/Tee.hs view
@@ -0,0 +1,617 @@+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}++#include "inline.hs"++-- |+-- Module      : Streamly.Internal.Data.Parser.ParserD.Tee+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Parallel parsers. Distributing the input to multiple parsers at the same+-- time.+--+-- For simplicity, we are using code where a particular state is unreachable+-- but it is not prevented by types.  Somehow uni-pattern match using "let"+-- produces better optimized code compared to using @case@ match and using+-- explicit error messages in unreachable cases.+--+-- There seem to be no way to silence individual warnings so we use a global+-- incomplete uni-pattern match warning suppression option for the file.+-- Disabling the warning for other code as well  has the potential to mask off+-- some legit warnings, therefore, we have segregated only the code that uses+-- uni-pattern matches in this module.++module Streamly.Internal.Data.Parser.Tee+    (+    {-+    -- Parallel zipped+      teeWith+    , teeWithFst+    , teeWithMin++    -- Parallel alternatives+    , shortest+    , longest+    -}+    )+where++{-+import Control.Exception (assert)+import Control.Monad.Catch (MonadCatch, try)+import Prelude+       hiding (any, all, takeWhile)++import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Parser.ParserD.Type+       (Initial(..), Parser(..), Step(..), ParseError)++-------------------------------------------------------------------------------+-- Distribute input to two parsers and collect both results+-------------------------------------------------------------------------------++-- When the input stream is distributed to two parsers, both the parsers can+-- backtrack independently. Therefore, we need separate buffer state for each+-- parser.+--+-- ParserK+--+-- We can keep the state of each parser in the zipper and pass around that+-- zipper to the parsers. Each parser can consume from the zipper and then pass+-- around the zipper to the other parser.+--+-- ParserD+--+-- In the approach we have taken here, the driver pushes one element at a time+-- to the tee and each of the parsers in the tee may buffer it independently+-- for backtracking. So they do not need to depend on the original stream+-- source for individual parser backtracking. Problem arises when both the+-- parsers backtrack and they do not need any input from the driver rather they+-- must consume from their buffers. For such situation we may need a+-- "Continue" style driver command from the tee so that the driver runs+-- the tee without providing it any input. Or we may need a local driver loop+-- until new input is to be demanded from the input stream.+--+-- When the tee errors out or stops, the tee driver may have to backtrack by+-- the specified amount (or the tee must return the leftover input). Therefore,+-- the tee driver also has to buffer, this leads to triple buffering.+--+-- When the tee stops we need to determine the backtracking amount from the+-- leftover of both the parsers. Since both the parsers may have consumed+-- different lengths of the stream we consider the maximum of the two as+-- consumed.+--+  -- XXX We can use Initial instead of StepState+{-# ANN type StepState Fuse #-}+data StepState s a = StepState s | StepResult a++-- | State of the pair of parsers in a tee composition+-- Note: strictness annotation is important for fusing the constructors+{-# ANN type TeeState Fuse #-}+data TeeState sL sR x a b =+-- @TeePair (past buffer, parser state, future-buffer1, future-buffer2) ...@+    TeePair !([x], StepState sL a, [x], [x]) !([x], StepState sR b, [x], [x])++{-# ANN type Res Fuse #-}+data Res = Yld Int | Stp Int | Skp | Err String++-- | See 'Streamly.Internal.Data.Parser.teeWith'.+--+-- /Broken/+--+{-# INLINE teeWith #-}+teeWith :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+teeWith zf (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        return $ case resL of+            IPartial sl ->+                case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])+                                                    ([], StepResult br, [], [])+                     IError err -> IError err+            IDone bl ->+                case resR of+                     IPartial sr ->+                         IPartial $ TeePair ([], StepResult bl, [], [])+                                            ([], StepState sr, [], [])+                     IDone br -> IDone $ zf bl br+                     IError err -> IError err+            IError err -> IError err++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- XXX This is currently broken, even though both the parsers need to+    -- consume from their buffers after backtracking the driver would still be+    -- pushing more input to the buffers.+    --+    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n s ->+                let src0 = Prelude.take n buf1+                    src  = Prelude.reverse src0+                    state = ([], StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Yld n))+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            SError err -> return (undefined, Err err)++    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case (stL,stR) of+            (Yld n1, Yld n2) -> Partial (min n1 n2) next+            (Yld n1, Stp n2) -> Partial (min n1 n2) next+            (Stp n1, Yld n2) -> Partial (min n1 n2) next+            (Stp n1, Stp n2) ->+                -- Uni-pattern match results in better optimized code compared+                -- to a case match.+                let (_, StepResult rL, _, _) = l+                    (_, StepResult rR, _, _) = r+                 in Done (min n1 n2) (zf rL rR)+            (Err err, _) -> SError err+            (_, Err err) -> SError err+            _ -> Continue 0 next++    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                r@(_, StepResult rR, _, _)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        let next = TeePair l r+        -- XXX If the unused count of this stream is lower than the unused+        -- count of the stopped stream, only then this will be correct. We need+        -- to fix the other case. We need to keep incrementing the unused count+        -- of the stopped stream and take the min of the two.+        return $ case stL of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rL, _, _) = l+                 in Done n (zf rL rR)+            Skp -> Continue 0 next+            Err err -> SError err++    step (TeePair l@(_, StepResult rL, _, _)+                    (bufR, StepState sR, inpR1, inpR2)) x = do+        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        -- XXX If the unused count of this stream is lower than the unused+        -- count of the stopped stream, only then this will be correct. We need+        -- to fix the other case. We need to keep incrementing the unused count+        -- of the stopped stream and take the min of the two.+        return $ case stR of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rR, _, _) = r+                 in Done n (zf rL rR)+            Skp -> Continue 0 next+            Err err -> SError err++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        case st of+            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do+                rL <- extractL sL+                rR <- extractR sR+                return $ zf rL rR+            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do+                rL <- extractL sL+                return $ zf rL rR+            TeePair (_, StepResult  rL, _, _) (_, StepState sR, _, _) -> do+                rR <- extractR sR+                return $ zf rL rR+            TeePair (_, StepResult rL, _, _) (_, StepResult rR, _, _) ->+                return $ zf rL rR++-- | See 'Streamly.Internal.Data.Parser.teeWithFst'.+--+-- /Broken/+--+{-# INLINE teeWithFst #-}+teeWithFst :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+teeWithFst zf (Parser stepL initialL extractL)+              (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        case resL of+            IPartial sl ->+                return $ case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])+                                                    ([], StepResult br, [], [])+                     IError err -> IError err+            IDone bl ->+                case resR of+                     IPartial sr -> IDone . zf bl <$> extractR sr+                     IDone br -> return $ IDone $ zf bl br+                     IError err -> return $ IError err+            IError err -> return $ IError err++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n _ -> return (undefined, Yld n) -- Not implemented+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            SError err -> return (undefined, Err err)++    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        case (stL,stR) of+            -- XXX what if the first parser returns an unused count which is+            -- more than the second parser's unused count? It does not make+            -- sense for the second parser to consume more than the first+            -- parser. We reset the input cursor based on the first parser.+            -- 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.+                let (_, StepResult rL, _, _) = l+                    (_, StepResult rR, _, _) = r+                 in return $ Done n1 (zf rL rR)+            (Stp n1, Yld _) ->+                let (_, StepResult rL, _, _) = l+                    (_, StepState  ssR, _, _) = r+                 in do+                    rR <- extractR ssR+                    return $ Done n1 (zf rL rR)+            (Yld n1, Yld n2) -> return $ Partial (min n1 n2) next+            (Yld n1, Stp n2) -> return $ Partial (min n1 n2) next+            (Err err, _) -> return $ SError err+            (_, Err err) -> return $ SError err+            _ -> return $ Continue 0 next++    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                r@(_, StepResult rR, _, _)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        let next = TeePair l r+        -- XXX If the unused count of this stream is lower than the unused+        -- count of the stopped stream, only then this will be correct. We need+        -- to fix the other case. We need to keep incrementing the unused count+        -- of the stopped stream and take the min of the two.+        return $ case stL of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rL, _, _) = l+                 in Done n (zf rL rR)+            Skp -> Continue 0 next+            Err err -> SError err++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        case st of+            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do+                rL <- extractL sL+                rR <- extractR sR+                return $ zf rL rR+            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do+                rL <- extractL sL+                return $ zf rL rR+            _ -> error "unreachable"++-- | See 'Streamly.Internal.Data.Parser.teeWithMin'.+--+-- /Unimplemented/+--+{-# INLINE teeWithMin #-}+teeWithMin ::+    -- Monad m =>+    (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+teeWithMin = undefined++-------------------------------------------------------------------------------+-- Distribute input to two parsers and choose one result+-------------------------------------------------------------------------------++-- | See 'Streamly.Internal.Data.Parser.shortest'.+--+-- /Broken/+--+{-# INLINE shortest #-}+shortest :: Monad m => Parser x m a -> Parser x m a -> Parser x m a+shortest (Parser stepL initialL extractL) (Parser stepR initialR _) =+    Parser step initial extract++    where++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        return $ case resL of+            IPartial sl ->+                case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IDone br+                     IError err -> IError err+            IDone bl -> IDone bl+            IError errL ->+                case resR of+                     IPartial _ -> IError errL+                     IDone br -> IDone br+                     IError errR -> IError errR++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n _ -> return (undefined, Yld n) -- Not implemented+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            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+    -- criterion of shortest is whichever parse decided to stop earlier.+    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case (stL,stR) of+            (Stp n1, _) ->+                let (_, StepResult rL, _, _) = l+                 in Done n1 rL+            (_, Stp n2) ->+                let (_, StepResult rR, _, _) = r+                 in Done n2 rR+            (Yld n1, Yld n2) -> Partial (min n1 n2) next+            (Err err, _) -> SError err+            (_, Err err) -> SError err+            _ -> Continue 0 next++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        case st of+            TeePair (_, StepState sL, _, _) _ -> extractL sL+            _ -> error "unreachable"++-- | See 'Streamly.Internal.Data.Parser.longest'.+--+-- /Broken/+--+{-# INLINE longest #-}+longest :: MonadCatch m => Parser x m a -> Parser x m a -> Parser x m a+longest (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where+++    {-# INLINE_LATE initial #-}+    initial = do+        resL <- initialL+        resR <- initialR+        return $ case resL of+            IPartial sl ->+                case resR of+                     IPartial sr -> IPartial $ TeePair ([], StepState sl, [], [])+                                                       ([], StepState sr, [], [])+                     IDone br -> IPartial $ TeePair ([], StepState sl, [], [])+                                                    ([], StepResult br, [], [])+                     IError _ ->+                         IPartial $ TeePair ([], StepState sl, [], [])+                                            ([], StepResult undefined, [], [])+            IDone bl ->+                case resR of+                     IPartial sr ->+                         IPartial $ TeePair ([], StepResult bl, [], [])+                                            ([], StepState sr, [], [])+                     IDone _ -> IDone bl+                     IError _ -> IDone bl+            IError _ ->+                case resR of+                     IPartial sr ->+                         IPartial $ TeePair ([], StepResult undefined, [], [])+                                            ([], StepState sr, [], [])+                     IDone br -> IDone br+                     IError err -> IError err++    {-# INLINE consume #-}+    consume buf inp1 inp2 stp st y = do+        let (x, inp11, inp21) =+                case inp1 of+                    [] -> (y, [], [])+                    z : [] -> (z, reverse (x:inp2), [])+                    z : zs -> (z, zs, x:inp2)+        r <- stp st x+        let buf1 = x:buf+        return (buf1, r, inp11, inp21)++    -- consume one input item and return the next state of the fold+    {-# INLINE useStream #-}+    useStream buf inp1 inp2 stp st y = do+        (buf1, r, inp11, inp21) <- consume buf inp1 inp2 stp st y+        case r of+            Partial 0 s ->+                let state = ([], StepState s, inp11, inp21)+                 in return (state, Yld 0)+            Partial n _ -> return (undefined, Yld n) -- Not implemented+            Done n b ->+                let state = (Prelude.take n buf1, StepResult b, inp11, inp21)+                 in assert (n <= length buf1) (return (state, Stp n))+            -- Continue 0 s -> (buf1, Right s, inp11, inp21)+            Continue n s ->+                let (src0, buf2) = splitAt n buf1+                    src  = Prelude.reverse src0+                    state = (buf2, StepState s, src ++ inp11, inp21)+                 in assert (n <= length buf1) (return (state, Skp))+            SError err -> return (undefined, Err err)++    {-# INLINE_LATE step #-}+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                  (bufR, StepState sR, inpR1, inpR2)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        (r,stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case (stL,stR) of+            (Yld n1, Yld n2) -> Partial (min n1 n2) next+            (Yld n1, Stp n2) -> Partial (min n1 n2) next+            (Stp n1, Yld n2) -> Partial (min n1 n2) next+            (Stp n1, Stp n2) ->+                let (_, StepResult rL, _, _) = l+                    (_, StepResult rR, _, _) = r+                 in Done (max n1 n2) (if n1 >= n2 then rL else rR)+            (Err err, _) -> SError err+            (_, Err err) -> SError err+            _ -> Continue 0 next++    -- XXX the parser that finishes last may not be the longest because it may+    -- return a lot of unused input which makes it shorter. Our current+    -- criterion of deciding longest is based on whoever decides to finish+    -- last and not whoever consumed more input.+    --+    -- To actually know who made more progress we need to keep an account of+    -- how many items are unconsumed since the last yield.+    --+    step (TeePair (bufL, StepState sL, inpL1, inpL2)+                r@(_, StepResult _, _, _)) x = do+        (l,stL) <- useStream bufL inpL1 inpL2 stepL sL x+        let next = TeePair l r+        return $ case stL of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rL, _, _) = l+                 in Done n rL+            Skp -> Continue 0 next+            Err err -> SError err++    step (TeePair l@(_, StepResult _, _, _)+                    (bufR, StepState sR, inpR1, inpR2)) x = do+        (r, stR) <- useStream bufR inpR1 inpR2 stepR sR x+        let next = TeePair l r+        return $ case stR of+            Yld n -> Partial n next+            Stp n ->+                let (_, StepResult rR, _, _) = r+                 in Done n rR+            Skp -> Continue 0 next+            Err err -> SError err++    step _ _ = undefined++    {-# INLINE_LATE extract #-}+    extract st =+        -- XXX When results are partial we may not be able to precisely compare+        -- which parser has made more progress till now.  One way to do that is+        -- to figure out the actually consumed input up to the last yield.+        --+        case st of+            TeePair (_, StepState sL, _, _) (_, StepState sR, _, _) -> do+                r <- try $ extractL sL+                case r of+                    Left (_ :: ParseError) -> extractR sR+                    Right b -> return b+            TeePair (_, StepState sL, _, _) (_, StepResult rR, _, _) -> do+                r <- try $ extractL sL+                case r of+                    Left (_ :: ParseError) -> return rR+                    Right b -> return b+            TeePair (_, StepResult rL, _, _) (_, StepState sR, _, _) -> do+                r <- try $ extractR sR+                case r of+                    Left (_ :: ParseError) -> return rL+                    Right b -> return b+            TeePair (_, StepResult _, _, _) (_, StepResult _, _, _) ->+                error "unreachable"+-}
+ src/Streamly/Internal/Data/Parser/Type.hs view
@@ -0,0 +1,1548 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE NoMonoLocalBinds #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-}+-- |+-- Module      : Streamly.Internal.Data.Parser.ParserD.Type+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Streaming and backtracking parsers.+--+-- Parsers just extend folds.  Please read the 'Fold' design notes in+-- "Streamly.Internal.Data.Fold.Type" for background on the design.+--+-- = Parser Design+--+-- The 'Parser' type or a parsing fold is a generalization of the 'Fold' type.+-- The 'Fold' type /always/ succeeds on each input. Therefore, it does not need+-- to buffer the input. In contrast, a 'Parser' may fail and backtrack to+-- replay the input again to explore another branch of the parser. Therefore,+-- it needs to buffer the input. Therefore, a 'Parser' is a fold with some+-- additional requirements.  To summarize, unlike a 'Fold', a 'Parser':+--+-- 1. may not generate a new value of the accumulator on every input, it may+-- generate a new accumulator only after consuming multiple input elements+-- (e.g. takeEQ).+-- 2. on success may return some unconsumed input (e.g. takeWhile)+-- 3. may fail and return all input without consuming it (e.g. satisfy)+-- 4. backtrack and start inspecting the past input again (e.g. alt)+--+-- These use cases require buffering and replaying of input.  To facilitate+-- this, the step function of the 'Fold' is augmented to return the next state+-- of the fold along with a command tag using a 'Step' functor, the tag tells+-- the fold driver to manipulate the future input as the parser wishes. The+-- 'Step' functor provides the following commands to the fold driver+-- corresponding to the use cases outlined in the previous para:+--+-- 1. 'Continue': buffer the current input and optionally go back to a previous+--    position in the stream+-- 2. 'Partial': buffer the current input and optionally go back to a previous+--    position in the stream, drop the buffer before that position.+-- 3. 'Done': parser succeeded, returns how much input was leftover+-- 4. 'SError': indicates that the parser has failed without a result+--+-- = How a Parser Works?+--+-- A parser is just like a fold, it keeps consuming inputs from the stream and+-- accumulating them in an accumulator. The accumulator of the parser could be+-- a singleton value or it could be a collection of values e.g. a list.+--+-- The parser may build a new output value from multiple input items. When it+-- consumes an input item but needs more input to build a complete output item+-- it uses @Continue 0 s@, yielding the intermediate state @s@ and asking the+-- driver to provide more input.  When the parser determines that a new output+-- value is complete it can use a @Done n b@ to terminate the parser with @n@+-- items of input unused and the final value of the accumulator returned as+-- @b@. If at any time the parser determines that the parse has failed it can+-- return @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+-- parser building a collection of values has yielded at least one value then+-- it is considered successful and cannot fail after that. In the current+-- implementation, this is not automatically enforced, there is a rule that the+-- parser MUST use only @Done@ for termination after the first @Partial@, it+-- cannot use @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+-- 'Streamly.Internal.Data.Parser.some' combinators are good examples of+-- efficient implementations using all features of this representation.  It is+-- possible to idiomatically build a collection of parsed items using a+-- singleton parser and @Alternative@ instance instead of using a+-- multi-yield parser.  However, this implementation is amenable to stream+-- fusion and can therefore be much faster.+--+-- = SError Handling+--+-- When a parser's @step@ function is invoked it may terminate by either a+-- '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+-- @extract@ function of the parser to retrieve the last yielded value of the+-- parser. If the parser has yielded at least one value then @extract@ MUST+-- return a value without throwing an error, otherwise it uses the 'ParseError'+-- exception to throw an error.+--+-- We chose the exception throwing mechanism for @extract@ instead of using an+-- explicit error return via an 'Either' type for keeping the interface simple+-- as most of the time we do not need to catch the error in intermediate+-- layers. Note that we cannot use exception throwing mechanism in @step@+-- function because of performance reasons. 'SError' constructor in that case+-- allows loop fusion and better performance.+--+-- = Optimizing backtracking+--+-- == Applicative Composition+--+-- If a parser once returned 'Partial' it can never fail after that. This is+-- used to reduce the buffering. A 'Partial' results in dropping the buffer and+-- we cannot backtrack before that point.+--+-- Parsers can be composed using an Alternative, if we are in an alternative+-- composition we may have to backtrack to try the other branch.  When we+-- compose two parsers using applicative @f <$> p1 <*> p2@ we can return a+-- 'Partial' result only after both the parsers have succeeded. While running+-- @p1@ we have to ensure that the input is not dropped until we have run @p2@,+-- therefore we have to return a Continue instead of a Partial.+--+-- However, if we know they both cannot fail then we know that the composed+-- parser can never fail.  For this reason we should have "backtracking folds"+-- as a separate type so that we can compose them in an efficient manner. In p1+-- itself we can drop the buffer as soon as a 'Partial' result arrives. In+-- fact, there is no Alternative composition for folds because they cannot+-- fail.+--+-- == Alternative Composition+--+-- In @p1 <|> p2@ as soon as the parser p1 returns 'Partial' we know that it+-- will not fail and we can immediately drop the buffer.+--+-- If we are not using the parser in an alternative composition we can+-- downgrade the parser to a backtracking fold and use the "backtracking+-- fold"'s applicative for more efficient implementation. To downgrade we can+-- translate the "SError" of parser to an exception.  This gives us best of both+-- worlds, the applicative as well as alternative would have optimal+-- backtracking buffer.+--+-- The "many" for parsers would be different than "many" for folds. In case of+-- folds an error would be propagated. In case of parsers the error would be+-- ignored.+--+-- = Implementation Approach+--+-- Backtracking folds have an issue with tee style composition because each+-- fold can backtrack independently, we will need independent buffers. Though+-- this may be possible to implement it may not be efficient especially for+-- folds that do not backtrack at all. Three types are possible, optimized for+-- different use cases:+--+-- * Non-backtracking folds: efficient Tee+-- * Backtracking folds: efficient applicative+-- * Parsers: alternative+--+-- Downgrade parsers to backtracking folds for applicative used without+-- alternative.  Upgrade backtracking folds to parsers when we have to use them+-- as the last alternative.+--+-- = Future Work+--+-- It may make sense to move "takeWhile" type of parsers, which cannot fail but+-- need some lookahead, to splitting folds.  This will allow such combinators+-- to be accepted where we need an unfailing "Fold" type.+--+-- Based on application requirements it should be possible to design even a+-- richer interface to manipulate the input stream/buffer. For example, we+-- could randomly seek into the stream in the forward or reverse directions or+-- we can even seek to the end or from the end or seek from the beginning.+--+-- We can distribute and scan/parse a stream using both folds and parsers and+-- merge the resulting streams using different merge strategies (e.g.+-- interleaving or serial).+--+-- == Naming+--+-- As far as possible, try that the names of the combinators in this module are+-- consistent with:+--+-- * <https://hackage.haskell.org/package/base/docs/Text-ParserCombinators-ReadP.html base/Text.ParserCombinators.ReadP>+-- * <http://hackage.haskell.org/package/parser-combinators parser-combinators>+-- * <http://hackage.haskell.org/package/megaparsec megaparsec>+-- * <http://hackage.haskell.org/package/attoparsec attoparsec>+-- * <http://hackage.haskell.org/package/parsec parsec>++module Streamly.Internal.Data.Parser.Type+    (+    -- * Types+      Initial (..)+    -- (..) 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++    , fromPure+    , fromEffect+    , splitWith+    , split_++    , die+    , dieM+    , splitSome -- parseSome?+    , splitMany -- parseMany?+    , splitManyPost+    , alt+    , concatMap++    -- * Input transformation+    , lmap+    , lmapM+    , filter++    , noErrorUnsafeSplitWith+    , noErrorUnsafeSplit_+    , noErrorUnsafeConcatMap++    , localReaderT+    )+where++#include "inline.hs"+#include "assert.hs"++#if !MIN_VERSION_base(4,18,0)+import Control.Applicative (liftA2)+#endif+import Control.Applicative (Alternative(..))+import Control.Exception (Exception(..))+-- import Control.Monad (MonadPlus(..), (>=>))+import Control.Monad ((>=>))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Trans.Reader (ReaderT, local)+import Data.Bifunctor (Bifunctor(..))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Fold.Type (Fold(..), toList)++import qualified Control.Monad.Fail as Fail+import qualified Streamly.Internal.Data.Fold.Type as FL++import Prelude hiding (concatMap, filter)++#include "DocTestDataParser.hs"++-- XXX The only differences between Initial and Step types are:+--+-- * There are no backtracking counts in Initial+-- * Continue and Partial are the same. Ideally Partial should mean that an+-- empty result is valid and can be extracted; and Continue should mean that+-- empty would result in an error on extraction. We can possibly distinguish+-- the two cases.+--+-- If we ignore the backtracking counts we can represent the Initial type using+-- Step itself. That will also simplify the implementation of various parsers+-- where the processing in intiial is just a sepcial case of step, see+-- takeBetween for example.++-- 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/+--+{-# ANN type Initial Fuse #-}+data Initial s b+    = IPartial !s   -- ^ Wait for step function to be called with state @s@.+    | IDone !b      -- ^ Return a result right away without an input.+    | IError !String -- ^ Return an error right away without an input.++-- | @first@ maps on 'IPartial' and @second@ maps on 'IDone'.+--+-- /Internal/+--+instance Bifunctor Initial where+    {-# INLINE bimap #-}+    bimap f _ (IPartial a) = IPartial (f a)+    bimap _ g (IDone b) = IDone (g b)+    bimap _ _ (IError err) = IError err++-- | Maps a function over the result held by 'IDone'.+--+-- >>> fmap = second+--+-- /Internal/+--+instance Functor (Initial s) where+    {-# INLINE fmap #-}+    fmap = second++-- We can simplify the Step type as follows:+--+-- Partial Int (Either s (s, b)) -- Left continue, right partial result+-- Done Int (Either String b)+--+-- In this case 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.+--+-- Folds can only return the right values. Parsers can also return lefts.++-- | The return type of a 'Parser' step.+--+-- /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.+--+-- /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@.+--+-- 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.+--+-- /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 =+        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 updated to @current position + count@.+    -- 3. All buffered input before the new position is dropped. The parser can+    -- never backtrack before this position.++    | SContinue !Int !s+    -- ^ @SContinue count state@. The following statements hold on an SContinue+    -- result:+    --+    -- 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.++    | SDone !Int !b+    -- ^ Done with leftover input count and 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@.++    | 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+            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+        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++instance Functor (Final s) where+    {-# INLINE fmap #-}+    fmap = second++-- | Map a function over the count.+--+{-# INLINE mapCount #-}+mapCount :: (Int -> Int) -> Step s b -> Step s b+mapCount f res =+    case res of+        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@.+--+-- /Internal/+{-# INLINE mapMStep #-}+mapMStep :: Applicative m => (a -> m b) -> Step s a -> m (Step s b)+mapMStep f res =+    case res of+        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@+-- with the state returned by the previous step and the next input element. It+-- results into a new state and a command to the driver represented by 'Step'+-- type. The driver keeps invoking the step function until it stops or fails.+-- At any point of time the driver can call @extract@ to inspect the result of+-- the fold. If the parser hits the end of input 'extract' is called.+-- It may result in an error or an output value.+--+-- /Pre-release/+--+data Parser a m b =+    forall s. Parser+        (s -> a -> m (Step s b))+        (m (Initial 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.+--+newtype ParseError = ParseError String+    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 #-}+    fmap f (Parser step1 initial1 extract) =+        Parser step initial (fmap3 f extract)++        where++        initial = fmap2 f initial1+        step s b = fmap2 f (step1 s b)+        fmap2 g = fmap (fmap g)+        fmap3 g = fmap (fmap (fmap g))++------------------------------------------------------------------------------+-- Mapping on the output+------------------------------------------------------------------------------++-- | @rmapM f parser@ maps the monadic function @f@ on the output of the parser.+--+-- >>> rmap = fmap+{-# INLINE rmapM #-}+rmapM :: Monad m => (b -> m c) -> Parser a m b -> Parser a m c+rmapM f (Parser step initial extract) =+    Parser step1 initial1 (extract >=> mapMFinal f)++    where++    initial1 = do+        res <- initial+        -- this is mapM f over result+        case res of+            IPartial x -> return $ IPartial x+            IDone a -> IDone <$> f a+            IError err -> return $ IError err+    step1 s a = step s a >>= mapMStep f++-- | A parser that always yields a pure value without consuming any input.+--+{-# INLINE_NORMAL fromPure #-}+fromPure :: Monad m => b -> Parser a m b+fromPure b = Parser undefined (pure $ IDone b) undefined++-- | A parser that always yields the result of an effectful action without+-- consuming any input.+--+{-# INLINE fromEffect #-}+fromEffect :: Monad m => m b -> Parser a m b+fromEffect b = Parser undefined (IDone <$> b) undefined++-------------------------------------------------------------------------------+-- Sequential applicative+-------------------------------------------------------------------------------++{-# ANN type SeqParseState Fuse #-}+data SeqParseState sl f sr = SeqParseL !sl | SeqParseR !f !sr++-- Note: this implementation of splitWith is fast because of stream fusion but+-- has quadratic time complexity, because each composition adds a new branch+-- that each subsequent parse's input element has to go through, therefore, it+-- cannot scale to a large number of compositions. After around 100+-- compositions the performance starts dipping rapidly beyond a CPS style+-- unfused implementation.+--+-- Note: This is a parsing dual of appending streams using+-- 'Streamly.Data.Stream.append', it splits the streams using two parsers and+-- zips the results.++-- | Sequential parser application. Apply two parsers sequentially to an input+-- stream. The first parser runs and processes the input, the remaining input+-- is then passed to the second parser. If both parsers succeed, their outputs+-- are combined using the supplied function. If either parser fails, the+-- operation fails.+--+-- This combinator delivers high performance by stream fusion but it comes with+-- some limitations. For those cases use the 'Applicative' instance of+-- 'Streamly.Data.ParserK.ParserK'.+--+-- CAVEAT 1: NO RECURSION. This function is strict in both arguments. As a+-- result, if a parser is defined recursively using this, it may cause an+-- infintie loop. The following example checks the strictness:+--+-- >>> p = Parser.splitWith const (Parser.satisfy (> 0)) undefined+-- >>> Stream.parse p $ Stream.fromList [1]+-- *** Exception: Prelude.undefined+-- ...+--+-- CAVEAT 2: QUADRATIC TIME COMPLEXITY. Static composition is fast due to+-- stream fusion, but it works well only for limited (e.g. up to 8)+-- compositions, use "Streamly.Data.ParserK" for larger compositions.+--+-- Below are some common idioms that can be expressed using 'splitWith':+--+-- >>> span p f1 f2 = Parser.splitWith (,) (Parser.takeWhile p f1) (Parser.fromFold f2)+-- >>> spanBy eq f1 f2 = Parser.splitWith (,) (Parser.groupBy eq f1) (Parser.fromFold f2)+--+-- /Pre-release/+--+{-# INLINE splitWith #-}+splitWith :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+splitWith func (Parser stepL initialL extractL)+               (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    initial = do+        -- XXX We can use bimap here if we make this a Step type+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqParseL sl+            IDone bl -> do+                resR <- initialR+                -- XXX We can use bimap here if we make this a Step type+                return $ case resR of+                    IPartial sr -> IPartial $ SeqParseR (func bl) sr+                    IDone br -> IDone (func bl br)+                    IError err -> IError err+            IError err -> return $ IError err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a Done at some point.+    step (SeqParseL st) a = do+        -- Important: Please do not use Applicative here. See+        -- https://github.com/composewell/streamly/issues/1033 and the problem+        -- defined in split_ for more info.+        -- XXX Use bimap+        resL <- stepL st a+        case resL of+            -- Note: We need to buffer the input for a possible Alternative+            -- e.g. in ((,) <$> p1 <*> p2) <|> p3, if p2 fails we have to+            -- backtrack and start running p3. So we need to keep the input+            -- buffered until we know that the applicative cannot fail.+            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 -> 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)++    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)+    extract (SeqParseL sL) = do+        -- XXX Use bimap here+        rL <- extractL sL+        case rL of+            FDone n bL -> do+                -- XXX Use bimap here if we use Step type in Initial+                iR <- initialR+                case iR of+                    IPartial sR -> do+                        fmap+                            (bimap (SeqParseR (func bL)) (func bL))+                            (extractR sR)+                    IDone bR -> return $ 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+-------------------------------------------------------------------------------++-- XXX Create a newtype for nonfailing parsers and downgrade the parser to that+-- type before this operation and then upgrade.+--+-- We can do an inspection testing to reject unwanted constructors at compile+-- time.+--+-- We can use the compiler to automatically annotate accumulators, terminating+-- folds, non-failing parsers and failing parsers.++-- | Better performance 'splitWith' for non-failing parsers.+--+-- Does not work correctly for parsers that can fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+{-# INLINE noErrorUnsafeSplitWith #-}+noErrorUnsafeSplitWith :: Monad m+    => (a -> b -> c) -> Parser x m a -> Parser x m b -> Parser x m c+noErrorUnsafeSplitWith func (Parser stepL initialL extractL)+               (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    errMsg e = error $ "noErrorUnsafeSplitWith: unreachable: " ++ e++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqParseL sl+            IDone bl -> do+                resR <- initialR+                return $ bimap (SeqParseR (func bl)) (func bl) resR+            IError err -> errMsg err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a 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.+            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 -> SPartial n $ SeqParseR (func b) sr+                          IDone br -> SDone n (func b br)+                          IError err -> errMsg err+            SError err -> errMsg err++    step (SeqParseR f st) a = fmap (bimap (SeqParseR f) f) (stepR st a)++    extract (SeqParseR f sR) = fmap (bimap (SeqParseR f) f) (extractR sR)++    extract (SeqParseL sL) = do+        rL <- extractL sL+        case rL of+            FDone n bL -> do+                iR <- initialR+                case iR of+                    IPartial sR -> do+                        rR <- extractR sR+                        return+                            $ bimapFinalOverrideCount+                                n (SeqParseR (func bL)) (func bL) rR+                    IDone bR -> return $ FDone n $ func bL bR+                    IError err -> errMsg err+            FError err -> errMsg err+            FContinue n s -> return $ FContinue n (SeqParseL s)++{-# ANN type SeqAState Fuse #-}+data SeqAState sl sr = SeqAL !sl | SeqAR !sr++-- This turns out to be slightly faster than splitWith++-- | Sequential parser application ignoring the output of the first parser.+-- Apply two parsers sequentially to an input stream.  The input is provided to+-- the first parser, when it is done the remaining input is provided to the+-- second parser. The output of the parser is the output of the second parser.+-- The operation fails if any of the parsers fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+-- This implementation is strict in the second argument, therefore, the+-- following will fail:+--+-- >>> Stream.parse (Parser.split_ (Parser.satisfy (> 0)) undefined) $ Stream.fromList [1]+-- *** Exception: Prelude.undefined+-- ...+--+-- /Pre-release/+--+{-# INLINE split_ #-}+split_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+split_ (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqAL sl+            IDone _ -> do+                resR <- initialR+                return $ first SeqAR resR+            IError err -> return $ IError err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a 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.+        resL <- stepL st a+        case resL of+            -- Note: this leads to buffering even if we are not in an+            -- Alternative composition.+            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 -> 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++    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)+    extract (SeqAL sL) = do+        rL <- extractL sL+        case rL of+            FDone n _ -> do+                iR <- initialR+                -- XXX For initial we can have a bimap with leftover.+                case iR of+                    IPartial sR ->+                        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.+--+-- Does not work correctly for parsers that can fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+{-# INLINE noErrorUnsafeSplit_ #-}+noErrorUnsafeSplit_ :: Monad m => Parser x m a -> Parser x m b -> Parser x m b+noErrorUnsafeSplit_+    (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    errMsg e = error $ "noErrorUnsafeSplit_: unreachable: " ++ e++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ SeqAL sl+            IDone _ -> do+                resR <- initialR+                return $ first SeqAR resR+            IError err -> errMsg err++    -- Note: For the composed parse to terminate, the left parser has to be+    -- a terminating parser returning a 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+            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 -> SPartial n (SeqAR s)+                    IDone b -> SDone n b+                    IError err -> errMsg err+            SError err -> errMsg err++    step (SeqAR st) a = first SeqAR <$> stepR st a++    extract (SeqAR sR) = fmap (first SeqAR) (extractR sR)+    extract (SeqAL sL) = do+        rL <- extractL sL+        case rL of+            FDone n _ -> do+                iR <- initialR+                case iR of+                    IPartial sR -> do+                        fmap (bimapFinalOverrideCount n SeqAR id) (extractR sR)+                    IDone bR -> return $ FDone n bR+                    IError err -> errMsg err+            FError err -> errMsg err+            FContinue n s -> return $ FContinue n (SeqAL s)++-- | READ THE CAVEATS in 'splitWith' before using this instance.+--+-- >>> pure = Parser.fromPure+-- >>> (<*>) = Parser.splitWith id+-- >>> (*>) = Parser.split_+instance Monad m => Applicative (Parser a m) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = splitWith id++    {-# INLINE (*>) #-}+    (*>) = split_++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++-------------------------------------------------------------------------------+-- Sequential Alternative+-------------------------------------------------------------------------------++{-# ANN type AltParseState Fuse #-}+data AltParseState sl sr = AltParseL !Int !sl | AltParseR !sr++-- Note: this implementation of alt is fast because of stream fusion but has+-- quadratic time complexity, because each composition adds a new branch that+-- each subsequent alternative's input element has to go through, therefore, it+-- cannot scale to a large number of compositions++-- | Sequential alternative. The input is first passed to the first parser,+-- if it succeeds, the result is returned. However, if the first parser fails,+-- the parser driver backtracks and tries the same input on the second+-- (alternative) parser, returning the result if it succeeds.+--+-- This combinator delivers high performance by stream fusion but it comes with+-- some limitations. For those cases use the 'Alternative' instance of+-- 'Streamly.Data.ParserK.ParserK'.+--+-- CAVEAT 1: NO RECURSION. This function is strict in both arguments. As a+-- result, if a parser is defined recursively using this, it may cause an+-- infintie loop. The following example checks the strictness:+--+-- >> p = Parser.satisfy (> 0) `Parser.alt` undefined+-- >> Stream.parse p $ Stream.fromList [1..10]+-- *** Exception: Prelude.undefined+--+-- CAVEAT 2: QUADRATIC TIME COMPLEXITY. Static composition is fast due to+-- stream fusion, but it works well only for limited (e.g. up to 8)+-- compositions, use "Streamly.Data.ParserK" for larger compositions.+--+-- /Time Complexity:/ O(n^2) where n is the number of compositions.+--+-- /Pre-release/+--+{-# INLINE alt #-}+alt :: Monad m => Parser x m a -> Parser x m a -> Parser x m a+alt (Parser stepL initialL extractL) (Parser stepR initialR extractR) =+    Parser step initial extract++    where++    initial = do+        resL <- initialL+        case resL of+            IPartial sl -> return $ IPartial $ AltParseL 0 sl+            IDone bl -> return $ IDone bl+            IError _ -> do+                resR <- initialR+                return $ case resR of+                    IPartial sr -> IPartial $ AltParseR sr+                    IDone br -> IDone br+                    IError err -> IError err++    -- Once a parser yields at least one value it cannot fail.  This+    -- restriction helps us make backtracking more efficient, as we do not need+    -- to keep the consumed items buffered after a yield. Note that we do not+    -- enforce this and if a misbehaving parser does not honor this then we can+    -- get unexpected results. XXX Can we detect and flag this?+    step (AltParseL cnt st) a = do+        r <- stepL st a+        case r of+            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 -> 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+            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+            FDone n b -> return $ FDone n b+            FError _ -> do+                res <- initialR+                return+                    $ case res of+                          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++-- | See documentation of 'Streamly.Internal.Data.Parser.many'.+--+-- /Pre-release/+--+{-# INLINE splitMany #-}+splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    handleCollect partial done fres =+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ partial $ Fused3 ps 0 fs+                    IDone pb ->+                        runCollectorWith (handleCollect partial done) fs pb+                    IError _ -> done <$> ffinal fs+            FL.Done fb -> return $ done fb++    runCollectorWith cont fs pb = fstep fs pb >>= cont++    -- See notes in Fold.many for the reason why the parser must be initialized+    -- right away instead of on first input.+    initial = finitial >>= handleCollect IPartial IDone++    {-# INLINE step #-}+    step (Fused3 st cnt fs) a = do+        r <- step1 st a+        case r of+            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+                -- XXX review, need a test for this+                return $ SDone (- cnt) xs++    extract (Fused3 _ 0 fs) = fmap (FDone 0) (ffinal fs)+    extract (Fused3 s cnt fs) = do+        r <- extract1 s+        case r of+            FError _ -> fmap (FDone (- cnt)) (ffinal fs)+            FDone n b -> do+                assertM((- n) <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    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.+--+-- /Internal/+--+{-# INLINE splitManyPost #-}+splitManyPost :: Monad m =>  Parser a m b -> Fold m b c -> Parser a m c+splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    handleCollect partial done fres =+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ partial $ Fused3 ps 0 fs+                    IDone pb ->+                        runCollectorWith (handleCollect partial done) fs pb+                    IError _ -> done <$> ffinal fs+            FL.Done fb -> return $ done fb++    runCollectorWith cont fs pb = fstep fs pb >>= cont++    initial = finitial >>= handleCollect IPartial IDone++    {-# INLINE step #-}+    step (Fused3 st cnt fs) a = do+        r <- step1 st a+        case r of+            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 $ SDone (- cnt) xs++    extract (Fused3 s cnt fs) = do+        r <- extract1 s+        case r of+            FError _ -> fmap (FDone (- cnt)) (ffinal fs)+            FDone n b -> do+                assertM((- n) <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    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'.+--+-- /Pre-release/+--+{-# INLINE splitSome #-}+splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+splitSome (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =+    Parser step initial extract++    where++    -- Caution! There is mutual recursion here, inlining the right functions is+    -- important.++    handleCollect partial done fres =+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ partial $ Fused3 ps 0 $ Right fs+                    IDone pb ->+                        runCollectorWith (handleCollect partial done) fs pb+                    IError _ -> done <$> ffinal fs+            FL.Done fb -> return $ done fb++    runCollectorWith cont fs pb = fstep fs pb >>= cont++    initial = do+        fres <- finitial+        case fres of+            FL.Partial fs -> do+                pres <- initial1+                case pres of+                    IPartial ps -> return $ IPartial $ Fused3 ps 0 $ Left fs+                    IDone pb ->+                        runCollectorWith (handleCollect IPartial IDone) fs pb+                    IError err -> return $ IError err+            FL.Done _ ->+                return+                    $ IError+                    $ "splitSome: The collecting fold terminated without"+                          ++ " consuming any elements."++    {-# INLINE step #-}+    step (Fused3 st cnt (Left fs)) a = do+        r <- step1 st a+        -- In the Left state, count is used only for the assert+        case r of+            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+        case r of+            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+            FError err -> return (FError err)+            FDone n b -> do+                assertM((- n) <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    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+            FError _ -> fmap (FDone (- cnt)) (ffinal fs)+            FDone n b -> do+                assertM((- n) <= cnt)+                fs1 <- fstep fs b+                case fs1 of+                    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.+--+{-# INLINE_NORMAL die #-}+die :: Monad m => String -> Parser a m b+die err = Parser undefined (pure (IError err)) undefined++-- | A parser that always fails with an effectful error message and without+-- consuming any input.+--+-- /Pre-release/+--+{-# INLINE dieM #-}+dieM :: Monad m => m String -> Parser a m b+dieM err = Parser undefined (IError <$> err) undefined++-- Note: The default implementations of "some" and "many" loop infinitely+-- because of the strict pattern match on both the arguments in applicative and+-- alternative. With the direct style parser type we cannot use the mutually+-- recursive definitions of "some" and "many".+--+-- Note: With the direct style parser type, the list in "some" and "many" is+-- accumulated strictly, it cannot be consumed lazily.++-- | READ THE CAVEATS in 'alt' before using this instance.+--+-- >>> empty = Parser.die "empty"+-- >>> (<|>) = Parser.alt+-- >>> many = flip Parser.many Fold.toList+-- >>> some = flip Parser.some Fold.toList+instance Monad m => Alternative (Parser a m) where+    {-# INLINE empty #-}+    empty = die "empty"++    {-# INLINE (<|>) #-}+    (<|>) = alt++    {-# INLINE many #-}+    many = flip splitMany toList++    {-# INLINE some #-}+    some = flip splitSome toList++{-# ANN type ConcatParseState Fuse #-}+data ConcatParseState sl m a b =+      ConcatParseL !sl+    | forall s. ConcatParseR (s -> a -> m (Step s b)) s (s -> m (Final s b))++-- XXX Does it fuse completely? Check and update, it cannot fuse the+-- dynamically generated parser.++-- | Map a 'Parser' returning function on the result of a 'Parser'.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+-- /Pre-release/+--+{-# INLINE concatMap #-}+concatMap :: Monad m =>+    (b -> Parser a m c) -> Parser a m b -> Parser a m c+concatMap func (Parser stepL initialL extractL) = Parser step initial extract++    where++    {-# INLINE initializeR #-}+    initializeR (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR+            IDone br -> IDone br+            IError err -> IError err++    initial = do+        res <- initialL+        case res of+            IPartial s -> return $ IPartial $ ConcatParseL s+            IDone b -> initializeR (func b)+            IError err -> return $ IError err++    {-# INLINE initializeRL #-}+    initializeRL n (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> 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+            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+            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+        res <- initialR+        case res of+            IPartial s ->+                fmap+                    (first (\s1 -> ConcatParseR stepR s1 extractR))+                    (extractR s)+            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+            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.+--+-- Does not work correctly for parsers that can fail.+--+-- ALL THE CAVEATS IN 'splitWith' APPLY HERE AS WELL.+--+{-# INLINE noErrorUnsafeConcatMap #-}+noErrorUnsafeConcatMap :: Monad m =>+    (b -> Parser a m c) -> Parser a m b -> Parser a m c+noErrorUnsafeConcatMap func (Parser stepL initialL extractL) =+    Parser step initial extract++    where++    {-# INLINE initializeR #-}+    initializeR (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> IPartial $ ConcatParseR stepR sr extractR+            IDone br -> IDone br+            IError err -> IError err++    initial = do+        res <- initialL+        case res of+            IPartial s -> return $ IPartial $ ConcatParseL s+            IDone b -> initializeR (func b)+            IError err -> return $ IError err++    {-# INLINE initializeRL #-}+    initializeRL n (Parser stepR initialR extractR) = do+        resR <- initialR+        return $ case resR of+            IPartial sr -> 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+            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+            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+        res <- initialR+        case res of+            IPartial s ->+                fmap+                    (first (\s1 -> ConcatParseR stepR s1 extractR))+                    (extractR s)+            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+            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+-- CPS version.++-- | READ THE CAVEATS in 'concatMap' before using this instance.+--+-- >>> (>>=) = flip Parser.concatMap+--+instance Monad m => Monad (Parser a m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap++    {-# INLINE (>>) #-}+    (>>) = (*>)++-- | >>> fail = Parser.die+instance Monad m => Fail.MonadFail (Parser a m) where+    {-# INLINE fail #-}+    fail = die++{-+-- | See documentation of 'Streamly.Internal.Data.Parser.ParserK.Type.Parser'.+--+instance Monad m => MonadPlus (Parser a m) where+    {-# INLINE mzero #-}+    mzero = die "mzero"++    {-# INLINE mplus #-}+    mplus = alt+-}++-- | >>> liftIO = Parser.fromEffect . liftIO+instance (MonadIO m) => MonadIO (Parser a m) where+    {-# INLINE liftIO #-}+    liftIO = fromEffect . liftIO++------------------------------------------------------------------------------+-- Mapping on input+------------------------------------------------------------------------------++-- | @lmap f parser@ maps the function @f@ on the input of the parser.+--+-- >>> Stream.parse (Parser.lmap (\x -> x * x) (Parser.fromFold Fold.sum)) (Stream.enumerateFromTo 1 100)+-- Right 338350+--+-- > lmap = Parser.lmapM return+--+{-# INLINE lmap #-}+lmap :: (a -> b) -> Parser b m r -> Parser a m r+lmap f (Parser step begin done) = Parser step1 begin done++    where++    step1 x a = step x (f a)++-- | @lmapM f parser@ maps the monadic function @f@ on the input of the parser.+--+{-# INLINE lmapM #-}+lmapM :: Monad m => (a -> m b) -> Parser b m r -> Parser a m r+lmapM f (Parser step begin done) = Parser step1 begin done++    where++    step1 x a = f a >>= step x++-- | Include only those elements that pass a predicate.+--+-- >>> Stream.parse (Parser.filter (> 5) (Parser.fromFold Fold.sum)) $ Stream.fromList [1..10]+-- Right 40+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Parser a m b -> Parser a m b+filter f (Parser step initial extract) = Parser step1 initial extract++    where++    step1 x a = if f a then step x a else return $ 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
@@ -0,0 +1,39 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.ParserK+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.ParserK+    (+      module Streamly.Internal.Data.ParserK.Type++    -- * 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
@@ -0,0 +1,629 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Parser.ParserK.Type+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- CPS style implementation of parsers.+--+-- The CPS representation allows linear performance for Applicative, sequence,+-- Monad, Alternative, and choice operations compared to the quadratic+-- complexity of the corresponding direct style operations. However, direct+-- style operations allow fusion with ~10x better performance than CPS.+--+-- The direct style representation does not allow for recursive definitions of+-- "some" and "many" whereas CPS allows that.+--+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 (..)++    -- * 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)+import Control.Applicative (liftA2)+#endif+import Control.Applicative (Alternative(..))+import Control.Monad (MonadPlus(..), ap)+import Control.Monad.IO.Class (MonadIO, liftIO)+-- import Control.Monad.Trans.Class (MonadTrans(lift))+import GHC.Types (SPEC(..))++import qualified Control.Monad.Fail as Fail+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.+--+-- We could specialize the ParserK type to use an Array directly, that provides+-- some performance improvement. The best advantage of that is when we consume+-- one element at a time from the array. If we really want that perf+-- improvement we can use a special ParserK type with the following Input.+--+-- data Input a = None | Chunk {-# UNPACK #-} !(Array a)+--+-- 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+-- (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').+--+-- 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 =+      Done !Int 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+    fmap f (Done n r) = Done n (f r)+    fmap f (Partial n k) = Partial n (fmap (fmap f) . k)+    fmap f (Continue n k) = Continue n (fmap (fmap f) . k)+    fmap _ (Error n e) = Error n e++-- Note: Passing position index separately instead of passing it with the+-- result causes huge regression in expression parsing becnhmarks.++-- | The parser's result.+--+-- Int is the position index 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/+--+data ParseResult b =+      Success !Int !b      -- Position index, result+    | Failure !Int !String -- Position index, error++-- | Map a function over 'Success'.+instance Functor ParseResult where+    fmap f (Success n b) = Success n (f b)+    fmap _ (Failure n e) = Failure n e++-- XXX Change the type to the shape (a -> m r -> m r) -> (m r -> m r) -> m r+--+-- The parse continuation would be: Array a -> m (Step a m r) -> m (Step a m r)+-- The extract continuation would be: m (Step a m r) -> m (Step a m r)+--+-- Use Step itself in place of ParseResult.++-- | A continuation passing style parser representation.++-- A 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.+           -- Do not eta reduce the applications of this continuation.+           -- Continuation to be invoked after the parser is done+           (ParseResult b -> Int -> StepParser a m r)+           -- stream position adjustment before the parser starts.+        -> Int+           -- initial used count for the current alternative.+        -> Int+            -- final parse result, when the last continuation is done.+        -> StepParser a m r+    }++-------------------------------------------------------------------------------+-- Functor+-------------------------------------------------------------------------------++-- XXX rewrite this using ParserD, expose rmapM from ParserD.++-- | Map a function on the result i.e. on @b@ in @Parser a m b@.+instance Functor m => Functor (ParserK a m) where+    {-# INLINE fmap #-}+    fmap f parser = MkParser $ \k pos used inp ->+        let k1 res = k (fmap f res)+         in runParser parser k1 pos used inp++-------------------------------------------------------------------------------+-- Sequential applicative+-------------------------------------------------------------------------------++-- This is the dual of stream "fromPure".++-- | A parser that always yields a pure value without consuming any input.+--+-- /Pre-release/+--+{-# INLINE fromPure #-}+fromPure :: b -> ParserK a m b+fromPure b = MkParser $ \k pos used inp -> k (Success pos b) used inp++-- | See 'Streamly.Internal.Data.Parser.fromEffect'.+--+-- /Pre-release/+--+{-# INLINE fromEffect #-}+fromEffect :: Monad m => m b -> ParserK a m b+fromEffect eff =+    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+-- is then passed to the second parser. If both parsers succeed, their outputs+-- are applied to the function @f@. If either parser fails, the operation+-- fails.+--+instance Monad m => Applicative (ParserK a m) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = ap++    {-# INLINE (*>) #-}+    p1 *> p2 = MkParser $ \k 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 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)++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++-- This is the dual of "nil".+--+-- | A parser that always fails with an error message without consuming+-- any input.+--+-- /Pre-release/+--+{-# INLINE die #-}+die :: String -> ParserK a m b+die err = MkParser (\k 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.+instance Monad m => Monad (ParserK a m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    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 (>>) #-}+    (>>) = (*>)++#if !(MIN_VERSION_base(4,13,0))+    -- This is redefined instead of just being Fail.fail to be+    -- compatible with base 4.8.+    {-# INLINE fail #-}+    fail = die+#endif+instance Monad m => Fail.MonadFail (ParserK a m) where+    {-# INLINE fail #-}+    fail = die++instance MonadIO m => MonadIO (ParserK a m) where+    {-# INLINE liftIO #-}+    liftIO = fromEffect . liftIO++-------------------------------------------------------------------------------+-- Alternative+-------------------------------------------------------------------------------++-- | @p1 \<|> p2@ passes the input to parser p1, if it succeeds, the result is+-- returned. However, if p1 fails, the parser driver backtracks and tries the+-- same input on the alternative parser p2, returning the result if it+-- succeeds.+--+instance Monad m => Alternative (ParserK a m) where+    {-# INLINE empty #-}+    empty = die "empty"++    {-# INLINE (<|>) #-}+    p1 <|> p2 = MkParser $ \k pos _ input ->+        let+            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.++    {-# INLINE many #-}+    many v = many_v++        where++        many_v = some_v <|> pure []+        some_v = (:) <$> v <*> many_v++    {-# INLINE some #-}+    some v = some_v++        where++        many_v = some_v <|> pure []+        some_v = (:) <$> v <*> many_v++-- | 'mzero' is same as 'empty', it aborts the parser. 'mplus' is same as+-- '<|>', it selects the first succeeding parser.+--+instance Monad m => MonadPlus (ParserK a m) where+    {-# INLINE mzero #-}+    mzero = die "mzero"++    {-# INLINE mplus #-}+    mplus = (<|>)++{-+instance MonadTrans (ParserK a) where+    {-# INLINE lift #-}+    lift = fromEffect+-}++--------------------------------------------------------------------------------+-- Make a ParserK from Parser+--------------------------------------------------------------------------------++{-# INLINE adaptWith #-}+adaptWith+    :: forall m a s b r. (Monad m)+    => (s -> a -> m (ParserD.Step s b))+    -> m (ParserD.Initial s b)+    -> (s -> m (ParserD.Final s b))+    -> (ParseResult b -> Int -> Input a -> m (Step a m r))+    -> Int+    -> Int+    -> Input a+    -> m (Step a m r)+adaptWith pstep initial extract cont !relPos !usedCount !input = do+    res <- initial+    case res of+        ParserD.IPartial pst -> do+            if relPos == 0+            then+                case input of+                    -- 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+                -- 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++    {-# NOINLINE parseContChunk #-}+    parseContChunk !count !state x = do+         go SPEC state++        where++        go !_ !pst = do+            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.SDone 0 b ->+                    cont (Success 0 b) count (Chunk x)+                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.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.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.SContinue 0 pst1 ->+                    -- XXX recurse or call the driver?+                    go SPEC pst1+                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+            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++    -- 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 element) = parseContChunk cnt pst element+    parseCont !cnt !pst None = parseContNothing cnt pst++-- | Convert a 'Parser' to 'ParserK'.+--+-- /Pre-release/+--+{-# 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++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 :: 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)++-- 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/+--+{-# INLINE_LATE toParser #-}+toParser :: Monad m => ParserK a m b -> ParserD.Parser a m b+toParser parser = ParserD.Parser step initial extract++    where++    initial = pure (ParserD.IPartial (runParser parser parserDone 0 0))++    step cont a = do+        r <- cont (Chunk a)+        return $ case r of+            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 ->  assert (n <= 0) (return $ ParserD.FDone n b)+            Error _ e -> return $ ParserD.FError e+            Partial _ cont1 -> extract cont1+            Continue n cont1 ->+                assert (n <= 0) (return $ ParserD.FContinue n cont1)++{-# 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,271 +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-      Pipe--    -- * Pipes-    -- ** Mapping-    , map-    , 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-    -}--    -- * Composing Pipes-    , tee-    , zipWith-    , compose--    {--    -- * 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--}+      module Streamly.Internal.Data.Pipe.Type     ) 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-       (Pipe(..), PipeState(..), Step(..), zipWith, tee, map, compose)--- import Streamly.Internal.Data.Array.Type (Array)--- import Streamly.Internal.Data.Ring.Unboxed (Ring)--- import Streamly.Internal.Data.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.StreamD as D--- import qualified Streamly.Internal.Data.Stream.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.hs view
@@ -24,31 +24,24 @@ -- unecessary function calls can be avoided.  module Streamly.Internal.Data.Producer-    ( Producer (..)+    (+      module Streamly.Internal.Data.Producer.Source+    , module Streamly.Internal.Data.Producer.Type      -- * Converting     , simplify--    -- * Producers-    , nil-    , nilM-    , unfoldrM     , fromStreamD-    , fromList--    -- * Combinators-    , NestedLoop (..)-    , concat     ) where  #include "inline.hs" -import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))-import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..))+import Streamly.Internal.Data.Stream.Step (Step(..))+import Streamly.Internal.Data.Stream.Type (Stream(..)) import Streamly.Internal.Data.SVar.Type (defState) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) +import Streamly.Internal.Data.Producer.Source import Streamly.Internal.Data.Producer.Type import Prelude hiding (concat)
src/Streamly/Internal/Data/Producer/Source.hs view
@@ -36,11 +36,12 @@ import Control.Exception (assert) import GHC.Exts (SpecConstrAnnotation(..)) import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))+import Streamly.Internal.Data.Parser+    (ParseError(..), ParseErrorPos(..), Step(..), Final(..)) import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Streamly.Internal.Data.Stream.Step (Step(..)) -import qualified Streamly.Internal.Data.Parser.ParserD as ParserD+import qualified Streamly.Internal.Data.Parser as ParserD -- import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK  import Prelude hiding (read)@@ -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,121 +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-                        return (Left (ParseError err), unread [x] s1)-            Skip s -> go SPEC s buf pst-            Stop -> goStop buf pst+                        let src  = Prelude.reverse (getList buf)+                        return+                            ( Left (ParseErrorPos (i + 1) err)+                            , unread (src ++ [x]) s1+                            )+            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-                    return (Left (ParseError err), unread (x:xs) s1)+                    let src  = Prelude.reverse (getList buf)+                    return+                        ( 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 ->-                    return (Left (ParseError err), unread (x:xs) (source Nothing))+            SError err -> do+                    let src  = Prelude.reverse (getList buf)+                    return+                        ( 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 ->-                return (Left (ParseError err), source Nothing)+            FError err -> do+                let src  = Prelude.reverse (getList buf)+                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
@@ -33,12 +33,16 @@ #include "inline.hs"  import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Streamly.Internal.Data.Stream.Step (Step(..)) import Prelude hiding (concat, map)  ------------------------------------------------------------------------------ -- 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/Refold/Type.hs view
@@ -47,12 +47,12 @@ import Fusion.Plugin.Types (Fuse(..)) import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep) -import Prelude hiding (take, iterate)+import Prelude hiding (Foldable(..), take, iterate)  -- $setup -- >>> :m -- >>> import qualified Streamly.Internal.Data.Refold.Type as Refold--- >>> import qualified Streamly.Internal.Data.Fold.Type as Fold+-- >>> import qualified Streamly.Internal.Data.Fold as Fold -- >>> import qualified Streamly.Internal.Data.Stream as Stream  -- All folds in the Fold module should be implemented using Refolds.
− src/Streamly/Internal/Data/Ring.hs 
@@ -1,164 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Ring--- Copyright   : (c) 2021 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC-----module Streamly.Internal.Data.Ring-    ( Ring(..)--    -- * Generation-    , createRing-    , writeLastN--    -- * Modification-    , seek-    , unsafeInsertRingWith--    -- * Conversion-    , toMutArray-    , toStreamWith-    ) where--#include "assert.hs"--import Control.Monad.IO.Class (liftIO, MonadIO)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Array.Generic.Mut.Type-    ( MutArray(..)-    , new-    , uninit-    , putIndexUnsafe-    , putSliceUnsafe-    )--- import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream-import qualified Streamly.Internal.Data.Fold.Type as Fold---- 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 <- new count-    arr1 <- uninit arr count-    return (Ring-        { ringArr = arr1-        , ringHead = 0-        , ringMax = count-        })---{-# INLINE writeLastN #-}-writeLastN :: MonadIO m => Int -> Fold m a (Ring a)-writeLastN n = Fold step initial 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)-    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--- may share the same underlying memory as the Ring.-{-# INLINE toMutArray #-}-toMutArray :: MonadIO m => Int -> Int -> Ring a -> m (MutArray a)-toMutArray adj n Ring{..} = do-    let len = min ringMax n-    let idx = mod (ringHead + adj) ringMax-        end = idx + len-    if end <= ringMax-    then-        -- putSliceUnsafe ringArr idx arr1 0 len-        return $ ringArr { arrStart = idx, arrLen = len }-    else do-        -- XXX Just swap the elements in the existing ring and return the-        -- same array without reallocation.-        arr <- liftIO $ new len-        arr1 <- uninit arr len-        putSliceUnsafe ringArr idx arr1 0 (ringMax - idx)-        putSliceUnsafe ringArr 0 arr1 (ringMax - idx) (end - ringMax)-        return arr1---- This would be theoretically slower than toMutArray because of a branch--- introduced for each element in the second half of the ring.---- | Seek by n and then read the entire ring. Use 'take' on the stream to--- restrict the reads.-toStreamWith :: Int -> Ring a -> Stream m a-toStreamWith = undefined-{--toStreamWith n Ring{..}-    | ringMax > 0 = concatEffect $ liftIO $ do-        idx <- readIORef ringHead-        let idx1 = idx + adj-            next = mod idx1 ringMax-            s1 = undefined  -- stream initial slice-            s2 = undefined  -- stream next slice-        return (s1 `Stream.append` s2)-    | otherwise = Stream.nil--}
− src/Streamly/Internal/Data/Ring/Unboxed.hs 
@@ -1,615 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Ring.Unboxed--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ A ring array is a circular mutable array.---- XXX Write benchmarks--- XXX Make the implementation similar to mutable array--- XXX Rename this module to Data.RingArray.Storable--module Streamly.Internal.Data.Ring.Unboxed-    ( Ring(..)--    -- * Construction-    , new-    , newRing-    , writeN--    , advance-    , moveBy-    , startOf--    -- * Random writes-    , unsafeInsert-    , slide-    , putIndex-    , modifyIndex--    -- * Unfolds-    , read-    , readRev--    -- * Random reads-    , getIndex-    , getIndexUnsafe-    , getIndexRev--    -- * Size-    , length-    , byteLength-    -- , capacity-    , byteCapacity-    , bytesFree--    -- * Casting-    , cast-    , castUnsafe-    , asBytes-    , fromArray--    -- * Folds-    , unsafeFoldRing-    , unsafeFoldRingM-    , unsafeFoldRingFullM-    , unsafeFoldRingNM--    -- * Stream of Arrays-    , ringsOf--    -- * Fast Byte Comparisons-    , unsafeEqArray-    , unsafeEqArrayN--    , slidingWindow-    , slidingWindowWith-    ) where--#include "ArrayMacros.h"-#include "inline.hs"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Word (Word8)-import Foreign.Storable-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, touchForeignPtr)-import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)-import Foreign.Ptr (plusPtr, minusPtr, castPtr)-import Streamly.Internal.Data.Unboxed as Unboxed (Unbox, peekWith)-import GHC.ForeignPtr (mallocPlainForeignPtrAlignedBytes)-import GHC.Ptr (Ptr(..))-import Streamly.Internal.Data.Array.Mut.Type (MutArray)-import Streamly.Internal.Data.Fold.Type (Fold(..), Step(..), lmap)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))-import Streamly.Internal.Data.Unfold.Type (Unfold(..))-import Streamly.Internal.System.IO (unsafeInlineIO)--import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Type as A--import Prelude hiding (length, concat, read)---- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Ring.Unboxed as Ring---- | A ring buffer is a mutable array of fixed size. Initially the array is--- empty, with ringStart pointing at the start of allocated memory. We call the--- next location to be written in the ring as ringHead. Initially ringHead ==--- ringStart. When the first item is added, ringHead points to ringStart +--- sizeof item. When the buffer becomes full ringHead would wrap around to--- ringStart. When the buffer is full, ringHead always points at the oldest--- item in the ring and the newest item added always overwrites the oldest--- item.------ When using it we should keep in mind that a ringBuffer is a mutable data--- structure. We should not leak out references to it for immutable use.----data Ring a = Ring-    { ringStart :: {-# UNPACK #-} !(ForeignPtr a) -- first address-    , ringBound :: {-# UNPACK #-} !(Ptr a)        -- first address beyond allocated memory-    }------------------------------------------------------------------------------------ Construction------------------------------------------------------------------------------------ | Get the first address of the ring as a pointer.-startOf :: Ring a -> Ptr a-startOf = unsafeForeignPtrToPtr . ringStart---- | Create a new ringbuffer and return the ring buffer and the ringHead.--- Returns the ring and the ringHead, the ringHead is same as ringStart.-{-# INLINE new #-}-new :: forall a. Storable a => Int -> IO (Ring a, Ptr a)-new count = do-    let size = count * max 1 (sizeOf (undefined :: a))-    fptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: a))-    let p = unsafeForeignPtrToPtr fptr-    return (Ring-        { ringStart = fptr-        , ringBound = p `plusPtr` size-        }, p)---- XXX Rename this to "new".------ | @newRing count@ allocates an empty array that can hold 'count' items.  The--- memory of the array is uninitialized and the allocation is aligned as per--- the 'Storable' instance of the type.------ /Unimplemented/-{-# INLINE newRing #-}-newRing :: Int -> m (Ring a)-newRing = undefined---- | Advance the ringHead by 1 item, wrap around if we hit the end of the--- array.-{-# INLINE advance #-}-advance :: forall a. Storable a => Ring a -> Ptr a -> Ptr a-advance Ring{..} ringHead =-    let ptr = PTR_NEXT(ringHead,a)-    in if ptr <  ringBound-       then ptr-       else unsafeForeignPtrToPtr ringStart---- | Move the ringHead by n items. The direction depends on the sign on whether--- n is positive or negative. Wrap around if we hit the beginning or end of the--- array.-{-# INLINE moveBy #-}-moveBy :: forall a. Storable a => Int -> Ring a -> Ptr a -> Ptr a-moveBy by Ring {..} ringHead = ringStartPtr `plusPtr` advanceFromHead--    where--    elemSize = STORABLE_SIZE_OF(a)-    ringStartPtr = unsafeForeignPtrToPtr ringStart-    lenInBytes = ringBound `minusPtr` ringStartPtr-    offInBytes = ringHead `minusPtr` ringStartPtr-    len = assert (lenInBytes `mod` elemSize == 0) $ lenInBytes `div` elemSize-    off = assert (offInBytes `mod` elemSize == 0) $ offInBytes `div` elemSize-    advanceFromHead = (off + by `mod` len) * elemSize---- XXX Move the writeLastN from array module here.------ | @writeN n@ is a rolling fold that keeps the last n elements of the stream--- in a ring array.------ /Unimplemented/-{-# INLINE writeN #-}-writeN :: -- (Storable a, MonadIO m) =>-    Int -> Fold m a (Ring a)-writeN = undefined------------------------------------------------------------------------------------ Conversions------------------------------------------------------------------------------------ | Cast a mutable array to a ring array.-fromArray :: MutArray a -> Ring a-fromArray = undefined------------------------------------------------------------------------------------ Conversion to/from array------------------------------------------------------------------------------------ | Modify a given index of a ring array using a modifier function.------ /Unimplemented/-modifyIndex :: -- forall m a b. (MonadIO m, Storable a) =>-    Ring a -> Int -> (a -> (a, b)) -> m b-modifyIndex = undefined---- | /O(1)/ Write the given element at the given index in the ring array.--- Performs in-place mutation of the array.------ >>> putIndex arr ix val = Ring.modifyIndex arr ix (const (val, ()))------ /Unimplemented/-{-# INLINE putIndex #-}-putIndex :: -- (MonadIO m, Storable a) =>-    Ring a -> Int -> a -> m ()-putIndex = undefined---- | Insert an item at the head of the ring, when the ring is full this--- replaces the oldest item in the ring with the new item. This is unsafe--- beause ringHead supplied is not verified to be within the Ring. Also,--- the ringStart foreignPtr must be guaranteed to be alive by the caller.-{-# INLINE unsafeInsert #-}-unsafeInsert :: Storable a => Ring a -> Ptr a -> a -> IO (Ptr a)-unsafeInsert rb ringHead newVal = do-    poke ringHead newVal-    -- touchForeignPtr (ringStart rb)-    return $ advance rb ringHead---- | Insert an item at the head of the ring, when the ring is full this--- replaces the oldest item in the ring with the new item.------ /Unimplemented/-slide :: -- forall m a. (MonadIO m, Storable a) =>-    Ring a -> a -> m (Ring a)-slide = undefined------------------------------------------------------------------------------------ Random reads------------------------------------------------------------------------------------ | Return the element at the specified index without checking the bounds.------ Unsafe because it does not check the bounds of the ring array.-{-# INLINE_NORMAL getIndexUnsafe #-}-getIndexUnsafe :: -- forall m a. (MonadIO m, Storable a) =>-    Ring a -> Int -> m a-getIndexUnsafe = undefined---- | /O(1)/ Lookup the element at the given index. Index starts from 0.----{-# INLINE getIndex #-}-getIndex :: -- (MonadIO m, Storable a) =>-    Ring a -> Int -> m a-getIndex = undefined---- | /O(1)/ Lookup the element at the given index from the end of the array.--- Index starts from 0.------ Slightly faster than computing the forward index and using getIndex.----{-# INLINE getIndexRev #-}-getIndexRev :: -- (MonadIO m, Storable a) =>-    Ring a -> Int -> m a-getIndexRev = undefined------------------------------------------------------------------------------------ Size------------------------------------------------------------------------------------ | /O(1)/ Get the byte length of the array.------ /Unimplemented/-{-# INLINE byteLength #-}-byteLength :: Ring a -> Int-byteLength = undefined---- | /O(1)/ Get the length of the array i.e. the number of elements in the--- array.------ Note that 'byteLength' is less expensive than this operation, as 'length'--- involves a costly division operation.------ /Unimplemented/-{-# INLINE length #-}-length :: -- forall a. Storable a =>-    Ring a -> Int-length = undefined---- | Get the total capacity of an array. An array may have space reserved--- beyond the current used length of the array.------ /Pre-release/-{-# INLINE byteCapacity #-}-byteCapacity :: Ring a -> Int-byteCapacity = undefined---- | The remaining capacity in the array for appending more elements without--- reallocation.------ /Pre-release/-{-# INLINE bytesFree #-}-bytesFree :: Ring a -> Int-bytesFree = undefined------------------------------------------------------------------------------------ Unfolds------------------------------------------------------------------------------------ XXX We can read the ring in a loop and use "take" to restrict the number of--- elements to be taken.------ | Read n elements from the ring starting at the supplied ring head. If n is--- more than the ring size it keeps reading the ring in a circular fashion.------ If the ring is not full the user must ensure than n is less than or equal to--- the number of valid elements in the ring.------ /Internal/-{-# INLINE_NORMAL read #-}-read :: forall m a. (MonadIO m, Storable a) => Unfold m (Ring a, Ptr a, Int) a-read = Unfold step return--    where--    step (rb, rh, n) = do-        if n <= 0-        then do-            liftIO $ touchForeignPtr (ringStart rb)-            return Stop-        else do-            x <- liftIO $ peek rh-            let rh1 = advance rb rh-            return $ Yield x (rb, rh1, n - 1)---- | Unfold a ring array into a stream in reverse order.------ /Unimplemented/-{-# INLINE_NORMAL readRev #-}-readRev :: -- forall m a. (MonadIO m, Storable a) =>-    Unfold m (MutArray a) a-readRev = undefined------------------------------------------------------------------------------------ Stream of arrays------------------------------------------------------------------------------------ XXX Move this module to a lower level Ring/Type module and move ringsOf to a--- higher level ring module where we can import "scan".---- | @ringsOf n stream@ groups the input stream into a stream of--- ring arrays of size n. Each ring is a sliding window of size n.------ /Unimplemented/-{-# INLINE_NORMAL ringsOf #-}-ringsOf :: -- forall m a. (MonadIO m, Storable a) =>-    Int -> Stream m a -> Stream m (MutArray a)-ringsOf = undefined -- Stream.scan (writeN n)------------------------------------------------------------------------------------ Casting------------------------------------------------------------------------------------ | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The array size must be a multiple of the size of type @b@.------ /Unimplemented/----castUnsafe :: Ring a -> Ring b-castUnsafe = undefined---- | Cast an @Array a@ into an @Array Word8@.------ /Unimplemented/----asBytes :: Ring a -> Ring Word8-asBytes = castUnsafe---- | Cast an array having elements of type @a@ into an array having elements of--- type @b@. The length of the array should be a multiple of the size of the--- target element otherwise 'Nothing' is returned.------ /Pre-release/----cast :: forall a b. Storable b => Ring a -> Maybe (Ring b)-cast arr =-    let len = byteLength arr-        r = len `mod` STORABLE_SIZE_OF(b)-     in if r /= 0-        then Nothing-        else Just $ castUnsafe arr------------------------------------------------------------------------------------ Equality------------------------------------------------------------------------------------ XXX remove all usage of unsafeInlineIO------ | Like 'unsafeEqArray' but compares only N bytes instead of entire length of--- the ring buffer. This is unsafe because the ringHead Ptr is not checked to--- be in range.-{-# INLINE unsafeEqArrayN #-}-unsafeEqArrayN :: Ring a -> Ptr a -> A.Array a -> Int -> Bool-unsafeEqArrayN Ring{..} rh A.Array{..} nBytes-    | nBytes < 0 = error "unsafeEqArrayN: n should be >= 0"-    | nBytes == 0 = True-    | otherwise = unsafeInlineIO $ check (castPtr rh) 0--    where--    w8Contents = arrContents--    check p i = do-        (relem :: Word8) <- peek p-        aelem <- peekWith w8Contents i-        if relem == aelem-        then go (p `plusPtr` 1) (i + 1)-        else return False--    go p i-        | i == nBytes = return True-        | castPtr p == ringBound =-            go (castPtr (unsafeForeignPtrToPtr ringStart)) i-        | castPtr p == rh = touchForeignPtr ringStart >> return True-        | otherwise = check p i---- XXX This is not modular. We should probably just convert the array and the--- ring buffer to streams and compare the two streams. Need to check perf--- though.---- | Byte compare the entire length of ringBuffer with the given array,--- starting at the supplied ringHead pointer.  Returns true if the Array and--- the ringBuffer have identical contents.------ This is unsafe because the ringHead Ptr is not checked to be in range. The--- supplied array must be equal to or bigger than the ringBuffer, ARRAY BOUNDS--- ARE NOT CHECKED.-{-# INLINE unsafeEqArray #-}-unsafeEqArray :: Ring a -> Ptr a -> A.Array a -> Bool-unsafeEqArray Ring{..} rh A.Array{..} =-    unsafeInlineIO $ check (castPtr rh) 0--    where--    w8Contents = arrContents--    check p i = do-        (relem :: Word8) <- peek p-        aelem <- peekWith w8Contents i-        if relem == aelem-        then go (p `plusPtr` 1) (i + 1)-        else return False--    go p i-        | castPtr p ==-              ringBound = go (castPtr (unsafeForeignPtrToPtr ringStart)) i-        | castPtr p == rh = touchForeignPtr ringStart >> return True-        | otherwise = check p i------------------------------------------------------------------------------------ Folding------------------------------------------------------------------------------------ XXX We can unfold it into a stream and fold the stream instead.--- XXX use MonadIO------ | Fold the buffer starting from ringStart up to the given 'Ptr' using a pure--- step function. This is useful to fold the items in the ring when the ring is--- not full. The supplied pointer is usually the end of the ring.------ Unsafe because the supplied Ptr is not checked to be in range.-{-# INLINE unsafeFoldRing #-}-unsafeFoldRing :: forall a b. Storable a-    => Ptr a -> (b -> a -> b) -> b -> Ring a -> b-unsafeFoldRing ptr f z Ring{..} =-    let !res = unsafeInlineIO $ withForeignPtr ringStart $ \p ->-                    go z p ptr-    in res-    where-      go !acc !p !q-        | p == q = return acc-        | otherwise = do-            x <- peek p-            go (f acc x) (PTR_NEXT(p,a)) q---- XXX Can we remove MonadIO here?-withForeignPtrM :: MonadIO m => ForeignPtr a -> (Ptr a -> m b) -> m b-withForeignPtrM fp fn = do-    r <- fn $ unsafeForeignPtrToPtr fp-    liftIO $ touchForeignPtr fp-    return r---- | Like unsafeFoldRing but with a monadic step function.-{-# INLINE unsafeFoldRingM #-}-unsafeFoldRingM :: forall m a b. (MonadIO m, Storable a)-    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b-unsafeFoldRingM ptr f z Ring {..} =-    withForeignPtrM ringStart $ \x -> go z x ptr-  where-    go !acc !start !end-        | start == end = return acc-        | otherwise = do-            let !x = unsafeInlineIO $ peek start-            acc1 <- f acc x-            go acc1 (PTR_NEXT(start,a)) end---- | Fold the entire length of a ring buffer starting at the supplied ringHead--- pointer.  Assuming the supplied ringHead pointer points to the oldest item,--- this would fold the ring starting from the oldest item to the newest item in--- the ring.------ Note, this will crash on ring of 0 size.----{-# INLINE unsafeFoldRingFullM #-}-unsafeFoldRingFullM :: forall m a b. (MonadIO m, Storable a)-    => Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b-unsafeFoldRingFullM rh f z rb@Ring {..} =-    withForeignPtrM ringStart $ \_ -> go z rh-  where-    go !acc !start = do-        let !x = unsafeInlineIO $ peek start-        acc' <- f acc x-        let ptr = advance rb start-        if ptr == rh-            then return acc'-            else go acc' ptr---- | Fold @Int@ items in the ring starting at @Ptr a@.  Won't fold more--- than the length of the ring.------ Note, this will crash on ring of 0 size.----{-# INLINE unsafeFoldRingNM #-}-unsafeFoldRingNM :: forall m a b. (MonadIO m, Storable a)-    => Int -> Ptr a -> (b -> a -> m b) -> b -> Ring a -> m b-unsafeFoldRingNM count rh f z rb@Ring {..} =-    withForeignPtrM ringStart $ \_ -> go count z rh--    where--    go 0 acc _ = return acc-    go !n !acc !start = do-        let !x = unsafeInlineIO $ peek start-        acc' <- f acc x-        let ptr = advance rb start-        if ptr == rh || n == 0-            then return acc'-            else go (n - 1) acc' ptr--data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Show---- | Like slidingWindow but also provides the entire ring contents as an Array.--- The array reflects the state of the ring after inserting the incoming--- element.------ IMPORTANT NOTE: The ring is mutable, therefore, the result of @(m (Array--- a))@ action depends on when it is executed. It does not capture the sanpshot--- of the ring at a particular time.-{-# INLINE slidingWindowWith #-}-slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)-    => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b-slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract--    where--    initial = do-        if n <= 0-        then error "Window size must be > 0"-        else do-            r <- initial1-            (rb, rh) <- liftIO $ new n-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh (0 :: Int) s-                    Done b -> Done b--    toArray foldRing rb rh = do-        arr <- liftIO $ MA.newPinned n-        let snoc' b a = liftIO $ MA.snocUnsafe b a-        foldRing rh snoc' arr rb--    step (Tuple4' rb rh i st) a-        | i < n = do-            rh1 <- liftIO $ unsafeInsert rb rh a-            liftIO $ touchForeignPtr (ringStart rb)-            let action = toArray unsafeFoldRingM rb (PTR_NEXT(rh, a))-            r <- step1 st ((a, Nothing), action)-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s-                    Done b -> Done b-        | otherwise = do-            old <- liftIO $ peek rh-            rh1 <- liftIO $ unsafeInsert rb rh a-            liftIO $ touchForeignPtr (ringStart rb)-            r <- step1 st ((a, Just old), toArray unsafeFoldRingFullM rb rh1)-            return $-                case r of-                    Partial s -> Partial $ Tuple4' rb rh1 (i + 1) s-                    Done b -> Done b--    extract (Tuple4' _ _ _ st) = extract1 st---- | @slidingWindow collector@ is an incremental sliding window--- fold that does not require all the intermediate elements in a computation.--- This maintains @n@ elements in the window, when a new element comes it slides--- out the oldest element and the new element along with the old element are--- supplied to the collector fold.------ The 'Maybe' type is for the case when initially the window is filling and--- there is no old element.----{-# INLINE slidingWindow #-}-slidingWindow :: forall m a b. (MonadIO m, Storable a, Unbox a)-    => Int -> Fold m (a, Maybe a) b -> Fold m a b-slidingWindow n f = slidingWindowWith n (lmap fst f)
+ src/Streamly/Internal/Data/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
@@ -0,0 +1,529 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- 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+      deriveSerialize+    , deriveSerializeWith++    -- Utilities+    , module Streamly.Internal.Data.Serialize.TH.Bottom+    -- ** Common+    , module Streamly.Internal.Data.Serialize.TH.Common+    -- ** RecHeader+    , module Streamly.Internal.Data.Serialize.TH.RecHeader+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.Foldable (length, foldMap)+import Data.List (foldl')+import Data.Word (Word16, Word32, Word64, Word8)++import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Streamly.Internal.Data.Serialize.Type++import Streamly.Internal.Data.Unbox.TH+    ( DataCon(..)+    , DataType(..)+    , reifyDataType+    )++import qualified Streamly.Internal.Data.Serialize.TH.RecHeader as RecHeader++import Streamly.Internal.Data.Serialize.TH.Bottom+import Streamly.Internal.Data.Serialize.TH.Common+import Streamly.Internal.Data.Serialize.TH.RecHeader+import Prelude hiding (Foldable(..))++--------------------------------------------------------------------------------+-- Domain specific helpers+--------------------------------------------------------------------------------++exprGetSize :: Q Exp -> (Int, Type) -> Q Exp+exprGetSize acc (i, _) = [|addSizeTo $(acc) $(varE (mkFieldName i))|]++getTagSize :: Int -> Int+getTagSize numConstructors+    | numConstructors == 1 = 0+    | fromIntegral (maxBound :: Word8) >= numConstructors = 1+    | fromIntegral (maxBound :: Word16) >= numConstructors = 2+    | fromIntegral (maxBound :: Word32) >= numConstructors = 4+    | fromIntegral (maxBound :: Word64) >= numConstructors = 8+    | otherwise = error "Too many constructors"++getTagType :: Int -> Name+getTagType numConstructors+    | numConstructors == 1 = error "No tag for 1 constructor"+    | fromIntegral (maxBound :: Word8) >= numConstructors = ''Word8+    | fromIntegral (maxBound :: Word16) >= numConstructors = ''Word16+    | fromIntegral (maxBound :: Word32) >= numConstructors = ''Word32+    | fromIntegral (maxBound :: Word64) >= numConstructors = ''Word64+    | otherwise = error "Too many constructors"++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++getNameBaseLen :: Name -> Word8+getNameBaseLen cname =+    let x = length (nameBase cname)+     in if x > 63+        then error "Max Constructor Len: 63 characters"+        else fromIntegral x++conEncLen :: Name -> Word8+conEncLen cname = getNameBaseLen cname + 1++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++mkSizeOfExpr :: Bool -> Bool -> TypeOfType -> Q Exp+mkSizeOfExpr True False tyOfTy =+    case tyOfTy of+        UnitType cname ->+            lamE+                [varP _acc, wildP]+                [|$(varE _acc) + $(litIntegral (conEncLen cname))|]+        TheType con ->+            lamE+                [varP _acc, varP _x]+                (caseE (varE _x) [matchCons (varE _acc) con])+        MultiType constructors -> sizeOfHeadDt constructors++    where++    sizeOfFields acc fields =+        foldl' exprGetSize acc $ zip [0..] fields++    matchCons acc (SimpleDataCon cname fields) =+        let a = litIntegral (conEncLen cname)+            b = sizeOfFields acc (map snd fields)+            expr = [|$(a) + $(b)|]+         in matchConstructor cname (length fields) expr++    sizeOfHeadDt cons =+        let acc = [|$(varE _acc)|]+         in lamE+                [varP _acc, varP _x]+                (caseE (varE _x) (fmap (matchCons acc) cons))++mkSizeOfExpr False False tyOfTy =+    case tyOfTy of+        UnitType _ -> lamE [varP _acc, wildP] [|$(varE _acc) + 1|]+        TheType con ->+            lamE+                [varP _acc, varP _x]+                (caseE (varE _x) [matchCons (varE _acc) con])+        MultiType constructors -> sizeOfHeadDt constructors++    where++    tagSizeExp numConstructors =+        litE (IntegerL (fromIntegral (getTagSize numConstructors)))++    -- XXX fields of the same type can be folded together, will reduce the code+    -- size when there are many fields of the same type.+    -- XXX const size fields can be calculated statically.+    -- XXX This can result in large compilation times due to nesting when there+    -- are many constructors. We can create a list and sum the list at run time+    -- to avoid that depending on the number of constructors. Or using a let+    -- statement for each case may help?+    -- appE (varE 'sum) (listE (acc : map (exprGetSize (litE (IntegerL 0))) (zip [0..] fields)))+    sizeOfFields acc fields =+        foldl' exprGetSize acc $ zip [0..] fields++    matchCons acc (SimpleDataCon cname fields) =+        let expr = sizeOfFields acc (map snd fields)+         in matchConstructor cname (length fields) expr++    -- XXX We fix VarSize for simplicity. Should be changed later.+    sizeOfHeadDt cons =+        let numCons = length cons+            acc = [|$(varE _acc) + $(tagSizeExp numCons)|]+         in lamE+                [varP _acc, varP _x]+                (caseE (varE _x) (fmap (matchCons acc) cons))++mkSizeOfExpr False True (TheType con) = RecHeader.mkRecSizeOfExpr con++mkSizeOfExpr _ _ _ = errorUnimplemented++mkSizeDec :: SerializeConfig -> Type -> [DataCon] -> Q [Dec]+mkSizeDec (SerializeConfig {..}) headTy cons = do+    -- INLINE on sizeOf actually worsens some benchmarks, and improves none+    sizeOfMethod <-+        mkSizeOfExpr+            cfgConstructorTagAsString+            cfgRecordSyntaxWithHeader+            (typeOfType headTy cons)+    pure+        ( foldMap+            (\x -> [PragmaD (InlineP 'addSizeTo x FunLike AllPhases)])+            cfgInlineSize+         ++ [FunD 'addSizeTo [Clause [] (NormalB sizeOfMethod) []]]+        )++--------------------------------------------------------------------------------+-- Peek+--------------------------------------------------------------------------------++mkDeserializeExpr :: Bool -> Bool -> Type -> TypeOfType -> Q Exp+mkDeserializeExpr True False headTy tyOfTy =+    case tyOfTy of+        UnitType cname -> deserializeConsExpr [SimpleDataCon cname []]+        TheType con -> deserializeConsExpr [con]+        MultiType cons -> deserializeConsExpr cons++  where++    deserializeConsExpr cons = do+        conLen <- newName "conLen"+        off1 <- newName "off1"+        [|do ($(varP off1), $(varP conLen) :: Word8) <-+                 deserializeAt+                     $(varE _initialOffset)+                     $(varE _arr)+                     $(varE _endOffset)+             $(multiIfE (map (guardCon conLen off1) cons ++ [catchAll]))|]++    catchAll =+        normalGE+            [|True|]+            [|error+               ("Found invalid tag while peeking (" +++                   $(lift (pprint headTy)) ++ ")")|]++    guardCon conLen off con@(SimpleDataCon cname _) = do+        let lenCname = getNameBaseLen cname+            tag = map c2w (nameBase cname)+        normalGE+            [|($(litIntegral lenCname) == $(varE conLen))+                   && $(xorCmp tag off _arr)|]+            [|let $(varP (makeI 0)) = $(varE off) + $(litIntegral lenCname)+               in $(mkDeserializeExprOne 'deserializeAt con)|]++mkDeserializeExpr False False headTy tyOfTy =+    case tyOfTy of+        -- Unit constructor+        -- XXX Should we peek and check if the byte value is 0?+        UnitType cname ->+            [|pure ($(varE _initialOffset) + 1, $(conE cname))|]+        -- Product type+        TheType con ->+            letE+                [valD (varP (mkName "i0")) (normalB (varE _initialOffset)) []]+                (mkDeserializeExprOne 'deserializeAt con)+        -- Sum type+        MultiType cons -> do+            let lenCons = length cons+                tagType = getTagType lenCons+            doE+                [ bindS+                      (tupP [varP (mkName "i0"), varP _tag])+                      [|deserializeAt $(varE _initialOffset) $(varE _arr) $(varE _endOffset)|]+                , noBindS+                      (caseE+                           (sigE (varE _tag) (conT tagType))+                           (fmap peekMatch (zip [0 ..] cons) ++ [peekErr]))+                ]+  where+    peekMatch (i, con) =+        match+            (litP (IntegerL i))+            (normalB (mkDeserializeExprOne 'deserializeAt con)) []+    peekErr =+        match+            wildP+            (normalB+                -- XXX Print the tag+                 [|error+                       ("Found invalid tag while peeking (" +++                        $(lift (pprint headTy)) ++ ")")|])+            []++mkDeserializeExpr False True _ (TheType con@(SimpleDataCon _ fields)) = do+    deserializeWithKeys <- newName "deserializeWithKeys"+    updateFunc <- newName "updateFunc"+    updateFuncDec <- RecHeader.conUpdateFuncDec updateFunc fields+    deserializeWithKeysDec <-+        RecHeader.mkDeserializeKeysDec deserializeWithKeys updateFunc con+    letE+        (pure <$> (deserializeWithKeysDec ++ updateFuncDec))+        (RecHeader.mkRecDeserializeExpr+             _initialOffset+             _endOffset+             deserializeWithKeys+             con)++mkDeserializeExpr _ _ _ _ = errorUnimplemented++mkDeserializeDec :: SerializeConfig -> Type -> [DataCon] -> Q [Dec]+mkDeserializeDec (SerializeConfig {..}) headTy cons = do+    peekMethod <-+        mkDeserializeExpr+            cfgConstructorTagAsString+            cfgRecordSyntaxWithHeader+            headTy+            (typeOfType headTy cons)+    pure+        ( foldMap+            (\x -> [PragmaD (InlineP 'deserializeAt x FunLike AllPhases)])+            cfgInlineDeserialize+         +++            [ FunD+              'deserializeAt+              [ Clause+                    (if isUnitType cons && not cfgConstructorTagAsString+                         then [VarP _initialOffset, WildP, WildP]+                         else [VarP _initialOffset, VarP _arr, VarP _endOffset])+                    (NormalB peekMethod)+                    []+              ]+            ]+        )++--------------------------------------------------------------------------------+-- Poke+--------------------------------------------------------------------------------++mkSerializeExprTag :: Name -> Int -> Q Exp+mkSerializeExprTag tagType tagVal =+    [|serializeAt+          $(varE _initialOffset)+          $(varE _arr)+          $(sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType))|]++mkSerializeExpr :: Bool -> Bool -> TypeOfType -> Q Exp+mkSerializeExpr True False tyOfTy =+    case tyOfTy of+        -- Unit type+        UnitType cname ->+            caseE+                (varE _val)+                [serializeDataCon (SimpleDataCon cname [])]+        -- Product type+        (TheType con) ->+            caseE+                (varE _val)+                [serializeDataCon con]+        -- Sum type+        (MultiType cons) ->+            caseE+                (varE _val)+                (map serializeDataCon cons)++    where++    serializeDataCon (SimpleDataCon cname fields) = do+        let tagLen8 = getNameBaseLen cname+            conEnc = tagLen8 : map c2w (nameBase cname)+        matchConstructor+            cname+            (length fields)+            (doE [ bindS+                       (varP (mkName "i0"))+                       (serializeW8List _initialOffset _arr conEnc)+                 , noBindS (mkSerializeExprFields 'serializeAt fields)+                 ])++mkSerializeExpr False False tyOfTy =+    case tyOfTy of+        -- Unit type+        UnitType _ ->+            [|serializeAt $(varE _initialOffset) $(varE _arr) (0 :: Word8)|]+        -- Product type+        (TheType (SimpleDataCon cname fields)) ->+            letE+                [valD (varP (mkName "i0")) (normalB (varE _initialOffset)) []]+                (caseE+                     (varE _val)+                     [ matchConstructor+                           cname+                           (length fields)+                           (mkSerializeExprFields 'serializeAt fields)+                     ])+        -- Sum type+        (MultiType cons) -> do+            let lenCons = length cons+                tagType = getTagType lenCons+            caseE+                (varE _val)+                (fmap (\(tagVal, SimpleDataCon cname fields) ->+                          matchConstructor+                              cname+                              (length fields)+                              (doE [ bindS+                                         (varP (mkName "i0"))+                                         (mkSerializeExprTag tagType tagVal)+                                   , noBindS+                                         (mkSerializeExprFields+                                              'serializeAt+                                              fields)+                                   ]))+                     (zip [0 ..] cons))++mkSerializeExpr False True (TheType con) =+    RecHeader.mkRecSerializeExpr _initialOffset con++mkSerializeExpr _ _ _ = errorUnimplemented++mkSerializeDec :: SerializeConfig -> Type -> [DataCon] -> Q [Dec]+mkSerializeDec (SerializeConfig {..}) headTy cons = do+    pokeMethod <-+        mkSerializeExpr+            cfgConstructorTagAsString+            cfgRecordSyntaxWithHeader+            (typeOfType headTy cons)+    pure+        ( foldMap+            (\x -> [PragmaD (InlineP 'serializeAt x FunLike AllPhases)])+            cfgInlineSerialize+         +++            [FunD+                  'serializeAt+                  [ Clause+                        (if isUnitType cons && not cfgConstructorTagAsString+                             then [VarP _initialOffset, VarP _arr, WildP]+                             else [VarP _initialOffset, VarP _arr, VarP _val])+                        (NormalB pokeMethod)+                        []+                  ]+            ]+        )++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++-- | A general function to derive Serialize instances where you can control+-- which Constructors of the datatype to consider and what the Context for the+-- 'Serialize' instance would be.+--+-- Consider the datatype:+-- @+-- data CustomDataType a b+--     = CDTConstructor1+--     | CDTConstructor2 Bool+--     | CDTConstructor3 Bool b+--     deriving (Show, Eq)+-- @+--+-- Usage:+-- @+-- $(deriveSerializeInternal+--       serializeConfig+--       [AppT (ConT ''Serialize) (VarT (mkName "b"))]+--       (AppT+--            (AppT (ConT ''CustomDataType) (VarT (mkName "a")))+--            (VarT (mkName "b")))+--       [ DataCon 'CDTConstructor1 [] [] []+--       , DataCon 'CDTConstructor2 [] [] [(Nothing, (ConT ''Bool))]+--       , DataCon+--             'CDTConstructor3+--             []+--             []+--             [(Nothing, (ConT ''Bool)), (Nothing, (VarT (mkName "b")))]+--       ])+-- @+deriveSerializeInternal ::+       SerializeConfig -> Type -> [DataCon] -> ([Dec] -> Q [Dec]) -> Q [Dec]+deriveSerializeInternal conf headTy cons next = do+    sizeDec <- mkSizeDec conf headTy cons+    peekDec <- mkDeserializeDec conf headTy cons+    pokeDec <- mkSerializeDec conf headTy cons+    let methods = concat [sizeDec, peekDec, pokeDec]+    next methods++-- | @deriveSerializeWith config-modifier instance-dec@ generates a template+-- Haskell splice consisting of a declaration of a 'Serialize' instance.+-- @instance-dec@ is a template Haskell declaration splice consisting of a+-- standard Haskell instance declaration without the type class methods (e.g.+-- @[d|instance Serialize a => Serialize (Maybe a)|]@).+--+-- The type class methods for the given instance are generated according to the+-- supplied @config-modifier@ parameter. See 'SerializeConfig' for default+-- configuration settings.+--+-- Usage:+--+-- @+-- \$(deriveSerializeWith+--       ( inlineSerializeAt (Just NoInline)+--       . inlineDeserializeAt (Just NoInline)+--       )+--       [d|instance Serialize a => Serialize (Maybe a)|])+-- @+deriveSerializeWith ::+    (SerializeConfig -> SerializeConfig) -> Q [Dec] -> Q [Dec]+deriveSerializeWith modifier mDecs = do+    dec <- mDecs+    case dec of+        [InstanceD mo preds headTyWC []] -> do+            let headTy = unwrap dec headTyWC+            dt <- reifyDataType (getMainTypeName dec headTy)+            let cons = dtCons dt+            deriveSerializeInternal+                (modifier serializeConfig) headTy cons (next mo preds headTyWC)+        _ -> errorMessage dec++    where++    next mo preds headTyWC methods = pure [InstanceD mo preds headTyWC methods]++    errorMessage dec =+        error $ unlines+            [ "Error: deriveSerializeWith:"+            , ""+            , ">> " ++ pprint dec+            , ""+            , "The supplied declaration is not a valid instance declaration."+            , "Provide a valid Haskell instance declaration without a body."+            , ""+            , "Examples:"+            , "instance Serialize (Proxy a)"+            , "instance Serialize a => Serialize (Identity a)"+            , "instance Serialize (TableT Identity)"+            ]++    unwrap _ (AppT (ConT _) r) = r+    unwrap dec _ = errorMessage dec++    getMainTypeName dec = go++        where++        go (ConT nm) = nm+        go (AppT l _) = go l+        go _ = errorMessage dec++-- | Given an 'Serialize' instance declaration splice without the methods (e.g.+-- @[d|instance Serialize a => Serialize (Maybe a)|]@), generate an instance+-- declaration including all the type class method implementations.+--+-- >>> deriveSerialize = deriveSerializeWith id+--+-- Usage:+--+-- @+-- \$(deriveSerialize+--       [d|instance Serialize a => Serialize (Maybe a)|])+-- @+deriveSerialize :: Q [Dec] -> Q [Dec]+deriveSerialize = deriveSerializeWith id
+ src/Streamly/Internal/Data/Serialize/TH/Bottom.hs view
@@ -0,0 +1,478 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH.Bottom+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH.Bottom+    (+    -- ** Config+      SerializeConfig(..)+    , serializeConfig+    , inlineAddSizeTo+    , inlineSerializeAt+    , inlineDeserializeAt+    , encodeConstrNames+    , encodeRecordFields++    -- ** Other Utilities+    , TypeOfType(..)+    , typeOfType+    , SimpleDataCon(..)+    , simplifyDataCon+    , Field+    , mkFieldName+    , isUnitType+    , isRecordSyntax+    , c2w+    , wListToString+    , xorCmp+    , serializeW8List+    , litIntegral+    , litProxy+    , matchConstructor+    , openConstructor+    , makeI+    , makeN+    , makeA+    , int_w8+    , int_w32+    , w32_int+    , w8_int+    , _acc+    , _arr+    , _endOffset+    , _initialOffset+    , _x+    , _tag+    , _val+    , errorUnsupported+    , errorUnimplemented+    ) where++import Data.Maybe (isJust)+import Data.Char (chr, ord)+import Data.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)+import Streamly.Internal.Data.Unbox (Unbox)+import Data.Proxy (Proxy)++import Language.Haskell.TH+import Streamly.Internal.Data.Serialize.Type++import qualified Streamly.Internal.Data.Unbox as Unbox++import Streamly.Internal.Data.Unbox.TH (DataCon(..))+import Prelude hiding (Foldable(..))++--------------------------------------------------------------------------------+-- Config+--------------------------------------------------------------------------------++-- NOTE: 'Nothing' is not eqvivalant to 'Just Inlinable'. Ie. Having no inline+-- specific pragma and having an Inlinable pragma are different. Having an+-- Inlinable pragma makes GHC put the code in the interface file whereas having+-- no inline specific pragma let's GHC decide whether to put the code in+-- interface file or not.++-- | Configuration to control how the 'Serialize' instance is generated. The+-- configuration is opaque and is modified by composing config modifier+-- functions, for example:+--+-- >>> import Language.Haskell.TH (Inline(..))+-- >>> configOpts = (inlineDeserializeAt (Just NoInline)) . (inlineSerializeAt (Just Inlinable))+--+-- The default configuration settings are:+--+-- * 'inlineAddSizeTo' Nothing+-- * 'inlineSerializeAt' (Just Inline)+-- * 'inlineDeserializeAt' (Just Inline)+--+-- The following experimental options are also available:+--+-- * 'encodeConstrNames' False+-- * 'encodeRecordFields' False+--+data SerializeConfig =+    SerializeConfig+        { cfgInlineSize :: Maybe Inline+        , cfgInlineSerialize :: Maybe Inline+        , cfgInlineDeserialize :: Maybe Inline+        , cfgConstructorTagAsString :: Bool+        , cfgRecordSyntaxWithHeader :: Bool+        }++-- | How should we inline the 'addSizeTo' function? The default is 'Nothing'+-- which means left to the compiler. Forcing inline on @addSizeTo@ function+-- actually worsens some benchmarks and improves none.+inlineAddSizeTo :: Maybe Inline -> SerializeConfig -> SerializeConfig+inlineAddSizeTo v cfg = cfg {cfgInlineSize = v}++-- XXX Should we make the default Inlinable instead?++-- | How should we inline the 'serialize' function? The default 'Just Inline'.+-- However, aggressive inlining can bloat the code and increase in compilation+-- times when there are big functions and too many nesting levels so you can+-- change it accordingly. A 'Nothing' value leaves the decision to the+-- compiler.+inlineSerializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+inlineSerializeAt v cfg = cfg {cfgInlineSerialize = v}++-- XXX Should we make the default Inlinable instead?++-- | How should we inline the 'deserialize' function? See guidelines in+-- 'inlineSerializeAt'.+inlineDeserializeAt :: Maybe Inline -> SerializeConfig -> SerializeConfig+inlineDeserializeAt v cfg = cfg {cfgInlineDeserialize = v}++-- | __Experimental__+--+-- In sum types, use Latin-1 encoded original constructor names rather than+-- binary values to identify constructors. This option is not applicable to+-- product types.+--+-- This option enables the following behavior:+--+-- * __Reordering__: Order of the fields can be changed without affecting+-- serialization.+-- * __Addition__: If a field is added in the new version, the old version of+-- the data type can still be deserialized by the new version. The new value+-- would never occur in the old one.+-- * __Deletion__: If a field is deleted in the new version, deserialization+-- of the old version will result in an error. TBD: We can possibly designate a+-- catch-all case to handle this scenario.+--+-- Note that if you change a type, change the semantics of a type, or delete a+-- field and add a new field with the same name, deserialization of old data+-- may result in silent unexpected behavior.+--+-- This option has to be the same on both encoding and decoding side.+--+-- The default is 'False'.+--+encodeConstrNames :: Bool -> SerializeConfig -> SerializeConfig+encodeConstrNames v cfg = cfg {cfgConstructorTagAsString = v}++-- XXX We can deserialize each field to Either, so if there is a+-- deserialization error in any field it can handled independently. Also, a+-- unique type/version identifier of the field (based on the versions of the+-- packages, full module name space + type identifier) can be serialized along+-- with the value for stricter compatibility, semantics checking. Or we can+-- store a type hash.++-- | __Experimental__+--+-- In explicit record types, use Latin-1 encoded record field names rather than+-- binary values to identify the record fields. Note that this option is not+-- applicable to sum types. Also, it does not work on a product type which is+-- not a record, because there are no field names to begin with.+--+-- This option enables the following behavior:+--+-- * __Reordering__: Order of the fields can be changed without affecting+-- serialization.+-- * __Addition__: If a 'Maybe' type field is added in the new version, the old+-- version of the data type can still be deserialized by the new version, the+-- field value in the older version is assumed to be 'Nothing'. If any other+-- type of field is added, deserialization of the older version results in an+-- error but only when that field is actually accessed in the deserialized+-- record.+-- * __Deletion__: If a field is deleted in the new version and it is+-- encountered in a previously serialized version then the field is discarded.+--+-- This option has to be the same on both encoding and decoding side.+--+-- There is a constant performance overhead proportional to the total length of+-- the record field names and the number of record fields.+--+-- The default is 'False'.+--+encodeRecordFields :: Bool -> SerializeConfig -> SerializeConfig+encodeRecordFields v cfg = cfg {cfgRecordSyntaxWithHeader = v}++serializeConfig :: SerializeConfig+serializeConfig =+    SerializeConfig+        { cfgInlineSize = Nothing+        , cfgInlineSerialize = Just Inline+        , cfgInlineDeserialize = Just Inline+        , cfgConstructorTagAsString = False+        , cfgRecordSyntaxWithHeader = False+        }++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++type Field = (Maybe Name, Type)++_x :: Name+_x = mkName "x"++_acc :: Name+_acc = mkName "acc"++_arr :: Name+_arr = mkName "arr"++_tag :: Name+_tag = mkName "tag"++_initialOffset :: Name+_initialOffset = mkName "initialOffset"++_endOffset :: Name+_endOffset = mkName "endOffset"++_val :: Name+_val = mkName "val"++mkFieldName :: Int -> Name+mkFieldName i = mkName ("field" ++ show i)++makeI :: Int -> Name+makeI i = mkName $ "i" ++ show i++makeN :: Int -> Name+makeN i = mkName $ "n" ++ show i++makeA :: Int -> Name+makeA i = mkName $ "a" ++ show i++--------------------------------------------------------------------------------+-- Domain specific helpers+--------------------------------------------------------------------------------++openConstructor :: Name -> Int -> Q Pat+openConstructor cname numFields =+    conP cname (map (varP. mkFieldName) [0 .. (numFields - 1)])++matchConstructor :: Name -> Int -> Q Exp -> Q Match+matchConstructor cname numFields exp0 =+    match (openConstructor cname numFields) (normalB exp0) []++--------------------------------------------------------------------------------+-- Constructor types+--------------------------------------------------------------------------------++data SimpleDataCon =+    SimpleDataCon Name [Field]+    deriving (Eq)++simplifyDataCon :: DataCon -> SimpleDataCon+simplifyDataCon (DataCon cname _ _ fields) = SimpleDataCon cname fields++data TypeOfType+    = UnitType Name             -- 1 constructor and 1 field+    | TheType SimpleDataCon      -- 1 constructor and 1+ fields+    | MultiType [SimpleDataCon] -- 1+ constructors+    deriving (Eq)++typeOfType :: Type -> [DataCon] -> TypeOfType+typeOfType headTy [] =+    error+        ("Attempting to get size with no constructors (" +++         pprint headTy ++ ")")+typeOfType _ [DataCon cname _ _ []] = UnitType cname+typeOfType _ [con@DataCon{}] = TheType $ simplifyDataCon con+typeOfType _ cons = MultiType $ map simplifyDataCon cons++isUnitType :: [DataCon] -> Bool+isUnitType [DataCon _ _ _ []] = True+isUnitType _ = False++isRecordSyntax :: SimpleDataCon -> Bool+isRecordSyntax (SimpleDataCon _ fields) = all (isJust . fst) fields++--------------------------------------------------------------------------------+-- Type casting+--------------------------------------------------------------------------------++int_w8 :: Int -> Word8+int_w8 = fromIntegral++int_w32 :: Int -> Word32+int_w32 = fromIntegral++w8_w16 :: Word8 -> Word16+w8_w16 = fromIntegral++w8_w32 :: Word8 -> Word32+w8_w32 = fromIntegral++w8_w64 :: Word8 -> Word64+w8_w64 = fromIntegral++w8_int :: Word8 -> Int+w8_int = fromIntegral++w32_int :: Word32 -> Int+w32_int = fromIntegral++c2w :: Char -> Word8+c2w = fromIntegral . ord++wListToString :: [Word8] -> String+wListToString = fmap (chr . fromIntegral)++--------------------------------------------------------------------------------+-- Bit manipulation+--------------------------------------------------------------------------------++shiftAdd :: Bits a => (b -> a) -> [b] -> a+shiftAdd conv xs =+    foldl' (.|.) zeroBits $+    fmap (\(j, x) -> shiftL x (j * 8)) $ zip [0 ..] $ map conv xs++-- Note: This only works in little endian machines+-- TODO:+-- Instead of generating this via TH can't we write it directly in Haskell and+-- use that? Creating one comparison function for each deserialization may be+-- too much code and may not be necessary.+-- Benchmark both the implementations and check.+xorCmp :: [Word8] -> Name -> Name -> Q Exp+xorCmp tag off arr =+    case tagLen of+        x | x < 2 -> [|$(go8 0) == zeroBits|]+        x | x < 4 -> [|$(go16 0) == zeroBits|]+        x | x < 8 -> [|$(go32 0) == zeroBits|]+        _ -> [|$(go64 0) == zeroBits|]+  where+    tagLen = length tag+    go8 i | i >= tagLen = [|zeroBits|]+    go8 i = do+        let wIntegral = litIntegral i+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word8) .|.+          $(go8 (i + 1))|]+    go16 i+        | i >= tagLen = [|zeroBits|]+    go16 i+        | tagLen - i < 2 = go16 (tagLen - 2)+    go16 i = do+        let wIntegral =+                litIntegral+                    (shiftAdd w8_w16 [tag !! i, tag !! (i + 1)] :: Word16)+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word16) .|.+          $(go16 (i + 2))|]+    go32 i+        | i >= tagLen = [|zeroBits|]+    go32 i+        | tagLen - i < 4 = go32 (tagLen - 4)+    go32 i = do+        let wIntegral =+                litIntegral+                    (shiftAdd+                         w8_w32+                         [ tag !! i+                         , tag !! (i + 1)+                         , tag !! (i + 2)+                         , tag !! (i + 3)+                         ] :: Word32)+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word32) .|.+          $(go32 (i + 4))|]+    go64 i+        | i >= tagLen = [|zeroBits|]+    go64 i+        | tagLen - i < 8 = go64 (tagLen - 8)+    go64 i = do+        let wIntegral =+                litIntegral+                    (shiftAdd+                         w8_w64+                         [ tag !! i+                         , tag !! (i + 1)+                         , tag !! (i + 2)+                         , tag !! (i + 3)+                         , tag !! (i + 4)+                         , tag !! (i + 5)+                         , tag !! (i + 6)+                         , tag !! (i + 7)+                         ])+        [|xor (unsafeInlineIO+                   (Unbox.peekAt+                        ($(varE off) + $(litIntegral i))+                        $(varE arr)))+              ($(wIntegral) :: Word64) .|.+          $(go64 (i + 8))|]++--------------------------------------------------------------------------------+-- Primitive serialization+--------------------------------------------------------------------------------++-- TODO:+-- Will this be too much of a code bloat?+-- Loop with the loop body unrolled?+-- Serialize this in batches similar to batch comparision in xorCmp?+serializeW8List :: Name -> Name -> [Word8] -> Q Exp+serializeW8List off arr w8List = do+    [|let $(varP (makeN 0)) = $(varE off)+       in $(doE (fmap makeBind [0 .. (lenW8List - 1)] +++                 [noBindS [|pure $(varE (makeN lenW8List))|]]))|]++    where++    lenW8List = length w8List+    makeBind i =+        bindS+            (varP (makeN (i + 1)))+            [|$(varE 'serializeAt)+                  $(varE (makeN i))+                  $(varE arr)+                  ($(litIntegral (w8List !! i)) :: Word8)|]++--------------------------------------------------------------------------------+-- TH Helpers+--------------------------------------------------------------------------------++litIntegral :: Integral a => a -> Q Exp+litIntegral = litE . IntegerL . fromIntegral++litProxy :: Unbox a => Proxy a -> Q Exp+litProxy = litE . IntegerL . fromIntegral . Unbox.sizeOf++--------------------------------------------------------------------------------+-- Error codes+--------------------------------------------------------------------------------++errorUnsupported :: String -> a+errorUnsupported err =+    error+        $ unlines+              [ "Unsupported"+              , "==========="+              , "This is improper use of the library."+              , "This case is unsupported."+              , "Please contact the developer if this case is of interest."+              , ""+              , "Message"+              , "-------"+              , err+              ]++errorUnimplemented :: a+errorUnimplemented =+    error+        $ unlines+              [ "Unimplemented"+              , "============="+              , "Please contact the developer if this case is of interest."+              ]
+ src/Streamly/Internal/Data/Serialize/TH/Common.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH.Common+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH.Common+    ( mkDeserializeExprOne+    , mkSerializeExprFields+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Language.Haskell.TH+import Streamly.Internal.Data.Serialize.TH.Bottom++--------------------------------------------------------------------------------+-- Code+--------------------------------------------------------------------------------++mkDeserializeExprOne :: Name -> SimpleDataCon -> Q Exp+mkDeserializeExprOne peeker (SimpleDataCon cname fields) =+    case fields of+        -- Only tag is serialized for unit fields, no actual value+        [] -> [|pure ($(varE (mkName "i0")), $(conE cname))|]+        _ ->+            doE+                (concat+                     [ fmap makeBind [0 .. (numFields - 1)]+                     , [ noBindS+                             (appE+                                  (varE 'pure)+                                  (tupE+                                       [ varE (makeI numFields)+                                       , appsE+                                             (conE cname :+                                              map (varE . makeA)+                                                   [0 .. (numFields - 1)])+                                       ]))+                       ]+                     ])+  where+    numFields = length fields+    makeBind i =+        bindS+            (tupP [varP (makeI (i + 1)), varP (makeA i)])+            [|$(varE peeker) $(varE (makeI i)) $(varE _arr) $(varE _endOffset)|]++mkSerializeExprFields :: Name -> [Field] -> Q Exp+mkSerializeExprFields poker fields =+    case fields of+        -- Unit constructor, do nothing just tag is enough+        [] -> [|pure ($(varE (mkName "i0")))|]+        _ ->+            doE+                (fmap makeBind [0 .. (numFields - 1)] +++                 [noBindS [|pure $(varE (makeI numFields))|]])+  where+    numFields = length fields+    makeBind i =+        bindS+            (varP (makeI (i + 1)))+            [|$(varE poker)+                   $(varE (makeI i)) $(varE _arr) $(varE (mkFieldName i))|]
+ src/Streamly/Internal/Data/Serialize/TH/RecHeader.hs view
@@ -0,0 +1,413 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Serialize.TH.RecHeader+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Serialize.TH.RecHeader+    ( mkRecSerializeExpr+    , mkRecDeserializeExpr+    , mkRecSizeOfExpr+    , conUpdateFuncDec+    , mkDeserializeKeysDec+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Monad (void)+import Data.Foldable (length, sum)+import Data.List (foldl')+import Data.Word (Word32, Word8)+import Data.Maybe (fromJust)+import Language.Haskell.TH+import Streamly.Internal.Data.Serialize.Type (Serialize(..))+import Data.Foldable (foldlM)+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray)+import Data.Proxy (Proxy(..))++import qualified Streamly.Internal.Data.Unbox as Unbox++import Streamly.Internal.Data.Serialize.TH.Bottom+import Streamly.Internal.Data.Serialize.TH.Common+import Prelude hiding (Foldable(..))++--------------------------------------------------------------------------------+-- Notes+--------------------------------------------------------------------------------++-- Compatibility Algorithm+-- =======================+--+-- The algorithm is written without any low level implementation details. See+-- the code for any low level implementation details.+--+-- Serialization:+-- --------------+--+-- To serialize the data,+--+-- * Get the list of keys for the record as @keyList@.+-- * Serialize the @keyList@.+-- * Serialize the @fields@ one-by-one after serializing the @keyList@.+--+-- Deserialization:+-- ----------------+--+-- To deserialize the data to type @T@,+--+-- __Checking for type match__:+--+-- * Get the list of keys for type @T@ as @targetKeyList@.+-- * Get the list of keys encoded as @encodedKeyList@.+-- * If @targetKeyList == encodedKeyList@ see the __Type Match__ section else+--   see the __No Type Match__ section.+--+-- __Type Match__:+--+-- * Decode the fields one-by-one and construct the type @T@ in the end.+--+-- __No Type Match__:+--+-- * Decode the list of keys encoded into @encodedKeyList@.+-- * Get the list of keys for type @T@ as @targetKeyList@.+-- * Loop through @encodedKeyList@ and start deserializing the encoded data.+-- * If the key is present in @encodedKeyList@ and not in @targetKeyList@+--   then skip parsing the corresponding value.+-- * If the key is present in @targetKeyList@ and not in @encodedKeyList@+--   then set the value for that key as @Nothing@.+-- * If the key is present in both @encodedKeyList@ and in @targetKeyList@+--   parse the value.+-- * Construct @T@ after parsing all the data.++-- Developer Notes+-- ===============+--+-- * Record update syntax is not robust across language extensions and common+--   record plugins (like record-dot-processor, large-records, etc.).++--------------------------------------------------------------------------------+-- Compact lists+--------------------------------------------------------------------------------++-- Like haskell list but the maximum length of the list is 255+newtype CompactList a =+    CompactList+        { unCompactList :: [a]+        }++-- We use 'Word8' to encode the length, hence the maximim number of elements in+-- the list is 255.+instance forall a. Serialize a => Serialize (CompactList a) where++    -- {-# INLINE addSizeTo #-}+    addSizeTo acc (CompactList xs) =+        foldl' addSizeTo (acc + Unbox.sizeOf (Proxy :: Proxy Word8)) xs++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE deserializeAt #-}+    deserializeAt off arr sz = do+        (off1, len8) <- deserializeAt off arr sz :: IO (Int, Word8)+        let len = w8_int len8+            peekList f o i | i >= 3 = do+              -- Unfold the loop three times+              (o1, x1) <- deserializeAt o arr sz+              (o2, x2) <- deserializeAt o1 arr sz+              (o3, x3) <- deserializeAt o2 arr sz+              peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3)+            peekList f o 0 = pure (o, f [])+            peekList f o i = do+              (o1, x) <- deserializeAt o arr sz+              peekList (f . (x:)) o1 (i - 1)+        (nextOff, lst) <- peekList id off1 len+        pure (nextOff, CompactList lst)++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE serializeAt #-}+    serializeAt off arr (CompactList val) = do+        void $ serializeAt off arr (int_w8 (length val) :: Word8)+        let off1 = off + Unbox.sizeOf (Proxy :: Proxy Word8)+        let pokeList o [] = pure o+            pokeList o (x:xs) = do+              o1 <- serializeAt o arr x+              pokeList o1 xs+        pokeList off1 val++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++fieldToNameBase :: Field -> String+fieldToNameBase = nameBase . fromJust . fst++isMaybeType :: Type -> Bool+isMaybeType (AppT (ConT m) _) = m == ''Maybe+isMaybeType _ = False++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++-- We add 4 here because we use 'serializeWithSize' for serializing.+exprGetSize :: Q Exp -> (Int, Type) -> Q Exp+exprGetSize acc (i, _) =+    [|addSizeTo $(acc) $(varE (mkFieldName i)) + 4|]++sizeOfHeader :: SimpleDataCon -> Int+sizeOfHeader (SimpleDataCon _ fields) =+    sizeForFinalOff + sizeForHeaderLength + sizeForNumFields+        + sum (map ((+ sizeForFieldLen) . length . fieldToNameBase) fields)++    where++    sizeForFinalOff = 4+    sizeForHeaderLength = 4 -- Max header length is (255 * (255 + 1) + 1) and+                            -- hence 2 bytes is enough to store it. But we still+                            -- use 4 bytes as using 2 bytes introduces+                            -- regression.+    sizeForNumFields = 1 -- At max 255 fields in the record constructor+    sizeForFieldLen = 1  -- At max 255 letters in the key++mkRecSizeOfExpr :: SimpleDataCon -> Q Exp+mkRecSizeOfExpr con = do+    n_acc <- newName "acc"+    n_x <- newName "x"+    lamE+         [varP n_acc, varP n_x]+         [|$(litIntegral hlen) ++            $(caseE (varE n_x) [matchCons (varE n_acc) con])|]++    where++    hlen = sizeOfHeader con+    sizeOfFields acc fields = foldl' exprGetSize acc $ zip [0 ..] fields+    matchCons acc (SimpleDataCon cname fields) =+        let expr = sizeOfFields acc (map snd fields)+         in matchConstructor cname (length fields) expr++--------------------------------------------------------------------------------+-- Header+--------------------------------------------------------------------------------++headerValue :: SimpleDataCon -> [Word8]+headerValue (SimpleDataCon _ fields) =+    int_w8 numFields : concatMap lengthPrependedFieldEncoding fields++    where++    -- Error out if the number of fields or the length of key is >= 256. We use+    -- Word8 for encoding the info and hence the max value is 255.+    numFields =+        let lenFields = length fields+         in if lenFields <= 255+            then lenFields+            else errorUnsupported+                     "Number of fields in the record should be <= 255."+    lengthPrependedFieldEncoding field =+        let fEnc =+                let fEnc_ = map c2w (fieldToNameBase field)+                    lenFEnc = length fEnc_+                 in if lenFEnc <= 255+                    then fEnc_+                    else+                        errorUnsupported+                            "Length of any key should be <= 255."+         in int_w8 (length fEnc) : fEnc++--------------------------------------------------------------------------------+-- Peek+--------------------------------------------------------------------------------++-- Encoding the size is required if we want to skip the field without knowing+-- its type. We encode the size as 'Word32' hence there is a 4 bytes increase+-- in size.+{-# INLINE serializeWithSize #-}+serializeWithSize :: Serialize a => Int -> MutByteArray -> a -> IO Int+serializeWithSize off arr val = do+    off1 <- serializeAt (off + 4) arr val+    Unbox.pokeAt off arr (int_w32 (off1 - off - 4) :: Word32)+    pure off1++mkRecSerializeExpr :: Name -> SimpleDataCon -> Q Exp+mkRecSerializeExpr initialOffset con@(SimpleDataCon cname fields) = do+    afterHLen <- newName "afterHLen"+    -- Encoding the header length is required.+    -- We first compare the header length encoded and the current header+    -- length. Only if the header lengths match, we compare the headers.+    [|do $(varP afterHLen) <-+             serializeAt+                 ($(varE initialOffset) + 4)+                 $(varE _arr)+                 ($(litIntegral hlen) :: Word32)+         $(varP (makeI 0)) <- $(serializeW8List afterHLen _arr hval)+         let $(openConstructor cname (length fields)) = $(varE _val)+         finalOff <- $(mkSerializeExprFields 'serializeWithSize fields)+         Unbox.pokeAt+             $(varE initialOffset)+             $(varE _arr)+             ((fromIntegral :: Int -> Word32)+                  (finalOff - $(varE initialOffset)))+         pure finalOff|]++    where++    hval = headerValue con+    hlen = length hval++--------------------------------------------------------------------------------+-- Poke+--------------------------------------------------------------------------------++{-# INLINE deserializeWithSize #-}+deserializeWithSize ::+       Serialize a => Int -> MutByteArray -> Int -> IO (Int, a)+deserializeWithSize off = deserializeAt (off + 4)++conUpdateFuncDec :: Name -> [Field] -> Q [Dec]+conUpdateFuncDec funcName fields = do+    prevAcc <- newName "prevAcc"+    curOff <- newName "curOff"+    endOff <- newName "endOff"+    arr <- newName "arr"+    key <- newName "key"+    method <-+        caseE+             (varE key)+             (concat+                  [ map (matchField arr endOff (prevAcc, curOff)) fnames+                  , [ match+                          wildP+                          (normalB+                               [|do (valOff, valLen :: Word32) <-+                                        deserializeAt+                                            $(varE curOff)+                                            $(varE arr)+                                            $(varE endOff)+                                    pure+                                        ( $(varE prevAcc)+                                        , valOff + w32_int valLen)|])+                          []+                    ]+                  ])+    pure+        [ PragmaD (InlineP funcName NoInline FunLike AllPhases)+        , FunD+              funcName+              [ Clause+                    [ VarP arr+                    , VarP endOff+                    , TupP [VarP prevAcc, VarP curOff]+                    , VarP key+                    ]+                    (NormalB method)+                    []+              ]+        ]++    where++    fnames = fmap (fromJust . fst) fields+    matchField :: Name -> Name -> (Name, Name) -> Name -> Q Match+    matchField arr endOff (acc, currOff) fname = do+        let fnameLit = StringL (nameBase fname)+        match+            (litP fnameLit)+            (normalB+                 [|do (valOff, valLen :: Word32) <-+                        deserializeAt+                            $(varE currOff)+                            $(varE arr)+                            $(varE endOff)+                      pure+                          ( ($(litE fnameLit), $(varE currOff)) : $(varE acc)+                          , valOff + w32_int valLen)|])+            []++mkDeserializeKeysDec :: Name -> Name -> SimpleDataCon -> Q [Dec]+mkDeserializeKeysDec funcName updateFunc (SimpleDataCon cname fields) = do+    hOff <- newName "hOff"+    finalOff <- newName "finalOff"+    arr <- newName "arr"+    endOff <- newName "endOff"+    kvEncoded <- newName "kvEncoded"+    finalRec <- newName "finalRec"+    let deserializeFieldExpr (Just name, ty) = do+            let nameLit = litE (StringL (nameBase name))+            [|case lookup $(nameLit) $(varE kvEncoded) of+                  Nothing -> $(emptyTy name ty)+                  Just off -> do+                      val <- deserializeWithSize off $(varE arr) $(varE endOff)+                      pure $ snd val|]+        deserializeFieldExpr _ =+            errorUnsupported "The datatype should use record syntax."+    method <-+        [|do (dataOff, hlist :: CompactList (CompactList Word8)) <-+                 deserializeAt $(varE hOff) $(varE arr) $(varE endOff)+             let keys = wListToString . unCompactList <$> unCompactList hlist+             ($(varP kvEncoded), _) <-+                 foldlM+                     ($(varE updateFunc) $(varE arr) $(varE endOff))+                     ([], dataOff)+                     keys+             $(varP finalRec) <-+                 $(foldl'+                       (\acc i ->+                            [|$(acc) <*>+                              $(deserializeFieldExpr i)|])+                       [|pure $(conE cname)|]+                       fields)+             pure ($(varE finalOff), $(varE finalRec))|]+    pure+        [ PragmaD (InlineP funcName NoInline FunLike AllPhases)+        , FunD+              funcName+              [ Clause+                    [ VarP hOff+                    , VarP finalOff+                    , VarP arr+                    , VarP endOff+                    ]+                    (NormalB method)+                    []+              ]+        ]++    where++    emptyTy k ty =+        if isMaybeType ty+            then [|pure Nothing|]+            else [|error $(litE (StringL (nameBase k ++ " is not found.")))|]+++mkRecDeserializeExpr :: Name -> Name -> Name -> SimpleDataCon -> Q Exp+mkRecDeserializeExpr initialOff endOff deserializeWithKeys con = do+    hOff <- newName "hOff"+    let  sizeForFinalOff = 4     -- Word32+         sizeForHeaderLength = 4 -- Word32+         sizePreData = sizeForFinalOff + sizeForHeaderLength + hlen+    [|do (hlenOff, encLen :: Word32) <-+             deserializeAt $(varE initialOff) $(varE _arr) $(varE endOff)+         ($(varP hOff), hlen1 :: Word32) <-+             deserializeAt hlenOff $(varE _arr) $(varE endOff)+         if (hlen1 == $(litIntegral hlen)) && $(xorCmp hval hOff _arr)+         then do+             let $(varP (makeI 0)) =+                     $(varE initialOff) ++                     $(litIntegral sizePreData)+             $(mkDeserializeExprOne 'deserializeWithSize con)+         else $(varE deserializeWithKeys)+                  $(varE hOff)+                  ($(varE initialOff) + w32_int encLen)+                  $(varE _arr)+                  $(varE endOff)|]++    where++    hval = headerValue con+    hlen = length hval
+ src/Streamly/Internal/Data/Serialize/Type.hs view
@@ -0,0 +1,321 @@+{- HLINT ignore -}+-- |+-- Module      : Streamly.Internal.Data.Serialize.Type+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--++module Streamly.Internal.Data.Serialize.Type+    (+      Serialize(..)+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Control.Monad (when)+import Data.List (foldl')+import Data.Proxy (Proxy (..))+import Streamly.Internal.Data.Unbox (Unbox)+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))+import Streamly.Internal.Data.Array.Type (Array(..))+import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))+import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))+import GHC.Stable (StablePtr(..))+import 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 GHC.Exts+import Prelude hiding (Foldable(..))++--------------------------------------------------------------------------------+-- Developer Note+--------------------------------------------------------------------------------++-- IMPORTANT+-- =========+--+-- Don't ever serialize the absolute offsets in the encoding. Serialize length+-- instead. Absolute offsets are NOT stable.+--+-- They will only work if the start offset of the Array when encoding and+-- decoding is the same. This is almost never the case.++--------------------------------------------------------------------------------+-- Types+--------------------------------------------------------------------------------++-- | The 'Serialize' type class provides operations for serialization and+-- deserialization of general Haskell data types to and from their byte stream+-- representation.+--+-- Unlike 'Unbox', 'Serialize' uses variable length encoding, therefore, it can+-- serialize recursive and variable length data types like lists, or variable+-- length sum types where the length of the value may vary depending on a+-- particular constructor. For variable length data types the length is encoded+-- along with the data.+--+-- The 'deserializeAt' operation reads bytes from the mutable byte array and+-- builds a Haskell data type from these bytes, the number of bytes it reads+-- depends on the type and the encoded value it is reading. 'serializeAt'+-- operation converts a Haskell data type to its binary representation which+-- must consist of as many bytes as added by the @addSizeTo@ operation for that+-- value and then stores these bytes into the mutable byte array. The+-- programmer is expected to use the @addSizeTo@ operation and allocate an+-- array of sufficient length before calling 'serializeAt'.+--+-- IMPORTANT: The serialized data's byte ordering remains the same as the host+-- machine's byte order. Therefore, it can not be deserialized from host+-- machines with a different byte ordering.+--+-- Instances can be derived via Template Haskell, or written manually.+--+-- Here is an example, for deriving an instance of this type class using+-- template Haskell:+--+-- >>> :{+-- data Object = Object+--     { _obj1 :: [Int]+--     , _obj2 :: Int+--     }+-- :}+--+-- @+-- import Streamly.Data.MutByteArray (deriveSerialize)+-- \$(deriveSerialize [d|instance Serialize Object|])+-- @+--+-- See 'Streamly.Data.MutByteArray.deriveSerialize' and+-- 'Streamly.Data.MutByteArray.deriveSerializeWith' for more information on+-- deriving using Template Haskell.+--+-- Here is an example of a manual instance.+--+-- >>> import Streamly.Data.MutByteArray (Serialize(..))+--+-- >>> :{+-- instance Serialize Object where+--     addSizeTo acc obj = addSizeTo (addSizeTo acc (_obj1 obj)) (_obj2 obj)+--     deserializeAt i arr len = do+--          -- Check the array bounds before reading+--         (i1, x0) <- deserializeAt i arr len+--         (i2, x1) <- deserializeAt i1 arr len+--         pure (i2, Object x0 x1)+--     serializeAt i arr (Object x0 x1) = do+--         i1 <- serializeAt i arr x0+--         i2 <- serializeAt i1 arr x1+--         pure i2+-- :}+--+class Serialize a where+    -- XXX Use (a -> Sum Int) instead, remove the Size type++    -- A left fold step to fold a generic structure to its serializable size.+    -- It is of the form @Int -> a -> Int@ because you can have tail-recursive+    -- traversal of the structures.++    -- | @addSizeTo accum value@ returns @accum@ incremented by the size of the+    -- serialized representation of @value@ in bytes. Size cannot be zero. It+    -- should be at least 1 byte.+    addSizeTo :: Int -> a -> Int++    -- We can implement the following functions without returning the `Int`+    -- offset but that may require traversing the Haskell structure again to get+    -- the size. Therefore, this is a performance optimization.++    -- | @deserializeAt byte-offset array arrayLen@ deserializes a value from+    -- the given byte-offset in the array. Returns a tuple consisting of the+    -- next byte-offset and the deserialized value.+    --+    -- The arrayLen passed is the entire length of the input buffer. It is to+    -- be used to check if we would overflow the input buffer when+    -- deserializing.+    --+    -- Throws an exception if the operation would exceed the supplied arrayLen.+    deserializeAt :: Int -> MutByteArray -> Int -> IO (Int, a)++    -- | @serializeAt byte-offset array value@ writes the serialized+    -- representation of the @value@ in the array at the given byte-offset.+    -- Returns the next byte-offset.+    --+    -- This is an unsafe operation, the programmer must ensure that the array+    -- has enough space available to serialize the value as determined by the+    -- @addSizeTo@ operation.+    serializeAt :: Int -> MutByteArray -> a -> IO Int++--------------------------------------------------------------------------------+-- Instances+--------------------------------------------------------------------------------++-- _size is the length from array start to the last accessed byte.+#ifdef DEBUG+{-# INLINE checkBounds #-}+checkBounds :: String -> Int -> MutByteArray -> IO ()+checkBounds _label _size _arr = do+    sz <- MBA.length _arr+    if (_size > sz)+    then error+        $ _label+            ++ ": accessing array at offset = "+            ++ show (_size - 1)+            ++ " max valid offset = " ++ show (sz - 1)+    else return ()+#endif++-- Note: Instead of passing around the size parameter, we can use+-- (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+-- structures. For fixed size structures we can do a check at the top level and+-- then use checkless deserialization using the Unbox type class. That will+-- require ConstSize and VarSize constructors in size. The programmer can+-- bundle all const size fields in a newtype to make serialization faster. This+-- can speed up the computation of size when serializing and checking size when+-- deserialing.+--+-- For variable size non-recursive structures a separate size validation method+-- could be used to validate the size before deserializing. "validate" can also+-- be used to collpase multiple chunks of arrays coming from network into a+-- single array for deserializing. But that can also be done by framing the+-- serialized value with a size header.+--+{-# INLINE deserializeChecked #-}+deserializeChecked :: forall a. Unbox a => Int -> MutByteArray -> Int -> IO (Int, a)+deserializeChecked off arr sz =+    let next = off + Unbox.sizeOf (Proxy :: Proxy a)+     in do+        -- Keep likely path in the straight branch.+        if next <= sz+        then Unbox.peekAt off arr >>= \val -> pure (next, val)+        else error+            $ "deserializeAt: accessing array at offset = "+                ++ show (next - 1)+                ++ " max valid offset = " ++ show (sz - 1)++{-# INLINE serializeUnsafe #-}+serializeUnsafe :: forall a. Unbox a => Int -> MutByteArray -> a -> IO Int+serializeUnsafe off arr val =+    let next = off + Unbox.sizeOf (Proxy :: Proxy a)+     in do+#ifdef DEBUG+        checkBounds "serializeAt" next arr+#endif+        Unbox.pokeAt off arr val+        pure next++#define DERIVE_SERIALIZE_FROM_UNBOX(_type) \+instance Serialize _type where \+; {-# INLINE addSizeTo #-} \+;    addSizeTo acc _ = acc +  Unbox.sizeOf (Proxy :: Proxy _type) \+; {-# INLINE deserializeAt #-} \+;    deserializeAt off arr end = deserializeChecked off arr end :: IO (Int, _type) \+; {-# INLINE serializeAt #-} \+;    serializeAt =  \+        serializeUnsafe :: Int -> MutByteArray -> _type -> IO Int++DERIVE_SERIALIZE_FROM_UNBOX(())+DERIVE_SERIALIZE_FROM_UNBOX(Bool)+DERIVE_SERIALIZE_FROM_UNBOX(Char)+DERIVE_SERIALIZE_FROM_UNBOX(Int8)+DERIVE_SERIALIZE_FROM_UNBOX(Int16)+DERIVE_SERIALIZE_FROM_UNBOX(Int32)+DERIVE_SERIALIZE_FROM_UNBOX(Int)+DERIVE_SERIALIZE_FROM_UNBOX(Int64)+DERIVE_SERIALIZE_FROM_UNBOX(Word)+DERIVE_SERIALIZE_FROM_UNBOX(Word8)+DERIVE_SERIALIZE_FROM_UNBOX(Word16)+DERIVE_SERIALIZE_FROM_UNBOX(Word32)+DERIVE_SERIALIZE_FROM_UNBOX(Word64)+DERIVE_SERIALIZE_FROM_UNBOX(Double)+DERIVE_SERIALIZE_FROM_UNBOX(Float)+DERIVE_SERIALIZE_FROM_UNBOX((StablePtr a))+DERIVE_SERIALIZE_FROM_UNBOX((Ptr a))+DERIVE_SERIALIZE_FROM_UNBOX((FunPtr a))+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++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE deserializeAt #-}+    deserializeAt off arr sz = do+        (off1, len64) <- deserializeAt off arr sz :: IO (Int, Int64)+        let len = (fromIntegral :: Int64 -> Int) len64+            peekList f o i | i >= 3 = do+              -- Unfold the loop three times+              (o1, x1) <- deserializeAt o arr sz+              (o2, x2) <- deserializeAt o1 arr sz+              (o3, x3) <- deserializeAt o2 arr sz+              peekList (f . (\xs -> x1:x2:x3:xs)) o3 (i - 3)+            peekList f o 0 = pure (o, f [])+            peekList f o i = do+              (o1, x) <- deserializeAt o arr sz+              peekList (f . (x:)) o1 (i - 1)+        peekList id off1 len++    -- Inlining this causes large compilation times for tests+    {-# INLINABLE serializeAt #-}+    serializeAt off arr val = do+        let off1 = off + Unbox.sizeOf (Proxy :: Proxy Int64)+        let pokeList acc o [] =+              Unbox.pokeAt off arr (acc :: Int64) >> pure o+            pokeList acc o (x:xs) = do+              o1 <- serializeAt o arr x+              pokeList (acc + 1) o1 xs+        pokeList 0 off1 val++instance+#ifdef DEVBUILD+    Unbox a =>+#endif+  Serialize (Array a) where+    {-# INLINE addSizeTo #-}+    addSizeTo i (Array {..}) = i + (arrEnd - arrStart) + 8++    {-# INLINE deserializeAt #-}+    deserializeAt off arr len = do+        (off1, byteLen) <- deserializeAt off arr len :: IO (Int, Int)+        let off2 = off1 + byteLen+        when (off2 > len) $+            error+                $ "deserializeAt: accessing array at offset = "+                    ++ show (off2 - 1)+                    ++ " max valid offset = " ++ show (len - 1)+        -- XXX Use MutByteArray.cloneSliceUnsafe+        let slice = MutArray.MutArray arr off1 off2 off2+        newArr <- MutArray.clone slice+        pure (off2, Array.unsafeFreeze newArr)++    {-# INLINE serializeAt #-}+    serializeAt off arr (Array {..}) = do+        let arrLen = arrEnd - arrStart+        off1 <- serializeAt off arr arrLen+        MBA.unsafePutSlice arrContents arrStart arr off1 arrLen+        pure (off1 + arrLen)++instance (Serialize a, Serialize b) => Serialize (a, b) where++    {-# INLINE addSizeTo #-}+    addSizeTo acc (a, b) = addSizeTo (addSizeTo acc a) b++    {-# INLINE serializeAt #-}+    serializeAt off arr (a, b) = do+        off1 <- serializeAt off arr a+        serializeAt off1 arr b++    {-# INLINE deserializeAt #-}+    deserializeAt off arr end = do+        (off1, a) <- deserializeAt off arr end+        (off2, b) <- deserializeAt off1 arr end+        pure (off2, (a, b))
src/Streamly/Internal/Data/Stream.hs view
@@ -1,14 +1,41 @@ -- | -- Module      : Streamly.Internal.Data.Stream--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC --+-- Direct style re-implementation of CPS stream in+-- "Streamly.Internal.Data.StreamK". GHC is able to INLINE and fuse direct+-- style better, providing better performance than CPS implementation.+--+-- @+-- import qualified Streamly.Internal.Data.Stream as Stream+-- @+ module Streamly.Internal.Data.Stream-    ( module Streamly.Internal.Data.Stream.StreamD+    (+      module Streamly.Internal.Data.Stream.Type+    , module Streamly.Internal.Data.Stream.Generate+    , module Streamly.Internal.Data.Stream.Eliminate+    , module Streamly.Internal.Data.Stream.Exception+    , module Streamly.Internal.Data.Stream.Lift+    , module Streamly.Internal.Data.Stream.Transformer+    , module Streamly.Internal.Data.Stream.Nesting+    , module Streamly.Internal.Data.Stream.Transform+    , module Streamly.Internal.Data.Stream.Top+    , module Streamly.Internal.Data.Stream.Container     ) where -import Streamly.Internal.Data.Stream.StreamD+import Streamly.Internal.Data.Stream.Type+import Streamly.Internal.Data.Stream.Generate+import Streamly.Internal.Data.Stream.Eliminate+import Streamly.Internal.Data.Stream.Exception+import Streamly.Internal.Data.Stream.Lift+import Streamly.Internal.Data.Stream.Transformer+import Streamly.Internal.Data.Stream.Nesting+import Streamly.Internal.Data.Stream.Transform+import Streamly.Internal.Data.Stream.Top+import Streamly.Internal.Data.Stream.Container
− src/Streamly/Internal/Data/Stream/Bottom.hs 
@@ -1,670 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Bottom--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Bottom level Stream module that can be used by all other upper level--- Stream modules.--module Streamly.Internal.Data.Stream.Bottom-    (-    -- * Generation-      fromPure-    , fromEffect-    , fromList-    , timesWith-    , absTimesWith-    , relTimesWith--    -- * Folds-    , fold-    , foldBreak-    , foldBreak2-    , foldEither-    , foldEither2-    , foldConcat--    -- * Builders-    , foldAdd-    , foldAddLazy--    -- * Scans-    , smapM-    -- $smapM_Notes-    , postscan-    , catMaybes-    , scanMaybe--    , take-    , takeWhile-    , takeEndBy-    , drop-    , findIndices--    -- * Merge-    , intersperseM--    -- * Fold and Unfold-    , reverse-    , reverse'--    -- * Expand-    , concatEffect-    , concatEffect2-    , concatMapM-    , concatMap--    -- * Reduce-    , foldManyPost--    -- * Zipping-    , zipWithM-    , zipWith-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Fold.Type (Fold (..))-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.System.IO (defaultChunkSize)-import Streamly.Internal.Data.SVar.Type (defState)--import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamK as K-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Prelude hiding (take, takeWhile, drop, reverse, concatMap, map, zipWith)--import Streamly.Internal.Data.Stream.Type------- $setup--- >>> :m--- >>> import Control.Monad (join, (>=>), (<=<))--- >>> import Data.Function (fix, (&))--- >>> import Data.Functor.Identity (Identity)--- >>> import Data.Maybe (fromJust, isJust)--- >>> import Prelude hiding (take, takeWhile, drop, reverse)--- >>> import Streamly.Data.Array (Array)--- >>> import Streamly.Data.Fold (Fold)--- >>> import Streamly.Data.Stream (Stream)--- >>> import System.IO.Unsafe (unsafePerformIO)--- >>> import qualified Streamly.Data.Array as Array--- >>> import qualified Streamly.Data.MutArray as MArray--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Parser as Parser--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Fold as Fold (toStream)--- >>> import Streamly.Internal.Data.Stream as Stream----------------------------------------------------------------------------------- Generation - Time related----------------------------------------------------------------------------------- | @timesWith g@ returns a stream of time value tuples. The first component--- of the tuple is an absolute time reference (epoch) denoting the start of the--- stream and the second component is a time relative to the reference.------ The argument @g@ specifies the granularity of the relative time in seconds.--- A lower granularity clock gives higher precision but is more expensive in--- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.------ >>> import Control.Concurrent (threadDelay)--- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE timesWith #-}-timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)-timesWith g = fromStreamD $ D.timesWith g---- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated--- as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimesWith #-}-absTimesWith :: MonadIO m => Double -> Stream m AbsTime-absTimesWith = fmap (uncurry addToAbsTime64) . timesWith---- | @relTimesWith g@ returns a stream of relative time values starting from 0,--- using a clock of granularity @g@ specified in seconds. A low granularity--- clock is more expensive in terms of CPU usage.  Any granularity lower than 1--- ms is treated as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimesWith #-}-relTimesWith :: MonadIO m => Double -> Stream m RelTime64-relTimesWith = fmap snd . timesWith----------------------------------------------------------------------------------- Elimination - Running a Fold----------------------------------------------------------------------------------- | Append a stream to a fold lazily to build an accumulator incrementally.------ Example, to continue folding a list of streams on the same sum fold:------ >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]]--- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams--- >>> Stream.fold f Stream.nil--- 55----{-# INLINE foldAddLazy #-}-foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b-foldAddLazy f s = D.foldAddLazy f $ toStreamD s---- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce---- |--- >>> foldAdd = flip Fold.addStream----foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)-foldAdd f = fold (Fold.duplicate f)---- >>> fold f = Fold.extractM . Stream.foldAddLazy f--- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f--- >>> fold f = Fold.extractM <=< Stream.foldAdd f---- | Fold a stream using the supplied left 'Fold' and reducing the resulting--- expression strictly at each step. The behavior is similar to 'foldl''. A--- 'Fold' can terminate early without consuming the full stream. See the--- documentation of individual 'Fold's for termination behavior.------ Definitions:------ >>> fold f = fmap fst . Stream.foldBreak f--- >>> fold f = Stream.parse (Parser.fromFold f)------ Example:------ >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)--- 5050----{-# INLINE fold #-}-fold :: Monad m => Fold m a b -> Stream m a -> m b-fold fl strm = D.fold fl $ D.fromStreamK $ toStreamK strm---- Alternative name foldSome, but may be confused vs foldMany.---- | Like 'fold' but also returns the remaining stream. The resulting stream--- would be 'Stream.nil' if the stream finished before the fold.------ /CPS/----{-# INLINE foldBreak #-}-foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-foldBreak fl strm = fmap f $ K.foldBreak fl (toStreamK strm)--    where--    f (b, str) = (b, fromStreamK str)---- XXX The quadratic slowdown in recursive use is because recursive function--- cannot be inlined and StreamD/StreamK conversions pile up and cannot be--- eliminated by rewrite rules.---- | Like 'foldBreak' but fuses.------ /Note:/ Unlike 'foldBreak', recursive application on the resulting stream--- would lead to quadratic slowdown. If you need recursion with fusion (within--- one iteration of recursion) use StreamD.foldBreak directly.------ /Internal/-{-# INLINE foldBreak2 #-}-foldBreak2 :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-foldBreak2 fl strm = fmap f $ D.foldBreak fl $ toStreamD strm--    where--    f (b, str) = (b, fromStreamD str)---- | Fold resulting in either breaking the stream or continuation of the fold.--- Instead of supplying the input stream in one go we can run the fold multiple--- times, each time supplying the next segment of the input stream. If the fold--- has not yet finished it returns a fold that can be run again otherwise it--- returns the fold result and the residual stream.------ /Internal/-{-# INLINE foldEither #-}-foldEither :: Monad m =>-    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))-foldEither fl strm = fmap (fmap f) $ K.foldEither fl $ toStreamK strm--    where--    f (b, str) = (b, fromStreamK str)---- | Like 'foldEither' but fuses. However, recursive application on resulting--- stream would lead to quadratic slowdown.------ /Internal/-{-# INLINE foldEither2 #-}-foldEither2 :: Monad m =>-    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))-foldEither2 fl strm = fmap (fmap f) $ D.foldEither fl $ toStreamD strm--    where--    f (b, str) = (b, fromStreamD str)---- XXX Array folds can be implemented using this.--- foldContainers? Specialized to foldArrays.---- | Generate streams from individual elements of a stream and fold the--- concatenation of those streams using the supplied fold. Return the result of--- the fold and residual stream.------ For example, this can be used to efficiently fold an Array Word8 stream--- using Word8 folds.------ The outer stream forces CPS to allow scalable appends and the inner stream--- forces direct style for stream fusion.------ /Internal/-{-# INLINE foldConcat #-}-foldConcat :: Monad m =>-    Producer m a b -> Fold m b c -> Stream m a -> m (c, Stream m a)-foldConcat-    (Producer pstep pinject pextract)-    (Fold fstep begin done)-    stream = do--    res <- begin-    case res of-        Fold.Partial fs -> go fs streamK-        Fold.Done fb -> return (fb, fromStreamK streamK)--    where--    streamK = toStreamK stream--    go !acc m1 = do-        let stop = do-                r <- done acc-                return (r, fromStreamK K.nil)-            single a = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> do-                        r <- done fs-                        return (r, fromStreamK K.nil)-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, fromStreamK (K.fromPure x))-            yieldk a r = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> go fs r-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, fromStreamK (x `K.cons` r))-         in K.foldStream defState yieldk single stop m1--    {-# INLINE go1 #-}-    go1 !_ !fs st = do-        r <- pstep st-        case r of-            D.Yield x s -> do-                res <- fstep fs x-                case res of-                    Fold.Done b -> return $ Right (b, s)-                    Fold.Partial fs1 -> go1 SPEC fs1 s-            D.Skip s -> go1 SPEC fs s-            D.Stop -> return $ Left fs----------------------------------------------------------------------------------- Transformation---------------------------------------------------------------------------------{---- |--- >>> map = fmap------ Same as 'fmap'.------ >>> Stream.fold Fold.toList $ fmap (+1) $ Stream.fromList [1,2,3]--- [2,3,4]----{-# INLINE map #-}-map :: Monad m => (a -> b) -> Stream m a -> Stream m b-map f = fromStreamD . D.map f . toStreamD--}---- | Postscan a stream using the given monadic fold.------ The following example extracts the input stream up to a point where the--- running average of elements is no more than 10:------ >>> import Data.Maybe (fromJust)--- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> s = Stream.enumerateFromTo 1.0 100.0--- >>> :{---  Stream.fold Fold.toList---   $ fmap (fromJust . fst)---   $ Stream.takeWhile (\(_,x) -> x <= 10)---   $ Stream.postscan (Fold.tee Fold.latest avg) s--- :}--- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0]----{-# INLINE postscan #-}-postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b-postscan fld = fromStreamD . D.postscan fld . toStreamD---- $smapM_Notes------ The stateful step function can be simplified to @(s -> a -> m b)@ to provide--- a read-only environment. However, that would just be 'mapM'.------ The initial action could be @m (s, Maybe b)@, and we can also add a final--- action @s -> m (Maybe b)@. This can be used to get pre/post scan like--- functionality and also to flush the state in the end like scanlMAfter'.--- We can also use it along with a fusible version of bracket to get--- scanlMAfter' like functionality. See issue #677.------ This can be further generalized to a type similar to Fold/Parser, giving it--- filtering and parsing capability as well (this is in fact equivalent to--- parseMany):------ smapM :: (s -> a -> m (Step s b)) -> m s -> Stream m a -> Stream m b------- | A stateful 'mapM', equivalent to a left scan, more like mapAccumL.--- Hopefully, this is a better alternative to @scan@. Separation of state from--- the output makes it easier to think in terms of a shared state, and also--- makes it easier to keep the state fully strict and the output lazy.------ See also: 'postscan'------ /Pre-release/----{-# INLINE smapM #-}-smapM :: Monad m =>-       (s -> a -> m (s, b))-    -> m s-    -> Stream m a-    -> Stream m b-smapM step initial stream =-    -- XXX implement this directly instead of using postscan-    let f = Fold.foldlM'-                (\(s, _) a -> step s a)-                (fmap (,undefined) initial)-     in fmap snd $ postscan f stream---- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.------ >>> catMaybes = Stream.mapMaybe id--- >>> catMaybes = fmap fromJust . Stream.filter isJust------ /Pre-release/----{-# INLINE catMaybes #-}-catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a--- catMaybes = fmap fromJust . filter isJust-catMaybes = fromStreamD . D.catMaybes . toStreamD---- | Use a filtering fold on a stream.------ >>> scanMaybe f = Stream.catMaybes . Stream.postscan f----{-# INLINE scanMaybe #-}-scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b-scanMaybe p = catMaybes . postscan p----------------------------------------------------------------------------------- Transformation - Trimming----------------------------------------------------------------------------------- | Take first 'n' elements from the stream and discard the rest.----{-# INLINE take #-}-take :: Monad m => Int -> Stream m a -> Stream m a--- take n = scanMaybe (Fold.taking n)-take n m = fromStreamD $ D.take n $ toStreamD m---- | End the stream as soon as the predicate fails on an element.----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- takeWhile p = scanMaybe (Fold.takingEndBy_ (not . p))-takeWhile p m = fromStreamD $ D.takeWhile p $ toStreamD m--{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- takeEndBy p = scanMaybe (Fold.takingEndBy p)-takeEndBy p m = fromStreamD $ D.takeEndBy p $ toStreamD m---- | Discard first 'n' elements from the stream and take the rest.----{-# INLINE drop #-}-drop :: Monad m => Int -> Stream m a -> Stream m a--- drop n = scanMaybe (Fold.dropping n)-drop n m = fromStreamD $ D.drop n $ toStreamD m----------------------------------------------------------------------------------- Searching----------------------------------------------------------------------------------- | Find all the indices where the element in the stream satisfies the given--- predicate.------ >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)----{-# INLINE findIndices #-}-findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int--- findIndices p = scanMaybe (Fold.findIndices p)-findIndices p m = fromStreamD $ D.findIndices p (toStreamD m)----------------------------------------------------------------------------------- Transformation by Inserting----------------------------------------------------------------------------------- intersperseM = intersperseMWith 1---- | Insert an effect and its output before consuming an element of a stream--- except the first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') input--- h.,e.,l.,l.,o"h,e,l,l,o"------ Be careful about the order of effects. In the above example we used trace--- after the intersperse, if we use it before the intersperse the output would--- be he.l.l.o."h,e,l,l,o".------ >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input--- he.l.l.o."h,e,l,l,o"----{-# INLINE intersperseM #-}-intersperseM :: Monad m => m a -> Stream m a -> Stream m a-intersperseM m = fromStreamD . D.intersperseM m . toStreamD----------------------------------------------------------------------------------- Transformation by Reordering----------------------------------------------------------------------------------- XXX Use a compact region list to temporarily store the list, in both reverse--- as well as in reverse'.------ /Note:/ 'reverse'' is much faster than this, use that when performance--- matters.------ | Returns the elements of the stream in reverse order.  The stream must be--- finite. Note that this necessarily buffers the entire stream in memory.------ >>> reverse = Stream.foldlT (flip Stream.cons) Stream.nil----{-# INLINE reverse #-}-reverse :: Stream m a -> Stream m a-reverse s = fromStreamK $ K.reverse $ toStreamK s---- | Like 'reverse' but several times faster, requires a 'Storable' instance.------ /O(n) space/------ /Pre-release/-{-# INLINE reverse' #-}-reverse' :: (MonadIO m, Unbox a) => Stream m a -> Stream m a--- reverse' s = fromStreamD $ D.reverse' $ toStreamD s-reverse' =-        fromStreamD-        . A.flattenArraysRev -- unfoldMany A.readRev-        . D.fromStreamK-        . K.reverse-        . D.toStreamK-        . A.chunksOf defaultChunkSize-        . toStreamD----------------------------------------------------------------------------------- Combine streams and flatten----------------------------------------------------------------------------------- | Map a stream producing monadic function on each element of the stream--- and then flatten the results into a single stream. Since the stream--- generation function is monadic, unlike 'concatMap', it can produce an--- effect at the beginning of each iteration of the inner loop.------ See 'unfoldMany' for a fusible alternative.----{-# INLINE concatMapM #-}-concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b-concatMapM f m = fromStreamD $ D.concatMapM (fmap toStreamD . f) (toStreamD m)---- | Map a stream producing function on each element of the stream and then--- flatten the results into a single stream.------ >>> concatMap f = Stream.concatMapM (return . f)--- >>> concatMap f = Stream.concatMapWith Stream.append f--- >>> concatMap f = Stream.concat . fmap f--- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream)------ See 'unfoldMany' for a fusible alternative.----{-# INLINE concatMap #-}-concatMap ::Monad m => (a -> Stream m b) -> Stream m a -> Stream m b-concatMap f m = fromStreamD $ D.concatMap (toStreamD . f) (toStreamD m)---- >>> concatEffect = Stream.concat . lift    -- requires (MonadTrans t)--- >>> concatEffect = join . lift             -- requires (MonadTrans t, Monad (Stream m))---- | Given a stream value in the underlying monad, lift and join the underlying--- monad with the stream monad.------ >>> concatEffect = Stream.concat . Stream.fromEffect------ See also: 'concat', 'sequence'------ See 'concatEffect2' for a fusible alternative.------  /CPS/----{-# INLINE concatEffect #-}-concatEffect :: Monad m => m (Stream m a) -> Stream m a-concatEffect generator =-    fromStreamK $ K.concatEffect $ fmap toStreamK generator--{-# INLINE concatEffect2 #-}-concatEffect2 :: Monad m => m (Stream m a) -> Stream m a--- concatEffect generator = concatMapM (\() -> generator) (fromPure ())-concatEffect2 generator =-    fromStreamD $ D.concatEffect $ fmap toStreamD generator---- XXX Need a more intuitive name, and need to reconcile the names--- foldMany/fold/parse/parseMany/parseManyPost etc.---- | Like 'foldMany' but evaluates the fold before the stream, and yields its--- output even if the stream is empty, therefore, always results in a non-empty--- output even on an empty stream (default result of the fold).------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f--- >>> fmany $ Stream.fromList []--- [0]------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7,0]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream without consuming the input.------ /Pre-release/----{-# INLINE foldManyPost #-}-foldManyPost-    :: Monad m-    => Fold m a b-    -> Stream m a-    -> Stream m b-foldManyPost f m = fromStreamD $ D.foldManyPost f (toStreamD m)----------------------------------------------------------------------------------- Zipping----------------------------------------------------------------------------------- | Like 'zipWith' but using a monadic zipping function.----{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c-zipWithM f m1 m2 = fromStreamK $ K.zipWithM f (toStreamK m1) (toStreamK m2)---- | Stream @a@ is evaluated first, followed by stream @b@, the resulting--- elements @a@ and @b@ are then zipped using the supplied zip function and the--- result @c@ is yielded to the consumer.------ If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends--- first, the element @a@ from previous evaluation of stream @a@ is discarded.------ >>> s1 = Stream.fromList [1,2,3]--- >>> s2 = Stream.fromList [4,5,6]--- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2--- [5,7,9]----{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWith f m1 m2 = fromStreamK $ K.zipWith f (toStreamK m1) (toStreamK m2)
− src/Streamly/Internal/Data/Stream/Chunked.hs 
@@ -1,1215 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Chunked--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Combinators to efficiently manipulate streams of immutable arrays.----module Streamly.Internal.Data.Stream.Chunked-    (-    -- * Creation-      chunksOf--    -- * Flattening to elements-    , concat-    , concatRev-    , interpose-    , interposeSuffix-    , intercalateSuffix-    , unlines--    -- * Elimination-    -- ** Element Folds-    -- The byte level foldBreak can work as efficiently as the chunk level. We-    -- can flatten the stream to byte stream and use that. But if we want the-    -- remaining stream to be a chunk stream then this could be handy. But it-    -- could also be implemented using parseBreak.-    , foldBreak -- StreamK.foldBreakChunks-    , foldBreakD-    -- The byte level parseBreak cannot work efficiently. Because the stream-    -- will have to be a StreamK for backtracking, StreamK at byte level would-    -- not be efficient.-    , parseBreak -- StreamK.parseBreakChunks-    -- , parseBreakD-    -- , foldManyChunks-    -- , parseManyChunks--    -- ** Array Folds-    -- XXX Use Parser.Chunked instead, need only chunkedParseBreak,-    -- foldBreak can be implemented using parseBreak. Use StreamK.-    , runArrayFold-    , runArrayFoldBreak-    -- , parseArr-    , runArrayParserDBreak -- StreamK.chunkedParseBreak-    , runArrayFoldMany     -- StreamK.chunkedParseMany--    , toArray--    -- * Compaction-    -- We can use something like foldManyChunks, parseManyChunks with a take-    -- fold.-    , lpackArraysChunksOf -- Fold.compactChunks-    , compact -- rechunk, compactChunks--    -- * Splitting-    -- We can use something like foldManyChunks, parseManyChunks with an-    -- appropriate splitting fold.-    , splitOn       -- Stream.rechunkOn-    , splitOnSuffix -- Stream.rechunkOnSuffix-    )-where--#include "ArrayMacros.h"-#include "inline.hs"--import Data.Bifunctor (second)-import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Proxy (Proxy(..))-import Data.Word (Word8)-import Streamly.Internal.Data.Unboxed (Unbox, peekWith, sizeOf)-import Fusion.Plugin.Types (Fuse(..))-import GHC.Exts (SpecConstrAnnotation(..))-import GHC.Types (SPEC(..))-import Prelude hiding (null, last, (!!), read, concat, unlines)--import Streamly.Data.Fold (Fold)-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Array.Mut.Type (MutArray)-import Streamly.Internal.Data.Fold.Chunked (ChunkFold(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamK (StreamK, fromStream, toStream)-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Array.Mut.Type-    (allocBytesToElemCount)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))--import qualified Streamly.Data.Fold as FL-import qualified Streamly.Internal.Data.Array as A-import qualified Streamly.Internal.Data.Array as Array-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Array.Mut.Stream as AS-import qualified Streamly.Internal.Data.Fold.Type as FL (Fold(..), Step(..))-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-    (Parser(..), Initial(..))-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K---- XXX Since these are immutable arrays MonadIO constraint can be removed from--- most places.------------------------------------------------------------------------------------ Generation------------------------------------------------------------------------------------ | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ > chunksOf n = Stream.groupsOf n (Array.writeN n)------ /Pre-release/-{-# INLINE chunksOf #-}-chunksOf :: (MonadIO m, Unbox a)-    => Int -> Stream m a -> Stream m (Array a)-chunksOf = A.chunksOf------------------------------------------------------------------------------------ Append------------------------------------------------------------------------------------ XXX efficiently compare two streams of arrays. Two streams can have chunks--- of different sizes, we can handle that in the stream comparison abstraction.--- This could be useful e.g. to fast compare whether two files differ.---- | Convert a stream of arrays into a stream of their elements.------ Same as the following:------ > concat = Stream.unfoldMany Array.read------ @since 0.7.0-{-# INLINE concat #-}-concat :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- concat m = fromStreamD $ A.flattenArrays (toStreamD m)--- concat m = fromStreamD $ D.concatMap A.toStreamD (toStreamD m)-concat = D.unfoldMany A.reader---- | Convert a stream of arrays into a stream of their elements reversing the--- contents of each array before flattening.------ > concatRev = Stream.unfoldMany Array.readerRev------ @since 0.7.0-{-# INLINE concatRev #-}-concatRev :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a--- concatRev m = fromStreamD $ A.flattenArraysRev (toStreamD m)-concatRev = D.unfoldMany A.readerRev------------------------------------------------------------------------------------ Intersperse and append------------------------------------------------------------------------------------ | Flatten a stream of arrays after inserting the given element between--- arrays.------ /Pre-release/-{-# INLINE interpose #-}-interpose :: (Monad m, Unbox a) => a -> Stream m (Array a) -> Stream m a-interpose x = D.interpose x A.reader--{-# INLINE intercalateSuffix #-}-intercalateSuffix :: (Monad m, Unbox a)-    => Array a -> Stream m (Array a) -> Stream m a-intercalateSuffix = D.intercalateSuffix A.reader---- | Flatten a stream of arrays appending the given element after each--- array.------ @since 0.7.0-{-# INLINE interposeSuffix #-}-interposeSuffix :: (Monad m, Unbox a)-    => a -> Stream m (Array a) -> Stream m a--- interposeSuffix x = fromStreamD . A.unlines x . toStreamD-interposeSuffix x = D.interposeSuffix x A.reader--data FlattenState s =-      OuterLoop s-    | InnerLoop s !MA.MutableByteArray !Int !Int---- XXX This is a special case of interposeSuffix, can be removed.--- XXX Remove monadIO constraint-{-# INLINE_NORMAL unlines #-}-unlines :: forall m a. (MonadIO m, Unbox a)-    => a -> D.Stream m (Array a) -> D.Stream m a-unlines sep (D.Stream step state) = D.Stream step' (OuterLoop state)-    where-    {-# INLINE_LATE step' #-}-    step' gst (OuterLoop st) = do-        r <- step (adaptState gst) st-        return $ case r of-            D.Yield Array{..} s ->-                D.Skip (InnerLoop s arrContents arrStart arrEnd)-            D.Skip s -> D.Skip (OuterLoop s)-            D.Stop -> D.Stop--    step' _ (InnerLoop st _ p end) | p == end =-        return $ D.Yield sep $ OuterLoop st--    step' _ (InnerLoop st contents p end) = do-        x <- liftIO $ peekWith contents p-        return $ D.Yield x (InnerLoop st contents (INDEX_NEXT(p,a)) end)------------------------------------------------------------------------------------ Compact------------------------------------------------------------------------------------ XXX These would not be needed once we implement compactLEFold, see--- module Streamly.Internal.Data.Array.Mut.Stream------ XXX Note that this thaws immutable arrays for appending, that may be--- problematic if multiple users do the same thing, however, immutable arrays--- would usually have no capacity to append, therefore, a copy will be forced--- anyway. Confirm this. We can forcefully trim the array capacity before thaw--- to ensure this.-{-# INLINE_NORMAL packArraysChunksOf #-}-packArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> D.Stream m (Array a) -> D.Stream m (Array a)-packArraysChunksOf n str =-    D.map A.unsafeFreeze $ AS.packArraysChunksOf n $ D.map A.unsafeThaw str---- XXX instead of writing two different versions of this operation, we should--- write it as a pipe.------ XXX Confirm that immutable arrays won't be modified.-{-# INLINE_NORMAL lpackArraysChunksOf #-}-lpackArraysChunksOf :: (MonadIO m, Unbox a)-    => Int -> Fold m (Array a) () -> Fold m (Array a) ()-lpackArraysChunksOf n fld =-    FL.lmap A.unsafeThaw $ AS.lpackArraysChunksOf n (FL.lmap A.unsafeFreeze fld)---- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a--- maximum specified size in bytes.------ @since 0.7.0-{-# INLINE compact #-}-compact :: (MonadIO m, Unbox a)-    => Int -> Stream m (Array a) -> Stream m (Array a)-compact = packArraysChunksOf------------------------------------------------------------------------------------ Split----------------------------------------------------------------------------------data SplitState s arr-    = Initial s-    | Buffering s arr-    | Splitting s arr-    | Yielding arr (SplitState s arr)-    | Finishing---- | Split a stream of arrays on a given separator byte, dropping the separator--- and coalescing all the arrays between two separators into a single array.------ @since 0.7.0-{-# INLINE_NORMAL _splitOn #-}-_splitOn-    :: MonadIO m-    => Word8-    -> D.Stream m (Array Word8)-    -> D.Stream m (Array Word8)-_splitOn byte (D.Stream step state) = D.Stream step' (Initial state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Initial st) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                (arr1, marr2) <- A.breakOn byte arr-                return $ case marr2 of-                    Nothing   -> D.Skip (Buffering s arr1)-                    Just arr2 -> D.Skip (Yielding arr1 (Splitting s arr2))-            D.Skip s -> return $ D.Skip (Initial s)-            D.Stop -> return D.Stop--    step' gst (Buffering st buf) = do-        r <- step gst st-        case r of-            D.Yield arr s -> do-                (arr1, marr2) <- A.breakOn byte arr-                buf' <- A.splice buf arr1-                return $ case marr2 of-                    Nothing -> D.Skip (Buffering s buf')-                    Just x -> D.Skip (Yielding buf' (Splitting s x))-            D.Skip s -> return $ D.Skip (Buffering s buf)-            D.Stop -> return $-                if A.byteLength buf == 0-                then D.Stop-                else D.Skip (Yielding buf Finishing)--    step' _ (Splitting st buf) = do-        (arr1, marr2) <- A.breakOn byte buf-        return $ case marr2 of-                Nothing -> D.Skip $ Buffering st arr1-                Just arr2 -> D.Skip $ Yielding arr1 (Splitting st arr2)--    step' _ (Yielding arr next) = return $ D.Yield arr next-    step' _ Finishing = return D.Stop---- XXX Remove MonadIO constraint.--- | Split a stream of arrays on a given separator byte, dropping the separator--- and coalescing all the arrays between two separators into a single array.------ @since 0.7.0-{-# INLINE splitOn #-}-splitOn-    :: (MonadIO m)-    => Word8-    -> Stream m (Array Word8)-    -> Stream m (Array Word8)-splitOn byte = D.splitInnerBy (A.breakOn byte) A.splice--{-# INLINE splitOnSuffix #-}-splitOnSuffix-    :: (MonadIO m)-    => Word8-    -> Stream m (Array Word8)-    -> Stream m (Array Word8)--- splitOn byte s = fromStreamD $ A.splitOn byte $ toStreamD s-splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice------------------------------------------------------------------------------------ Elimination - Running folds----------------------------------------------------------------------------------{-# INLINE_NORMAL foldBreakD #-}-foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>-    Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))-foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do-    res <- initial-    case res of-        FL.Partial fs -> go SPEC state fs-        FL.Done fb -> return $! (fb, stream)--    where--    {-# INLINE go #-}-    go !_ st !fs = do-        r <- step defState st-        case r of-            D.Yield (Array contents start end) s ->-                let fp = Tuple' end contents-                 in goArray SPEC s fp start fs-            D.Skip s -> go SPEC s fs-            D.Stop -> do-                b <- extract fs-                return (b, D.nil)--    goArray !_ s (Tuple' end _) !cur !fs-        | cur == end = do-            go SPEC s fs-    goArray !_ st fp@(Tuple' end contents) !cur !fs = do-        x <- liftIO $ peekWith contents cur-        res <- fstep fs x-        let next = INDEX_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array contents next end-                return $! (b, D.cons arr (D.Stream step st))-            FL.Partial fs1 -> goArray SPEC st fp next fs1--{-# INLINE_NORMAL foldBreakK #-}-foldBreakK :: forall m a b. (MonadIO m, Unbox a) =>-    Fold m a b -> K.StreamK m (Array a) -> m (b, K.StreamK m (Array a))-foldBreakK (FL.Fold fstep initial extract) stream = do-    res <- initial-    case res of-        FL.Partial fs -> go fs stream-        FL.Done fb -> return (fb, stream)--    where--    {-# INLINE go #-}-    go !fs st = do-        let stop = (, K.nil) <$> extract fs-            single a = yieldk a K.nil-            yieldk (Array contents start end) r =-                let fp = Tuple' end contents-                 in goArray fs r fp start-         in K.foldStream defState yieldk single stop st--    goArray !fs st (Tuple' end _) !cur-        | cur == end = do-            go fs st-    goArray !fs st fp@(Tuple' end contents) !cur = do-        x <- liftIO $ peekWith contents cur-        res <- fstep fs x-        let next = INDEX_NEXT(cur,a)-        case res of-            FL.Done b -> do-                let arr = Array contents next end-                return $! (b, K.cons arr st)-            FL.Partial fs1 -> goArray fs1 st fp next---- | Fold an array stream using the supplied 'Fold'. Returns the fold result--- and the unconsumed stream.------ > foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)------ /Internal/----{-# INLINE_NORMAL foldBreak #-}-foldBreak ::-       (MonadIO m, Unbox a)-    => Fold m a b-    -> StreamK m (A.Array a)-    -> m (b, StreamK m (A.Array a))--- foldBreak f s = fmap fromStreamD <$> foldBreakD f (toStreamD s)-foldBreak = foldBreakK--- If foldBreak performs better than runArrayFoldBreak we can use a rewrite--- rule to rewrite runArrayFoldBreak to fold.--- foldBreak f = runArrayFoldBreak (ChunkFold.fromFold f)------------------------------------------------------------------------------------ Fold to a single Array------------------------------------------------------------------------------------ When we have to take an array partially, take the last part of the array.-{-# INLINE takeArrayListRev #-}-takeArrayListRev :: forall a. Unbox a => Int -> [Array a] -> [Array a]-takeArrayListRev = go--    where--    go _ [] = []-    go n _ | n <= 0 = []-    go n (x:xs) =-        let len = Array.length x-        in if n > len-           then x : go (n - len) xs-           else if n == len-           then [x]-           else let !(Array contents _ end) = x-                    !start = end - (n * SIZE_OF(a))-                 in [Array contents start end]---- When we have to take an array partially, take the last part of the array in--- the first split.-{-# INLINE splitAtArrayListRev #-}-splitAtArrayListRev ::-    forall a. Unbox a => Int -> [Array a] -> ([Array a],[Array a])-splitAtArrayListRev n ls-  | n <= 0 = ([], ls)-  | otherwise = go n ls-    where-        go :: Int -> [Array a] -> ([Array a], [Array a])-        go _  []     = ([], [])-        go m (x:xs) =-            let len = Array.length x-                (xs', xs'') = go (m - len) xs-             in if m > len-                then (x:xs', xs'')-                else if m == len-                then ([x],xs)-                else let !(Array contents start end) = x-                         end1 = end - (m * SIZE_OF(a))-                         arr2 = Array contents start end1-                         arr1 = Array contents end1 end-                      in ([arr1], arr2:xs)------------------------------------------------------------------------------------ Fold to a single Array------------------------------------------------------------------------------------ XXX Both of these implementations of splicing seem to perform equally well.--- We need to perform benchmarks over a range of sizes though.---- CAUTION! length must more than equal to lengths of all the arrays in the--- stream.-{-# INLINE spliceArraysLenUnsafe #-}-spliceArraysLenUnsafe :: (MonadIO m, Unbox a)-    => Int -> Stream m (MutArray a) -> m (MutArray a)-spliceArraysLenUnsafe len buffered = do-    arr <- liftIO $ MA.newPinned len-    D.foldlM' MA.spliceUnsafe (return arr) buffered--{-# INLINE _spliceArrays #-}-_spliceArrays :: (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-_spliceArrays s = do-    buffered <- D.foldr K.cons K.nil s-    len <- K.fold FL.sum (fmap Array.length buffered)-    arr <- liftIO $ MA.newPinned len-    final <- D.foldlM' writeArr (return arr) (toStream buffered)-    return $ A.unsafeFreeze final--    where--    writeArr dst arr = MA.spliceUnsafe dst (A.unsafeThaw arr)--{-# INLINE _spliceArraysBuffered #-}-_spliceArraysBuffered :: (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-_spliceArraysBuffered s = do-    buffered <- D.foldr K.cons K.nil s-    len <- K.fold FL.sum (fmap Array.length buffered)-    A.unsafeFreeze <$>-        spliceArraysLenUnsafe len (fmap A.unsafeThaw (toStream buffered))--{-# INLINE spliceArraysRealloced #-}-spliceArraysRealloced :: forall m a. (MonadIO m, Unbox a)-    => Stream m (Array a) -> m (Array a)-spliceArraysRealloced s = do-    let n = allocBytesToElemCount (undefined :: a) (4 * 1024)-        idst = liftIO $ MA.newPinned n--    arr <- D.foldlM' MA.spliceExp idst (fmap A.unsafeThaw s)-    liftIO $ A.unsafeFreeze <$> MA.rightSize arr---- XXX This should just be "fold A.write"------ | Given a stream of arrays, splice them all together to generate a single--- array. The stream must be /finite/.------ @since 0.7.0-{-# INLINE toArray #-}-toArray :: (MonadIO m, Unbox a) => Stream m (Array a) -> m (Array a)-toArray = spliceArraysRealloced--- spliceArrays = _spliceArraysBuffered---- exponentially increasing sizes of the chunks upto the max limit.--- XXX this will be easier to implement with parsers/terminating folds--- With this we should be able to reduce the number of chunks/allocations.--- The reallocation/copy based toArray can also be implemented using this.----{--{-# INLINE toArraysInRange #-}-toArraysInRange :: (MonadIO m, Unbox a)-    => Int -> Int -> Fold m (Array a) b -> Fold m a b-toArraysInRange low high (Fold step initial extract) =--}--{---- | Fold the input to a pure buffered stream (List) of arrays.-{-# INLINE _toArraysOf #-}-_toArraysOf :: (MonadIO m, Unbox a)-    => Int -> Fold m a (Stream Identity (Array a))-_toArraysOf n = FL.groupsOf n (A.writeNF n) FL.toStream--}------------------------------------------------------------------------------------ Elimination - running element parsers------------------------------------------------------------------------------------ GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need--- to make a newtype.-{-# ANN type List NoSpecConstr #-}-newtype List a = List {getList :: [a]}--{---- This can be generalized to any type provided it can be unfolded to a stream--- and it can be combined using a semigroup operation.------ XXX This should be written using CPS (as parseK) if we want it to scale wrt--- to the number of times it can be called on the same stream.-{-# INLINE_NORMAL parseBreakD #-}-parseBreakD ::-       forall m a b. (MonadIO m, MonadThrow m, Unbox a)-    => PRD.Parser a m b-    -> D.Stream m (Array.Array a)-    -> m (b, D.Stream m (Array.Array a))-parseBreakD-    (PRD.Parser pstep initial extract) stream@(D.Stream step state) = do--    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (b, stream)-        PRD.IError err -> throwM $ ParseError err--    where--    -- "backBuf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    go !_ st backBuf !pst = do-        r <- step defState st-        case r of-            D.Yield (Array contents start end) s ->-                gobuf SPEC s backBuf-                    (Tuple' end contents) start pst-            D.Skip s -> go SPEC s backBuf pst-            D.Stop -> do-                b <- extract pst-                return (b, D.nil)--    -- Use strictness on "cur" to keep it unboxed-    gobuf !_ s backBuf (Tuple' end _) !cur !pst-        | cur == end = do-            go SPEC s backBuf pst-    gobuf !_ s backBuf fp@(Tuple' end contents) !cur !pst = do-        x <- liftIO $ peekWith contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 pst1 ->-                 gobuf SPEC s (List []) fp next pst1-            PR.Partial n pst1 -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let src0 = Prelude.take n (x:getList backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                let !(Array cont1 start end1) = src-                    fp1 = Tuple' end1 cont1-                gobuf SPEC s (List []) fp1 start pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC s (List (x:getList backBuf)) fp next pst1-            PR.Continue n pst1 -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:getList backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                let !(Array cont1 start end1) = src-                    fp1 = Tuple' end1 cont1-                gobuf SPEC s (List buf1) fp1 start pst1-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (b, D.cons arr (D.Stream step s))-            PR.Done n b -> do-                assert (n <= Prelude.length (x:getList backBuf)) (return ())-                let src0 = Prelude.take n (x:getList backBuf)-                    -- XXX create the array in reverse instead-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    -- XXX Use StreamK to avoid adding arbitrary layers of-                    -- constructors every time.-                    str = D.cons arr0 (D.cons arr1 (D.Stream step s))-                return (b, str)-            PR.Error err -> throwM $ ParseError err--}--{-# INLINE_NORMAL parseBreakK #-}-parseBreakK ::-       forall m a b. (MonadIO m, Unbox a)-    => PRD.Parser a m b-    -> K.StreamK m (Array.Array a)-    -> m (Either ParseError b, K.StreamK m (Array.Array a))-parseBreakK (PRD.Parser pstep initial extract) stream = do-    res <- initial-    case res of-        PRD.IPartial s -> go s stream []-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    where--    -- "backBuf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    go !pst st backBuf = do-        let stop = goStop pst backBuf -- (, K.nil) <$> extract pst-            single a = yieldk a K.nil-            yieldk arr r = goArray pst backBuf r arr-         in K.foldStream defState yieldk single stop st--    -- Use strictness on "cur" to keep it unboxed-    goArray !pst backBuf st (Array _ cur end) | cur == end = go pst st backBuf-    goArray !pst backBuf st (Array contents cur end) = do-        x <- liftIO $ peekWith contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 s ->-                 goArray s [] st (Array contents next end)-            PR.Partial n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goArray s [] st src-            PR.Continue 0 s ->-                goArray s (x:backBuf) st (Array contents next end)-            PR.Continue n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goArray s buf1 st src-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (Right b, K.cons arr st)-            PR.Done n b -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    str = K.cons arr0 (K.cons arr1 st)-                return (Right b, str)-            PR.Error err -> do-                let str = K.cons (Array contents cur end) stream-                return (Left (ParseError err), str)--    -- This is a simplified goArray-    goExtract !pst backBuf (Array _ cur end)-        | cur == end = goStop pst backBuf-    goExtract !pst backBuf (Array contents cur end) = do-        x <- liftIO $ peekWith contents cur-        pRes <- pstep pst x-        let next = INDEX_NEXT(cur,a)-        case pRes of-            PR.Partial 0 s ->-                 goExtract s [] (Array contents next end)-            PR.Partial n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let src0 = Prelude.take n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goExtract s [] src-            PR.Continue 0 s ->-                goExtract s backBuf (Array contents next end)-            PR.Continue n s -> do-                assert (n <= Prelude.length (x:backBuf)) (return ())-                let (src0, buf1) = splitAt n (x:backBuf)-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    src = arr0 <> arr1-                goExtract s buf1 src-            PR.Done 0 b -> do-                let arr = Array contents next end-                return (Right b, K.fromPure arr)-            PR.Done n b -> do-                assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                    arr1 = Array contents next end-                    str = K.cons arr0 (K.fromPure arr1)-                return (Right b, str)-            PR.Error err -> do-                let str = K.fromPure (Array contents cur end)-                return (Left (ParseError err), str)--    -- This is a simplified goExtract-    {-# INLINE goStop #-}-    goStop !pst backBuf = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-            PR.Continue 0 s ->-                goStop s backBuf-            PR.Continue n s -> do-                assert (n <= Prelude.length backBuf) (return ())-                let (src0, buf1) = splitAt n backBuf-                    arr = A.fromListN n (Prelude.reverse src0)-                goExtract s buf1 arr-            PR.Done 0 b ->-                return (Right b, K.nil)-            PR.Done n b -> do-                assert (n <= Prelude.length backBuf) (return ())-                let src0 = Prelude.take n backBuf-                    -- XXX Use fromListRevN once implemented-                    -- arr0 = A.fromListRevN n src0-                    arr0 = A.fromListN n (Prelude.reverse src0)-                return (Right b, K.fromPure arr0)-            PR.Error err ->-                return (Left (ParseError err), K.nil)---- | Parse an array stream using the supplied 'Parser'.  Returns the parse--- result and the unconsumed stream. Throws 'ParseError' if the parse fails.------ /Internal/----{-# INLINE_NORMAL parseBreak #-}-parseBreak ::-       (MonadIO m, Unbox a)-    => PR.Parser a m b-    -> StreamK m (A.Array a)-    -> m (Either ParseError b, StreamK m (A.Array a))-{--parseBreak p s =-    fmap fromStreamD <$> parseBreakD (PRD.fromParserK p) (toStreamD s)--}-parseBreak = parseBreakK------------------------------------------------------------------------------------ Elimination - Running Array Folds and parsers------------------------------------------------------------------------------------ | Note that this is not the same as using a @Parser (Array a) m b@ with the--- regular "Streamly.Internal.Data.IsStream.parse" function. The regular parse--- would consume the input arrays as single unit. This parser parses in the way--- as described in the ChunkFold module. The input arrays are treated as @n@--- element units and can be consumed partially. The remaining elements are--- inserted in the source stream as an array.----{-# INLINE_NORMAL runArrayParserDBreak #-}-runArrayParserDBreak ::-       forall m a b. (MonadIO m, Unbox a)-    => PRD.Parser (Array a) m b-    -> D.Stream m (Array.Array a)-    -> m (Either ParseError b, D.Stream m (Array.Array a))-runArrayParserDBreak-    (PRD.Parser pstep initial extract)-    stream@(D.Stream step state) = do--    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    where--    -- "backBuf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    go _ st backBuf !pst = do-        r <- step defState st-        case r of-            D.Yield x s -> gobuf SPEC [x] s backBuf pst-            D.Skip s -> go SPEC s backBuf pst-            D.Stop -> goStop backBuf pst--    gobuf !_ [] s backBuf !pst = go SPEC s backBuf pst-    gobuf !_ (x:xs) s backBuf !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                 gobuf SPEC xs s (List []) pst1-            PR.Partial n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC src s (List []) pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC xs s (List (x:getList backBuf)) pst1-            PR.Continue n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC src s (List buf1) pst1-            PR.Done 0 b -> do-                let str = D.append (D.fromList xs) (D.Stream step s)-                return (Right b, str)-            PR.Done n b -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src = Prelude.reverse src0 ++ xs-                return (Right b, D.append (D.fromList src) (D.Stream step s))-            PR.Error err -> do-                let strm = D.append (D.fromList (x:xs)) (D.Stream step s)-                return (Left (ParseError err), strm)--    -- This is a simplified gobuf-    goExtract _ [] backBuf !pst = goStop backBuf pst-    goExtract _ (x:xs) backBuf !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                 goExtract SPEC xs (List []) pst1-            PR.Partial n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC src (List []) pst1-            PR.Continue 0 pst1 ->-                goExtract SPEC xs (List (x:getList backBuf)) pst1-            PR.Continue n pst1 -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:getList backBuf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC src (List buf1) pst1-            PR.Done 0 b ->-                return (Right b, D.fromList xs)-            PR.Done n b -> do-                assert-                    (n <= sum (map Array.length (x:getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (x:getList backBuf)-                    src = Prelude.reverse src0 ++ xs-                return (Right b, D.fromList src)-            PR.Error err ->-                return (Left (ParseError err), D.fromList (x:xs))--    -- This is a simplified goExtract-    {-# INLINE goStop #-}-    goStop backBuf pst = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: runArrayParserDBreak: Partial in extract"-            PR.Continue 0 pst1 ->-                goStop backBuf pst1-            PR.Continue n pst1 -> do-                assert-                    (n <= sum (map Array.length (getList backBuf)))-                    (return ())-                let (src0, buf1) = splitAtArrayListRev n (getList backBuf)-                    src = Prelude.reverse src0-                goExtract SPEC src (List buf1) pst1-            PR.Done 0 b -> return (Right b, D.nil)-            PR.Done n b -> do-                assert-                    (n <= sum (map Array.length (getList backBuf)))-                    (return ())-                let src0 = takeArrayListRev n (getList backBuf)-                    src = Prelude.reverse src0-                return (Right b, D.fromList src)-            PR.Error err ->-                return (Left (ParseError err), D.nil)--{---- | Parse an array stream using the supplied 'Parser'.  Returns the parse--- result and the unconsumed stream. Throws 'ParseError' if the parse fails.------ /Internal/----{-# INLINE parseArr #-}-parseArr ::-       (MonadIO m, MonadThrow m, Unbox a)-    => ASF.Parser a m b-    -> Stream m (A.Array a)-    -> m (b, Stream m (A.Array a))-parseArr p s = fmap fromStreamD <$> parseBreakD p (toStreamD s)--}---- | Fold an array stream using the supplied array stream 'Fold'.------ /Pre-release/----{-# INLINE runArrayFold #-}-runArrayFold :: (MonadIO m, Unbox a) =>-    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b)-runArrayFold (ChunkFold p) s = fst <$> runArrayParserDBreak p (toStream s)---- | Like 'fold' but also returns the remaining stream.------ /Pre-release/----{-# INLINE runArrayFoldBreak #-}-runArrayFoldBreak :: (MonadIO m, Unbox a) =>-    ChunkFold m a b -> StreamK m (A.Array a) -> m (Either ParseError b, StreamK m (A.Array a))-runArrayFoldBreak (ChunkFold p) s =-    second fromStream <$> runArrayParserDBreak p (toStream s)--{-# ANN type ParseChunksState Fuse #-}-data ParseChunksState x inpBuf st pst =-      ParseChunksInit inpBuf st-    | ParseChunksInitBuf inpBuf-    | ParseChunksInitLeftOver inpBuf-    | ParseChunksStream st inpBuf !pst-    | ParseChunksStop inpBuf !pst-    | ParseChunksBuf inpBuf st inpBuf !pst-    | ParseChunksExtract inpBuf inpBuf !pst-    | ParseChunksYield x (ParseChunksState x inpBuf st pst)--{-# INLINE_NORMAL runArrayFoldManyD #-}-runArrayFoldManyD-    :: (Monad m, Unbox a)-    => ChunkFold m a b-    -> D.Stream m (Array a)-    -> D.Stream m (Either ParseError b)-runArrayFoldManyD-    (ChunkFold (PRD.Parser pstep initial extract)) (D.Stream step state) =--    D.Stream stepOuter (ParseChunksInit [] state)--    where--    {-# INLINE_LATE stepOuter #-}-    -- Buffer is empty, get the first element from the stream, initialize the-    -- fold and then go to stream processing loop.-    stepOuter gst (ParseChunksInit [] st) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                res <- initial-                case res of-                    PRD.IPartial ps ->-                        return $ D.Skip $ ParseChunksBuf [x] s [] ps-                    PRD.IDone pb -> do-                        let next = ParseChunksInit [x] s-                        return $ D.Skip $ ParseChunksYield (Right pb) next-                    PRD.IError err -> do-                        let next = ParseChunksInitLeftOver []-                        return-                            $ D.Skip-                            $ ParseChunksYield (Left (ParseError err)) next-            D.Skip s -> return $ D.Skip $ ParseChunksInit [] s-            D.Stop   -> return D.Stop--    -- Buffer is not empty, go to buffered processing loop-    stepOuter _ (ParseChunksInit src st) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ D.Skip $ ParseChunksBuf src st [] ps-            PRD.IDone pb ->-                let next = ParseChunksInit src st-                 in return $ D.Skip $ ParseChunksYield (Right pb) next-            PRD.IError err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    -- This is a simplified ParseChunksInit-    stepOuter _ (ParseChunksInitBuf src) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ D.Skip $ ParseChunksExtract src [] ps-            PRD.IDone pb ->-                let next = ParseChunksInitBuf src-                 in return $ D.Skip $ ParseChunksYield (Right pb) next-            PRD.IError err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    -- XXX we just discard any leftover input at the end-    stepOuter _ (ParseChunksInitLeftOver _) = return D.Stop--    -- Buffer is empty, process elements from the stream-    stepOuter gst (ParseChunksStream st backBuf pst) = do-        r <- step (adaptState gst) st-        case r of-            D.Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 ->-                        return $ D.Skip $ ParseChunksStream s [] pst1-                    PR.Partial n pst1 -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let src0 = takeArrayListRev n (x:backBuf)-                            src  = Prelude.reverse src0-                        return $ D.Skip $ ParseChunksBuf src s [] pst1-                    PR.Continue 0 pst1 ->-                        return $ D.Skip $ ParseChunksStream s (x:backBuf) pst1-                    PR.Continue n pst1 -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let (src0, buf1) = splitAtArrayListRev n (x:backBuf)-                            src  = Prelude.reverse src0-                        return $ D.Skip $ ParseChunksBuf src s buf1 pst1-                    PR.Done 0 b -> do-                        return $ D.Skip $-                            ParseChunksYield (Right b) (ParseChunksInit [] s)-                    PR.Done n b -> do-                        assert-                            (n <= sum (map Array.length (x:backBuf)))-                            (return ())-                        let src0 = takeArrayListRev n (x:backBuf)-                            src = Prelude.reverse src0-                            next = ParseChunksInit src s-                        return-                            $ D.Skip-                            $ ParseChunksYield (Right b) next-                    PR.Error err -> do-                        let next = ParseChunksInitLeftOver []-                        return-                            $ D.Skip-                            $ ParseChunksYield (Left (ParseError err)) next--            D.Skip s -> return $ D.Skip $ ParseChunksStream s backBuf pst-            D.Stop -> return $ D.Skip $ ParseChunksStop backBuf pst--    -- go back to stream processing mode-    stepOuter _ (ParseChunksBuf [] s buf pst) =-        return $ D.Skip $ ParseChunksStream s buf pst--    -- buffered processing loop-    stepOuter _ (ParseChunksBuf (x:xs) s backBuf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ D.Skip $ ParseChunksBuf xs s [] pst1-            PR.Partial n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksBuf src s [] pst1-            PR.Continue 0 pst1 ->-                return $ D.Skip $ ParseChunksBuf xs s (x:backBuf) pst1-            PR.Continue n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksBuf src s buf1 pst1-            PR.Done 0 b ->-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)-            PR.Done n b -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src = Prelude.reverse src0 ++ xs-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit src s)-            PR.Error err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    -- This is a simplified ParseChunksBuf-    stepOuter _ (ParseChunksExtract [] buf pst) =-        return $ D.Skip $ ParseChunksStop buf pst--    stepOuter _ (ParseChunksExtract (x:xs) backBuf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ D.Skip $ ParseChunksExtract xs [] pst1-            PR.Partial n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksExtract src [] pst1-            PR.Continue 0 pst1 ->-                return $ D.Skip $ ParseChunksExtract xs (x:backBuf) pst1-            PR.Continue n pst1 -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let (src0, buf1) = splitAtArrayListRev n (x:backBuf)-                    src  = Prelude.reverse src0 ++ xs-                return $ D.Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b ->-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)-            PR.Done n b -> do-                assert (n <= sum (map Array.length (x:backBuf))) (return ())-                let src0 = takeArrayListRev n (x:backBuf)-                    src = Prelude.reverse src0 ++ xs-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next---    -- This is a simplified ParseChunksExtract-    stepOuter _ (ParseChunksStop backBuf pst) = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "runArrayFoldManyD: Partial in extract"-            PR.Continue 0 pst1 ->-                return $ D.Skip $ ParseChunksStop backBuf pst1-            PR.Continue n pst1 -> do-                assert (n <= sum (map Array.length backBuf)) (return ())-                let (src0, buf1) = splitAtArrayListRev n backBuf-                    src  = Prelude.reverse src0-                return $ D.Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b ->-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitLeftOver [])-            PR.Done n b -> do-                assert (n <= sum (map Array.length backBuf)) (return ())-                let src0 = takeArrayListRev n backBuf-                    src = Prelude.reverse src0-                return-                    $ D.Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err -> do-                let next = ParseChunksInitLeftOver []-                return-                    $ D.Skip-                    $ ParseChunksYield (Left (ParseError err)) next--    stepOuter _ (ParseChunksYield a next) = return $ D.Yield a next---- | Apply an 'ChunkFold' repeatedly on an array stream and emit the--- fold outputs in the output stream.------ See "Streamly.Data.Stream.foldMany" for more details.------ /Pre-release/-{-# INLINE runArrayFoldMany #-}-runArrayFoldMany-    :: (Monad m, Unbox a)-    => ChunkFold m a b-    -> StreamK m (Array a)-    -> StreamK m (Either ParseError b)-runArrayFoldMany p m = fromStream $ runArrayFoldManyD p (toStream m)
− src/Streamly/Internal/Data/Stream/Common.hs 
@@ -1,105 +0,0 @@-{-# OPTIONS_GHC -Wno-orphans #-}---- |--- Module      : Streamly.Internal.Data.Stream.Common--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Low level functions using StreamK as the intermediate stream type. These--- functions are used in other stream modules to implement their instances.----module Streamly.Internal.Data.Stream.Common-    (-    -- * Conversion operations-      fromList-    , toList--    -- * Fold operations-    , foldr-    , foldl'-    , fold--    -- * Zip style operations-    , eqBy-    , cmpBy-    )-where--#include "inline.hs"--import Streamly.Internal.Data.Fold.Type (Fold (..))--import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D--import Prelude hiding (foldr, repeat)----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- |--- @--- fromList = 'Prelude.foldr' 'K.cons' 'K.nil'--- @------ Construct a stream from a list of pure values. This is more efficient than--- 'K.fromFoldable' for serial streams.----{-# INLINE_EARLY fromList #-}-fromList :: Monad m => [a] -> K.StreamK m a-fromList = D.toStreamK . D.fromList-{-# RULES "fromList fallback to StreamK" [1]-    forall a. D.toStreamK (D.fromList a) = K.fromFoldable a #-}---- | Convert a stream into a list in the underlying monad.----{-# INLINE toList #-}-toList :: Monad m => K.StreamK m a -> m [a]-toList m = D.toList $ D.fromStreamK m----------------------------------------------------------------------------------- Folds---------------------------------------------------------------------------------{-# INLINE foldrM #-}-foldrM :: Monad m => (a -> m b -> m b) -> m b -> K.StreamK m a -> m b-foldrM step acc m = D.foldrM step acc $ D.fromStreamK m--{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> K.StreamK m a -> m b-foldr f z = foldrM (\a b -> f a <$> b) (return z)---- | Strict left associative fold.----{-# INLINE foldl' #-}-foldl' ::-    Monad m => (b -> a -> b) -> b -> K.StreamK m a -> m b-foldl' step begin m = D.foldl' step begin $ D.fromStreamK m---{-# INLINE fold #-}-fold :: Monad m => Fold m a b -> K.StreamK m a -> m b-fold fld m = D.fold fld $ D.fromStreamK m----------------------------------------------------------------------------------- Comparison----------------------------------------------------------------------------------- | Compare two streams for equality----{-# INLINE eqBy #-}-eqBy :: Monad m =>-    (a -> b -> Bool) -> K.StreamK m a -> K.StreamK m b -> m Bool-eqBy f m1 m2 = D.eqBy f (D.fromStreamK m1) (D.fromStreamK m2)---- | Compare two streams----{-# INLINE cmpBy #-}-cmpBy-    :: Monad m-    => (a -> b -> Ordering) -> K.StreamK m a -> K.StreamK m b -> m Ordering-cmpBy f m1 m2 = D.cmpBy f (D.fromStreamK m1) (D.fromStreamK m2)
+ src/Streamly/Internal/Data/Stream/Container.hs view
@@ -0,0 +1,308 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Container+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Stream operations that require transformers or containers like Set or Map.++module Streamly.Internal.Data.Stream.Container+    (+    -- * Deduplication+      ordNub++    -- * Joins+    , leftJoin+    , outerJoin++    -- * Ord Joins+    , innerOrdJoin+    , leftOrdJoin+    , outerOrdJoin+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.State.Strict (get, put)+import Data.Function ((&))+import Data.Maybe (isJust)+import Streamly.Internal.Data.Stream.Step (Step(..))+import Streamly.Internal.Data.Stream.Type (Stream(..), Nested(..))++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Array.Generic as Array+import qualified Streamly.Internal.Data.MutArray.Type as MA+import qualified Streamly.Internal.Data.Stream.Type as Stream+import qualified Streamly.Internal.Data.Stream.Generate as Stream+import qualified Streamly.Internal.Data.Stream.Transform as Stream+import qualified Streamly.Internal.Data.Stream.Transformer as Stream++#include "DocTestDataStream.hs"++-- | @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++    step gst (set, st) = do+        r <- step1 gst st+        return+            $ case r of+                Yield x s ->+                    if Set.member x set+                    then Skip (set, s)+                    else Yield x (Set.insert x set, s)+                Skip s -> Skip (set, s)+                Stop -> Stop++-- XXX Generate error if a duplicate insertion is attempted?+toMap ::  (Monad m, Ord k) => Stream m (k, v) -> m (Map.Map k v)+toMap =+    let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty+     in Stream.fold f++-- If the second stream is too big it can be partitioned based on hashes and+-- then we can process one parition at a time.+--+-- XXX An IntMap may be faster when the keys are Int.+-- XXX Use hashmap instead of map?++-- | 'innerJoin' specialized to 'Ord' types for better performance.+--+-- If the input streams have duplicate keys, the behavior is undefined.+--+-- For space efficiency use the smaller stream as the second stream.+--+-- Space: O(n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE innerOrdJoin #-}+innerOrdJoin :: (Monad m, Ord k) =>+    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)+innerOrdJoin s1 s2 =+    Stream.concatEffect $ do+        km <- toMap s2+        pure $ Stream.mapMaybe (joinAB km) s1++    where++    joinAB kvm (k, a) =+        case k `Map.lookup` kvm of+            Just b -> Just (k, a, b)+            Nothing -> Nothing++-- XXX We can do this concurrently.+-- XXX 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).++-- | 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)@.+--+-- 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.+--+-- 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 leftJoin #-}+leftJoin :: Monad m =>+    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+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?+    Nested (Stream.fromEffect $ put False)+    let final = Stream.concatEffect $ do+            r <- get+            if r+            then pure Stream.nil+            else pure (Stream.fromPure Nothing)+    b <- Nested (fmap Just (Stream.liftInner s2) `Stream.append` final)+    case b of+        Just b1 ->+            if a `eq` b1+            then do+                Nested (Stream.fromEffect $ put True)+                return (a, Just b1)+            else Nested Stream.nil+        Nothing -> return (a, Nothing)++-- | 'leftJoin' specialized to 'Ord' types for better performance.+--+-- Space: O(n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE leftOrdJoin #-}+leftOrdJoin :: (Ord k, Monad m) =>+    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)+leftOrdJoin s1 s2 =+    Stream.concatEffect $ do+        km <- toMap s2+        return $ fmap (joinAB km) s1++            where++            joinAB km (k, a) =+                case k `Map.lookup` km of+                    Just b -> (k, a, Just b)+                    Nothing -> (k, a, Nothing)++-- XXX We can do this concurrently.+-- XXX Check performance of StreamD vs StreamK cross operation.++-- | 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)+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE outerJoin #-}+outerJoin :: MonadIO m =>+       (a -> b -> Bool)+    -> Stream m a+    -> Stream m b+    -> Stream m (Maybe a, Maybe b)+outerJoin eq s1 s2 =+    Stream.concatEffect $ do+        inputArr <- Array.fromStream s2+        let len = Array.length inputArr+        foundArr <-+            Stream.fold+            (MA.createOf len)+            (Stream.fromList (Prelude.replicate len False))+        return $ go inputArr foundArr `Stream.append` leftOver inputArr foundArr++    where++    leftOver inputArr foundArr =+            let stream1 = Array.read inputArr+                stream2 = Stream.unfold MA.reader foundArr+            in Stream.filter+                    isJust+                    ( Stream.zipWith (\x y ->+                        if y+                        then Nothing+                        else Just (Nothing, Just x)+                        ) stream1 stream2+                    ) & Stream.catMaybes++    evalState = Stream.evalStateT (return False) . unNested++    go inputArr foundArr = evalState $ 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?+        Nested (Stream.fromEffect $ put False)+        let final = Stream.concatEffect $ do+                r <- get+                if r+                then pure Stream.nil+                else pure (Stream.fromPure Nothing)+        (i, b) <-+            let stream = Array.read inputArr+             in Nested+                (Stream.indexed $ fmap Just (Stream.liftInner stream) `Stream.append` final)++        case b of+            Just b1 ->+                if a `eq` b1+                then do+                    Nested (Stream.fromEffect $ put True)+                    MA.putIndex i foundArr True+                    return (Just a, Just b1)+                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).++-- | 'outerJoin' specialized to 'Ord' types for better performance.+--+-- Space: O(m + n)+--+-- Time: O(m + n)+--+-- /Pre-release/+{-# INLINE outerOrdJoin #-}+outerOrdJoin ::+    (Ord k, MonadIO m) =>+    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)+outerOrdJoin s1 s2 =+    Stream.concatEffect $ do+        km1 <- kvFold s1+        km2 <- kvFold s2++        -- XXX Not sure if toList/fromList would fuse optimally. We may have to+        -- create a fused Map.toStream function.+        let res1 = fmap (joinAB km2)+                        $ Stream.fromList $ Map.toList km1+                    where+                    joinAB km (k, a) =+                        case k `Map.lookup` km of+                            Just b -> (k, Just a, Just b)+                            Nothing -> (k, Just a, Nothing)++        -- XXX We can take advantage of the lookups in the first pass above to+        -- reduce the number of lookups in this pass. If we keep mutable cells+        -- in the second Map, we can flag it in the first pass and not do any+        -- lookup in the second pass if it is flagged.+        let res2 = Stream.mapMaybe (joinAB km1)+                        $ Stream.fromList $ Map.toList km2+                    where+                    joinAB km (k, b) =+                        case k `Map.lookup` km of+                            Just _ -> Nothing+                            Nothing -> Just (k, Nothing, Just b)++        return $ Stream.append res1 res2++        where++        -- XXX Generate error if a duplicate insertion is attempted?+        kvFold =+            let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty+             in Stream.fold f
− src/Streamly/Internal/Data/Stream/Cross.hs 
@@ -1,143 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.Cross--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Cross-    (-      CrossStream (..)-    )-where--import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Applicative (liftA2)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity(..))-import GHC.Exts (IsList(..), IsString(..))-import Streamly.Internal.Data.Stream.Type (Stream)--import qualified Streamly.Internal.Data.Stream.Type as Stream-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---- $setup--- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream----------------------------------------------------------------------------------- Stream with a cross product style monad instance----------------------------------------------------------------------------------- | A newtype wrapper for the 'Stream' type with a cross product style monad--- instance.------ Semigroup instance appends two streams.------ A 'Monad' bind behaves like a @for@ loop:------ >>> :{--- Stream.fold Fold.toList $ unCrossStream $ do---      x <- CrossStream (Stream.fromList [1,2]) -- foreach x in stream---      return x--- :}--- [1,2]------ Nested monad binds behave like nested @for@ loops:------ >>> :{--- Stream.fold Fold.toList $ unCrossStream $ do---     x <- CrossStream (Stream.fromList [1,2]) -- foreach x in stream---     y <- CrossStream (Stream.fromList [3,4]) -- foreach y in stream---     return (x, y)--- :}--- [(1,3),(1,4),(2,3),(2,4)]----newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a}-        deriving (Functor, Semigroup, Monoid, Foldable)---- Pure (Identity monad) stream instances-deriving instance Traversable (CrossStream Identity)-deriving instance IsList (CrossStream Identity a)-deriving instance (a ~ Char) => IsString (CrossStream Identity a)-deriving instance Eq a => Eq (CrossStream Identity a)-deriving instance Ord a => Ord (CrossStream Identity a)-deriving instance Show a => Show (CrossStream Identity a)-deriving instance Read a => Read (CrossStream Identity a)----------------------------------------------------------------------------------- Applicative----------------------------------------------------------------------------------- Note: we need to define all the typeclass operations because we want to--- INLINE them.-instance Monad m => Applicative (CrossStream m) where-    {-# INLINE pure #-}-    pure x = CrossStream (Stream.fromPure x)--    {-# INLINE (<*>) #-}-    (CrossStream s1) <*> (CrossStream s2) =-        CrossStream (Stream.crossApply s1 s2)-    -- (<*>) = K.crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (CrossStream s1) *> (CrossStream s2) =-        CrossStream (Stream.crossApplySnd s1 s2)-    -- (*>)  = K.crossApplySnd--    {-# INLINE (<*) #-}-    (CrossStream s1) <* (CrossStream s2) =-        CrossStream (Stream.crossApplyFst s1 s2)-    -- (<*)  = K.crossApplyFst----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (CrossStream m) where-    return = pure--    -- Benchmarks better with StreamD bind and pure:-    -- toList, filterAllout, *>, *<, >> (~2x)-    ---    -- pure = Stream . D.fromStreamD . D.fromPure-    -- m >>= f = D.fromStreamD $ D.concatMap (D.toStreamD . f) (D.toStreamD m)--    -- Benchmarks better with CPS bind and pure:-    -- Prime sieve (25x)-    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)-    ---    {-# INLINE (>>=) #-}-    (>>=) (CrossStream m) f =-        CrossStream-            (Stream.fromStreamK-                $ K.bindWith-                    K.append-                    (Stream.toStreamK m)-                    (Stream.toStreamK . unCrossStream . f))--    {-# INLINE (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- Transformers---------------------------------------------------------------------------------instance (MonadIO m) => MonadIO (CrossStream m) where-    liftIO x = CrossStream (Stream.fromEffect $ liftIO x)--instance MonadTrans CrossStream where-    {-# INLINE lift #-}-    lift x = CrossStream (Stream.fromEffect x)--instance (MonadThrow m) => MonadThrow (CrossStream m) where-    throwM = lift . throwM
src/Streamly/Internal/Data/Stream/Eliminate.hs view
@@ -1,233 +1,138 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Eliminate--- Copyright   : (c) 2017 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010 -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC------ This module contains functions ending in the shape:------ @--- Stream m a -> m b--- @------ We call them stream folding functions, they reduce a stream @Stream m a@ to--- a monadic value @m b@. +-- A few functions in this module have been adapted from the vector package+-- (c) Roman Leshchinskiy.+-- module Streamly.Internal.Data.Stream.Eliminate     (-    -- * Running Examples-    -- $setup--    -- * Running a 'Fold'-    --  See "Streamly.Internal.Data.Fold".-      fold-    , foldBreak-    , foldBreak2-    , foldEither-    , foldEither2-    , foldConcat--    -- * Builders-    , foldAdd-    , foldAddLazy--    -- * Running a 'Parser'-    -- "Streamly.Internal.Data.Parser".-    , parse-    --, parseK-    , parseD-    --, parseBreak-    , parseBreakD+    -- * Running a Parser+      parse+    , parsePos+    , parseBreak+    , parseBreakPos -    -- * Stream Deconstruction-    -- | foldr and foldl do not provide the remaining stream.  'uncons' is more-    -- general, as it can be used to implement those as well.  It allows to use-    -- the stream one element at a time, and we have the remaining stream all-    -- the time.+    -- * Deconstruction     , uncons-    , init      -- * Right Folds-    , foldrM-    , foldr+    , foldr1 -    -- * Left Folds-    -- Lazy left folds are useful only for reversing the stream-    , foldlS+    -- * Specific Fold Functions+    , mapM_ -- Map and Fold+    , null+    , init+    , tail+    , last+    , elem+    , notElem+    , all+    , any+    , maximum+    , maximumBy+    , minimum+    , minimumBy+    , lookup+    , findM+    , find+    , (!!)+    , the -    -- * Multi-Stream folds-    -- Full equivalence-    , eqBy-    , cmpBy+    -- * To containers+    , toListRev -    -- finding subsequences+    -- * Multi-Stream Folds+    -- | These should probably be expressed using parsers.     , isPrefixOf     , isInfixOf     , isSuffixOf+    , isSuffixOfUnbox     , isSubsequenceOf--    -- trimming sequences     , stripPrefix-    -- , stripInfix     , stripSuffix+    , stripSuffixUnbox++    -- * Deprecated+    , parseD+    , parseBreakD     ) where  #include "inline.hs"+#include "deprecation.h"  import Control.Monad.IO.Class (MonadIO(..))-import Foreign.Storable (Storable)-import Streamly.Internal.Data.Parser (Parser (..), ParseError (..))-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Stream.Type (Stream)+import GHC.Types (SPEC(..))+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'(..))+ import qualified Streamly.Internal.Data.Array.Type as Array import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Parser.ParserK.Type as PRK-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.StreamK as K--import Streamly.Internal.Data.Stream.Bottom-import Streamly.Internal.Data.Stream.Type hiding (Stream)+import qualified Streamly.Internal.Data.Parser as PR+import qualified Streamly.Internal.Data.ParserDrivers as Drivers+import qualified Streamly.Internal.Data.Stream.Nesting as Nesting+import qualified Streamly.Internal.Data.Stream.Transform as StreamD -import Prelude hiding (foldr, init, reverse)+import Prelude hiding+       ( Foldable(..), all, any, head, last, lookup, mapM, mapM_+       , notElem, splitAt, init, tail, (!!))+import Streamly.Internal.Data.Stream.Type hiding (splitAt) --- $setup--- >>> :m--- >>> import Streamly.Internal.Data.Stream (Stream)--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold+#include "DocTestDataStream.hs"  --------------------------------------------------------------------------------- Deconstruction+-- Elimination by Folds ------------------------------------------------------------------------------ --- | Decompose a stream into its head and tail. If the stream is empty, returns--- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is--- the head of the stream and @ma@ its tail.------ Properties:------ >>> Nothing <- Stream.uncons Stream.nil--- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil)------ This can be used to consume the stream in an imperative manner one element--- at a time, as it just breaks down the stream into individual elements and we--- can loop over them as we deem fit. For example, this can be used to convert--- a streamly stream into other stream types.------ All the folds in this module can be expressed in terms of 'uncons', however,--- this is generally less efficient than specific folds because it takes apart--- the stream one element at a time, therefore, does not take adavantage of--- stream fusion.------ 'foldBreak' is a more general way of consuming a stream piecemeal.------ >>> :{--- uncons xs = do---     r <- Stream.foldBreak Fold.one xs---     return $ case r of---         (Nothing, _) -> Nothing---         (Just h, t) -> Just (h, t)--- :}------ /CPS/----{-# INLINE uncons #-}-uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons m = fmap (fmap (fmap fromStreamK)) $ K.uncons (toStreamK m)---- | Extract all but the last element of the stream, if any.------ Note: This will end up buffering the entire stream.------ /Pre-release/-{-# INLINE init #-}-init :: Monad m => Stream m a -> m (Maybe (Stream m a))-init m = fmap (fmap fromStreamK) $ K.init $ toStreamK m- ------------------------------------------------------------------------------ -- Right Folds ------------------------------------------------------------------------------ --- | Right associative/lazy pull fold. @foldrM build final stream@ constructs--- an output structure using the step function @build@. @build@ is invoked with--- the next input element and the remaining (lazy) tail of the output--- structure. It builds a lazy output expression using the two. When the "tail--- structure" in the output expression is evaluated it calls @build@ again thus--- lazily consuming the input @stream@ until either the output expression built--- by @build@ is free of the "tail" or the input is exhausted in which case--- @final@ is used as the terminating case for the output structure. For more--- details see the description in the previous section.------ Example, determine if any element is 'odd' in a stream:------ >>> s = Stream.fromList (2:4:5:undefined)--- >>> step x xs = if odd x then return True else xs--- >>> Stream.foldrM step (return False) s--- True----{-# INLINE foldrM #-}-foldrM ::  Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-foldrM step acc m = D.foldrM step acc $ toStreamD m---- | Right fold, lazy for lazy monads and pure streams, and strict for strict--- monads.------ Please avoid using this routine in strict monads like IO unless you need a--- strict right fold. This is provided only for use in lazy monads (e.g.--- Identity) or pure streams. Note that with this signature it is not possible--- to implement a lazy foldr when the monad @m@ is strict. In that case it--- would be strict in its accumulator and therefore would necessarily consume--- all its input.------ >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z)----{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr f z = foldrM (\a b -> f a <$> b) (return z)+{-# INLINE_NORMAL foldr1 #-}+foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)+foldr1 f m = do+     r <- uncons m+     case r of+         Nothing   -> return Nothing+         Just (h, t) -> fmap Just (foldr f h t)  --------------------------------------------------------------------------------- Left Folds+-- Parsers ------------------------------------------------------------------------------ --- | Lazy left fold to a stream.-{-# INLINE foldlS #-}-foldlS ::-    (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b-foldlS f z =-    fromStreamK-        . K.foldlS-            (\xs x -> toStreamK $ f (fromStreamK xs) x)-            (toStreamK z)-        . toStreamK----------------------------------------------------------------------------------- Running a Parser-------------------------------------------------------------------------------+-- 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. --- | Parse a stream using the supplied ParserD 'PRD.Parser'.------ /Internal/+-- | Parse a stream using the supplied 'Parser'. ---{-# INLINE_NORMAL parseD #-}-parseD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b)-parseD p = D.parseD p . toStreamD+{-# INLINE parseBreak #-}+parseBreak, parseBreakD :: Monad m =>+    PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+parseBreak = Drivers.parseBreak --- XXX Drive directly as parserK rather than converting to parserD first.+RENAME(parseBreakD,parseBreak) --- | Parse a stream using the supplied ParserK 'PRK.Parser'.+-- | Like 'parseBreak' but includes stream position information in the error+-- messages. ----- /Internal/---{-# INLINE parseK #-}---parseK :: Monad m => PRK.Parser a m b -> Stream m a -> m (Either ParseError b)---parseK = parse+{-# 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'. --@@ -242,25 +147,330 @@ -- Note: @parse p@ is not the same as  @head . parseMany p@ on an empty stream. -- {-# INLINE [3] parse #-}-parse :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b)-parse = parseD+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 -{-# INLINE_NORMAL parseBreakD #-}-parseBreakD :: Monad m =>-    PRD.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)-parseBreakD parser strm = do-    (b, strmD) <- D.parseBreakD parser (toStreamD strm)-    return $! (b, fromStreamD strmD)+RENAME(parseD,parse) --- | Parse a stream using the supplied 'Parser'.+-- | Like 'parse' but includes stream position information in the error+-- messages. ----- /CPS/+-- >>> Stream.parsePos (Parser.takeEQ 2 Fold.drain) (Stream.fromList [1])+-- Left (ParseErrorPos 1 "takeEQ: Expecting exactly 2 elements, input terminated on 1") -----{-# INLINE parseBreak #-}---parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)---parseBreak p strm = D.parseBreak p strm+{-# INLINE [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+------------------------------------------------------------------------------++-- benchmark after dropping 1 item from stream or using unfolds+{-# INLINE_NORMAL null #-}+null :: Monad m => Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+null = fold Fold.null+#else+null = foldrM (\_ _ -> return False) (return True)+#endif++{-# INLINE_NORMAL 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)++            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+        r <- step defState st+        case r of+            Yield _ s -> return (Just $ Stream step s)+            Skip  s   -> go SPEC s+            Stop      -> return Nothing+-}++-- XXX will it fuse? need custom impl?+{-# INLINE_NORMAL last #-}+last :: Monad m => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+last = fold Fold.last+#else+last = foldl' (\_ y -> Just y) Nothing+#endif++-- XXX Use the foldrM based impl instead+{-# INLINE_NORMAL elem #-}+elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+elem e = fold (Fold.elem e)+#else+-- elem e m = foldrM (\x xs -> if x == e then return True else xs) (return False) m+elem e (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s+              | x == e -> return True+              | otherwise -> go SPEC s+            Skip s -> go SPEC s+            Stop   -> return False+#endif++{-# INLINE_NORMAL notElem #-}+notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool+notElem e s = fmap not (e `elem` s)++{-# INLINE_NORMAL all #-}+all :: Monad m => (a -> Bool) -> Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+all p = fold (Fold.all p)+#else+-- all p m = foldrM (\x xs -> if p x then xs else return False) (return True) m+all p (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s+              | p x -> go SPEC s+              | otherwise -> return False+            Skip s -> go SPEC s+            Stop   -> return True+#endif++{-# INLINE_NORMAL any #-}+any :: Monad m => (a -> Bool) -> Stream m a -> m Bool+#ifdef USE_FOLDS_EVERYWHERE+any p = fold (Fold.any p)+#else+-- any p m = foldrM (\x xs -> if p x then return True else xs) (return False) m+any p (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s+              | p x -> return True+              | otherwise -> go SPEC s+            Skip s -> go SPEC s+            Stop   -> return False+#endif++{-# INLINE_NORMAL maximum #-}+maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+maximum = fold Fold.maximum+#else+maximum (Stream step state) = go SPEC Nothing' state+  where+    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s+              | acc <= x  -> go SPEC (Just' x) s+              | otherwise -> go SPEC (Just' acc) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+maximumBy cmp = fold (Fold.maximumBy cmp)+#else+maximumBy cmp (Stream step state) = go SPEC Nothing' state+  where+    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s -> case cmp acc x of+                GT -> go SPEC (Just' acc) s+                _  -> go SPEC (Just' x) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL minimum #-}+minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+minimum = fold Fold.minimum+#else+minimum (Stream step state) = go SPEC Nothing' state++    where++    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s+              | acc <= x  -> go SPEC (Just' acc) s+              | otherwise -> go SPEC (Just' x) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL minimumBy #-}+minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+minimumBy cmp = fold (Fold.minimumBy cmp)+#else+minimumBy cmp (Stream step state) = go SPEC Nothing' state++    where++    go !_ Nothing' st = do+        r <- step defState st+        case r of+            Yield x s -> go SPEC (Just' x) s+            Skip  s   -> go SPEC Nothing' s+            Stop      -> return Nothing+    go !_ (Just' acc) st = do+        r <- step defState st+        case r of+            Yield x s -> case cmp acc x of+                GT -> go SPEC (Just' x) s+                _  -> go SPEC (Just' acc) s+            Skip s -> go SPEC (Just' acc) s+            Stop   -> return (Just acc)+#endif++{-# INLINE_NORMAL (!!) #-}+(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+stream !! i = fold (Fold.index i) stream+#else+(Stream step state) !! i = go SPEC i state++    where++    go !_ !n st = do+        r <- step defState st+        case r of+            Yield x s | n < 0 -> return Nothing+                      | n == 0 -> return $ Just x+                      | otherwise -> go SPEC (n - 1) s+            Skip s -> go SPEC n s+            Stop   -> return Nothing+#endif++{-# INLINE_NORMAL lookup #-}+lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)+#ifdef USE_FOLDS_EVERYWHERE+lookup e = fold (Fold.lookup e)+#else+lookup e = foldrM (\(a, b) xs -> if e == a then return (Just b) else xs)+                   (return Nothing)+#endif++{-# INLINE_NORMAL findM #-}+findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+findM p = fold (Fold.findM p)+#else+findM p = foldrM (\x xs -> p x >>= \r -> if r then return (Just x) else xs)+                   (return Nothing)+#endif++{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)+find p = findM (return . p)++{-# INLINE toListRev #-}+toListRev :: Monad m => Stream m a -> m [a]+#ifdef USE_FOLDS_EVERYWHERE+toListRev = fold Fold.toListRev+#else+toListRev = foldl' (flip (:)) []+#endif++------------------------------------------------------------------------------+-- Transformation comprehensions+------------------------------------------------------------------------------++{-# INLINE_NORMAL the #-}+the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)+#ifdef USE_FOLDS_EVERYWHERE+the = fold Fold.the+#else+the (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s -> go' SPEC x s+            Skip s    -> go SPEC s+            Stop      -> return Nothing+    go' !_ n st = do+        r <- step defState st+        case r of+            Yield x s | x == n -> go' SPEC n s+                      | otherwise -> return Nothing+            Skip s -> go' SPEC n s+            Stop   -> return (Just n)+#endif++------------------------------------------------------------------------------+-- Map and Fold+------------------------------------------------------------------------------++-- | Execute a monadic action for each element of the 'Stream'+{-# INLINE_NORMAL mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()+#ifdef USE_FOLDS_EVERYWHERE+mapM_ f = fold (Fold.drainBy f)+#else+mapM_ m = drain . mapM m+#endif++------------------------------------------------------------------------------ -- Multi-stream folds ------------------------------------------------------------------------------ @@ -270,10 +480,91 @@ -- >>> Stream.isPrefixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char) -- True ---{-# INLINE isPrefixOf #-}+{-# INLINE_NORMAL isPrefixOf #-} isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)+isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb +    where++    go !_ Nothing' sa sb = do+        r <- stepa defState sa+        case r of+            Yield x sa' -> go SPEC (Just' x) sa' sb+            Skip sa'    -> go SPEC Nothing' sa' sb+            Stop        -> return True++    go !_ (Just' x) sa sb = do+        r <- stepb defState sb+        case r of+            Yield y sb' ->+                if x == y+                    then go SPEC Nothing' sa sb'+                    else return False+            Skip sb' -> go SPEC (Just' x) sa sb'+            Stop     -> return False++-- | Returns 'True' if all the elements of the first stream occur, in order, in+-- the second stream. The elements do not have to occur consecutively. A stream+-- is a subsequence of itself.+--+-- >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char)+-- True+--+{-# INLINE_NORMAL isSubsequenceOf #-}+isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb++    where++    go !_ Nothing' sa sb = do+        r <- stepa defState sa+        case r of+            Yield x sa' -> go SPEC (Just' x) sa' sb+            Skip sa' -> go SPEC Nothing' sa' sb+            Stop -> return True++    go !_ (Just' x) sa sb = do+        r <- stepb defState sb+        case r of+            Yield y sb' ->+                if x == y+                    then go SPEC Nothing' sa sb'+                    else go SPEC (Just' x) sa sb'+            Skip sb' -> go SPEC (Just' x) sa sb'+            Stop -> return False++-- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@+-- stream if it is a prefix of input. Returns 'Nothing' if the input does not+-- start with the given prefix, stripped input otherwise. Returns @Just nil@+-- when the prefix is the same as the input stream.+--+-- Space: @O(1)@+--+{-# INLINE_NORMAL stripPrefix #-}+stripPrefix+    :: (Monad m, Eq a)+    => Stream m a -> Stream m a -> m (Maybe (Stream m a))+stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb++    where++    go !_ Nothing' sa sb = do+        r <- stepa defState sa+        case r of+            Yield x sa' -> go SPEC (Just' x) sa' sb+            Skip sa'    -> go SPEC Nothing' sa' sb+            Stop        -> return $ Just (Stream stepb sb)++    go !_ (Just' x) sa sb = do+        r <- stepb defState sb+        case r of+            Yield y sb' ->+                if x == y+                    then go SPEC Nothing' sa sb'+                    else return Nothing+            Skip sb' -> go SPEC (Just' x) sa sb'+            Stop     -> return Nothing+ -- | Returns 'True' if the first stream is an infix of the second. A stream is -- considered an infix of itself. --@@ -288,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 <- D.null $ D.drop 1 $ D.splitOnSeq arr Fold.drain $ toStreamD 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@@ -326,36 +617,15 @@ -- {-# INLINE isSuffixOf #-} isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSuffixOf suffix stream = reverse suffix `isPrefixOf` reverse stream---- | Returns 'True' if all the elements of the first stream occur, in order, in--- the second stream. The elements do not have to occur consecutively. A stream--- is a subsequence of itself.------ >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char)--- True----{-# INLINE isSubsequenceOf #-}-isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSubsequenceOf m1 m2 = D.isSubsequenceOf (toStreamD m1) (toStreamD m2)---- Note: If we want to return a Maybe value to know whether the--- suffix/infix was present or not along with the stripped stream then--- we need to buffer the whole input stream.+isSuffixOf suffix stream =+    StreamD.reverse suffix `isPrefixOf` StreamD.reverse stream --- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@--- stream if it is a prefix of input. Returns 'Nothing' if the input does not--- start with the given prefix, stripped input otherwise. Returns @Just nil@--- when the prefix is the same as the input stream.------ Space: @O(1)@----{-# INLINE stripPrefix #-}-stripPrefix-    :: (Monad m, Eq a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripPrefix m1 m2 = fmap fromStreamD <$>-    D.stripPrefix (toStreamD m1) (toStreamD m2)+-- | Much faster than 'isSuffixOf'.+{-# INLINE isSuffixOfUnbox #-}+isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) =>+    Stream m a -> Stream m a -> m Bool+isSuffixOfUnbox suffix stream =+    StreamD.reverseUnbox suffix `isPrefixOf` StreamD.reverseUnbox stream  -- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does -- not end with the given suffix. Returns @Just nil@ when the suffix is the@@ -365,8 +635,6 @@ -- stripSuffix on that especially if the elements have a Storable or Prim -- instance. ----- See also "Streamly.Internal.Data.Stream.Reduce.dropSuffix".--- -- Space: @O(n)@, buffers the entire input stream as well as the suffix -- -- /Pre-release/@@ -374,4 +642,15 @@ stripSuffix     :: (Monad m, Eq a)     => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripSuffix m1 m2 = fmap reverse <$> stripPrefix (reverse m1) (reverse m2)+stripSuffix m1 m2 =+    fmap StreamD.reverse+        <$> stripPrefix (StreamD.reverse m1) (StreamD.reverse m2)++-- | Much faster than 'stripSuffix'.+{-# INLINE stripSuffixUnbox #-}+stripSuffixUnbox+    :: (MonadIO m, Eq a, Unbox a)+    => Stream m a -> Stream m a -> m (Maybe (Stream m a))+stripSuffixUnbox m1 m2 =+    fmap StreamD.reverseUnbox+        <$> stripPrefix (StreamD.reverseUnbox m1) (StreamD.reverseUnbox m2)
− src/Streamly/Internal/Data/Stream/Enumerate.hs 
@@ -1,560 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Enumerate--- Copyright   : (c) 2018 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ The functions defined in this module should be rarely needed for direct use,--- try to use the operations from the 'Enumerable' type class--- instances instead.------ This module provides an 'Enumerable' type class to enumerate 'Enum' types--- into a stream. The operations in this type class correspond to similar--- perations in the 'Enum' type class, the only difference is that they produce--- a stream instead of a list. These operations cannot be defined generically--- based on the 'Enum' type class. We provide instances for commonly used--- types. If instances for other types are needed convenience functions defined--- in this module can be used to define them. Alternatively, these functions--- can be used directly.---- XXX The Unfold.Enumeration module is more modular, check the differences and--- reconcile the two.--module Streamly.Internal.Data.Stream.Enumerate-    (-      Enumerable (..)--    -- ** Enumerating 'Bounded' 'Enum' Types-    , enumerate-    , enumerateTo-    , enumerateFromBounded--    -- ** Enumerating 'Enum' Types not larger than 'Int'-    , enumerateFromToSmall-    , enumerateFromThenToSmall-    , enumerateFromThenSmallBounded--    -- ** Enumerating 'Bounded' 'Integral' Types-    , enumerateFromIntegral-    , enumerateFromThenIntegral--    -- ** Enumerating 'Integral' Types-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    -- ** Enumerating unbounded 'Integral' Types-    , enumerateFromStepIntegral--    -- ** Enumerating 'Fractional' Types-    , enumerateFromFractional-    , enumerateFromToFractional-    , enumerateFromThenFractional-    , enumerateFromThenToFractional-    )-where--import Data.Fixed-import Data.Int-import Data.Ratio-import Data.Word-import Numeric.Natural-import Data.Functor.Identity (Identity(..))--import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD)--import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D---- $setup--- >>> import Streamly.Data.Fold as Fold--- >>> import Streamly.Internal.Data.Stream as Stream--- >>> import Streamly.Internal.Data.Stream.Enumerate as Stream------------------------------------------------------------------------------------ Enumeration of Integral types-------------------------------------------------------------------------------------- | @enumerateFromStepIntegral from step@ generates an infinite stream whose--- first element is @from@ and the successive elements are in increments of--- @step@.------ CAUTION: This function is not safe for finite integral types. It does not--- check for overflow, underflow or bounds.------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)--- [0,-2,-4]------ @----{-# INLINE enumerateFromStepIntegral #-}-enumerateFromStepIntegral-    :: (Monad m, Integral a)-    => a -> a -> Stream m a-enumerateFromStepIntegral from stride =-    fromStreamD $ D.enumerateFromStepIntegral from stride---- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a--- stream whose first element is @from@ and the successive elements are in--- increments of @1@. The stream is bounded by the size of the 'Integral' type.------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)--- [0,1,2,3]------ @----{-# INLINE enumerateFromIntegral #-}-enumerateFromIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> Stream m a-enumerateFromIntegral from = fromStreamD $ D.enumerateFromIntegral from---- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from--- then@ generates a stream whose first element is @from@, the second element--- is @then@ and the successive elements are in increments of @then - from@.--- The stream is bounded by the size of the 'Integral' type.------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)--- [0,-2,-4,-6]------ @----{-# INLINE enumerateFromThenIntegral #-}-enumerateFromThenIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenIntegral from next =-    fromStreamD $ D.enumerateFromThenIntegral from next---- | Enumerate an 'Integral' type up to a given limit.--- @enumerateFromToIntegral from to@ generates a finite stream whose first--- element is @from@ and successive elements are in increments of @1@ up to--- @to@.------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromToIntegral 0 4--- [0,1,2,3,4]------ @----{-# INLINE enumerateFromToIntegral #-}-enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a-enumerateFromToIntegral from to =-    fromStreamD $ D.enumerateFromToIntegral from to---- | Enumerate an 'Integral' type in steps up to a given limit.--- @enumerateFromThenToIntegral from then to@ generates a finite stream whose--- first element is @from@, the second element is @then@ and the successive--- elements are in increments of @then - from@ up to @to@.------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 2 6--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)--- [0,-2,-4,-6]------ @----{-# INLINE enumerateFromThenToIntegral #-}-enumerateFromThenToIntegral-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegral from next to =-    fromStreamD $ D.enumerateFromThenToIntegral from next to------------------------------------------------------------------------------------ Enumeration of Fractional types-------------------------------------------------------------------------------------- Even though the underlying implementation of enumerateFromFractional and--- enumerateFromThenFractional works for any 'Num' we have restricted these to--- 'Fractional' because these do not perform any bounds check, in contrast to--- integral versions and are therefore not equivalent substitutes for those.------ | Numerically stable enumeration from a 'Fractional' number in steps of size--- @1@. @enumerateFromFractional from@ generates a stream whose first element--- is @from@ and the successive elements are in increments of @1@.  No overflow--- or underflow checks are performed.------ This is the equivalent to 'enumFrom' for 'Fractional' types. For example:------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1--- [1.1,2.1,3.1,4.1]------ @-------{-# INLINE enumerateFromFractional #-}-enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a-enumerateFromFractional from = fromStreamD $ D.enumerateFromNum from---- | Numerically stable enumeration from a 'Fractional' number in steps.--- @enumerateFromThenFractional from then@ generates a stream whose first--- element is @from@, the second element is @then@ and the successive elements--- are in increments of @then - from@.  No overflow or underflow checks are--- performed.------ This is the equivalent of 'enumFromThen' for 'Fractional' types. For--- example:------ @--- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)--- [1.1,-2.1,-5.300000000000001,-8.500000000000002]------ @----{-# INLINE enumerateFromThenFractional #-}-enumerateFromThenFractional-    :: (Monad m, Fractional a)-    => a -> a -> Stream m a-enumerateFromThenFractional from next = fromStreamD $ D.enumerateFromThenNum from next---- | Numerically stable enumeration from a 'Fractional' number to a given--- limit.  @enumerateFromToFractional from to@ generates a finite stream whose--- first element is @from@ and successive elements are in increments of @1@ up--- to @to@.------ This is the equivalent of 'enumFromTo' for 'Fractional' types. For--- example:------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4.6--- [1.1,2.1,3.1,4.1,5.1]------ @------ Notice that the last element is equal to the specified @to@ value after--- rounding to the nearest integer.----{-# INLINE enumerateFromToFractional #-}-enumerateFromToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> Stream m a-enumerateFromToFractional from to =-    fromStreamD $ D.enumerateFromToFractional from to---- | Numerically stable enumeration from a 'Fractional' number in steps up to a--- given limit.  @enumerateFromThenToFractional from then to@ generates a--- finite stream whose first element is @from@, the second element is @then@--- and the successive elements are in increments of @then - from@ up to @to@.------ This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For--- example:------ @--- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 2 6--- [0.1,2.0,3.9,5.799999999999999]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)--- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]------ @-------{-# INLINE enumerateFromThenToFractional #-}-enumerateFromThenToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> a -> Stream m a-enumerateFromThenToFractional from next to =-    fromStreamD $ D.enumerateFromThenToFractional from next to------------------------------------------------------------------------------------ Enumeration of Enum types not larger than Int-------------------------------------------------------------------------------------- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromToSmall #-}-enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a-enumerateFromToSmall from to =-      fmap toEnum-    $ enumerateFromToIntegral (fromEnum from) (fromEnum to)---- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromThenToSmall #-}-enumerateFromThenToSmall :: (Monad m, Enum a)-    => a -> a -> a -> Stream m a-enumerateFromThenToSmall from next to =-          fmap toEnum-        $ enumerateFromThenToIntegral-            (fromEnum from) (fromEnum next) (fromEnum to)---- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.------ Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a--- type is bounded but does not have a 'Bounded' instance then we can go on--- enumerating it beyond the legal values of the type, resulting in the failure--- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'--- instance for this function to be safely used.----{-# INLINE enumerateFromThenSmallBounded #-}-enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenSmallBounded from next =-    if fromEnum next >= fromEnum from-    then enumerateFromThenTo from next maxBound-    else enumerateFromThenTo from next minBound------------------------------------------------------------------------------------ Enumerable type class-------------------------------------------------------------------------------------- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream--- enumerations like this:------ {-# RULES "fromList enumFrom" [1]---     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}------ But this does not work because enumFrom is a class method and GHC rewrites--- it quickly, so we do not get a chance to have our rule fired.---- | Types that can be enumerated as a stream. The operations in this type--- class are equivalent to those in the 'Enum' type class, except that these--- generate a stream instead of a list. Use the functions in--- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.----class Enum a => Enumerable a where-    -- | @enumerateFrom from@ generates a stream starting with the element-    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or-    -- generating an infinite stream when the type is not 'Bounded'.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)-    -- [0,1,2,3]-    ---    -- @-    ---    -- For 'Fractional' types, enumeration is numerically stable. However, no-    -- overflow or underflow checks are performed.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1-    -- [1.1,2.1,3.1,4.1]-    ---    -- @-    ---    enumerateFrom :: (Monad m) => a -> Stream m a--    -- | Generate a finite stream starting with the element @from@, enumerating-    -- the type up to the value @to@. If @to@ is smaller than @from@ then an-    -- empty stream is returned.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 0 4-    -- [0,1,2,3,4]-    ---    -- @-    ---    -- For 'Fractional' types, the last element is equal to the specified @to@-    -- value after rounding to the nearest integral value.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4-    -- [1.1,2.1,3.1,4.1]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4.6-    -- [1.1,2.1,3.1,4.1,5.1]-    ---    -- @-    ---    enumerateFromTo :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThen from then@ generates a stream whose first element-    -- is @from@, the second element is @then@ and the successive elements are-    -- in increments of @then - from@.  Enumeration can occur downwards or-    -- upwards depending on whether @then@ comes before or after @from@. For-    -- 'Bounded' types the stream ends when 'maxBound' is reached, for-    -- unbounded types it keeps enumerating infinitely.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)-    -- [0,-2,-4,-6]-    ---    -- @-    ---    enumerateFromThen :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThenTo from then to@ generates a finite stream whose-    -- first element is @from@, the second element is @then@ and the successive-    -- elements are in increments of @then - from@ up to @to@. Enumeration can-    -- occur downwards or upwards depending on whether @then@ comes before or-    -- after @from@.-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 2 6-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)-    -- [0,-2,-4,-6]-    ---    -- @-    ---    enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a---- MAYBE: Sometimes it is more convenient to know the count rather then the--- ending or starting element. For those cases we can define the folllowing--- APIs. All of these will work only for bounded types if we represent the--- count by Int.------ enumerateN--- enumerateFromN--- enumerateToN--- enumerateFromStep--- enumerateFromStepN------------------------------------------------------------------------------------ Convenient functions for bounded types-------------------------------------------------------------------------------------- |--- > enumerate = enumerateFrom minBound------ Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'----{-# INLINE enumerate #-}-enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a-enumerate = enumerateFrom minBound---- |--- > enumerateTo = enumerateFromTo minBound------ Enumerate a 'Bounded' type from its 'minBound' to specified value.----{-# INLINE enumerateTo #-}-enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a-enumerateTo = enumerateFromTo minBound---- |--- > enumerateFromBounded = enumerateFromTo from maxBound------ 'enumerateFrom' for 'Bounded' 'Enum' types.----{-# INLINE enumerateFromBounded #-}-enumerateFromBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> Stream m a-enumerateFromBounded from = enumerateFromTo from maxBound------------------------------------------------------------------------------------ Enumerable Instances-------------------------------------------------------------------------------------- For Enum types smaller than or equal to Int size.-#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \-instance Enumerable SMALL_TYPE where {                 \-    {-# INLINE enumerateFrom #-};                      \-    enumerateFrom = enumerateFromBounded;              \-    {-# INLINE enumerateFromThen #-};                  \-    enumerateFromThen = enumerateFromThenSmallBounded; \-    {-# INLINE enumerateFromTo #-};                    \-    enumerateFromTo = enumerateFromToSmall;            \-    {-# INLINE enumerateFromThenTo #-};                \-    enumerateFromThenTo = enumerateFromThenToSmall }---ENUMERABLE_BOUNDED_SMALL(())-ENUMERABLE_BOUNDED_SMALL(Bool)-ENUMERABLE_BOUNDED_SMALL(Ordering)-ENUMERABLE_BOUNDED_SMALL(Char)---- For bounded Integral Enum types, may be larger than Int.-#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \-instance Enumerable INTEGRAL_TYPE where {           \-    {-# INLINE enumerateFrom #-};                   \-    enumerateFrom = enumerateFromIntegral;          \-    {-# INLINE enumerateFromThen #-};               \-    enumerateFromThen = enumerateFromThenIntegral;  \-    {-# INLINE enumerateFromTo #-};                 \-    enumerateFromTo = enumerateFromToIntegral;      \-    {-# INLINE enumerateFromThenTo #-};             \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_BOUNDED_INTEGRAL(Int)-ENUMERABLE_BOUNDED_INTEGRAL(Int8)-ENUMERABLE_BOUNDED_INTEGRAL(Int16)-ENUMERABLE_BOUNDED_INTEGRAL(Int32)-ENUMERABLE_BOUNDED_INTEGRAL(Int64)-ENUMERABLE_BOUNDED_INTEGRAL(Word)-ENUMERABLE_BOUNDED_INTEGRAL(Word8)-ENUMERABLE_BOUNDED_INTEGRAL(Word16)-ENUMERABLE_BOUNDED_INTEGRAL(Word32)-ENUMERABLE_BOUNDED_INTEGRAL(Word64)---- For unbounded Integral Enum types.-#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \-instance Enumerable INTEGRAL_TYPE where {                         \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom from = enumerateFromStepIntegral from 1;        \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen from next =                                 \-        enumerateFromStepIntegral from (next - from);             \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToIntegral;                    \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)-ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)--#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \-instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom = enumerateFromFractional;                      \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen = enumerateFromThenFractional;              \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToFractional;                  \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToFractional }--ENUMERABLE_FRACTIONAL(Float,)-ENUMERABLE_FRACTIONAL(Double,)-ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)-ENUMERABLE_FRACTIONAL((Ratio a),Integral a)--instance Enumerable a => Enumerable (Identity a) where-    {-# INLINE enumerateFrom #-}-    enumerateFrom (Identity from) =-        fmap Identity $ enumerateFrom from-    {-# INLINE enumerateFromThen #-}-    enumerateFromThen (Identity from) (Identity next) =-        fmap Identity $ enumerateFromThen from next-    {-# INLINE enumerateFromTo #-}-    enumerateFromTo (Identity from) (Identity to) =-        fmap Identity $ enumerateFromTo from to-    {-# INLINE enumerateFromThenTo #-}-    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =-          fmap Identity-        $ enumerateFromThenTo from next to---- TODO-{--instance Enumerable a => Enumerable (Last a)-instance Enumerable a => Enumerable (First a)-instance Enumerable a => Enumerable (Max a)-instance Enumerable a => Enumerable (Min a)-instance Enumerable a => Enumerable (Const a b)-instance Enumerable (f a) => Enumerable (Alt f a)-instance Enumerable (f a) => Enumerable (Ap f a)--}
src/Streamly/Internal/Data/Stream/Exception.hs view
@@ -1,6 +1,7 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Exception--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2020 Composewell Technologies and Contributors -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental@@ -8,46 +9,209 @@  module Streamly.Internal.Data.Stream.Exception     (+    -- * Resources       before-    , afterUnsafe     , afterIO+    , afterUnsafe+    , finallyIO+    , finallyIO'+    , finallyIO''+    , finallyUnsafe+    , gbracket_+    , gbracket     , bracketUnsafe-    , bracketIO     , bracketIO3+    , bracketIO+    , bracketIO'+    , bracketIO''++    , withAcquireIO+    , withAcquireIO'++    -- * Exceptions     , onException-    , finallyUnsafe-    , finallyIO     , ghandle     , handle     ) where -import Control.Exception (Exception)+#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Control.Exception (Exception, SomeException, mask_) import Control.Monad.Catch (MonadCatch)-import Control.Monad.IO.Class (MonadIO)-import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)+import 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 Streamly.Internal.Data.Stream.StreamD as D+import qualified Control.Monad.Catch as MC+import qualified Data.IntMap.Strict as Map --- $setup--- >>> :m--- >>> import qualified Streamly.Internal.Data.Stream as Stream+import Streamly.Internal.Data.Stream.Type ---------------------------------------------------------------------------------- Exceptions-------------------------------------------------------------------------------+#include "DocTestDataStream.hs" +data GbracketState s1 s2 v+    = GBracketInit+    | GBracketNormal s1 v+    | GBracketException s2++-- | Like 'gbracket' but with following differences:+--+-- * alloc action @m c@ runs with async exceptions enabled+-- * cleanup action @c -> m d@ won't run if the stream is garbage collected+--   after partial evaluation.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+--+{-# INLINE_NORMAL gbracket_ #-}+gbracket_+    :: Monad m+    => m c                                  -- ^ before+    -> (c -> m d)                           -- ^ after, on normal stop+    -> (c -> e -> Stream m b -> m (Stream m b)) -- ^ on exception+    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)+    -> (c -> Stream m b)                    -- ^ stream generator+    -> Stream m b+gbracket_ bef aft onExc ftry action =+    Stream step GBracketInit++    where++    {-# INLINE_LATE step #-}+    step _ GBracketInit = do+        r <- bef+        return $ Skip $ GBracketNormal (action r) r++    step gst (GBracketNormal (UnStream step1 st) v) = do+        res <- ftry $ step1 gst st+        case res of+            Right r -> case r of+                Yield x s ->+                    return $ Yield x (GBracketNormal (Stream step1 s) v)+                Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)+                Stop -> aft v >> return Stop+            -- XXX Do not handle async exceptions, just rethrow them.+            Left e -> do+                strm <- onExc v e (UnStream step1 st)+                return $ Skip (GBracketException strm)+    step gst (GBracketException (UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s -> return $ Yield x (GBracketException (Stream step1 s))+            Skip s    -> return $ Skip (GBracketException (Stream step1 s))+            Stop      -> return Stop++data GbracketIOState s1 s2 v wref+    = GBracketIOInit+    | GBracketIONormal s1 v wref+    | GBracketIOException s2++-- | Run the alloc action @m c@ with async exceptions disabled but keeping+-- blocking operations interruptible (see 'Control.Exception.mask').  Use the+-- output @c@ as input to @c -> Stream m b@ to generate an output stream. When+-- generating the stream use the supplied @try@ operation @forall s. m s -> m+-- (Either e s)@ to catch synchronous exceptions. If an exception occurs run+-- the exception handler @c -> e -> Stream m b -> m (Stream m b)@. Note that+-- 'gbracket' does not rethrow the exception, it has to be done by the+-- exception handler if desired.+--+-- The cleanup action @c -> m d@, runs whenever the stream ends normally, due+-- to a sync or async exception or if it gets garbage collected after a partial+-- lazy evaluation.  See 'bracket' for the semantics of the cleanup action.+--+-- 'gbracket' can express all other exception handling combinators.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL gbracket #-}+gbracket+    :: MonadIO m+    => IO c -- ^ before+    -> (c -> IO d1) -- ^ on normal stop+    -> (c -> e -> Stream m b -> IO (Stream m b)) -- ^ on exception+    -> (c -> IO d2) -- ^ on GC without normal stop or exception+    -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)+    -> (c -> Stream m b) -- ^ stream generator+    -> Stream m b+gbracket bef aft onExc onGC ftry action =+    Stream step GBracketIOInit++    where++    -- If the stream is never evaluated the "aft" action will never be+    -- called. For that to occur we will need the user of this API to pass a+    -- weak pointer to us.+    {-# INLINE_LATE step #-}+    step _ GBracketIOInit = do+        -- 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)+            return (r, ref)+        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+                Yield x s ->+                    return $ Yield x (GBracketIONormal (Stream step1 s) v ref)+                Skip s ->+                    return $ Skip (GBracketIONormal (Stream step1 s) v ref)+                Stop ->+                    liftIO (clearingIOFinalizer ref (aft v)) >> return Stop+            -- XXX Do not handle async exceptions, just rethrow them.+            Left e -> do+                -- Clearing of finalizer and running of exception handler must+                -- be atomic wrt async exceptions. Otherwise if we have cleared+                -- the finalizer and have not run the exception handler then we+                -- may leak the resource.+                stream <-+                    liftIO (clearingIOFinalizer ref (onExc v e (UnStream step1 st)))+                return $ Skip (GBracketIOException stream)+    step gst (GBracketIOException (UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s ->+                return $ Yield x (GBracketIOException (Stream step1 s))+            Skip s    -> return $ Skip (GBracketIOException (Stream step1 s))+            Stop      -> return Stop+ -- | Run the action @m b@ before the stream yields its first element. -- -- Same as the following but more efficient due to fusion: ----- >>> before action xs = Stream.nilM action <> xs -- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action) ---{-# INLINE before #-}+{-# INLINE_NORMAL before #-} before :: Monad m => m b -> Stream m a -> Stream m a-before action xs = fromStreamD $ D.before action $ toStreamD xs+before action (Stream step state) = Stream step' Nothing +    where++    {-# INLINE_LATE step' #-}+    step' _ Nothing = action >> return (Skip (Just state))++    step' gst (Just st) = do+        res <- step gst st+        case res of+            Yield x s -> return $ Yield x (Just s)+            Skip s    -> return $ Skip (Just s)+            Stop      -> return Stop+ -- | Like 'after', with following differences: -- -- * action @m b@ won't run if the stream is garbage collected@@ -61,10 +225,20 @@ -- -- /Pre-release/ ---{-# INLINE afterUnsafe #-}+{-# INLINE_NORMAL afterUnsafe #-} afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a-afterUnsafe action xs = fromStreamD $ D.afterUnsafe action $ toStreamD xs+afterUnsafe action (Stream step state) = Stream step' state +    where++    {-# INLINE_LATE step' #-}+    step' gst st = do+        res <- step gst st+        case res of+            Yield x s -> return $ Yield x s+            Skip s    -> return $ Skip s+            Stop      -> action >> return Stop+ -- | Run the action @IO b@ whenever the stream is evaluated to completion, or -- if it is garbage collected after a partial lazy evaluation. --@@ -73,51 +247,61 @@ -- -- /See also 'afterUnsafe'/ ---{-# INLINE afterIO #-}-afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a-afterIO action xs = fromStreamD $ D.afterIO action $ toStreamD xs+{-# INLINE_NORMAL afterIO #-}+afterIO :: MonadIO m+    => IO b -> Stream m a -> Stream m a+afterIO action (Stream step state) = Stream step' Nothing +    where++    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        ref <- liftIO $ newIOFinalizer action+        return $ Skip $ Just (state, ref)+    step' gst (Just (st, ref)) = do+        res <- step gst st+        case res of+            Yield x s -> return $ Yield x (Just (s, ref))+            Skip s    -> return $ Skip (Just (s, ref))+            Stop      -> do+                runIOFinalizer ref+                return Stop++-- XXX For high performance error checks in busy streams we may need another+-- Error constructor in step.+ -- | Run the action @m b@ if the stream evaluation is aborted due to an -- exception. The exception is not caught, simply rethrown. --+-- Observes exceptions only in the stream generation, and not in stream+-- consumers.+-- -- /Inhibits stream fusion/ ---{-# INLINE onException #-}+{-# INLINE_NORMAL onException #-} onException :: MonadCatch m => m b -> Stream m a -> Stream m a-onException action xs = fromStreamD $ D.onException action $ toStreamD xs+onException action stream =+    gbracket_+        (return ()) -- before+        return      -- after+        (\_ (e :: MC.SomeException) _ -> action >> MC.throwM e)+        (inline MC.try)+        (const stream) --- | Like 'finally' with following differences:------ * action @m b@ won't run if the stream is garbage collected---   after partial evaluation.--- * has slightly better performance than 'finallyIO'.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE finallyUnsafe #-}-finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a-finallyUnsafe action xs = fromStreamD $ D.finallyUnsafe action $ toStreamD xs+{-# INLINE_NORMAL _onException #-}+_onException :: MonadCatch m => m b -> Stream m a -> Stream m a+_onException action (Stream step state) = Stream step' state --- | Run the action @IO b@ whenever the stream stream stops normally, aborts--- due to an exception or if it is garbage collected after a partial lazy--- evaluation.------ The semantics of running the action @IO b@ are similar to the cleanup action--- semantics described in 'bracketIO'.------ >>> finallyIO release = Stream.bracketIO (return ()) (const release)------ /See also 'finallyUnsafe'/------ /Inhibits stream fusion/----{-# INLINE finallyIO #-}-finallyIO :: (MonadIO m, MonadCatch m) =>-    IO b -> Stream m a -> Stream m a-finallyIO action xs = fromStreamD $ D.finallyIO action $ toStreamD xs+    where +    {-# INLINE_LATE step' #-}+    step' gst st = do+        res <- step gst st `MC.onException` action+        case res of+            Yield x s -> return $ Yield x s+            Skip s    -> return $ Skip s+            Stop      -> return Stop+ -- | Like 'bracket' but with following differences: -- -- * alloc action @m b@ runs with async exceptions enabled@@ -129,41 +313,22 @@ -- -- /Pre-release/ ---{-# INLINE bracketUnsafe #-}+{-# INLINE_NORMAL bracketUnsafe #-} bracketUnsafe :: MonadCatch m     => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-bracketUnsafe bef aft bet = fromStreamD $ D.bracketUnsafe bef aft (toStreamD . bet)---- | Run the alloc action @IO b@ with async exceptions disabled but keeping--- blocking operations interruptible (see 'Control.Exception.mask').  Use the--- output @b@ as input to @b -> Stream m a@ to generate an output stream.------ @b@ is usually a resource under the IO monad, e.g. a file handle, that--- requires a cleanup after use. The cleanup action @b -> IO c@, runs whenever--- the stream ends normally, due to a sync or async exception or if it gets--- garbage collected after a partial lazy evaluation.------ 'bracketIO' only guarantees that the cleanup action runs, and it runs with--- async exceptions enabled. The action must ensure that it can successfully--- cleanup the resource in the face of sync or async exceptions.------ When the stream ends normally or on a sync exception, cleanup action runs--- immediately in the current thread context, whereas in other cases it runs in--- the GC context, therefore, cleanup may be delayed until the GC gets to run.------ /See also: 'bracketUnsafe'/------ /Inhibits stream fusion/----{-# INLINE bracketIO #-}-bracketIO :: (MonadIO m, MonadCatch m)-    => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a-bracketIO bef aft = bracketIO3 bef aft aft aft+bracketUnsafe bef aft =+    gbracket_+        bef+        aft+        (\a (e :: SomeException) _ -> aft a >> MC.throwM e)+        (inline MC.try)  -- For a use case of this see the "streamly-process" package. It needs to kill -- the process in case of exception or garbage collection, but waits for the -- process to terminate in normal cases. +-- XXX Just use bracketIO2 instead - stop and exception.+ -- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the -- mode of termination: --@@ -176,20 +341,393 @@ -- stream is abandoned @onGC@ is executed, if the stream encounters an -- exception @onException@ is executed. --+-- The exception is not caught, it is rethrown.+-- -- /Inhibits stream fusion/ -- -- /Pre-release/-{-# INLINE bracketIO3 #-}-bracketIO3 :: (MonadIO m, MonadCatch m)-    => IO b+{-# INLINE_NORMAL bracketIO3 #-}+bracketIO3 :: (MonadIO m, MonadCatch m) =>+       IO b     -> (b -> IO c)     -> (b -> IO d)     -> (b -> IO e)     -> (b -> Stream m a)     -> Stream m a-bracketIO3 bef aft gc exc bet = fromStreamD $-    D.bracketIO3 bef aft exc gc (toStreamD . bet)+bracketIO3 bef aft onExc onGC =+    gbracket+        bef+        aft+        (\a (e :: SomeException) _ -> onExc a >> MC.throwM e)+        onGC+        (inline MC.try) +-- 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 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+-- cleanup the resource in the face of sync or async exceptions.+--+-- /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.+--+-- /See also: 'bracketUnsafe'/+--+-- /Inhibits stream fusion/+--+{-# INLINE bracketIO #-}+bracketIO :: (MonadIO m, MonadCatch m)+    => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a+bracketIO bef aft = bracketIO3 bef aft aft aft++-- 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'.+--+{-# INLINE_NORMAL _bracket #-}+_bracket :: MonadCatch m+    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a+_bracket bef aft bet = Stream step' BracketInit++    where++    {-# INLINE_LATE step' #-}+    step' _ BracketInit = bef >>= \x -> return (Skip (BracketRun (bet x) x))++    -- NOTE: It is important to use UnStream instead of the Stream pattern+    -- here, otherwise we get huge perf degradation, see note in concatMap.+    step' gst (BracketRun (UnStream step state) v) = do+        -- res <- step gst state `MC.onException` aft v+        res <- inline MC.try $ step gst state+        case res of+            Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop+            Right r -> case r of+                Yield x s -> return $ Yield x (BracketRun (Stream step s) v)+                Skip s    -> return $ Skip (BracketRun (Stream step s) v)+                Stop      -> aft v >> return Stop++-- | Like 'finally' with following differences:+--+-- * action @m b@ won't run if the stream is garbage collected+--   after partial evaluation.+-- * has slightly better performance than 'finallyIO'.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+--+{-# INLINE finallyUnsafe #-}+finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a+finallyUnsafe action xs = bracketUnsafe (return ()) (const action) (const xs)++-- | Run the action @IO b@ whenever the stream stream stops normally, aborts+-- due to an exception or if it is garbage collected after a partial lazy+-- evaluation.+--+-- The semantics of running the action @IO b@ are similar to the cleanup action+-- semantics described in 'bracketIO'.+--+-- >>> finallyIO release stream = Stream.bracketIO (return ()) (const release) (const stream)+--+-- See also finallyIO' for stricter resource release guarantees.+--+-- /See also 'finallyUnsafe'/+--+-- /Inhibits stream fusion/+--+{-# INLINE finallyIO #-}+finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a+finallyIO action xs = bracketIO3 (return ()) act act act (const xs)+    where act _ = action+ -- | Like 'handle' but the exception handler is also provided with the stream -- that generated the exception as input. The exception handler can thus -- re-evaluate the stream to retry the action that failed. The exception@@ -202,21 +740,51 @@ -- -- /Pre-release/ ---{-# INLINE ghandle #-}+{-# INLINE_NORMAL ghandle #-} ghandle :: (MonadCatch m, Exception e)-    => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a-ghandle handler =-      fromStreamD-    . D.ghandle (\e xs -> toStreamD $ handler e (fromStreamD xs))-    . toStreamD+    => (e -> Stream m a -> m (Stream m a)) -> Stream m a -> Stream m a+ghandle f stream =+    gbracket_ (return ()) return (const f) (inline MC.try) (const stream)  -- | When evaluating a stream if an exception occurs, stream evaluation aborts -- and the specified exception handler is run with the exception as argument.+-- The exception is caught and handled unless the handler decides to rethrow+-- it. Note that exception handling is not applied to the stream returned by+-- the exception handler. --+-- Observes exceptions only in the stream generation, and not in stream+-- consumers.+-- -- /Inhibits stream fusion/ ---{-# INLINE handle #-}+{-# INLINE_NORMAL handle #-} handle :: (MonadCatch m, Exception e)+    => (e -> m (Stream m a)) -> Stream m a -> Stream m a+handle f stream =+    gbracket_ (return ()) return (\_ e _ -> f e) (inline MC.try) (const stream)++-- | Alternate (custom) implementation of 'handle'.+--+{-# INLINE_NORMAL _handle #-}+_handle :: (MonadCatch m, Exception e)     => (e -> Stream m a) -> Stream m a -> Stream m a-handle handler xs =-    fromStreamD $ D.handle (toStreamD . handler) $ toStreamD xs+_handle f (Stream step state) = Stream step' (Left state)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Left st) = do+        res <- inline MC.try $ step gst st+        case res of+            Left e -> return $ Skip $ Right (f e)+            Right r -> case r of+                Yield x s -> return $ Yield x (Left s)+                Skip s    -> return $ Skip (Left s)+                Stop      -> return Stop++    step' gst (Right (UnStream step1 st)) = do+        res <- step1 gst st+        case res of+            Yield x s -> return $ Yield x (Right (Stream step1 s))+            Skip s    -> return $ Skip (Right (Stream step1 s))+            Stop      -> return Stop
− src/Streamly/Internal/Data/Stream/Expand.hs 
@@ -1,893 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Expand--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Expand a stream by combining two or more streams or by combining streams--- with unfolds.--module Streamly.Internal.Data.Stream.Expand-    (-    -- * Binary Combinators (Linear)-    -- | Functions ending in the shape:-    ---    -- @Stream m a -> Stream m a -> Stream m a@.-    ---    -- The functions in this section have a linear or flat n-ary combining-    -- characterstics. It means that when combined @n@ times (e.g. @a `serial`-    -- b `serial` c ...@) the resulting expression will have an @O(n)@-    -- complexity (instead O(n^2) for pair wise combinators described in the-    -- next section. These functions can be used efficiently with-    -- 'concatMapWith' et. al.  combinators that combine streams in a linear-    -- fashion (contrast with 'mergeMapWith' which combines streams as a-    -- binary tree).--      append-    -- * Binary Combinators (Pair Wise)-    -- | Like the functions in the section above these functions also combine-    -- two streams into a single stream but when used @n@ times linearly they-    -- exhibit O(n^2) complexity. They are best combined in a binary tree-    -- fashion using 'mergeMapWith' giving a @n * log n@ complexity.  Avoid-    -- using these with 'concatMapWith' when combining a large or infinite-    -- number of streams.--    -- ** Append-    , append2--    -- ** Interleave-    , interleave-    , interleave2-    , interleaveFst-    , interleaveFst2-    , interleaveFstSuffix2-    , interleaveMin-    , interleaveMin2--    -- ** Round Robin-    , roundrobin--    -- ** Merge-    , mergeBy-    , mergeByM-    , mergeByM2-    , mergeMinBy-    , mergeFstBy--    -- ** Zip-    , zipWith-    , zipWithM--    -- * Combine Streams and Unfolds-    -- |-    -- Expand a stream by repeatedly using an unfold and merging the resulting-    -- streams.  Functions generally ending in the shape:-    ---    -- @Unfold m a b -> Stream m a -> Stream m b@--    -- ** Unfold and combine streams-    -- | Unfold and flatten streams.-    , unfoldMany -- XXX Rename to unfoldAppend-    , unfoldInterleave-    , unfoldRoundRobin--    -- ** Interpose-    -- | Insert effects between streams. Like unfoldMany but intersperses an-    -- effect between the streams. A special case of gintercalate.-    , interpose-    , interposeSuffix-    -- , interposeBy--    -- ** Intercalate-    -- | Insert Streams between Streams.-    -- Like unfoldMany but intersperses streams from another source between-    -- the streams from the first source.-    , intercalate-    , intercalateSuffix-    , gintercalate-    , gintercalateSuffix--    -- * Combine Streams of Streams-    -- | Map and serially append streams. 'concatMapM' is a generalization of-    -- the binary append operation to append many streams.-    , concatMapM-    , concatMap-    , concatEffect-    , concat--    -- * ConcatMapWith-    -- | Map and flatten a stream like 'concatMap' but using a custom binary-    -- stream merging combinator instead of just appending the streams.  The-    -- merging occurs sequentially, it works efficiently for 'serial', 'async',-    -- 'ahead' like merge operations where we consume one stream before the-    -- next or in case of 'wAsync' or 'parallel' where we consume all streams-    -- simultaneously anyway.-    ---    -- However, in cases where the merging consumes streams in a round robin-    -- fashion, a pair wise merging using 'mergeMapWith' would be more-    -- efficient. These cases include operations like 'mergeBy' or 'zipWith'.--    , concatMapWith-    , bindWith-    , concatSmapMWith--    -- * MergeMapWith-    -- | See the notes about suitable merge functions in the 'concatMapWith'-    -- section.-    , mergeMapWith--    -- * Iterate-    -- | Map and flatten Trees of Streams-    , unfoldIterateDfs-    , unfoldIterateBfs-    , unfoldIterateBfsRev--    , concatIterateWith-    , mergeIterateWith--    , concatIterateDfs-    , concatIterateBfs--    -- More experimental ops-    , concatIterateBfsRev-    , concatIterateLeftsWith-    , concatIterateScanWith-    , concatIterateScan-    )-where--#include "inline.hs"--import Streamly.Internal.Data.Stream.Bottom-    ( concatEffect, concatMapM, concatMap, smapM, zipWith, zipWithM)-import Streamly.Internal.Data.Stream.Type-    ( Stream, fromStreamD, fromStreamK, toStreamD, toStreamK-    , bindWith, concatMapWith, cons, nil)-import Streamly.Internal.Data.Unfold.Type (Unfold)--import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K (mergeBy, mergeByM)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import Prelude hiding (concat, concatMap, zipWith)---- $setup--- >>> :m--- >>> import Data.Either (either)--- >>> import Data.IORef--- >>> import Streamly.Internal.Data.Stream (Stream)--- >>> import Prelude hiding (zipWith, concatMap, concat)--- >>> import qualified Streamly.Data.Array as Array--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Internal.FileSystem.Dir as Dir-------------------------------------------------------------------------------------- Appending---------------------------------------------------------------------------------infixr 6 `append2`---- | This is fused version of 'append'. It could be up to 100x faster than--- 'append' when combining two fusible streams. However, it slows down--- quadratically with the number of streams being appended. Therefore, it is--- suitable for ad-hoc append of a few streams, and should not be used with--- 'concatMapWith' or 'mergeMapWith'.------ /Fused/----{-# INLINE append2 #-}-append2 ::Monad m => Stream m b -> Stream m b -> Stream m b-append2 m1 m2 = fromStreamD $ D.append (toStreamD m1) (toStreamD m2)--infixr 6 `append`---- | Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ >>> s1 = Stream.fromList [1,2]--- >>> s2 = Stream.fromList [3,4]--- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2--- [1,2,3,4]------ This has O(n) append performance where @n@ is the number of streams. It can--- be used to efficiently fold an infinite lazy container of streams--- 'concatMapWith' et. al.------ See 'append2' for a fusible alternative.------ /CPS/-{-# INLINE append #-}-append :: Stream m a -> Stream m a -> Stream m a-append = (<>)----------------------------------------------------------------------------------- Interleaving---------------------------------------------------------------------------------infixr 6 `interleave`---- | Interleaves two streams, yielding one element from each stream--- alternately.  When one stream stops the rest of the other stream is used in--- the output stream.------ When joining many streams in a left associative manner earlier streams will--- get exponential priority than the ones joining later. Because of exponential--- weighting it can be used with 'concatMapWith' even on a large number of--- streams.------ See 'interleave2' for a fusible alternative.------ /CPS/-{-# INLINE interleave #-}-interleave :: Stream m a -> Stream m a -> Stream m a-interleave s1 s2 = fromStreamK $ K.interleave (toStreamK s1) (toStreamK s2)--{-# INLINE interleave2 #-}-interleave2 :: Monad m => Stream m a -> Stream m a -> Stream m a-interleave2 s1 s2 = fromStreamD $ D.interleave (toStreamD s1) (toStreamD s2)---- | Like `interleave` but stops interleaving as soon as the first stream--- stops.------ See 'interleaveFst2' for a fusible alternative.------ /CPS/-{-# INLINE interleaveFst #-}-interleaveFst :: Stream m a -> Stream m a -> Stream m a-interleaveFst s1 s2 =-    fromStreamK $ K.interleaveFst (toStreamK s1) (toStreamK s2)---- | Like `interleave` but stops interleaving as soon as any of the two streams--- stops.------ See 'interleaveMin2' for a fusible alternative.------ /CPS/-{-# INLINE interleaveMin #-}-interleaveMin :: Stream m a -> Stream m a -> Stream m a-interleaveMin s1 s2 =-    fromStreamK $ K.interleaveMin (toStreamK s1) (toStreamK s2)--{-# INLINE interleaveMin2 #-}-interleaveMin2 :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveMin2 s1 s2 =-    fromStreamD $ D.interleaveMin (toStreamD s1) (toStreamD s2)---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream. As soon as the first stream--- finishes, the output stops, discarding the remaining part of the second--- stream. In this case, the last element in the resulting stream would be from--- the second stream. If the second stream finishes early then the first stream--- still continues to yield elements until it finishes.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFstSuffix2 "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c,"--- >>> Stream.interleaveFstSuffix2 "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFstSuffix2' is a dual of 'interleaveFst2'.------ Do not use at scale in concatMapWith.------ /Pre-release/-{-# INLINE interleaveFstSuffix2 #-}-interleaveFstSuffix2 :: Monad m => Stream m b -> Stream m b -> Stream m b-interleaveFstSuffix2 m1 m2 =-    fromStreamD $ D.interleaveFstSuffix (toStreamD m1) (toStreamD m2)---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream and ending at the first stream.--- If the second stream is longer than the first, elements from the second--- stream are infixed with elements from the first stream. If the first stream--- is longer then it continues yielding elements even after the second stream--- has finished.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFst2 "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c"--- >>> Stream.interleaveFst2 "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFst2' is a dual of 'interleaveFstSuffix2'.------ Do not use at scale in concatMapWith.------ /Pre-release/-{-# INLINE interleaveFst2 #-}-interleaveFst2 :: Monad m => Stream m b -> Stream m b -> Stream m b-interleaveFst2 m1 m2 =-    fromStreamD $ D.interleaveFst (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Scheduling----------------------------------------------------------------------------------- | Schedule the execution of two streams in a fair round-robin manner,--- executing each stream once, alternately. Execution of a stream may not--- necessarily result in an output, a stream may chose to @Skip@ producing an--- element until later giving the other stream a chance to run. Therefore, this--- combinator fairly interleaves the execution of two streams rather than--- fairly interleaving the output of the two streams. This can be useful in--- co-operative multitasking without using explicit threads. This can be used--- as an alternative to `async`.------ Do not use at scale in concatMapWith.------ /Pre-release/-{-# INLINE roundrobin #-}-roundrobin :: Monad m => Stream m b -> Stream m b -> Stream m b-roundrobin m1 m2 = fromStreamD $ D.roundRobin (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Merging (sorted streams)----------------------------------------------------------------------------------- | Merge two streams using a comparison function. The head elements of both--- the streams are compared and the smaller of the two elements is emitted, if--- both elements are equal then the element from the first stream is used--- first.------ If the streams are sorted in ascending order, the resulting stream would--- also remain sorted in ascending order.------ >>> s1 = Stream.fromList [1,3,5]--- >>> s2 = Stream.fromList [2,4,6,8]--- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2--- [1,2,3,4,5,6,8]------ See 'mergeByM2' for a fusible alternative.------ /CPS/-{-# INLINE mergeBy #-}-mergeBy :: (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeBy f m1 m2 = fromStreamK $ K.mergeBy f (toStreamK m1) (toStreamK m2)---- | Like 'mergeBy' but with a monadic comparison function.------ Merge two streams randomly:------ @--- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT--- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])--- [2,1,2,2,2,1,1,1]--- @------ Merge two streams in a proportion of 2:1:------ >>> :{--- do---  let s1 = Stream.fromList [1,1,1,1,1,1]---      s2 = Stream.fromList [2,2,2]---  let proportionately m n = do---       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]---       return $ \_ _ -> do---          r <- readIORef ref---          writeIORef ref $ Prelude.tail r---          return $ Prelude.head r---  f <- proportionately 2 1---  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2---  print xs--- :}--- [1,1,2,1,1,2,1,1,2]------ See 'mergeByM2' for a fusible alternative.------ /CPS/-{-# INLINE mergeByM #-}-mergeByM-    :: Monad m-    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeByM f m1 m2 = fromStreamK $ K.mergeByM f (toStreamK m1) (toStreamK m2)---- | Like 'mergeByM' but much faster, works best when merging statically known--- number of streams. When merging more than two streams try to merge pairs and--- pair of pairs in a tree like structure.'mergeByM' works better with variable--- number of streams being merged using 'mergeMapWith'.------ /Internal/-{-# INLINE mergeByM2 #-}-mergeByM2-    :: Monad m-    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeByM2 f m1 m2 =-    fromStreamD $ D.mergeByM f (toStreamD m1) (toStreamD m2)---- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.------ /Unimplemented/-{-# INLINABLE mergeMinBy #-}-mergeMinBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeMinBy _f _m1 _m2 = undefined-    -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)---- | Like 'mergeByM' but stops merging as soon as the first stream stops.------ /Unimplemented/-{-# INLINABLE mergeFstBy #-}-mergeFstBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeFstBy _f _m1 _m2 = undefined-    -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Combine N Streams - unfoldMany----------------------------------------------------------------------------------- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike--- 'concatMap' this can fuse the 'Unfold' code with the inner loop and--- therefore provide many times better performance.----{-# INLINE unfoldMany #-}-unfoldMany ::Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldMany u m = fromStreamD $ D.unfoldMany u (toStreamD m)---- | This does not pair streams like mergeMapWith, instead, it goes through--- each stream one by one and yields one element from each stream. After it--- goes to the last stream it reverses the traversal to come back to the first--- stream yielding elements from each stream on its way back to the first--- stream and so on.------ >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]--- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists--- >>> Stream.fold Fold.toList interleaved--- [1,2,3,4,5,5,4,3,2,1]------ Note that this is order of magnitude more efficient than "mergeMapWith--- wSerial" because of fusion.------ /Fused/-{-# INLINE unfoldInterleave #-}-unfoldInterleave ::Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldInterleave u m =-    fromStreamD $ D.unfoldInterleave u (toStreamD m)---- | 'unfoldInterleave' switches to the next stream whenever a value from a--- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps--- skipping for long time other streams won't get a chance to run.--- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each--- stream fairly irrespective of whether it produces a value or not.----{-# INLINE unfoldRoundRobin #-}-unfoldRoundRobin ::Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldRoundRobin u m =-    fromStreamD $ D.unfoldRoundRobin u (toStreamD m)----------------------------------------------------------------------------------- Combine N Streams - interpose----------------------------------------------------------------------------------- > interpose x unf str = gintercalate unf str UF.identity (repeat x)---- | Unfold the elements of a stream, intersperse the given element between the--- unfolded streams and then concat them into a single stream.------ >>> unwords = Stream.interpose ' '------ /Pre-release/-{-# INLINE interpose #-}-interpose :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interpose x unf str =-    fromStreamD $ D.interpose x unf (toStreamD str)---- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)---- | Unfold the elements of a stream, append the given element after each--- unfolded stream and then concat them into a single stream.------ >>> unlines = Stream.interposeSuffix '\n'------ /Pre-release/-{-# INLINE interposeSuffix #-}-interposeSuffix :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffix x unf str =-    fromStreamD $ D.interposeSuffix x unf (toStreamD str)----------------------------------------------------------------------------------- Combine N Streams - intercalate----------------------------------------------------------------------------------- XXX we can swap the order of arguments to gintercalate so that the--- definition of unfoldMany becomes simpler? The first stream should be--- infixed inside the second one. However, if we change the order in--- "interleave" as well similarly, then that will make it a bit unintuitive.------ > unfoldMany unf str =--- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())---- | 'interleaveFst' followed by unfold and concat.------ /Pre-release/-{-# INLINE gintercalate #-}-gintercalate-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalate unf1 str1 unf2 str2 =-    fromStreamD $ D.gintercalate-        unf1 (toStreamD str1)-        unf2 (toStreamD str2)---- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)---- | 'intersperse' followed by unfold and concat.------ >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a--- >>> intersperse = Stream.intercalate Unfold.identity--- >>> unwords = Stream.intercalate Unfold.fromList " "------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input--- "abc def ghi"----{-# INLINE intercalate #-}-intercalate :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalate unf seed str = fromStreamD $-    D.unfoldMany unf $ D.intersperse seed (toStreamD str)---- | 'interleaveFstSuffix2' followed by unfold and concat.------ /Pre-release/-{-# INLINE gintercalateSuffix #-}-gintercalateSuffix-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalateSuffix unf1 str1 unf2 str2 =-    fromStreamD $ D.gintercalateSuffix-        unf1 (toStreamD str1)-        unf2 (toStreamD str2)---- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)---- | 'intersperseMSuffix' followed by unfold and concat.------ >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a--- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity--- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input--- "abc\ndef\nghi\n"----{-# INLINE intercalateSuffix #-}-intercalateSuffix :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalateSuffix unf seed =-    fromStreamD . D.intercalateSuffix unf seed . toStreamD----------------------------------------------------------------------------------- Combine N Streams - concatMap----------------------------------------------------------------------------------- | Flatten a stream of streams to a single stream.------ >>> concat = Stream.concatMap id------ /Pre-release/-{-# INLINE concat #-}-concat :: Monad m => Stream m (Stream m a) -> Stream m a-concat = concatMap id----------------------------------------------------------------------------------- Combine N Streams - concatMap----------------------------------------------------------------------------------- | Like 'concatMapWith' but carries a state which can be used to share--- information across multiple steps of concat.------ >>> concatSmapMWith combine f initial = Stream.concatMapWith combine id . Stream.smapM f initial------ /Pre-release/----{-# INLINE concatSmapMWith #-}-concatSmapMWith-    :: Monad m-    => (Stream m b -> Stream m b -> Stream m b)-    -> (s -> a -> m (s, Stream m b))-    -> m s-    -> Stream m a-    -> Stream m b-concatSmapMWith combine f initial =-    concatMapWith combine id . smapM f initial---- XXX Implement a StreamD version for fusion.---- | Combine streams in pairs using a binary combinator, the resulting streams--- are then combined again in pairs recursively until we get to a single--- combined stream. The composition would thus form a binary tree.------ For example, you can sort a stream using merge sort like this:------ >>> s = Stream.fromList [5,1,7,9,2]--- >>> generate = Stream.fromPure--- >>> combine = Stream.mergeBy compare--- >>> Stream.fold Fold.toList $ Stream.mergeMapWith combine generate s--- [1,2,5,7,9]------ Note that if the stream length is not a power of 2, the binary tree composed--- by mergeMapWith would not be balanced, which may or may not be important--- depending on what you are trying to achieve.------ /Caution: the stream of streams must be finite/------ /CPS/------ /Pre-release/----{-# INLINE mergeMapWith #-}-mergeMapWith ::-       (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m a-    -> Stream m b-mergeMapWith par f m =-    fromStreamK-        $ K.mergeMapWith-            (\s1 s2 -> toStreamK $ fromStreamK s1 `par` fromStreamK s2)-            (toStreamK . f)-            (toStreamK m)----------------------------------------------------------------------------------- concatIterate - Map and flatten Trees of Streams----------------------------------------------------------------------------------- | Yield an input element in the output stream, map a stream generator on it--- and repeat the process on the resulting stream. Resulting streams are--- flattened using the 'concatMapWith' combinator. This can be used for a depth--- first style (DFS) traversal of a tree like structure.------ Example, list a directory tree using DFS:------ >>> f = either Dir.readEitherPaths (const Stream.nil)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateWith Stream.append f input------ Note that 'iterateM' is a special case of 'concatIterateWith':------ >>> iterateM f = Stream.concatIterateWith Stream.append (Stream.fromEffect . f) . Stream.fromEffect------ /CPS/------ /Pre-release/----{-# INLINE concatIterateWith #-}-concatIterateWith ::-       (Stream m a -> Stream m a -> Stream m a)-    -> (a -> Stream m a)-    -> Stream m a-    -> Stream m a-concatIterateWith combine f = iterateStream--    where--    iterateStream = concatMapWith combine generate--    generate x = x `cons` iterateStream (f x)---- | Traverse the stream in depth first style (DFS). Map each element in the--- input stream to a stream and flatten, recursively map the resulting elements--- as well to a stream and flatten until no more streams are generated.------ Example, list a directory tree using DFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateDfs f input------ This is equivalent to using @concatIterateWith Stream.append@.------ /Pre-release/-{-# INLINE concatIterateDfs #-}-concatIterateDfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateDfs f stream =-    fromStreamD-        $ D.concatIterateDfs (fmap toStreamD . f ) (toStreamD stream)---- | Similar to 'concatIterateDfs' except that it traverses the stream in--- breadth first style (BFS). First, all the elements in the input stream are--- emitted, and then their traversals are emitted.------ Example, list a directory tree using BFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateBfs f input------ /Pre-release/-{-# INLINE concatIterateBfs #-}-concatIterateBfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfs f stream =-    fromStreamD-        $ D.concatIterateBfs (fmap toStreamD . f ) (toStreamD stream)---- | Same as 'concatIterateBfs' except that the traversal of the last--- element on a level is emitted first and then going backwards up to the first--- element (reversed ordering). This may be slightly faster than--- 'concatIterateBfs'.----{-# INLINE concatIterateBfsRev #-}-concatIterateBfsRev :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfsRev f stream =-    fromStreamD-        $ D.concatIterateBfsRev (fmap toStreamD . f ) (toStreamD stream)---- | Like 'concatIterateWith' but uses the pairwise flattening combinator--- 'mergeMapWith' for flattening the resulting streams. This can be used for a--- balanced traversal of a tree like structure.------ Example, list a directory tree using balanced traversal:------ >>> f = either Dir.readEitherPaths (const Stream.nil)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.mergeIterateWith Stream.interleave f input------ /CPS/------ /Pre-release/----{-# INLINE mergeIterateWith #-}-mergeIterateWith ::-       (Stream m a -> Stream m a -> Stream m a)-    -> (a -> Stream m a)-    -> Stream m a-    -> Stream m a-mergeIterateWith combine f = iterateStream--    where--    iterateStream = mergeMapWith combine generate--    generate x = x `cons` iterateStream (f x)---- | Same as @concatIterateDfs@ but more efficient due to stream fusion.------ Example, list a directory tree using DFS:------ >>> f = Unfold.either Dir.eitherReaderPaths Unfold.nil--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.unfoldIterateDfs f input------ /Pre-release/-{-# INLINE unfoldIterateDfs #-}-unfoldIterateDfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a-unfoldIterateDfs u = fromStreamD . D.unfoldIterateDfs u . toStreamD---- | Like 'unfoldIterateDfs' but uses breadth first style traversal.------ /Pre-release/-{-# INLINE unfoldIterateBfs #-}-unfoldIterateBfs :: Monad m => Unfold m a a -> Stream m a -> Stream m a-unfoldIterateBfs u = fromStreamD . D.unfoldIterateBfs u . toStreamD---- | Like 'unfoldIterateBfs' but processes the children in reverse order,--- therefore, may be slightly faster.------ /Pre-release/-{-# INLINE unfoldIterateBfsRev #-}-unfoldIterateBfsRev :: Monad m => Unfold m a a -> Stream m a -> Stream m a-unfoldIterateBfsRev u =-    fromStreamD . D.unfoldIterateBfsRev u . toStreamD----------------------------------------------------------------------------------- Flattening Graphs----------------------------------------------------------------------------------- To traverse graphs we need a state to be carried around in the traversal.--- For example, we can use a hashmap to store the visited status of nodes.---- | Like 'iterateMap' but carries a state in the stream generation function.--- This can be used to traverse graph like structures, we can remember the--- visited nodes in the state to avoid cycles.------ Note that a combination of 'iterateMap' and 'usingState' can also be used to--- traverse graphs. However, this function provides a more localized state--- instead of using a global state.------ See also: 'mfix'------ /Pre-release/----{-# INLINE concatIterateScanWith #-}-concatIterateScanWith-    :: Monad m-    => (Stream m a -> Stream m a -> Stream m a)-    -> (b -> a -> m (b, Stream m a))-    -> m b-    -> Stream m a-    -> Stream m a-concatIterateScanWith combine f initial stream =-    concatEffect $ do-        b <- initial-        iterateStream (b, stream)--    where--    iterateStream (b, s) = pure $ concatMapWith combine (generate b) s--    generate b a = a `cons` feedback b a--    feedback b a = concatEffect $ f b a >>= iterateStream---- Next stream is to be generated by the return value of the previous stream. A--- general intuitive way of doing that could be to use an appending monad--- instance for streams where the result of the previous stream is used to--- generate the next one. In the first pass we can just emit the values in the--- stream and keep building a buffered list/stream, once done we can then--- process the buffered stream.--{-# INLINE concatIterateScan #-}-concatIterateScan-    :: Monad m-    => (b -> a -> m b)-    -> (b -> m (Maybe (b, Stream m a)))-    -> b-    -> Stream m a-concatIterateScan scanner generate initial =-    fromStreamD-        $ D.concatIterateScan-            scanner (fmap (fmap (fmap toStreamD)) . generate) initial----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- Keep concating either streams as long as rights are generated, stop as soon--- as a left is generated and concat the left stream.------ See also: 'handle'------ /Unimplemented/----{--concatMapEitherWith-    :: (forall x. t m x -> t m x -> t m x)-    -> (a -> t m (Either (Stream m b) b))-    -> Stream m a-    -> Stream m b-concatMapEitherWith = undefined--}---- XXX We should prefer using the Maybe stream returning signatures over this.--- This API should perhaps be removed in favor of those.---- | In an 'Either' stream iterate on 'Left's.  This is a special case of--- 'concatIterateWith':------ >>> concatIterateLeftsWith combine f = Stream.concatIterateWith combine (either f (const Stream.nil))------ To traverse a directory tree:------ >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateLeftsWith Stream.append Dir.readEither input------ /Pre-release/----{-# INLINE concatIterateLeftsWith #-}-concatIterateLeftsWith-    :: (b ~ Either a c)-    => (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m b-    -> Stream m b-concatIterateLeftsWith combine f =-    concatIterateWith combine (either f (const nil))
src/Streamly/Internal/Data/Stream/Generate.hs view
@@ -1,460 +1,1214 @@-{-# OPTIONS_GHC -Wno-orphans #-}---- |--- Module      : Streamly.Internal.Data.Stream.Generate--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Generate-    (-    -- * Primitives-      Stream.nil-    , Stream.nilM-    , Stream.cons-    , Stream.consM--    -- * From 'Unfold'-    , unfold--    -- * Unfolding-    , unfoldr-    , unfoldrM--    -- * From Values-    , Stream.fromPure-    , Stream.fromEffect-    , repeat-    , repeatM-    , replicate-    , replicateM--    -- * Enumeration-    , Enumerable (..)-    , enumerate-    , enumerateTo--    -- * Time Enumeration-    , times-    , timesWith-    , absTimes-    , absTimesWith-    , relTimes-    , relTimesWith-    , durations-    , timeout--    -- * Iteration-    , iterate-    , iterateM--    -- * Cyclic Elements-    , mfix--    -- * From Containers-    , Bottom.fromList-    , fromFoldable--    -- * From memory-    , fromPtr-    , fromPtrN-    , fromByteStr#- -- , fromByteArray#-    , fromUnboxedIORef-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO)-import Data.Word (Word8)-import Foreign.Storable (Storable)-import GHC.Exts (Addr#, Ptr (Ptr))-import Streamly.Internal.Data.Stream.Bottom-    (absTimesWith, relTimesWith, timesWith)-import Streamly.Internal.Data.Stream.Enumerate-    (Enumerable(..), enumerate, enumerateTo)-import Streamly.Internal.Data.Stream.Type-    (Stream, fromStreamD, fromStreamK, toStreamK)-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.Data.Unfold.Type (Unfold)--import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed-import qualified Streamly.Internal.Data.Stream.Bottom as Bottom-import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-import qualified Streamly.Internal.Data.Stream.Type as Stream-import qualified Streamly.Internal.Data.Stream.Transform as Stream (sequence)--import Prelude hiding (iterate, replicate, repeat, take)---- $setup--- >>> :m--- >>> import Control.Concurrent (threadDelay)--- >>> import Data.Function (fix, (&))--- >>> import Data.Semigroup (cycle1)--- >>> import Streamly.Internal.Data.Stream.Cross (CrossStream(..))--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import GHC.Exts (Ptr (Ptr))----------------------------------------------------------------------------------- From Unfold----------------------------------------------------------------------------------- | Convert an 'Unfold' into a stream by supplying it an input seed.------ >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello")--- >>> Stream.fold Fold.drain s--- hello--- hello--- hello----{-# INLINE unfold #-}-unfold :: Monad m => Unfold m a b -> a -> Stream m b-unfold unf = Stream.fromStreamD . D.unfold unf----------------------------------------------------------------------------------- Generation by Unfolding----------------------------------------------------------------------------------- |--- >>> :{--- unfoldr step s =---     case step s of---         Nothing -> Stream.nil---         Just (a, b) -> a `Stream.cons` unfoldr step b--- :}------ Build a stream by unfolding a /pure/ step function @step@ starting from a--- seed @s@.  The step function returns the next element in the stream and the--- next seed value. When it is done it returns 'Nothing' and the stream ends.--- For example,------ >>> :{--- let f b =---         if b > 2---         then Nothing---         else Just (b, b + 1)--- in Stream.fold Fold.toList $ Stream.unfoldr f 0--- :}--- [0,1,2]----{-# INLINE_EARLY unfoldr #-}-unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a-unfoldr step seed = fromStreamD (D.unfoldr step seed)-{-# RULES "unfoldr fallback to StreamK" [1]-    forall a b. D.toStreamK (D.unfoldr a b) = K.unfoldr a b #-}---- | Build a stream by unfolding a /monadic/ step function starting from a--- seed.  The step function returns the next element in the stream and the next--- seed value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ >>> :{--- let f b =---         if b > 2---         then return Nothing---         else return (Just (b, b + 1))--- in Stream.fold Fold.toList $ Stream.unfoldrM f 0--- :}--- [0,1,2]----{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> Stream m a-unfoldrM step = fromStreamD . D.unfoldrM step----------------------------------------------------------------------------------- From Values----------------------------------------------------------------------------------- |--- Generate an infinite stream by repeating a pure value.----{-# INLINE_NORMAL repeat #-}-repeat :: Monad m => a -> Stream m a-repeat = fromStreamD . D.repeat---- |--- >>> repeatM = Stream.sequence . Stream.repeat--- >>> repeatM = fix . Stream.consM--- >>> repeatM = cycle1 . Stream.fromEffect------ Generate a stream by repeatedly executing a monadic action forever.------ >>> :{--- repeatAction =---        Stream.repeatM (threadDelay 1000000 >> print 1)---      & Stream.take 10---      & Stream.fold Fold.drain--- :}----{-# INLINE_NORMAL repeatM #-}-repeatM :: Monad m => m a -> Stream m a-repeatM = Stream.sequence . repeat---- |--- >>> replicate n = Stream.take n . Stream.repeat------ Generate a stream of length @n@ by repeating a value @n@ times.----{-# INLINE_NORMAL replicate #-}-replicate :: Monad m => Int -> a -> Stream m a-replicate n = fromStreamD . D.replicate n---- |--- >>> replicateM n = Stream.sequence . Stream.replicate n------ Generate a stream by performing a monadic action @n@ times.-{-# INLINE_NORMAL replicateM #-}-replicateM :: Monad m => Int -> m a -> Stream m a-replicateM n = Stream.sequence . replicate n----------------------------------------------------------------------------------- Time Enumeration----------------------------------------------------------------------------------- | @times@ returns a stream of time value tuples with clock of 10 ms--- granularity. The first component of the tuple is an absolute time reference--- (epoch) denoting the start of the stream and the second component is a time--- relative to the reference.------ >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.times--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE times #-}-times :: MonadIO m => Stream m (AbsTime, RelTime64)-times = timesWith 0.01---- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms--- granularity.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimes #-}-absTimes :: MonadIO m => Stream m AbsTime-absTimes = fmap (uncurry addToAbsTime64) times---- | @relTimes@ returns a stream of relative time values starting from 0,--- using a clock of granularity 10 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimes #-}-relTimes ::  MonadIO m => Stream m RelTime64-relTimes = fmap snd times---- | @durations g@ returns a stream of relative time values measuring the time--- elapsed since the immediate predecessor element of the stream was generated.--- The first element of the stream is always 0. @durations@ uses a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.--- Durations lower than 1 ms will be 0.------ Note: This API is not safe on 32-bit machines.------ /Unimplemented/----{-# INLINE durations #-}-durations :: -- Monad m =>-    Double -> t m RelTime64-durations = undefined---- | Generate a singleton event at or after the specified absolute time. Note--- that this is different from a threadDelay, a threadDelay starts from the--- time when the action is evaluated, whereas if we use AbsTime based timeout--- it will immediately expire if the action is evaluated too late.------ /Unimplemented/----{-# INLINE timeout #-}-timeout :: -- Monad m =>-    AbsTime -> t m ()-timeout = undefined----------------------------------------------------------------------------------- Iterating functions----------------------------------------------------------------------------------- |--- >>> iterate f x = x `Stream.cons` iterate f x------ Generate an infinite stream with @x@ as the first element and each--- successive element derived by applying the function @f@ on the previous--- element.------ >>> Stream.fold Fold.toList $ Stream.take 5 $ Stream.iterate (+1) 1--- [1,2,3,4,5]----{-# INLINE_NORMAL iterate #-}-iterate :: Monad m => (a -> a) -> a -> Stream m a-iterate step = fromStreamD . D.iterate step---- |--- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a)------ Generate an infinite stream with the first element generated by the action--- @m@ and each successive element derived by applying the monadic function--- @f@ on the previous element.------ >>> :{--- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0)---     & Stream.take 3---     & Stream.fold Fold.toList--- :}--- 0--- 1--- [0,1,2]----{-# INLINE iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> Stream m a-iterateM step = fromStreamD . D.iterateM step---- | We can define cyclic structures using @let@:------ >>> let (a, b) = ([1, b], head a) in (a, b)--- ([1,1],1)------ The function @fix@ defined as:------ >>> fix f = let x = f x in x------ ensures that the argument of a function and its output refer to the same--- lazy value @x@ i.e.  the same location in memory.  Thus @x@ can be defined--- in terms of itself, creating structures with cyclic references.------ >>> f ~(a, b) = ([1, b], head a)--- >>> fix f--- ([1,1],1)------ 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic--- values.------ Using 'mfix' for streams we can construct a stream in which each element of--- the stream is defined in a cyclic fashion. The argument of the function--- being fixed represents the current element of the stream which is being--- returned by the stream monad. Thus, we can use the argument to construct--- itself.------ In the following example, the argument @action@ of the function @f@--- represents the tuple @(x,y)@ returned by it in a given iteration. We define--- the first element of the tuple in terms of the second.------ >>> import Streamly.Internal.Data.Stream as Stream--- >>> import System.IO.Unsafe (unsafeInterleaveIO)------ >>> :{--- main = Stream.fold (Fold.drainMapM print) $ Stream.mfix f---     where---     f action = unCrossStream $ do---         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act---         x <- CrossStream (Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action])---         y <- CrossStream (Stream.fromList [4,5])---         return (x, y)--- :}------ Note: you cannot achieve this by just changing the order of the monad--- statements because that would change the order in which the stream elements--- are generated.------ Note that the function @f@ must be lazy in its argument, that's why we use--- 'unsafeInterleaveIO' on @action@ because IO monad is strict.------ /CPS/------ /Pre-release/-{-# INLINE mfix #-}-mfix :: Monad m => (m a -> Stream m a) -> Stream m a-mfix f = fromStreamK $ K.mfix (toStreamK . f)----------------------------------------------------------------------------------- Conversions----------------------------------------------------------------------------------- |--- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil------ Construct a stream from a 'Foldable' containing pure values:------ /CPS/----{-# INLINE fromFoldable #-}-fromFoldable :: Foldable f => f a -> Stream m a-fromFoldable = fromStreamK . K.fromFoldable----------------------------------------------------------------------------------- From pointers----------------------------------------------------------------------------------- | Keep reading 'Storable' elements from 'Ptr' onwards.------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtr #-}-fromPtr :: (MonadIO m, Storable a) => Ptr a -> Stream m a-fromPtr = Stream.fromStreamD . D.fromPtr---- | Take @n@ 'Storable' elements starting from 'Ptr' onwards.------ >>> fromPtrN n = Stream.take n . Stream.fromPtr------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtrN #-}-fromPtrN :: (MonadIO m, Storable a) => Int -> Ptr a -> Stream m a-fromPtrN n = Stream.fromStreamD . D.take n . D.fromPtr---- | Read bytes from an 'Addr#' until a 0 byte is encountered, the 0 byte is--- not included in the stream.------ >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr------ /Unsafe:/ The caller is responsible for safe addressing.------ Note that this is completely safe when reading from Haskell string--- literals because they are guaranteed to be NULL terminated:------ >>> Stream.fold Fold.toList $ Stream.fromByteStr# "\1\2\3\0"#--- [1,2,3]----{-# INLINE fromByteStr# #-}-fromByteStr# :: MonadIO m => Addr# -> Stream m Word8-fromByteStr# addr =-    Stream.fromStreamD $ D.takeWhile (/= 0) $ D.fromPtr $ Ptr addr---- | Construct a stream by reading an 'Unboxed' 'IORef' repeatedly.------ /Pre-release/----{-# INLINE fromUnboxedIORef #-}-fromUnboxedIORef :: (MonadIO m, Unbox a) => Unboxed.IORef a -> Stream m a-fromUnboxedIORef = fromStreamD . Unboxed.toStreamD+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Generate+-- Copyright   : (c) 2020 Composewell Technologies and Contributors+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++-- A few combinators in this module have been adapted from the vector package+-- (c) Roman Leshchinskiy. See the notes in specific combinators.+--+module Streamly.Internal.Data.Stream.Generate+  (+    -- * Primitives+      nil+    , cons++    -- * Unfolding+    , unfoldr+    , unfoldrM++    -- * From Values+    , repeat+    , repeatM+    , replicate+    , replicateM++    -- * Enumeration+    -- ** Enumerating 'Num' Types+    , enumerateFromStepNum+    , enumerateFromNum+    , enumerateFromThenNum++    -- ** Enumerating 'Bounded' 'Enum' Types+    , enumerate+    , enumerateTo+    , enumerateFromBounded++    -- ** Enumerating 'Enum' Types not larger than 'Int'+    , enumerateFromToSmall+    , enumerateFromThenToSmall+    , enumerateFromThenSmallBounded++    -- ** Enumerating 'Bounded' 'Integral' Types+    , enumerateFromIntegral+    , enumerateFromThenIntegral++    -- ** Enumerating 'Integral' Types+    , enumerateFromToIntegral+    , enumerateFromThenToIntegral++    -- ** Enumerating unbounded 'Integral' Types+    , enumerateFromStepIntegral++    -- ** Enumerating 'Fractional' Types+    , enumerateFromFractional+    , enumerateFromToFractional+    , enumerateFromThenFractional+    , enumerateFromThenToFractional++    -- ** Enumerable Type Class+    , Enumerable(..)++    -- * Time Enumeration+    , times+    , timesWith+    , absTimes+    , absTimesWith+    , relTimes+    , relTimesWith+    , durations+    , timeout++    -- * From Generators+    -- | Generate a monadic stream from a seed.+    , fromIndices+    , fromIndicesM+    , generate+    , generateM++    -- * Iteration+    , iterate+    , iterateM++    -- * From Containers+    -- | Transform an input structure into a stream.++    , fromListM+    , fromFoldable+    , fromFoldableM++    -- * From Pointers+    , fromPtr+    , fromPtrN+    , fromCString#+    , fromW16CString#++    -- * Deprecated+    , fromByteStr#+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Monad.IO.Class (MonadIO(..))+import Data.Functor.Identity (Identity(..))+import Foreign.Ptr (Ptr, plusPtr)+import Foreign.Storable (Storable (peek), sizeOf)+import GHC.Exts (Addr#, Ptr (Ptr))+import Streamly.Internal.Data.Time.Clock+    (Clock(Monotonic), asyncClock, readClock)+import Streamly.Internal.Data.Time.Units+    (toAbsTime, AbsTime, toRelTime64, RelTime64, addToAbsTime64)+import Streamly.Internal.System.IO (unsafeInlineIO)++#ifdef USE_UNFOLDS_EVERYWHERE+import qualified Streamly.Internal.Data.Unfold as Unfold+#endif++import Data.Fixed+import Data.Int+import Data.Ratio+import Data.Word+import Numeric.Natural+import Prelude hiding (iterate, repeat, replicate, take, takeWhile)+import Streamly.Internal.Data.Stream.Type++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Primitives+------------------------------------------------------------------------------++-- XXX implement in terms of nilM?++-- | A stream that terminates without producing any output or side effect.+--+-- >>> Stream.toList Stream.nil+-- []+--+{-# INLINE_NORMAL nil #-}+nil :: Applicative m => Stream m a+nil = Stream (\_ _ -> pure Stop) ()++infixr 5 `cons`++-- XXX implement in terms of consM?+-- cons x = consM (return x)+-- From an implementation perspective, StreamK.cons translates into a+-- functional call whereas fused cons translates into a conditional branch+-- (jump). However, the overhead of the function call in StreamK.cons only+-- occurs once, while the overhead of the conditional branch in fused cons is+-- incurred for each subsequent element in the stream. As a result,+-- StreamK.cons has a time complexity of O(n), while fused cons has a time+-- complexity of O(n^2), where @n@ represents the number of 'cons' used.++-- When composing a few elements together statically, a balanced tree composed+-- using 'cons' and 'append' is more efficient than a right associated one+-- composed using 'cons':+--+-- >>> s1 = 1 `Stream.cons` 2 `Stream.cons` Stream.nil+-- >>> s2 = 2 `Stream.cons` 3 `Stream.cons` Stream.nil+-- >>> s = s1 `Stream.append` s2+--+-- However, generating a stream using a case statement or indexing into a+-- static literal array would be the best. Check if the case statement+-- translates to a look up table or a binary search.++-- | WARNING! O(n^2) time complexity wrt number of elements. Use the O(n)+-- complexity StreamK.'Streamly.Data.StreamK.cons' unless you want to+-- statically fuse just a few elements.+--+-- Fuse a pure value at the head of an existing stream::+--+-- >>> s = 1 `Stream.cons` Stream.fromList [2,3]+-- >>> Stream.toList s+-- [1,2,3]+--+-- Definition:+--+-- >>> cons x xs = return x `Stream.consM` xs+--+{-# INLINE_NORMAL cons #-}+cons :: Applicative m => a -> Stream m a -> Stream m a+cons x (Stream step state) = Stream step1 Nothing+    where+    {-# INLINE_LATE step1 #-}+    step1 _ Nothing = pure $ Yield x (Just state)+    step1 gst (Just st) = do+          (\case+            Yield a s -> Yield a (Just s)+            Skip  s   -> Skip (Just s)+            Stop      -> Stop) <$> step gst st++------------------------------------------------------------------------------+-- Unfolding+------------------------------------------------------------------------------++-- Adapted from vector package++-- | Build a stream by unfolding a /monadic/ step function starting from a+-- seed.  The step function returns the next element in the stream and the next+-- seed value. When it is done it returns 'Nothing' and the stream ends. For+-- example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then return Nothing+--         else return (Just (b, b + 1))+-- in Stream.toList $ Stream.unfoldrM f 0+-- :}+-- [0,1,2]+--+{-# INLINE_NORMAL unfoldrM #-}+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+unfoldrM next = unfold (Unfold.unfoldrM next)+#else+unfoldrM next = Stream step+  where+    {-# INLINE_LATE step #-}+    step _ st = do+        r <- next st+        return $ case r of+            Just (x, s) -> Yield x s+            Nothing     -> Stop+#endif++-- | Build a stream by unfolding a /pure/ step function @step@ starting from a+-- seed @s@.  The step function returns the next element in the stream and the+-- next seed value. When it is done it returns 'Nothing' and the stream ends.+-- For example,+--+-- >>> :{+-- let f b =+--         if b > 2+--         then Nothing+--         else Just (b, b + 1)+-- in Stream.toList $ Stream.unfoldr f 0+-- :}+-- [0,1,2]+--+{-# INLINE_LATE unfoldr #-}+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a+unfoldr f = unfoldrM (return . f)++------------------------------------------------------------------------------+-- From values+------------------------------------------------------------------------------++-- |+-- >>> repeatM act = Stream.iterateM (const act) act+-- >>> repeatM = Stream.sequence . Stream.repeat+--+-- Generate a stream by repeatedly executing a monadic action forever.+--+-- >>> :{+-- repeatAction =+--        Stream.repeatM (threadDelay 1000000 >> print 1)+--      & Stream.take 10+--      & Stream.fold Fold.drain+-- :}+--+{-# INLINE_NORMAL repeatM #-}+repeatM :: Monad m => m a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+repeatM = unfold Unfold.repeatM+#else+repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) ()+#endif++-- |+-- Generate an infinite stream by repeating a pure value.+--+-- >>> repeat = Stream.iterate id+-- >>> repeat x = Stream.repeatM (pure x)+--+{-# INLINE_NORMAL repeat #-}+repeat :: Monad m => a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+repeat x = repeatM (pure x)+#else+repeat x = Stream (\_ _ -> return $ Yield x ()) ()+#endif++-- Adapted from the vector package++-- |+-- >>> replicateM n = Stream.sequence . Stream.replicate n+--+-- Generate a stream by performing a monadic action @n@ times.+{-# INLINE_NORMAL replicateM #-}+replicateM :: Monad m => Int -> m a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+replicateM n p = unfold Unfold.replicateM (n, p)+#else+replicateM n p = Stream step n+  where+    {-# INLINE_LATE step #-}+    step _ (i :: Int)+      | i <= 0    = return Stop+      | otherwise = do+          x <- p+          return $ Yield x (i - 1)+#endif++-- |+-- >>> replicate n = Stream.take n . Stream.repeat+-- >>> replicate n x = Stream.replicateM n (pure x)+--+-- Generate a stream of length @n@ by repeating a value @n@ times.+--+{-# INLINE_NORMAL replicate #-}+replicate :: Monad m => Int -> a -> Stream m a+replicate n x = replicateM n (return x)++------------------------------------------------------------------------------+-- Enumeration of Num+------------------------------------------------------------------------------++-- | For floating point numbers if the increment is less than the precision then+-- it just gets lost. Therefore we cannot always increment it correctly by just+-- repeated addition.+-- 9007199254740992 + 1 + 1 :: Double => 9.007199254740992e15+-- 9007199254740992 + 2     :: Double => 9.007199254740994e15+--+-- Instead we accumulate the increment counter and compute the increment+-- every time before adding it to the starting number.+--+-- This works for Integrals as well as floating point numbers, but+-- enumerateFromStepIntegral is faster for integrals.+{-# INLINE_NORMAL enumerateFromStepNum #-}+enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromStepNum from stride =+    unfold Unfold.enumerateFromStepNum (from, stride)+#else+enumerateFromStepNum from stride = Stream step 0+    where+    {-# INLINE_LATE step #-}+    step _ !i = return $ (Yield $! (from + i * stride)) $! (i + 1)+#endif++{-# INLINE_NORMAL enumerateFromNum #-}+enumerateFromNum :: (Monad m, Num a) => a -> Stream m a+enumerateFromNum from = enumerateFromStepNum from 1++{-# INLINE_NORMAL enumerateFromThenNum #-}+enumerateFromThenNum :: (Monad m, Num a) => a -> a -> Stream m a+enumerateFromThenNum from next = enumerateFromStepNum from (next - from)++------------------------------------------------------------------------------+-- Enumeration of Integrals+------------------------------------------------------------------------------++#ifndef USE_UNFOLDS_EVERYWHERE+data EnumState a = EnumInit | EnumYield a a a | EnumStop++{-# INLINE_NORMAL enumerateFromThenToIntegralUp #-}+enumerateFromThenToIntegralUp+    :: (Monad m, Integral a)+    => a -> a -> a -> Stream m a+enumerateFromThenToIntegralUp from next to = Stream step EnumInit+    where+    {-# INLINE_LATE step #-}+    step _ EnumInit =+        return $+            if to < next+            then if to < from+                 then Stop+                 else Yield from EnumStop+            else -- from <= next <= to+                let stride = next - from+                in Skip $ EnumYield from stride (to - stride)++    step _ (EnumYield x stride toMinus) =+        return $+            if x > toMinus+            then Yield x EnumStop+            else Yield x $ EnumYield (x + stride) stride toMinus++    step _ EnumStop = return Stop++{-# INLINE_NORMAL enumerateFromThenToIntegralDn #-}+enumerateFromThenToIntegralDn+    :: (Monad m, Integral a)+    => a -> a -> a -> Stream m a+enumerateFromThenToIntegralDn from next to = Stream step EnumInit+    where+    {-# INLINE_LATE step #-}+    step _ EnumInit =+        return $ if to > next+            then if to > from+                 then Stop+                 else Yield from EnumStop+            else -- from >= next >= to+                let stride = next - from+                in Skip $ EnumYield from stride (to - stride)++    step _ (EnumYield x stride toMinus) =+        return $+            if x < toMinus+            then Yield x EnumStop+            else Yield x $ EnumYield (x + stride) stride toMinus++    step _ EnumStop = return Stop+#endif++-- XXX This can perhaps be simplified and written in terms of+-- enumeratFromStepIntegral as we have done in unfolds.++-- | Enumerate an 'Integral' type in steps up to a given limit.+-- @enumerateFromThenToIntegral from then to@ generates a finite stream whose+-- first element is @from@, the second element is @then@ and the successive+-- elements are in increments of @then - from@ up to @to@.+--+-- >>> Stream.toList $ Stream.enumerateFromThenToIntegral 0 2 6+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)+-- [0,-2,-4,-6]+--+{-# INLINE_NORMAL enumerateFromThenToIntegral #-}+enumerateFromThenToIntegral+    :: (Monad m, Integral a)+    => a -> a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromThenToIntegral from next to =+    unfold Unfold.enumerateFromThenToIntegral (from, next, to)+#else+enumerateFromThenToIntegral from next to+    | next >= from = enumerateFromThenToIntegralUp from next to+    | otherwise    = enumerateFromThenToIntegralDn from next to+#endif++-- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from+-- then@ generates a stream whose first element is @from@, the second element+-- is @then@ and the successive elements are in increments of @then - from@.+-- The stream is bounded by the size of the 'Integral' type.+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)+-- [0,-2,-4,-6]+--+{-# INLINE_NORMAL enumerateFromThenIntegral #-}+enumerateFromThenIntegral+    :: (Monad m, Integral a, Bounded a)+    => a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromThenIntegral from next =+    unfold Unfold.enumerateFromThenIntegralBounded (from, next)+#else+enumerateFromThenIntegral from next =+    if next > from+    then enumerateFromThenToIntegralUp from next maxBound+    else enumerateFromThenToIntegralDn from next minBound+#endif++-- | @enumerateFromStepIntegral from step@ generates an infinite stream whose+-- first element is @from@ and the successive elements are in increments of+-- @step@.+--+-- CAUTION: This function is not safe for finite integral types. It does not+-- check for overflow, underflow or bounds.+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2+-- [0,2,4,6]+--+-- >>> Stream.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)+-- [0,-2,-4]+--+{-# INLINE_NORMAL enumerateFromStepIntegral #-}+enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+enumerateFromStepIntegral from stride =+    unfold Unfold.enumerateFromStepIntegral (from, stride)+#else+enumerateFromStepIntegral from stride =+    from `seq` stride `seq` Stream step from+    where+        {-# INLINE_LATE step #-}+        step _ !x = return $ Yield x $! (x + stride)+#endif++-- | Enumerate an 'Integral' type up to a given limit.+-- @enumerateFromToIntegral from to@ generates a finite stream whose first+-- element is @from@ and successive elements are in increments of @1@ up to+-- @to@.+--+-- >>> Stream.toList $ Stream.enumerateFromToIntegral 0 4+-- [0,1,2,3,4]+--+{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a+enumerateFromToIntegral from to =+    takeWhile (<= to) $ enumerateFromStepIntegral from 1++-- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a+-- stream whose first element is @from@ and the successive elements are in+-- increments of @1@. The stream is bounded by the size of the 'Integral' type.+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)+-- [0,1,2,3]+--+{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a+enumerateFromIntegral from = enumerateFromToIntegral from maxBound++------------------------------------------------------------------------------+-- Enumeration of Fractionals+------------------------------------------------------------------------------++-- We cannot write a general function for Num.  The only way to write code+-- portable between the two is to use a 'Real' constraint and convert between+-- Fractional and Integral using fromRational which is horribly slow.++-- Even though the underlying implementation of enumerateFromFractional and+-- enumerateFromThenFractional works for any 'Num' we have restricted these to+-- 'Fractional' because these do not perform any bounds check, in contrast to+-- integral versions and are therefore not equivalent substitutes for those.++-- | Numerically stable enumeration from a 'Fractional' number in steps of size+-- @1@. @enumerateFromFractional from@ generates a stream whose first element+-- is @from@ and the successive elements are in increments of @1@.  No overflow+-- or underflow checks are performed.+--+-- This is the equivalent to 'enumFrom' for 'Fractional' types. For example:+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1+-- [1.1,2.1,3.1,4.1]+--+{-# INLINE enumerateFromFractional #-}+enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a+enumerateFromFractional = enumerateFromNum++-- | Numerically stable enumeration from a 'Fractional' number in steps.+-- @enumerateFromThenFractional from then@ generates a stream whose first+-- element is @from@, the second element is @then@ and the successive elements+-- are in increments of @then - from@.  No overflow or underflow checks are+-- performed.+--+-- This is the equivalent of 'enumFromThen' for 'Fractional' types. For+-- example:+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1+-- [1.1,2.1,3.1,4.1]+--+-- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)+-- [1.1,-2.1,-5.300000000000001,-8.500000000000002]+--+{-# INLINE enumerateFromThenFractional #-}+enumerateFromThenFractional+    :: (Monad m, Fractional a)+    => a -> a -> Stream m a+enumerateFromThenFractional = enumerateFromThenNum++-- | Numerically stable enumeration from a 'Fractional' number to a given+-- limit.  @enumerateFromToFractional from to@ generates a finite stream whose+-- first element is @from@ and successive elements are in increments of @1@ up+-- to @to@.+--+-- This is the equivalent of 'enumFromTo' for 'Fractional' types. For+-- example:+--+-- >>> Stream.toList $ Stream.enumerateFromToFractional 1.1 4+-- [1.1,2.1,3.1,4.1]+--+-- >>> Stream.toList $ Stream.enumerateFromToFractional 1.1 4.6+-- [1.1,2.1,3.1,4.1,5.1]+--+-- Notice that the last element is equal to the specified @to@ value after+-- rounding to the nearest integer.+--+{-# INLINE_NORMAL enumerateFromToFractional #-}+enumerateFromToFractional+    :: (Monad m, Fractional a, Ord a)+    => a -> a -> Stream m a+enumerateFromToFractional from to =+    takeWhile (<= to + 1 / 2) $ enumerateFromStepNum from 1++-- | Numerically stable enumeration from a 'Fractional' number in steps up to a+-- given limit.  @enumerateFromThenToFractional from then to@ generates a+-- finite stream whose first element is @from@, the second element is @then@+-- and the successive elements are in increments of @then - from@ up to @to@.+--+-- This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For+-- example:+--+-- >>> Stream.toList $ Stream.enumerateFromThenToFractional 0.1 2 6+-- [0.1,2.0,3.9,5.799999999999999]+--+-- >>> Stream.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)+-- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]+--+{-# INLINE_NORMAL enumerateFromThenToFractional #-}+enumerateFromThenToFractional+    :: (Monad m, Fractional a, Ord a)+    => a -> a -> a -> Stream m a+enumerateFromThenToFractional from next to =+    takeWhile predicate $ enumerateFromThenFractional from next+    where+    mid = (next - from) / 2+    predicate | next >= from  = (<= to + mid)+              | otherwise     = (>= to + mid)++-------------------------------------------------------------------------------+-- Enumeration of Enum types not larger than Int+-------------------------------------------------------------------------------+--+-- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.+--+{-# INLINE enumerateFromToSmall #-}+enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a+enumerateFromToSmall from to =+      fmap toEnum+    $ enumerateFromToIntegral (fromEnum from) (fromEnum to)++-- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.+--+{-# INLINE enumerateFromThenToSmall #-}+enumerateFromThenToSmall :: (Monad m, Enum a)+    => a -> a -> a -> Stream m a+enumerateFromThenToSmall from next to =+          fmap toEnum+        $ enumerateFromThenToIntegral+            (fromEnum from) (fromEnum next) (fromEnum to)++-- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.+--+-- Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a+-- type is bounded but does not have a 'Bounded' instance then we can go on+-- enumerating it beyond the legal values of the type, resulting in the failure+-- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'+-- instance for this function to be safely used.+--+{-# INLINE enumerateFromThenSmallBounded #-}+enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a)+    => a -> a -> Stream m a+enumerateFromThenSmallBounded from next =+    if fromEnum next >= fromEnum from+    then enumerateFromThenTo from next maxBound+    else enumerateFromThenTo from next minBound++-------------------------------------------------------------------------------+-- Enumerable type class+-------------------------------------------------------------------------------+--+-- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream+-- enumerations like this:+--+-- {-# RULES "fromList enumFrom" [1]+--     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}+--+-- But this does not work because enumFrom is a class method and GHC rewrites+-- it quickly, so we do not get a chance to have our rule fired.++-- | Types that can be enumerated as a stream. The operations in this type+-- class are equivalent to those in the 'Enum' type class, except that these+-- generate a stream instead of a list. Use the functions in+-- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.+--+class Enum a => Enumerable a where+    -- | @enumerateFrom from@ generates a stream starting with the element+    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or+    -- generating an infinite stream when the type is not 'Bounded'.+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)+    -- [0,1,2,3]+    --+    -- For 'Fractional' types, enumeration is numerically stable. However, no+    -- overflow or underflow checks are performed.+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1+    -- [1.1,2.1,3.1,4.1]+    --+    enumerateFrom :: (Monad m) => a -> Stream m a++    -- | Generate a finite stream starting with the element @from@, enumerating+    -- the type up to the value @to@. If @to@ is smaller than @from@ then an+    -- empty stream is returned.+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 0 4+    -- [0,1,2,3,4]+    --+    -- For 'Fractional' types, the last element is equal to the specified @to@+    -- value after rounding to the nearest integral value.+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 1.1 4+    -- [1.1,2.1,3.1,4.1]+    --+    -- >>> Stream.toList $ Stream.enumerateFromTo 1.1 4.6+    -- [1.1,2.1,3.1,4.1,5.1]+    --+    enumerateFromTo :: (Monad m) => a -> a -> Stream m a++    -- | @enumerateFromThen from then@ generates a stream whose first element+    -- is @from@, the second element is @then@ and the successive elements are+    -- in increments of @then - from@.  Enumeration can occur downwards or+    -- upwards depending on whether @then@ comes before or after @from@. For+    -- 'Bounded' types the stream ends when 'maxBound' is reached, for+    -- unbounded types it keeps enumerating infinitely.+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2+    -- [0,2,4,6]+    --+    -- >>> Stream.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)+    -- [0,-2,-4,-6]+    --+    enumerateFromThen :: (Monad m) => a -> a -> Stream m a++    -- | @enumerateFromThenTo from then to@ generates a finite stream whose+    -- first element is @from@, the second element is @then@ and the successive+    -- elements are in increments of @then - from@ up to @to@. Enumeration can+    -- occur downwards or upwards depending on whether @then@ comes before or+    -- after @from@.+    --+    -- >>> Stream.toList $ Stream.enumerateFromThenTo 0 2 6+    -- [0,2,4,6]+    --+    -- >>> Stream.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)+    -- [0,-2,-4,-6]+    --+    enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a++-- MAYBE: Sometimes it is more convenient to know the count rather then the+-- ending or starting element. For those cases we can define the folllowing+-- APIs. All of these will work only for bounded types if we represent the+-- count by Int.+--+-- enumerateN+-- enumerateFromN+-- enumerateToN+-- enumerateFromStep+-- enumerateFromStepN++-------------------------------------------------------------------------------+-- Convenient functions for bounded types+-------------------------------------------------------------------------------+--+-- |+-- > enumerate = enumerateFrom minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'+--+{-# INLINE enumerate #-}+enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a+enumerate = enumerateFrom minBound++-- |+-- >>> enumerateTo = Stream.enumerateFromTo minBound+--+-- Enumerate a 'Bounded' type from its 'minBound' to specified value.+--+{-# INLINE enumerateTo #-}+enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a+enumerateTo = enumerateFromTo minBound++-- |+-- >>> enumerateFromBounded from = Stream.enumerateFromTo from maxBound+--+-- 'enumerateFrom' for 'Bounded' 'Enum' types.+--+{-# INLINE enumerateFromBounded #-}+enumerateFromBounded :: (Monad m, Enumerable a, Bounded a)+    => a -> Stream m a+enumerateFromBounded from = enumerateFromTo from maxBound++-------------------------------------------------------------------------------+-- Enumerable Instances+-------------------------------------------------------------------------------+--+-- For Enum types smaller than or equal to Int size.+#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \+instance Enumerable SMALL_TYPE where {                 \+    {-# INLINE enumerateFrom #-};                      \+    enumerateFrom = enumerateFromBounded;              \+    {-# INLINE enumerateFromThen #-};                  \+    enumerateFromThen = enumerateFromThenSmallBounded; \+    {-# INLINE enumerateFromTo #-};                    \+    enumerateFromTo = enumerateFromToSmall;            \+    {-# INLINE enumerateFromThenTo #-};                \+    enumerateFromThenTo = enumerateFromThenToSmall }++ENUMERABLE_BOUNDED_SMALL(())+ENUMERABLE_BOUNDED_SMALL(Bool)+ENUMERABLE_BOUNDED_SMALL(Ordering)+ENUMERABLE_BOUNDED_SMALL(Char)++-- For bounded Integral Enum types, may be larger than Int.+#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \+instance Enumerable INTEGRAL_TYPE where {           \+    {-# INLINE enumerateFrom #-};                   \+    enumerateFrom = enumerateFromIntegral;          \+    {-# INLINE enumerateFromThen #-};               \+    enumerateFromThen = enumerateFromThenIntegral;  \+    {-# INLINE enumerateFromTo #-};                 \+    enumerateFromTo = enumerateFromToIntegral;      \+    {-# INLINE enumerateFromThenTo #-};             \+    enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_BOUNDED_INTEGRAL(Int)+ENUMERABLE_BOUNDED_INTEGRAL(Int8)+ENUMERABLE_BOUNDED_INTEGRAL(Int16)+ENUMERABLE_BOUNDED_INTEGRAL(Int32)+ENUMERABLE_BOUNDED_INTEGRAL(Int64)+ENUMERABLE_BOUNDED_INTEGRAL(Word)+ENUMERABLE_BOUNDED_INTEGRAL(Word8)+ENUMERABLE_BOUNDED_INTEGRAL(Word16)+ENUMERABLE_BOUNDED_INTEGRAL(Word32)+ENUMERABLE_BOUNDED_INTEGRAL(Word64)++-- For unbounded Integral Enum types.+#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \+instance Enumerable INTEGRAL_TYPE where {                         \+    {-# INLINE enumerateFrom #-};                                 \+    enumerateFrom from = enumerateFromStepIntegral from 1;        \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen from next =                                 \+        enumerateFromStepIntegral from (next - from);             \+    {-# INLINE enumerateFromTo #-};                               \+    enumerateFromTo = enumerateFromToIntegral;                    \+    {-# INLINE enumerateFromThenTo #-};                           \+    enumerateFromThenTo = enumerateFromThenToIntegral }++ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)+ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)++#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \+instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \+    {-# INLINE enumerateFrom #-};                                 \+    enumerateFrom = enumerateFromFractional;                      \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen = enumerateFromThenFractional;              \+    {-# INLINE enumerateFromTo #-};                               \+    enumerateFromTo = enumerateFromToFractional;                  \+    {-# INLINE enumerateFromThenTo #-};                           \+    enumerateFromThenTo = enumerateFromThenToFractional }++ENUMERABLE_FRACTIONAL(Float,)+ENUMERABLE_FRACTIONAL(Double,)+ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)+ENUMERABLE_FRACTIONAL((Ratio a),Integral a)++instance Enumerable a => Enumerable (Identity a) where+    {-# INLINE enumerateFrom #-}+    enumerateFrom (Identity from) =+        fmap Identity $ enumerateFrom from+    {-# INLINE enumerateFromThen #-}+    enumerateFromThen (Identity from) (Identity next) =+        fmap Identity $ enumerateFromThen from next+    {-# INLINE enumerateFromTo #-}+    enumerateFromTo (Identity from) (Identity to) =+        fmap Identity $ enumerateFromTo from to+    {-# INLINE enumerateFromThenTo #-}+    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =+          fmap Identity+        $ enumerateFromThenTo from next to++-- TODO+{-+instance Enumerable a => Enumerable (Last a)+instance Enumerable a => Enumerable (First a)+instance Enumerable a => Enumerable (Max a)+instance Enumerable a => Enumerable (Min a)+instance Enumerable a => Enumerable (Const a b)+instance Enumerable (f a) => Enumerable (Alt f a)+instance Enumerable (f a) => Enumerable (Ap f a)+-}+------------------------------------------------------------------------------+-- Time Enumeration+------------------------------------------------------------------------------++-- | @timesWith g@ returns a stream of time value tuples. The first component+-- of the tuple is an absolute time reference (epoch) denoting the start of the+-- stream and the second component is a time relative to the reference.+--+-- The argument @g@ specifies the granularity of the relative time in seconds.+-- A lower granularity clock gives higher precision but is more expensive in+-- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.+--+-- >>> import Control.Concurrent (threadDelay)+-- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)+-- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE_NORMAL timesWith #-}+timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)+timesWith g = Stream step Nothing++    where++    {-# INLINE_LATE step #-}+    step _ Nothing = do+        clock <- liftIO $ asyncClock Monotonic g+        a <- liftIO $ readClock clock+        return $ Skip $ Just (clock, a)++    step _ s@(Just (clock, t0)) = do+        a <- liftIO $ readClock clock+        -- XXX we can perhaps use an AbsTime64 using a 64 bit Int for+        -- efficiency.  or maybe we can use a representation using Double for+        -- floating precision time+        return $ Yield (toAbsTime t0, toRelTime64 (a - t0)) s++-- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of+-- granularity @g@ specified in seconds. A low granularity clock is more+-- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated+-- as 1 ms.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE absTimesWith #-}+absTimesWith :: MonadIO m => Double -> Stream m AbsTime+absTimesWith = fmap (uncurry addToAbsTime64) . timesWith++-- | @relTimesWith g@ returns a stream of relative time values starting from 0,+-- using a clock of granularity @g@ specified in seconds. A low granularity+-- clock is more expensive in terms of CPU usage.  Any granularity lower than 1+-- ms is treated as 1 ms.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE relTimesWith #-}+relTimesWith :: MonadIO m => Double -> Stream m RelTime64+relTimesWith = fmap snd . timesWith++-- | @times@ returns a stream of time value tuples with clock of 10 ms+-- granularity. The first component of the tuple is an absolute time reference+-- (epoch) denoting the start of the stream and the second component is a time+-- relative to the reference.+--+-- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)+-- >>> Stream.fold f $ Stream.take 3 $ Stream.times+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+-- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE times #-}+times :: MonadIO m => Stream m (AbsTime, RelTime64)+times = timesWith 0.01++-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms+-- granularity.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+-- AbsTime (TimeSpec {sec = ..., nsec = ...})+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE absTimes #-}+absTimes :: MonadIO m => Stream m AbsTime+absTimes = fmap (uncurry addToAbsTime64) times++-- | @relTimes@ returns a stream of relative time values starting from 0,+-- using a clock of granularity 10 ms.+--+-- >>> f = Fold.drainMapM print+-- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+-- RelTime64 (NanoSecond64 ...)+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Pre-release/+--+{-# INLINE relTimes #-}+relTimes ::  MonadIO m => Stream m RelTime64+relTimes = fmap snd times++-- | @durations g@ returns a stream of relative time values measuring the time+-- elapsed since the immediate predecessor element of the stream was generated.+-- The first element of the stream is always 0. @durations@ uses a clock of+-- granularity @g@ specified in seconds. A low granularity clock is more+-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.+-- Durations lower than 1 ms will be 0.+--+-- Note: This API is not safe on 32-bit machines.+--+-- /Unimplemented/+--+{-# INLINE durations #-}+durations :: -- Monad m =>+    Double -> t m RelTime64+durations = undefined++-- | Generate a singleton event at or after the specified absolute time. Note+-- that this is different from a threadDelay, a threadDelay starts from the+-- time when the action is evaluated, whereas if we use AbsTime based timeout+-- it will immediately expire if the action is evaluated too late.+--+-- /Unimplemented/+--+{-# INLINE timeout #-}+timeout :: -- Monad m =>+    AbsTime -> t m ()+timeout = undefined++-------------------------------------------------------------------------------+-- From Generators+-------------------------------------------------------------------------------++{-# INLINE_NORMAL fromIndicesM #-}+fromIndicesM :: Monad m => (Int -> m a) -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+fromIndicesM gen = unfold (Unfold.fromIndicesM gen) 0+#else+fromIndicesM gen = Stream step 0+  where+    {-# INLINE_LATE step #-}+    step _ i = do+       x <- gen i+       return $ Yield x (i + 1)+#endif++{-# INLINE fromIndices #-}+fromIndices :: Monad m => (Int -> a) -> Stream m a+fromIndices gen = fromIndicesM (return . gen)++-- Adapted from the vector package+{-# INLINE_NORMAL generateM #-}+generateM :: Monad m => Int -> (Int -> m a) -> Stream m a+generateM n gen = n `seq` Stream step 0+  where+    {-# INLINE_LATE step #-}+    step _ i | i < n     = do+                           x <- gen i+                           return $ Yield x (i + 1)+             | otherwise = return Stop++{-# INLINE generate #-}+generate :: Monad m => Int -> (Int -> a) -> Stream m a+generate n gen = generateM n (return . gen)++-------------------------------------------------------------------------------+-- Iteration+-------------------------------------------------------------------------------++-- | Generate an infinite stream with the first element generated by the action+-- @m@ and each successive element derived by applying the monadic function @f@+-- on the previous element.+--+-- >>> :{+-- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0)+--     & Stream.take 3+--     & Stream.toList+-- :}+-- 0+-- 1+-- [0,1,2]+--+{-# INLINE_NORMAL iterateM #-}+iterateM :: Monad m => (a -> m a) -> m a -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+iterateM step = unfold (Unfold.iterateM step)+#else+iterateM step = Stream (\_ st -> st >>= \(!x) -> return $ Yield x (step x))+#endif++-- | Generate an infinite stream with @x@ as the first element and each+-- successive element derived by applying the function @f@ on the previous+-- element.+--+-- >>> Stream.toList $ Stream.take 5 $ Stream.iterate (+1) 1+-- [1,2,3,4,5]+--+{-# INLINE_NORMAL iterate #-}+iterate :: Monad m => (a -> a) -> a -> Stream m a+iterate step st = iterateM (return . step) (return st)++-------------------------------------------------------------------------------+-- From containers+-------------------------------------------------------------------------------++-- | Convert a list of monadic actions to a 'Stream'+{-# INLINE_LATE fromListM #-}+fromListM :: Monad m => [m a] -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+fromListM = unfold Unfold.fromListM+#else+fromListM = Stream step+  where+    {-# INLINE_LATE step #-}+    step _ (m:ms) = m >>= \x -> return $ Yield x ms+    step _ []     = return Stop+#endif++-- |+-- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil+--+-- Construct a stream from a 'Foldable' containing pure values:+--+-- /WARNING: O(n^2), suitable only for a small number of+-- elements in the stream/+--+{-# INLINE fromFoldable #-}+fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a+fromFoldable = Prelude.foldr cons nil++-- |+-- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil+--+-- Construct a stream from a 'Foldable' containing pure values:+--+-- /WARNING: O(n^2), suitable only for a small number of+-- elements in the stream/+--+{-# INLINE fromFoldableM #-}+fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a+fromFoldableM = Prelude.foldr consM nil++-------------------------------------------------------------------------------+-- From pointers+-------------------------------------------------------------------------------++-- | Keep reading 'Storable' elements from an immutable 'Ptr' onwards.+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- /Pre-release/+{-# INLINE fromPtr #-}+fromPtr :: forall m a. (Monad m, Storable a) => Ptr a -> Stream m a+fromPtr = Stream step++    where++    {-# INLINE_LATE step #-}+    step _ p = do+        let !x = unsafeInlineIO $ peek p+        return $ Yield x (PTR_NEXT(p, a))++-- | Take @n@ 'Storable' elements starting from an immutable 'Ptr' onwards.+--+-- >>> fromPtrN n = Stream.take n . Stream.fromPtr+--+-- /Unsafe:/ The caller is responsible for safe addressing.+--+-- /Pre-release/+{-# INLINE fromPtrN #-}+fromPtrN :: (Monad m, Storable a) => Int -> Ptr a -> Stream m a+fromPtrN n = take n . fromPtr++-- | Read bytes from an immutable 'Addr#' until a 0 byte is encountered, the 0+-- byte is not included in the stream.+--+-- >>> :set -XMagicHash+-- >>> 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.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# = 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
@@ -1,16 +1,19 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Lift--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC+--+-- Transform the underlying monad of a stream.  module Streamly.Internal.Data.Stream.Lift     (     -- * Generalize Inner Monad       morphInner-    , generalizeInner+    , generalizeInner -- XXX rename to morphPure      -- * Transform Inner Monad     , liftInnerWith@@ -19,22 +22,19 @@     ) where -import Data.Functor.Identity (Identity (..))-import Streamly.Internal.Data.Stream.Type-    (Stream, fromStreamD, toStreamD, fromStreamK, toStreamK)+#include "inline.hs" -import qualified Streamly.Internal.Data.Stream.StreamD as D-import qualified Streamly.Internal.Data.Stream.StreamK as K+import Data.Functor.Identity (Identity(..))+import Streamly.Internal.Data.SVar.Type (adaptState) --- $setup--- >>> :m--- >>> import Data.Functor.Identity (runIdentity)--- >>> import Streamly.Internal.Data.Stream as Stream+import Streamly.Internal.Data.Stream.Type ---------------------------------------------------------------------------------- Generalize the underlying monad-------------------------------------------------------------------------------+#include "DocTestDataStream.hs" +-------------------------------------------------------------------------------+-- Generalize Inner Monad+-------------------------------------------------------------------------------+ -- | Transform the inner monad of a stream using a natural transformation. -- -- Example, generalize the inner monad from Identity to any other:@@ -43,11 +43,17 @@ -- -- Also known as hoist. ----- /CPS/-{-# INLINE morphInner #-}-morphInner :: (Monad m, Monad n)-    => (forall x. m x -> n x) -> Stream m a -> Stream n a-morphInner f xs = fromStreamK $ K.hoist f (toStreamK xs)+{-# INLINE_NORMAL morphInner #-}+morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a+morphInner f (Stream step state) = Stream step' state+    where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- f $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip  s   -> Skip s+            Stop      -> Stop  -- | Generalize the inner monad of the stream from 'Identity' to any monad. --@@ -55,41 +61,69 @@ -- -- >>> generalizeInner = Stream.morphInner (return . runIdentity) ----- /CPS/--- {-# INLINE generalizeInner #-} generalizeInner :: Monad m => Stream Identity a -> Stream m a generalizeInner = morphInner (return . runIdentity)-    -- fromStreamK $ K.hoist (return . runIdentity) (toStreamK xs) ---------------------------------------------------------------------------------- Add and remove a monad transformer-------------------------------------------------------------------------------+-------------------------------------------------------------------------------+-- Transform Inner Monad+-------------------------------------------------------------------------------  -- | Lift the inner monad @m@ of a stream @Stream m a@ to @t m@ using the -- supplied lift function. ---{-# INLINE liftInnerWith #-}-liftInnerWith :: (Monad m, Monad (t m))-    => (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a-liftInnerWith lift xs = fromStreamD $ D.liftInnerWith lift (toStreamD xs)+{-# INLINE_NORMAL liftInnerWith #-}+liftInnerWith :: (Monad (t m)) =>+    (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a+liftInnerWith lift (Stream step state) = Stream step1 state +    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- lift $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip s    -> Skip s+            Stop      -> Stop+ -- | Evaluate the inner monad of a stream using the supplied runner function. ---{-# INLINE runInnerWith #-}-runInnerWith :: (Monad m, Applicative (t m)) =>+{-# INLINE_NORMAL runInnerWith #-}+runInnerWith :: Monad m =>     (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a-runInnerWith run xs = fromStreamD $ D.runInnerWith run (toStreamD xs)+runInnerWith run (Stream step state) = Stream step1 state +    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- run $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip s -> Skip s+            Stop -> Stop+ -- | Evaluate the inner monad of a stream using the supplied stateful runner -- function and the initial state. The state returned by an invocation of the -- runner is supplied as input state to the next invocation. ---{-# INLINE runInnerWithState #-}-runInnerWithState :: (Monad m, Applicative (t m)) =>-       (forall b. s -> t m b -> m (b, s))+{-# INLINE_NORMAL runInnerWithState #-}+runInnerWithState :: Monad m =>+    (forall b. s -> t m b -> m (b, s))     -> m s     -> Stream (t m) a     -> Stream m (s, a)-runInnerWithState run initial xs =-    fromStreamD $ D.runInnerWithState run initial (toStreamD xs)+runInnerWithState run initial (Stream step state) =+    Stream step1 (state, initial)++    where++    {-# INLINE_LATE step1 #-}+    step1 gst (st, action) = do+        sv <- action+        (r, !sv1) <- run sv (step (adaptState gst) st)+        return $ case r of+            Yield x s -> Yield (sv1, x) (s, return sv1)+            Skip s -> Skip (s, return sv1)+            Stop -> Stop
+ src/Streamly/Internal/Data/Stream/Nesting.hs view
@@ -0,0 +1,3981 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Nesting+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- This module contains transformations involving multiple streams, unfolds or+-- folds. There are two types of transformations generational or eliminational.+-- Generational transformations are like the "Generate" module but they+-- generate a stream by combining streams instead of elements. Eliminational+-- transformations are like the "Eliminate" module but they transform a stream+-- by eliminating parts of the stream instead of eliminating the whole stream.+--+-- These combinators involve transformation, generation, elimination so can be+-- classified under any of those.++-- 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 #-}+dropSuffix ::+    -- (Monad m, Eq a) =>+    Stream m a -> Stream m a -> Stream m a+dropSuffix = error "Not implemented yet!"
− src/Streamly/Internal/Data/Stream/Reduce.hs 
@@ -1,444 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.Reduce--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Reduce streams by streams, folds or parsers.--module Streamly.Internal.Data.Stream.Reduce-    (-    -- * Reduce By Streams-      dropPrefix-    , dropInfix-    , dropSuffix--    -- * Reduce By Folds-    -- |-    -- Reduce a stream by folding or parsing chunks of the stream.  Functions-    -- generally ending in these shapes:-    ---    -- @-    -- f (Fold m a b) -> Stream m a -> Stream m b-    -- f (Parser a m b) -> Stream m a -> Stream m b-    -- @--    -- ** Generic Folding-    -- | Apply folds on a stream.-    , foldMany-    , foldManyPost-    , refoldMany-    , foldSequence-    , foldIterateM-    , refoldIterateM-    , reduceIterateBfs--    -- ** Chunking-    -- | Element unaware grouping.-    , chunksOf--    -- ** Splitting-    -- XXX Implement these as folds or parsers instead.-    , splitOnSuffixSeqAny-    , splitOnPrefix-    , splitOnAny--    -- * Reduce By Parsers-    -- ** Generic Parsing-    -- | Apply parsers on a stream.-    , parseMany-    , parseManyD-    , parseManyTill-    , parseSequence-    , parseIterate--    )-where--import Control.Monad.IO.Class (MonadIO(..))-import Streamly.Internal.Data.Array.Type (Array)-import Streamly.Internal.Data.Fold.Type (Fold (..))-import Streamly.Internal.Data.Parser (Parser (..))-import Streamly.Internal.Data.Parser.ParserD (ParseError)-import Streamly.Internal.Data.Refold.Type (Refold (..))-import Streamly.Internal.Data.Stream.Bottom (foldManyPost)-import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)-import Streamly.Internal.Data.Unboxed (Unbox)--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Parser.ParserD as ParserD-import qualified Streamly.Internal.Data.Stream.StreamD as D--import Prelude hiding (concatMap, map)---- $setup--- >>> :m--- >>> import Prelude hiding (zipWith, concatMap, concat)--- >>> import Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Parser as Parser--- >>> import qualified Streamly.Data.Array as Array----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Drop prefix from the input stream if present.------ Space: @O(1)@------ /Unimplemented/-{-# INLINE dropPrefix #-}-dropPrefix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropPrefix = error "Not implemented yet!"---- | Drop all matching infix from the input stream if present. Infix stream--- may be consumed multiple times.------ Space: @O(n)@ where n is the length of the infix.------ /Unimplemented/-{-# INLINE dropInfix #-}-dropInfix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropInfix = error "Not implemented yet!"---- | Drop suffix from the input stream if present. Suffix stream may be--- consumed multiple times.------ Space: @O(n)@ where n is the length of the suffix.------ /Unimplemented/-{-# INLINE dropSuffix #-}-dropSuffix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropSuffix = error "Not implemented yet!"----------------------------------------------------------------------------------- Folding----------------------------------------------------------------------------------- | Apply a 'Fold' repeatedly on a stream and emit the results in the--- output stream. Unlike 'foldManyPost' it evaluates the fold after the stream,--- therefore, an empty input stream results in an empty output stream.------ Definition:------ >>> foldMany f = Stream.parseMany (Parser.fromFold f)------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f--- >>> fmany $ Stream.fromList []--- []------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream on a non-empty input stream.----{-# INLINE foldMany #-}-foldMany-    :: Monad m-    => Fold m a b-    -> Stream m a-    -> Stream m b-foldMany f m = fromStreamD $ D.foldMany f (toStreamD m)---- | Like 'foldMany' but using the 'Refold' type instead of 'Fold'.------ /Pre-release/-{-# INLINE refoldMany #-}-refoldMany :: Monad m =>-    Refold m c a b -> m c -> Stream m a -> Stream m b-refoldMany f action = fromStreamD . D.refoldMany f action . toStreamD---- | Apply a stream of folds to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE foldSequence #-}-foldSequence-       :: -- Monad m =>-       Stream m (Fold m a b)-    -> Stream m a-    -> Stream m b-foldSequence _f _m = undefined---- | Iterate a fold generator on a stream. The initial value @b@ is used to--- generate the first fold, the fold is applied on the stream and the result of--- the fold is used to generate the next fold and so on.------ >>> import Data.Monoid (Sum(..))--- >>> f x = return (Fold.take 2 (Fold.sconcat x))--- >>> s = fmap Sum $ Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- folds where next fold is dependent on the previous fold.------ /Pre-release/----{-# INLINE foldIterateM #-}-foldIterateM ::-       Monad m => (b -> m (Fold m a b)) -> m b -> Stream m a -> Stream m b-foldIterateM f i m = fromStreamD $ D.foldIterateM f i (toStreamD m)---- | Like 'foldIterateM' but using the 'Refold' type instead. This could be--- much more efficient due to stream fusion.------ /Internal/-{-# INLINE refoldIterateM #-}-refoldIterateM :: Monad m =>-    Refold m b a b -> m b -> Stream m a -> Stream m b-refoldIterateM c i m = fromStreamD $ D.refoldIterateM c i (toStreamD m)---- | Binary BFS style reduce, folds a level entirely using the supplied fold--- function, collecting the outputs as next level of the tree, then repeats the--- same process on the next level. The last elements of a previously folded--- level are folded first.-{-# INLINE reduceIterateBfs #-}-reduceIterateBfs :: Monad m =>-    (a -> a -> m a) -> Stream m a -> m (Maybe a)-reduceIterateBfs f stream = D.reduceIterateBfs f (toStreamD stream)----------------------------------------------------------------------------------- Splitting----------------------------------------------------------------------------------- Implement this as a fold or a parser instead.--- This can be implemented easily using Rabin Karp--- | Split post any one of the given patterns.------ /Unimplemented/-{-# INLINE splitOnSuffixSeqAny #-}-splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnSuffixSeqAny _subseq _f _m = undefined-    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)---- | Split on a prefixed separator element, dropping the separator.  The--- supplied 'Fold' is applied on the split segments.------ @--- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)--- > splitOnPrefix' (== '.') ".a.b"--- ["a","b"]--- @------ An empty stream results in an empty output stream:--- @--- > splitOnPrefix' (== '.') ""--- []--- @------ An empty segment consisting of only a prefix is folded to the default output--- of the fold:------ @--- > splitOnPrefix' (== '.') "."--- [""]------ > splitOnPrefix' (== '.') ".a.b."--- ["a","b",""]------ > splitOnPrefix' (== '.') ".a..b"--- ["a","","b"]------ @------ A prefix is optional at the beginning of the stream:------ @--- > splitOnPrefix' (== '.') "a"--- ["a"]------ > splitOnPrefix' (== '.') "a.b"--- ["a","b"]--- @------ 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:------ > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id------ Assuming the input stream does not contain the separator:------ > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id------ /Unimplemented/-{-# INLINE splitOnPrefix #-}-splitOnPrefix :: -- (IsStream t, MonadCatch m) =>-    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-splitOnPrefix _predicate _f = undefined-    -- parseMany (Parser.sliceBeginBy predicate f)---- Int list examples for splitOn:------ >>> splitList [] [1,2,3,3,4]--- > [[1],[2],[3],[3],[4]]------ >>> splitList [5] [1,2,3,3,4]--- > [[1,2,3,3,4]]------ >>> splitList [1] [1,2,3,3,4]--- > [[],[2,3,3,4]]------ >>> splitList [4] [1,2,3,3,4]--- > [[1,2,3,3],[]]------ >>> splitList [2] [1,2,3,3,4]--- > [[1],[3,3,4]]------ >>> splitList [3] [1,2,3,3,4]--- > [[1,2],[],[4]]------ >>> splitList [3,3] [1,2,3,3,4]--- > [[1,2],[4]]------ >>> splitList [1,2,3,3,4] [1,2,3,3,4]--- > [[],[]]---- This can be implemented easily using Rabin Karp--- | Split on any one of the given patterns.------ /Unimplemented/----{-# INLINE splitOnAny #-}-splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnAny _subseq _f _m =-    undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)----------------------------------------------------------------------------------- Parsing----------------------------------------------------------------------------------- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the--- output stream.------ Example:------ >>> s = Stream.fromList [1..10]--- >>> parser = Parser.takeBetween 0 2 Fold.sum--- >>> Stream.fold Fold.toList $ Stream.parseMany parser s--- [Right 3,Right 7,Right 11,Right 15,Right 19]------ This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse--- combinator.------ Known Issues: When the parser fails there is no way to get the remaining--- stream.----{-# INLINE parseMany #-}-parseMany-    :: Monad m-    => Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseMany p m =-    fromStreamD $ D.parseManyD p (toStreamD m)---- | Same as parseMany but for StreamD streams.------ /Internal/----{-# INLINE parseManyD #-}-parseManyD-    :: Monad m-    => ParserD.Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseManyD p m =-    fromStreamD $ D.parseManyD p (toStreamD m)---- | Apply a stream of parsers to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE parseSequence #-}-parseSequence-       :: -- Monad m =>-       Stream m (Parser a m b)-    -> Stream m a-    -> Stream m b-parseSequence _f _m = undefined---- XXX Change the parser arguments' order---- | @parseManyTill collect test stream@ tries the parser @test@ on the input,--- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds--- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The--- output of @test@ is discarded and the output of @collect@ is emitted in the--- output stream. The parser fails if @collect@ fails.------ /Unimplemented/----{-# INLINE parseManyTill #-}-parseManyTill ::-    -- MonadThrow m =>-       Parser a m b-    -> Parser a m x-    -> t m a-    -> t m b-parseManyTill = undefined---- | Iterate a parser generating function on a stream. The initial value @b@ is--- used to generate the first parser, the parser is applied on the stream and--- the result is used to generate the next parser and so on.------ >>> import Data.Monoid (Sum(..))--- >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- parsers where next parser is dependent on the previous parser.------ /Pre-release/----{-# INLINE parseIterate #-}-parseIterate-    :: Monad m-    => (b -> Parser a m b)-    -> b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseIterate f i m = fromStreamD $-    D.parseIterateD f i (toStreamD m)----------------------------------------------------------------------------------- Chunking----------------------------------------------------------------------------------- | @chunksOf n stream@ groups the elements in the input stream into arrays of--- @n@ elements each.------ Same as the following but may be more efficient:------ >>> chunksOf n = Stream.foldMany (Array.writeN n)------ /Pre-release/-{-# INLINE chunksOf #-}-chunksOf :: (MonadIO m, Unbox a)-    => Int -> Stream m a -> Stream m (Array a)-chunksOf n = fromStreamD . Array.chunksOf n . toStreamD
+ src/Streamly/Internal/Data/Stream/Step.hs view
@@ -0,0 +1,39 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Step+-- Copyright   : (c) 2018 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Step+    (+    -- * The stream type+      Step (..)+    )+where++import Fusion.Plugin.Types (Fuse(..))++-- | A stream is a succession of 'Step's. A 'Yield' produces a single value and+-- the next state of the stream. 'Stop' indicates there are no more values in+-- the stream.+{-# ANN type Step Fuse #-}+data Step s a = Yield a s | Skip s | Stop++instance Functor (Step s) where+    {-# INLINE fmap #-}+    fmap f (Yield x s) = Yield (f x) s+    fmap _ (Skip s) = Skip s+    fmap _ Stop = Stop++{-+fromPure :: Monad m => a -> s -> m (Step s a)+fromPure a = return . Yield a++skip :: Monad m => s -> m (Step s a)+skip = return . Skip++stop :: Monad m => m (Step s a)+stop = return Stop+-}
src/Streamly/Internal/Data/Stream/StreamD.hs view
@@ -5,38 +5,12 @@ -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC------ Direct style re-implementation of CPS stream in--- "Streamly.Internal.Data.Stream.StreamK".  The symbol or suffix 'D' in this--- module denotes the "Direct" style.  GHC is able to INLINE and fuse direct--- style better, providing better performance than CPS implementation.------ @--- import qualified Streamly.Internal.Data.Stream.StreamD as D--- @  module Streamly.Internal.Data.Stream.StreamD+{-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream\" instead." #-}     (-      module Streamly.Internal.Data.Stream.StreamD.Type-    , module Streamly.Internal.Data.Stream.StreamD.Generate-    , module Streamly.Internal.Data.Stream.StreamD.Eliminate-    , module Streamly.Internal.Data.Stream.StreamD.Exception-    , module Streamly.Internal.Data.Stream.StreamD.Lift-    , module Streamly.Internal.Data.Stream.StreamD.Transformer-    , module Streamly.Internal.Data.Stream.StreamD.Nesting-    , module Streamly.Internal.Data.Stream.StreamD.Transform-    , module Streamly.Internal.Data.Stream.StreamD.Top-    , module Streamly.Internal.Data.Stream.StreamD.Container+      module Streamly.Internal.Data.Stream     ) where -import Streamly.Internal.Data.Stream.StreamD.Type-import Streamly.Internal.Data.Stream.StreamD.Generate-import Streamly.Internal.Data.Stream.StreamD.Eliminate-import Streamly.Internal.Data.Stream.StreamD.Exception-import Streamly.Internal.Data.Stream.StreamD.Lift-import Streamly.Internal.Data.Stream.StreamD.Transformer-import Streamly.Internal.Data.Stream.StreamD.Nesting-import Streamly.Internal.Data.Stream.StreamD.Transform-import Streamly.Internal.Data.Stream.StreamD.Top-import Streamly.Internal.Data.Stream.StreamD.Container+import Streamly.Internal.Data.Stream
− src/Streamly/Internal/Data/Stream/StreamD/Container.hs 
@@ -1,302 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Container--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Stream operations that require transformers or containers like Set or Map.--module Streamly.Internal.Data.Stream.StreamD.Container-    (-      nub--    -- * Joins for unconstrained types-    , joinLeftGeneric-    , joinOuterGeneric--    -- * Joins with Ord constraint-    , joinInner-    , joinLeft-    , joinOuter-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO)-import Control.Monad.Trans.State.Strict (get, put)-import Data.Function ((&))-import Data.Maybe (isJust)-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))-import Streamly.Internal.Data.Stream.StreamD.Type-    (Stream(..), mkCross, unCross)--import qualified Data.Map.Strict as Map-import qualified Data.Set as Set-import qualified Streamly.Data.Fold as Fold-import qualified Streamly.Internal.Data.Array.Generic as Array-import qualified Streamly.Internal.Data.Array.Mut.Type as MA-import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as Stream--#include "DocTestDataStream.hs"---- | The memory used is proportional to the number of unique elements in the--- stream. If we want to limit the memory we can just use "take" to limit the--- uniq elements in the stream.-{-# INLINE_NORMAL nub #-}-nub :: (Monad m, Ord a) => Stream m a -> Stream m a-nub (Stream step1 state1) = Stream step (Set.empty, state1)--    where--    step gst (set, st) = do-        r <- step1 gst st-        return-            $ case r of-                Yield x s ->-                    if Set.member x set-                    then Skip (set, s)-                    else Yield x (Set.insert x set, s)-                Skip s -> Skip (set, s)-                Stop -> Stop---- XXX Generate error if a duplicate insertion is attempted?-toMap ::  (Monad m, Ord k) => Stream m (k, v) -> m (Map.Map k v)-toMap =-    let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty-     in Stream.fold f---- If the second stream is too big it can be partitioned based on hashes and--- then we can process one parition at a time.------ XXX An IntMap may be faster when the keys are Int.--- XXX Use hashmap instead of map?------ | Like 'joinInner' but uses a 'Map' for efficiency.------ If the input streams have duplicate keys, the behavior is undefined.------ For space efficiency use the smaller stream as the second stream.------ Space: O(n)------ Time: O(m + n)------ /Pre-release/-{-# INLINE joinInner #-}-joinInner :: (Monad m, Ord k) =>-    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, b)-joinInner s1 s2 =-    Stream.concatEffect $ do-        km <- toMap s2-        pure $ Stream.mapMaybe (joinAB km) s1--    where--    joinAB kvm (k, a) =-        case k `Map.lookup` kvm of-            Just b -> Just (k, a, b)-            Nothing -> Nothing---- XXX We can do this concurrently.--- XXX If the second stream is sorted and passed as an Array or a seek capable--- stream then we could use binary search if we have an Ord instance or--- Ordering returning function. The time complexity would then become (m x log--- n).---- XXX Check performance of StreamD vs StreamK---- | Like 'joinInner' but emit @(a, Just b)@, and additionally, for those @a@'s--- that are not equal to any @b@ emit @(a, Nothing)@.------ The second stream is evaluated multiple times. If the stream is a--- consume-once stream then the caller should cache it in an 'Data.Array.Array'--- before calling this function. Caching may also improve performance if the--- stream is expensive to evaluate.------ >>> joinRightGeneric eq = flip (Stream.joinLeftGeneric eq)------ Space: O(n) assuming the second stream is cached in memory.------ Time: O(m x n)------ /Unimplemented/-{-# INLINE joinLeftGeneric #-}-joinLeftGeneric :: Monad m =>-    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)-joinLeftGeneric eq s1 s2 = Stream.evalStateT (return False) $ unCross $ do-    a <- mkCross (Stream.liftInner s1)-    -- XXX should we use StreamD monad here?-    -- XXX Is there a better way to perform some action at the end of a loop-    -- iteration?-    mkCross (Stream.fromEffect $ put False)-    let final = Stream.concatEffect $ do-            r <- get-            if r-            then pure Stream.nil-            else pure (Stream.fromPure Nothing)-    b <- mkCross (fmap Just (Stream.liftInner s2) `Stream.append` final)-    case b of-        Just b1 ->-            if a `eq` b1-            then do-                mkCross (Stream.fromEffect $ put True)-                return (a, Just b1)-            else mkCross Stream.nil-        Nothing -> return (a, Nothing)---- XXX rename to joinLeftOrd?---- | A more efficient 'joinLeft' using a hashmap for efficiency.------ Space: O(n)------ Time: O(m + n)------ /Pre-release/-{-# INLINE joinLeft #-}-joinLeft :: (Ord k, Monad m) =>-    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, a, Maybe b)-joinLeft s1 s2 =-    Stream.concatEffect $ do-        km <- toMap s2-        return $ fmap (joinAB km) s1--            where--            joinAB km (k, a) =-                case k `Map.lookup` km of-                    Just b -> (k, a, Just b)-                    Nothing -> (k, a, Nothing)---- XXX We can do this concurrently.---- XXX Check performance of StreamD vs StreamK---- | Like 'joinLeft' but emits a @(Just a, Just b)@. Like 'joinLeft', for those--- @a@'s that are not equal to any @b@ emit @(Just a, Nothing)@, but--- additionally, for those @b@'s that are not equal to any @a@ emit @(Nothing,--- Just b)@.------ For space efficiency use the smaller stream as the second stream.------ Space: O(n)------ Time: O(m x n)------ /Pre-release/-{-# INLINE joinOuterGeneric #-}-joinOuterGeneric :: MonadIO m =>-       (a -> b -> Bool)-    -> Stream m a-    -> Stream m b-    -> Stream m (Maybe a, Maybe b)-joinOuterGeneric eq s1 s =-    Stream.concatEffect $ do-        inputArr <- Array.fromStream s-        let len = Array.length inputArr-        foundArr <--            Stream.fold-            (MA.writeN len)-            (Stream.fromList (Prelude.replicate len False))-        return $ go inputArr foundArr `Stream.append` leftOver inputArr foundArr--    where--    leftOver inputArr foundArr =-            let stream1 = Array.read inputArr-                stream2 = Stream.unfold MA.reader foundArr-            in Stream.filter-                    isJust-                    ( Stream.zipWith (\x y ->-                        if y-                        then Nothing-                        else Just (Nothing, Just x)-                        ) stream1 stream2-                    ) & Stream.catMaybes--    evalState = Stream.evalStateT (return False) . unCross--    go inputArr foundArr = evalState $ do-        a <- mkCross (Stream.liftInner s1)-        -- XXX should we use StreamD monad here?-        -- XXX Is there a better way to perform some action at the end of a loop-        -- iteration?-        mkCross (Stream.fromEffect $ put False)-        let final = Stream.concatEffect $ do-                r <- get-                if r-                then pure Stream.nil-                else pure (Stream.fromPure Nothing)-        (i, b) <--            let stream = Array.read inputArr-             in mkCross-                (Stream.indexed $ fmap Just (Stream.liftInner stream) `Stream.append` final)--        case b of-            Just b1 ->-                if a `eq` b1-                then do-                    mkCross (Stream.fromEffect $ put True)-                    MA.putIndex i foundArr True-                    return (Just a, Just b1)-                else mkCross Stream.nil-            Nothing -> return (Just a, Nothing)---- Put the b's that have been paired, in another hash or mutate the hash to set--- a flag. At the end go through @Stream m b@ and find those that are not in that--- hash to return (Nothing, b).---- | Like 'joinOuter' but uses a 'Map' for efficiency.------ Space: O(m + n)------ Time: O(m + n)------ /Pre-release/-{-# INLINE joinOuter #-}-joinOuter ::-    (Ord k, MonadIO m) =>-    Stream m (k, a) -> Stream m (k, b) -> Stream m (k, Maybe a, Maybe b)-joinOuter s1 s2 =-    Stream.concatEffect $ do-        km1 <- kvFold s1-        km2 <- kvFold s2--        -- XXX Not sure if toList/fromList would fuse optimally. We may have to-        -- create a fused Map.toStream function.-        let res1 = fmap (joinAB km2)-                        $ Stream.fromList $ Map.toList km1-                    where-                    joinAB km (k, a) =-                        case k `Map.lookup` km of-                            Just b -> (k, Just a, Just b)-                            Nothing -> (k, Just a, Nothing)--        -- XXX We can take advantage of the lookups in the first pass above to-        -- reduce the number of lookups in this pass. If we keep mutable cells-        -- in the second Map, we can flag it in the first pass and not do any-        -- lookup in the second pass if it is flagged.-        let res2 = Stream.mapMaybe (joinAB km1)-                        $ Stream.fromList $ Map.toList km2-                    where-                    joinAB km (k, b) =-                        case k `Map.lookup` km of-                            Just _ -> Nothing-                            Nothing -> Just (k, Nothing, Just b)--        return $ Stream.append res1 res2--        where--        -- XXX Generate error if a duplicate insertion is attempted?-        kvFold =-            let f = Fold.foldl' (\kv (k, b) -> Map.insert k b kv) Map.empty-             in Stream.fold f
− src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs 
@@ -1,833 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Eliminate--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC---- A few functions in this module have been adapted from the vector package--- (c) Roman Leshchinskiy.----module Streamly.Internal.Data.Stream.StreamD.Eliminate-    (-    -- * Running a 'Fold'-      fold--    -- -- * Running a 'Parser'-    , parse-    , parseD-    , parseBreak-    , parseBreakD--    -- * Stream Deconstruction-    , uncons--    -- * Right Folds-    , foldrM-    , foldr-    , foldrMx-    , foldr1--    -- * Left Folds-    , foldlM'-    , foldl'-    , foldlMx'-    , foldlx'--    -- * Specific Fold Functions-    , drain-    , mapM_ -- Map and Fold-    , null-    , head-    , headElse-    , tail-    , last-    , elem-    , notElem-    , all-    , any-    , maximum-    , maximumBy-    , minimum-    , minimumBy-    , lookup-    , findM-    , find-    , (!!)-    , the--    -- * To containers-    , toList-    , toListRev--    -- * Multi-Stream Folds-    -- ** Comparisons-    -- | These should probably be expressed using zipping operations.-    , eqBy-    , cmpBy--    -- ** Substreams-    -- | These should probably be expressed using parsers.-    , isPrefixOf-    , isInfixOf-    , isSuffixOf-    , isSuffixOfUnbox-    , isSubsequenceOf-    , stripPrefix-    , stripSuffix-    , stripSuffixUnbox-    )-where--#include "inline.hs"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Foreign.Storable (Storable)-import GHC.Exts (SpecConstrAnnotation(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.SVar.Type (defState)-import Streamly.Internal.Data.Unboxed (Unbox)--import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Stream.StreamD.Generate as StreamD-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Nesting-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as StreamD--import Prelude hiding-       ( all, any, elem, foldr, foldr1, head, last, lookup, mapM, mapM_-       , maximum, minimum, notElem, null, splitAt, tail, (!!))-import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Elimination by Folds------------------------------------------------------------------------------------------------------------------------------------------------------------------ Right Folds---------------------------------------------------------------------------------{-# INLINE_NORMAL foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> Stream m a -> m (Maybe a)-foldr1 f m = do-     r <- uncons m-     case r of-         Nothing   -> return Nothing-         Just (h, t) -> fmap Just (foldr f h t)----------------------------------------------------------------------------------- Parsers----------------------------------------------------------------------------------- Inlined definition. Without the inline "serially/parser/take" benchmark--- degrades and parseMany does not fuse. Even using "inline" at the callsite--- does not help.-{-# INLINE splitAt #-}-splitAt :: Int -> [a] -> ([a],[a])-splitAt n ls-  | n <= 0 = ([], ls)-  | otherwise          = splitAt' n ls-    where-        splitAt' :: Int -> [a] -> ([a], [a])-        splitAt' _  []     = ([], [])-        splitAt' 1  (x:xs) = ([x], xs)-        splitAt' m  (x:xs) = (x:xs', xs'')-          where-            (xs', xs'') = splitAt' (m - 1) xs---- GHC parser does not accept {-# ANN type [] NoSpecConstr #-}, so we need--- to make a newtype.-{-# ANN type List NoSpecConstr #-}-newtype List a = List {getList :: [a]}---- | Run a 'Parse' over a stream.-{-# INLINE_NORMAL parseD #-}-parseD-    :: Monad m-    => PRD.Parser a m b-    -> Stream m a-    -> m (Either ParseError b)-parseD parser strm = do-    (b, _) <- parseBreakD parser strm-    return b---- | Parse a stream using the supplied 'Parser'.------ Parsers (See "Streamly.Internal.Data.Parser") are more powerful folds that--- add backtracking and error functionality to terminating folds. Unlike folds,--- parsers may not always result in a valid output, they may result in an--- error.  For example:------ >>> Stream.parse (Parser.takeEQ 1 Fold.drain) Stream.nil--- Left (ParseError "takeEQ: Expecting exactly 1 elements, input terminated on 0")------ Note: @parse p@ is not the same as  @head . parseMany p@ on an empty stream.----{-# INLINE [3] parse #-}-parse :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b)-parse = parseD---- XXX It may be a good idea to use constant sized chunks for backtracking. We--- can take a byte stream but when we have to backtrack we create constant--- sized chunks. We maintain one forward list and one backward list of constant--- sized chunks, and a last backtracking offset. That way we just need lists of--- contents and no need to maintain start/end pointers for individual arrays,--- reducing bookkeeping work.---- | Run a 'Parse' over a stream and return rest of the Stream.-{-# INLINE_NORMAL parseBreakD #-}-parseBreakD-    :: Monad m-    => PRD.Parser a m b-    -> Stream m a-    -> m (Either ParseError b, Stream m a)-parseBreakD (PRD.Parser pstep initial extract) stream@(Stream step state) = do-    res <- initial-    case res of-        PRD.IPartial s -> go SPEC state (List []) s-        PRD.IDone b -> return (Right b, stream)-        PRD.IError err -> return (Left (ParseError err), stream)--    where--    -- "buf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    go !_ st buf !pst = do-        r <- step defState st-        case r of-            Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 -> go SPEC s (List []) pst1-                    PR.Partial 1 pst1 -> go1 SPEC s x pst1-                    PR.Partial n pst1 -> do-                        assert (n <= length (x:getList buf)) (return ())-                        let src0 = Prelude.take n (x:getList buf)-                            src  = Prelude.reverse src0-                        gobuf SPEC s (List []) (List src) pst1-                    PR.Continue 0 pst1 -> go SPEC s (List (x:getList buf)) pst1-                    PR.Continue 1 pst1 -> gobuf SPEC s buf (List [x]) pst1-                    PR.Continue n pst1 -> do-                        assert (n <= length (x:getList buf)) (return ())-                        let (src0, buf1) = splitAt n (x:getList buf)-                            src  = Prelude.reverse src0-                        gobuf SPEC s (List buf1) (List src) pst1-                    PR.Done 0 b -> return (Right b, Stream step s)-                    PR.Done n b -> do-                        assert (n <= length (x:getList buf)) (return ())-                        let src0 = Prelude.take n (x:getList buf)-                            src  = Prelude.reverse src0-                        -- XXX This would make it quadratic. We should probably-                        -- use StreamK if we have to append many times.-                        return-                            ( Right b,-                              Nesting.append (fromList src) (Stream step s))-                    PR.Error err ->-                        return (Left (ParseError err), Stream step s)-            Skip s -> go SPEC s buf pst-            Stop -> goStop SPEC buf pst--    go1 _ s x !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                go SPEC s (List []) pst1-            PR.Partial 1 pst1 -> do-                go1 SPEC s x pst1-            PR.Partial n _ ->-                error $ "parseBreak: parser bug, go1: Partial n = " ++ show n-            PR.Continue 0 pst1 ->-                go SPEC s (List [x]) pst1-            PR.Continue 1 pst1 ->-                go1 SPEC s x pst1-            PR.Continue n _ -> do-                error $ "parseBreak: parser bug, go1: Continue n = " ++ show n-            PR.Done 0 b -> do-                return (Right b, Stream step s)-            PR.Done 1 b -> do-                return (Right b, StreamD.cons x (Stream step s))-            PR.Done n _ -> do-                error $ "parseBreak: parser bug, go1: Done n = " ++ show n-            PR.Error err ->-                return-                    ( Left (ParseError err)-                    , Nesting.append (fromPure x) (Stream step s)-                    )--    gobuf !_ s buf (List []) !pst = go SPEC s buf pst-    gobuf !_ s buf (List (x:xs)) !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                gobuf SPEC s (List []) (List xs) pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC s (List []) (List src) pst1-            PR.Continue 0 pst1 ->-                gobuf SPEC s (List (x:getList buf)) (List xs) pst1-            PR.Continue 1 pst1 ->-                gobuf SPEC s buf (List (x:xs)) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let (src0, buf1) = splitAt n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                gobuf SPEC s (List buf1) (List src) pst1-            PR.Done n b -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0-                return (Right b, Nesting.append (fromList src) (Stream step s))-            PR.Error err ->-                return-                    ( Left (ParseError err)-                    , Nesting.append (fromList (x:xs)) (Stream step s)-                    )--    -- This is simplified gobuf-    goExtract !_ buf (List []) !pst = goStop SPEC buf pst-    goExtract !_ buf (List (x:xs)) !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                goExtract SPEC (List []) (List xs) pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC (List []) (List src) pst1-            PR.Continue 0 pst1 ->-                goExtract SPEC (List (x:getList buf)) (List xs) pst1-            PR.Continue 1 pst1 ->-                goExtract SPEC buf (List (x:xs)) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:getList buf)) (return ())-                let (src0, buf1) = splitAt n (x:getList buf)-                    src  = Prelude.reverse src0 ++ xs-                goExtract SPEC (List buf1) (List src) pst1-            PR.Done n b -> do-                assert (n <= length (x:getList buf)) (return ())-                let src0 = Prelude.take n (x:getList buf)-                    src  = Prelude.reverse src0-                return (Right b, fromList src)-            PR.Error err -> return (Left (ParseError err), fromList (x:xs))--    -- This is simplified goExtract-    -- XXX Use SPEC?-    {-# INLINE goStop #-}-    goStop _ buf pst = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-            PR.Continue 0 pst1 -> goStop SPEC buf pst1-            PR.Continue n pst1 -> do-                assert (n <= length (getList buf)) (return ())-                let (src0, buf1) = splitAt n (getList buf)-                    src = Prelude.reverse src0-                goExtract SPEC (List buf1) (List src) pst1-            PR.Done 0 b -> return (Right b, StreamD.nil)-            PR.Done n b -> do-                assert (n <= length (getList buf)) (return ())-                let src0 = Prelude.take n (getList buf)-                    src  = Prelude.reverse src0-                return (Right b, fromList src)-            PR.Error err ->-                return (Left (ParseError err), StreamD.nil)---- | Parse a stream using the supplied 'Parser'.----{-# INLINE parseBreak #-}-parseBreak :: Monad m => PR.Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)-parseBreak = parseBreakD----------------------------------------------------------------------------------- Specialized Folds----------------------------------------------------------------------------------- benchmark after dropping 1 item from stream or using unfolds-{-# INLINE_NORMAL null #-}-null :: Monad m => Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-null = fold Fold.null-#else-null = foldrM (\_ _ -> return False) (return True)-#endif--{-# INLINE_NORMAL head #-}-head :: Monad m => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-head = fold Fold.one-#else-head = foldrM (\x _ -> return (Just x)) (return Nothing)-#endif--{-# INLINE_NORMAL headElse #-}-headElse :: Monad m => a -> Stream m a -> m a-headElse a = foldrM (\x _ -> return x) (return a)---- Does not fuse, has the same performance as the StreamK version.-{-# INLINE_NORMAL tail #-}-tail :: Monad m => Stream m a -> m (Maybe (Stream m a))-tail (UnStream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield _ s -> return (Just $ Stream step s)-            Skip  s   -> go SPEC s-            Stop      -> return Nothing---- XXX will it fuse? need custom impl?-{-# INLINE_NORMAL last #-}-last :: Monad m => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-last = fold Fold.last-#else-last = foldl' (\_ y -> Just y) Nothing-#endif---- XXX Use the foldrM based impl instead-{-# INLINE_NORMAL elem #-}-elem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-elem e = fold (Fold.elem e)-#else--- elem e m = foldrM (\x xs -> if x == e then return True else xs) (return False) m-elem e (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s-              | x == e -> return True-              | otherwise -> go SPEC s-            Skip s -> go SPEC s-            Stop   -> return False-#endif--{-# INLINE_NORMAL notElem #-}-notElem :: (Monad m, Eq a) => a -> Stream m a -> m Bool-notElem e s = fmap not (elem e s)--{-# INLINE_NORMAL all #-}-all :: Monad m => (a -> Bool) -> Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-all p = fold (Fold.all p)-#else--- all p m = foldrM (\x xs -> if p x then xs else return False) (return True) m-all p (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s-              | p x -> go SPEC s-              | otherwise -> return False-            Skip s -> go SPEC s-            Stop   -> return True-#endif--{-# INLINE_NORMAL any #-}-any :: Monad m => (a -> Bool) -> Stream m a -> m Bool-#ifdef USE_FOLDS_EVERYWHERE-any p = fold (Fold.any p)-#else--- any p m = foldrM (\x xs -> if p x then return True else xs) (return False) m-any p (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s-              | p x -> return True-              | otherwise -> go SPEC s-            Skip s -> go SPEC s-            Stop   -> return False-#endif--{-# INLINE_NORMAL maximum #-}-maximum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-maximum = fold Fold.maximum-#else-maximum (Stream step state) = go SPEC Nothing' state-  where-    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s-              | acc <= x  -> go SPEC (Just' x) s-              | otherwise -> go SPEC (Just' acc) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-maximumBy cmp = fold (Fold.maximumBy cmp)-#else-maximumBy cmp (Stream step state) = go SPEC Nothing' state-  where-    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s -> case cmp acc x of-                GT -> go SPEC (Just' acc) s-                _  -> go SPEC (Just' x) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL minimum #-}-minimum :: (Monad m, Ord a) => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-minimum = fold Fold.minimum-#else-minimum (Stream step state) = go SPEC Nothing' state--    where--    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s-              | acc <= x  -> go SPEC (Just' acc) s-              | otherwise -> go SPEC (Just' x) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL minimumBy #-}-minimumBy :: Monad m => (a -> a -> Ordering) -> Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-minimumBy cmp = fold (Fold.minimumBy cmp)-#else-minimumBy cmp (Stream step state) = go SPEC Nothing' state--    where--    go !_ Nothing' st = do-        r <- step defState st-        case r of-            Yield x s -> go SPEC (Just' x) s-            Skip  s   -> go SPEC Nothing' s-            Stop      -> return Nothing-    go !_ (Just' acc) st = do-        r <- step defState st-        case r of-            Yield x s -> case cmp acc x of-                GT -> go SPEC (Just' x) s-                _  -> go SPEC (Just' acc) s-            Skip s -> go SPEC (Just' acc) s-            Stop   -> return (Just acc)-#endif--{-# INLINE_NORMAL (!!) #-}-(!!) :: (Monad m) => Stream m a -> Int -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-stream !! i = fold (Fold.index i) stream-#else-(Stream step state) !! i = go SPEC i state--    where--    go !_ !n st = do-        r <- step defState st-        case r of-            Yield x s | n < 0 -> return Nothing-                      | n == 0 -> return $ Just x-                      | otherwise -> go SPEC (n - 1) s-            Skip s -> go SPEC n s-            Stop   -> return Nothing-#endif--{-# INLINE_NORMAL lookup #-}-lookup :: (Monad m, Eq a) => a -> Stream m (a, b) -> m (Maybe b)-#ifdef USE_FOLDS_EVERYWHERE-lookup e = fold (Fold.lookup e)-#else-lookup e = foldrM (\(a, b) xs -> if e == a then return (Just b) else xs)-                   (return Nothing)-#endif--{-# INLINE_NORMAL findM #-}-findM :: Monad m => (a -> m Bool) -> Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-findM p = fold (Fold.findM p)-#else-findM p = foldrM (\x xs -> p x >>= \r -> if r then return (Just x) else xs)-                   (return Nothing)-#endif--{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)-find p = findM (return . p)--{-# INLINE toListRev #-}-toListRev :: Monad m => Stream m a -> m [a]-#ifdef USE_FOLDS_EVERYWHERE-toListRev = fold Fold.toListRev-#else-toListRev = foldl' (flip (:)) []-#endif----------------------------------------------------------------------------------- Transformation comprehensions---------------------------------------------------------------------------------{-# INLINE_NORMAL the #-}-the :: (Eq a, Monad m) => Stream m a -> m (Maybe a)-#ifdef USE_FOLDS_EVERYWHERE-the = fold Fold.the-#else-the (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s -> go' SPEC x s-            Skip s    -> go SPEC s-            Stop      -> return Nothing-    go' !_ n st = do-        r <- step defState st-        case r of-            Yield x s | x == n -> go' SPEC n s-                      | otherwise -> return Nothing-            Skip s -> go' SPEC n s-            Stop   -> return (Just n)-#endif----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- | Execute a monadic action for each element of the 'Stream'-{-# INLINE_NORMAL mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()-#ifdef USE_FOLDS_EVERYWHERE-mapM_ f = fold (Fold.drainBy f)-#else-mapM_ m = drain . mapM m-#endif----------------------------------------------------------------------------------- Multi-stream folds----------------------------------------------------------------------------------- | Returns 'True' if the first stream is the same as or a prefix of the--- second. A stream is a prefix of itself.------ >>> Stream.isPrefixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char)--- True----{-# INLINE_NORMAL isPrefixOf #-}-isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isPrefixOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb--    where--    go !_ Nothing' sa sb = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go SPEC (Just' x) sa' sb-            Skip sa'    -> go SPEC Nothing' sa' sb-            Stop        -> return True--    go !_ (Just' x) sa sb = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go SPEC Nothing' sa sb'-                    else return False-            Skip sb' -> go SPEC (Just' x) sa sb'-            Stop     -> return False---- | Returns 'True' if all the elements of the first stream occur, in order, in--- the second stream. The elements do not have to occur consecutively. A stream--- is a subsequence of itself.------ >>> Stream.isSubsequenceOf (Stream.fromList "hlo") (Stream.fromList "hello" :: Stream IO Char)--- True----{-# INLINE_NORMAL isSubsequenceOf #-}-isSubsequenceOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSubsequenceOf (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb--    where--    go !_ Nothing' sa sb = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go SPEC (Just' x) sa' sb-            Skip sa' -> go SPEC Nothing' sa' sb-            Stop -> return True--    go !_ (Just' x) sa sb = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go SPEC Nothing' sa sb'-                    else go SPEC (Just' x) sa sb'-            Skip sb' -> go SPEC (Just' x) sa sb'-            Stop -> return False---- | @stripPrefix prefix input@ strips the @prefix@ stream from the @input@--- stream if it is a prefix of input. Returns 'Nothing' if the input does not--- start with the given prefix, stripped input otherwise. Returns @Just nil@--- when the prefix is the same as the input stream.------ Space: @O(1)@----{-# INLINE_NORMAL stripPrefix #-}-stripPrefix-    :: (Monad m, Eq a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripPrefix (Stream stepa ta) (Stream stepb tb) = go SPEC Nothing' ta tb--    where--    go !_ Nothing' sa sb = do-        r <- stepa defState sa-        case r of-            Yield x sa' -> go SPEC (Just' x) sa' sb-            Skip sa'    -> go SPEC Nothing' sa' sb-            Stop        -> return $ Just (Stream stepb sb)--    go !_ (Just' x) sa sb = do-        r <- stepb defState sb-        case r of-            Yield y sb' ->-                if x == y-                    then go SPEC Nothing' sa sb'-                    else return Nothing-            Skip sb' -> go SPEC (Just' x) sa sb'-            Stop     -> return Nothing---- | Returns 'True' if the first stream is an infix of the second. A stream is--- considered an infix of itself.------ >>> s = Stream.fromList "hello" :: Stream IO Char--- >>> Stream.isInfixOf s s--- True------ Space: @O(n)@ worst case where @n@ is the length of the infix.------ /Pre-release/------ /Requires 'Storable' constraint/----{-# INLINE isInfixOf #-}-isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a, Unbox a)-    => Stream m a -> Stream m a -> m Bool-isInfixOf infx stream = do-    arr <- fold Array.write infx-    -- XXX can use breakOnSeq instead (when available)-    r <- null $ StreamD.drop 1 $ Nesting.splitOnSeq arr Fold.drain stream-    return (not r)---- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf--- may use the suffix stream many times. To run in optimal memory we do not--- want to buffer the suffix stream in memory therefore  we need an ability to--- clone (or consume it multiple times) the suffix stream without any side--- effects so that multiple potential suffix matches can proceed in parallel--- without buffering the suffix stream. For example, we may create the suffix--- stream from a file handle, however, if we evaluate the stream multiple--- times, once for each match, we will need a different file handle each time--- which may exhaust the file descriptors. Instead, we want to share the same--- underlying file descriptor, use pread on it to generate the stream and clone--- the stream for each match. Therefore the suffix stream should be built in--- such a way that it can be consumed multiple times without any problems.---- XXX Can be implemented with better space/time complexity.--- Space: @O(n)@ worst case where @n@ is the length of the suffix.---- | Returns 'True' if the first stream is a suffix of the second. A stream is--- considered a suffix of itself.------ >>> Stream.isSuffixOf (Stream.fromList "hello") (Stream.fromList "hello" :: Stream IO Char)--- True------ Space: @O(n)@, buffers entire input stream and the suffix.------ /Pre-release/------ /Suboptimal/ - Help wanted.----{-# INLINE isSuffixOf #-}-isSuffixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool-isSuffixOf suffix stream =-    StreamD.reverse suffix `isPrefixOf` StreamD.reverse stream---- | Much faster than 'isSuffixOf'.-{-# INLINE isSuffixOfUnbox #-}-isSuffixOfUnbox :: (MonadIO m, Eq a, Unbox a) =>-    Stream m a -> Stream m a -> m Bool-isSuffixOfUnbox suffix stream =-    StreamD.reverseUnbox suffix `isPrefixOf` StreamD.reverseUnbox stream---- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does--- not end with the given suffix. Returns @Just nil@ when the suffix is the--- same as the stream.------ It may be more efficient to convert the stream to an Array and use--- stripSuffix on that especially if the elements have a Storable or Prim--- instance.------ See also "Streamly.Internal.Data.Stream.Reduce.dropSuffix".------ Space: @O(n)@, buffers the entire input stream as well as the suffix------ /Pre-release/-{-# INLINE stripSuffix #-}-stripSuffix-    :: (Monad m, Eq a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripSuffix m1 m2 =-    fmap StreamD.reverse-        <$> stripPrefix (StreamD.reverse m1) (StreamD.reverse m2)---- | Much faster than 'stripSuffix'.-{-# INLINE stripSuffixUnbox #-}-stripSuffixUnbox-    :: (MonadIO m, Eq a, Unbox a)-    => Stream m a -> Stream m a -> m (Maybe (Stream m a))-stripSuffixUnbox m1 m2 =-    fmap StreamD.reverseUnbox-        <$> stripPrefix (StreamD.reverseUnbox m1) (StreamD.reverseUnbox m2)
− src/Streamly/Internal/Data/Stream/StreamD/Exception.hs 
@@ -1,479 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Exception--- Copyright   : (c) 2020 Composewell Technologies and Contributors--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.StreamD.Exception-    (-      gbracket_-    , gbracket-    , before-    , afterUnsafe-    , afterIO-    , bracketUnsafe-    , bracketIO3-    , bracketIO-    , onException-    , finallyUnsafe-    , finallyIO-    , ghandle-    , handle-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Control.Exception (Exception, SomeException, mask_)-import Control.Monad.Catch (MonadCatch)-import GHC.Exts (inline)-import Streamly.Internal.Data.IOFinalizer-    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)--import qualified Control.Monad.Catch as MC--import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"--data GbracketState s1 s2 v-    = GBracketInit-    | GBracketNormal s1 v-    | GBracketException s2---- | Like 'gbracket' but with following differences:------ * alloc action @m c@ runs with async exceptions enabled--- * cleanup action @c -> m d@ won't run if the stream is garbage collected---   after partial evaluation.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL gbracket_ #-}-gbracket_-    :: Monad m-    => m c                                  -- ^ before-    -> (c -> m d)                           -- ^ after, on normal stop-    -> (c -> e -> Stream m b -> Stream m b) -- ^ on exception-    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)-    -> (c -> Stream m b)                    -- ^ stream generator-    -> Stream m b-gbracket_ bef aft onExc ftry action =-    Stream step GBracketInit--    where--    {-# INLINE_LATE step #-}-    step _ GBracketInit = do-        r <- bef-        return $ Skip $ GBracketNormal (action r) r--    step gst (GBracketNormal (UnStream step1 st) v) = do-        res <- ftry $ step1 gst st-        case res of-            Right r -> case r of-                Yield x s ->-                    return $ Yield x (GBracketNormal (Stream step1 s) v)-                Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)-                Stop -> aft v >> return Stop-            -- XXX Do not handle async exceptions, just rethrow them.-            Left e ->-                return-                    $ Skip (GBracketException (onExc v e (UnStream step1 st)))-    step gst (GBracketException (UnStream step1 st)) = do-        res <- step1 gst st-        case res of-            Yield x s -> return $ Yield x (GBracketException (Stream step1 s))-            Skip s    -> return $ Skip (GBracketException (Stream step1 s))-            Stop      -> return Stop--data GbracketIOState s1 s2 v wref-    = GBracketIOInit-    | GBracketIONormal s1 v wref-    | GBracketIOException s2---- | Run the alloc action @m c@ with async exceptions disabled but keeping--- blocking operations interruptible (see 'Control.Exception.mask').  Use the--- output @c@ as input to @c -> Stream m b@ to generate an output stream. When--- generating the stream use the supplied @try@ operation @forall s. m s -> m--- (Either e s)@ to catch synchronous exceptions. If an exception occurs run--- the exception handler @c -> e -> Stream m b -> m (Stream m b)@. Note that--- 'gbracket' does not rethrow the exception, it has to be done by the--- exception handler if desired.------ The cleanup action @c -> m d@, runs whenever the stream ends normally, due--- to a sync or async exception or if it gets garbage collected after a partial--- lazy evaluation.  See 'bracket' for the semantics of the cleanup action.------ 'gbracket' can express all other exception handling combinators.------ /Inhibits stream fusion/------ /Pre-release/-{-# INLINE_NORMAL gbracket #-}-gbracket-    :: MonadIO m-    => IO c -- ^ before-    -> (c -> IO d1) -- ^ on normal stop-    -> (c -> e -> Stream m b -> IO (Stream m b)) -- ^ on exception-    -> (c -> IO d2) -- ^ on GC without normal stop or exception-    -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)-    -> (c -> Stream m b) -- ^ stream generator-    -> Stream m b-gbracket bef aft onExc onGC ftry action =-    Stream step GBracketIOInit--    where--    -- If the stream is never evaluated the "aft" action will never be-    -- called. For that to occur we will need the user of this API to pass a-    -- weak pointer to us.-    {-# INLINE_LATE step #-}-    step _ GBracketIOInit = do-        -- We mask asynchronous exceptions to make the execution-        -- of 'bef' and the registration of 'aft' atomic.-        -- A similar thing is done in the resourcet package: https://git.io/JvKV3-        -- Tutorial: https://markkarpov.com/tutorial/exceptions.html-        (r, ref) <- liftIO $ mask_ $ do-            r <- bef-            ref <- newIOFinalizer (onGC r)-            return (r, ref)-        return $ Skip $ GBracketIONormal (action r) r ref--    step gst (GBracketIONormal (UnStream step1 st) v ref) = do-        res <- ftry $ step1 gst st-        case res of-            Right r -> case r of-                Yield x s ->-                    return $ Yield x (GBracketIONormal (Stream step1 s) v ref)-                Skip s ->-                    return $ Skip (GBracketIONormal (Stream step1 s) v ref)-                Stop ->-                    liftIO (clearingIOFinalizer ref (aft v)) >> return Stop-            -- XXX Do not handle async exceptions, just rethrow them.-            Left e -> do-                -- Clearing of finalizer and running of exception handler must-                -- be atomic wrt async exceptions. Otherwise if we have cleared-                -- the finalizer and have not run the exception handler then we-                -- may leak the resource.-                stream <--                    liftIO (clearingIOFinalizer ref (onExc v e (UnStream step1 st)))-                return $ Skip (GBracketIOException stream)-    step gst (GBracketIOException (UnStream step1 st)) = do-        res <- step1 gst st-        case res of-            Yield x s ->-                return $ Yield x (GBracketIOException (Stream step1 s))-            Skip s    -> return $ Skip (GBracketIOException (Stream step1 s))-            Stop      -> return Stop---- | Run the action @m b@ before the stream yields its first element.------ Same as the following but more efficient due to fusion:------ >>> before action xs = Stream.nilM action <> xs--- >>> before action xs = Stream.concatMap (const xs) (Stream.fromEffect action)----{-# INLINE_NORMAL before #-}-before :: Monad m => m b -> Stream m a -> Stream m a-before action (Stream step state) = Stream step' Nothing--    where--    {-# INLINE_LATE step' #-}-    step' _ Nothing = action >> return (Skip (Just state))--    step' gst (Just st) = do-        res <- step gst st-        case res of-            Yield x s -> return $ Yield x (Just s)-            Skip s    -> return $ Skip (Just s)-            Stop      -> return Stop---- | Like 'after', with following differences:------ * action @m b@ won't run if the stream is garbage collected---   after partial evaluation.--- * Monad @m@ does not require any other constraints.--- * has slightly better performance than 'after'.------ Same as the following, but with stream fusion:------ >>> afterUnsafe action xs = xs <> Stream.nilM action------ /Pre-release/----{-# INLINE_NORMAL afterUnsafe #-}-afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a-afterUnsafe action (Stream step state) = Stream step' state--    where--    {-# INLINE_LATE step' #-}-    step' gst st = do-        res <- step gst st-        case res of-            Yield x s -> return $ Yield x s-            Skip s    -> return $ Skip s-            Stop      -> action >> return Stop---- | Run the action @IO b@ whenever the stream is evaluated to completion, or--- if it is garbage collected after a partial lazy evaluation.------ The semantics of the action @IO b@ are similar to the semantics of cleanup--- action in 'bracketIO'.------ /See also 'afterUnsafe'/----{-# INLINE_NORMAL afterIO #-}-afterIO :: MonadIO m-    => IO b -> Stream m a -> Stream m a-afterIO action (Stream step state) = Stream step' Nothing--    where--    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        ref <- liftIO $ newIOFinalizer action-        return $ Skip $ Just (state, ref)-    step' gst (Just (st, ref)) = do-        res <- step gst st-        case res of-            Yield x s -> return $ Yield x (Just (s, ref))-            Skip s    -> return $ Skip (Just (s, ref))-            Stop      -> do-                runIOFinalizer ref-                return Stop---- XXX For high performance error checks in busy streams we may need another--- Error constructor in step.---- | Run the action @m b@ if the stream evaluation is aborted due to an--- exception. The exception is not caught, simply rethrown.------ /Inhibits stream fusion/----{-# INLINE_NORMAL onException #-}-onException :: MonadCatch m => m b -> Stream m a -> Stream m a-onException action stream =-    gbracket_-        (return ()) -- before-        return      -- after-        (\_ (e :: MC.SomeException) _ -> nilM (action >> MC.throwM e))-        (inline MC.try)-        (const stream)--{-# INLINE_NORMAL _onException #-}-_onException :: MonadCatch m => m b -> Stream m a -> Stream m a-_onException action (Stream step state) = Stream step' state--    where--    {-# INLINE_LATE step' #-}-    step' gst st = do-        res <- step gst st `MC.onException` action-        case res of-            Yield x s -> return $ Yield x s-            Skip s    -> return $ Skip s-            Stop      -> return Stop---- | Like 'bracket' but with following differences:------ * alloc action @m b@ runs with async exceptions enabled--- * cleanup action @b -> m c@ won't run if the stream is garbage collected---   after partial evaluation.--- * has slightly better performance than 'bracketIO'.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL bracketUnsafe #-}-bracketUnsafe :: MonadCatch m-    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-bracketUnsafe bef aft =-    gbracket_-        bef-        aft-        (\a (e :: SomeException) _ -> nilM (aft a >> MC.throwM e))-        (inline MC.try)---- For a use case of this see the "streamly-process" package. It needs to kill--- the process in case of exception or garbage collection, but waits for the--- process to terminate in normal cases.---- | Like 'bracketIO' but can use 3 separate cleanup actions depending on the--- mode of termination:------ 1. When the stream stops normally--- 2. When the stream is garbage collected--- 3. When the stream encounters an exception------ @bracketIO3 before onStop onGC onException action@ runs @action@ using the--- result of @before@. If the stream stops, @onStop@ action is executed, if the--- stream is abandoned @onGC@ is executed, if the stream encounters an--- exception @onException@ is executed.------ /Inhibits stream fusion/------ /Pre-release/-{-# INLINE_NORMAL bracketIO3 #-}-bracketIO3 :: (MonadIO m, MonadCatch m) =>-       IO b-    -> (b -> IO c)-    -> (b -> IO d)-    -> (b -> IO e)-    -> (b -> Stream m a)-    -> Stream m a-bracketIO3 bef aft onExc onGC =-    gbracket-        bef-        aft-        (\a (e :: SomeException) _ -> onExc a >> return (nilM (MC.throwM e)))-        onGC-        (inline MC.try)---- | Run the alloc action @IO b@ with async exceptions disabled but keeping--- blocking operations interruptible (see 'Control.Exception.mask').  Use the--- output @b@ as input to @b -> Stream m a@ to generate an output stream.------ @b@ is usually a resource under the IO monad, e.g. a file handle, that--- requires a cleanup after use. The cleanup action @b -> IO c@, runs whenever--- the stream ends normally, due to a sync or async exception or if it gets--- garbage collected after a partial lazy evaluation.------ 'bracketIO' only guarantees that the cleanup action runs, and it runs with--- async exceptions enabled. The action must ensure that it can successfully--- cleanup the resource in the face of sync or async exceptions.------ When the stream ends normally or on a sync exception, cleanup action runs--- immediately in the current thread context, whereas in other cases it runs in--- the GC context, therefore, cleanup may be delayed until the GC gets to run.------ /See also: 'bracketUnsafe'/------ /Inhibits stream fusion/----{-# INLINE bracketIO #-}-bracketIO :: (MonadIO m, MonadCatch m)-    => IO b -> (b -> IO c) -> (b -> Stream m a) -> Stream m a-bracketIO bef aft = bracketIO3 bef aft aft aft--data BracketState s v = BracketInit | BracketRun s v---- | Alternate (custom) implementation of 'bracket'.----{-# INLINE_NORMAL _bracket #-}-_bracket :: MonadCatch m-    => m b -> (b -> m c) -> (b -> Stream m a) -> Stream m a-_bracket bef aft bet = Stream step' BracketInit--    where--    {-# INLINE_LATE step' #-}-    step' _ BracketInit = bef >>= \x -> return (Skip (BracketRun (bet x) x))--    -- NOTE: It is important to use UnStream instead of the Stream pattern-    -- here, otherwise we get huge perf degradation, see note in concatMap.-    step' gst (BracketRun (UnStream step state) v) = do-        -- res <- step gst state `MC.onException` aft v-        res <- inline MC.try $ step gst state-        case res of-            Left (e :: SomeException) -> aft v >> MC.throwM e >> return Stop-            Right r -> case r of-                Yield x s -> return $ Yield x (BracketRun (Stream step s) v)-                Skip s    -> return $ Skip (BracketRun (Stream step s) v)-                Stop      -> aft v >> return Stop---- | Like 'finally' with following differences:------ * action @m b@ won't run if the stream is garbage collected---   after partial evaluation.--- * has slightly better performance than 'finallyIO'.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE finallyUnsafe #-}-finallyUnsafe :: MonadCatch m => m b -> Stream m a -> Stream m a-finallyUnsafe action xs = bracketUnsafe (return ()) (const action) (const xs)---- | Run the action @IO b@ whenever the stream stream stops normally, aborts--- due to an exception or if it is garbage collected after a partial lazy--- evaluation.------ The semantics of running the action @IO b@ are similar to the cleanup action--- semantics described in 'bracketIO'.------ >>> finallyIO release = Stream.bracketIO (return ()) (const release)------ /See also 'finallyUnsafe'/------ /Inhibits stream fusion/----{-# INLINE finallyIO #-}-finallyIO :: (MonadIO m, MonadCatch m) => IO b -> Stream m a -> Stream m a-finallyIO action xs = bracketIO3 (return ()) act act act (const xs)-    where act _ = action---- | Like 'handle' but the exception handler is also provided with the stream--- that generated the exception as input. The exception handler can thus--- re-evaluate the stream to retry the action that failed. The exception--- handler can again call 'ghandle' on it to retry the action multiple times.------ This is highly experimental. In a stream of actions we can map the stream--- with a retry combinator to retry each action on failure.------ /Inhibits stream fusion/------ /Pre-release/----{-# INLINE_NORMAL ghandle #-}-ghandle :: (MonadCatch m, Exception e)-    => (e -> Stream m a -> Stream m a) -> Stream m a -> Stream m a-ghandle f stream =-    gbracket_ (return ()) return (const f) (inline MC.try) (const stream)---- | When evaluating a stream if an exception occurs, stream evaluation aborts--- and the specified exception handler is run with the exception as argument.------ /Inhibits stream fusion/----{-# INLINE_NORMAL handle #-}-handle :: (MonadCatch m, Exception e)-    => (e -> Stream m a) -> Stream m a -> Stream m a-handle f stream =-    gbracket_ (return ()) return (\_ e _ -> f e) (inline MC.try) (const stream)---- | Alternate (custom) implementation of 'handle'.----{-# INLINE_NORMAL _handle #-}-_handle :: (MonadCatch m, Exception e)-    => (e -> Stream m a) -> Stream m a -> Stream m a-_handle f (Stream step state) = Stream step' (Left state)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Left st) = do-        res <- inline MC.try $ step gst st-        case res of-            Left e -> return $ Skip $ Right (f e)-            Right r -> case r of-                Yield x s -> return $ Yield x (Left s)-                Skip s    -> return $ Skip (Left s)-                Stop      -> return Stop--    step' gst (Right (UnStream step1 st)) = do-        res <- step1 gst st-        case res of-            Yield x s -> return $ Yield x (Right (Stream step1 s))-            Skip s    -> return $ Skip (Right (Stream step1 s))-            Stop      -> return Stop
− src/Streamly/Internal/Data/Stream/StreamD/Generate.hs 
@@ -1,1205 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Generate--- Copyright   : (c) 2020 Composewell Technologies and Contributors---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------- A few combinators in this module have been adapted from the vector package--- (c) Roman Leshchinskiy. See the notes in specific combinators.----module Streamly.Internal.Data.Stream.StreamD.Generate-  (-    -- * Primitives-      nil-    , nilM-    , cons-    , consM--    -- * From 'Unfold'-    , unfold--    -- * Unfolding-    , unfoldr-    , unfoldrM--    -- * From Values-    , fromPure-    , fromEffect-    , repeat-    , repeatM-    , replicate-    , replicateM--    -- * Enumeration-    -- ** Enumerating 'Num' Types-    , enumerateFromStepNum-    , enumerateFromNum-    , enumerateFromThenNum--    -- ** Enumerating 'Bounded' 'Enum' Types-    , enumerate-    , enumerateTo-    , enumerateFromBounded--    -- ** Enumerating 'Enum' Types not larger than 'Int'-    , enumerateFromToSmall-    , enumerateFromThenToSmall-    , enumerateFromThenSmallBounded--    -- ** Enumerating 'Bounded' 'Integral' Types-    , enumerateFromIntegral-    , enumerateFromThenIntegral--    -- ** Enumerating 'Integral' Types-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    -- ** Enumerating unbounded 'Integral' Types-    , enumerateFromStepIntegral--    -- ** Enumerating 'Fractional' Types-    , enumerateFromFractional-    , enumerateFromToFractional-    , enumerateFromThenFractional-    , enumerateFromThenToFractional--    -- ** Enumerable Type Class-    , Enumerable(..)--    -- * Time Enumeration-    , times-    , timesWith-    , absTimes-    , absTimesWith-    , relTimes-    , relTimesWith-    , durations-    , timeout--    -- * From Generators-    -- | Generate a monadic stream from a seed.-    , fromIndices-    , fromIndicesM-    , generate-    , generateM--    -- * Iteration-    , iterate-    , iterateM--    -- * From Containers-    -- | Transform an input structure into a stream.--    , fromList-    , fromListM-    , fromFoldable-    , fromFoldableM--    -- * From Pointers-    , fromPtr-    , fromPtrN-    , fromByteStr#--    -- * Conversions-    , fromStreamK-    , toStreamK-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Monad.IO.Class (MonadIO(..))-import Data.Functor.Identity (Identity(..))-import Foreign.Ptr (Ptr, plusPtr)-import Foreign.Storable (Storable (peek), sizeOf)-import GHC.Exts (Addr#, Ptr (Ptr))-import Streamly.Internal.Data.Time.Clock-    (Clock(Monotonic), asyncClock, readClock)-import Streamly.Internal.Data.Time.Units-    (toAbsTime, AbsTime, toRelTime64, RelTime64, addToAbsTime64)--#ifdef USE_UNFOLDS_EVERYWHERE-import qualified Streamly.Internal.Data.Unfold as Unfold-import qualified Streamly.Internal.Data.Unfold.Enumeration as Unfold-#endif--import Data.Fixed-import Data.Int-import Data.Ratio-import Data.Word-import Numeric.Natural-import Prelude hiding (iterate, repeat, replicate, take, takeWhile)-import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Primitives----------------------------------------------------------------------------------- XXX implement in terms of nilM?---- | A stream that terminates without producing any output or side effect.------ >>> Stream.fold Fold.toList Stream.nil--- []----{-# INLINE_NORMAL nil #-}-nil :: Applicative m => Stream m a-nil = Stream (\_ _ -> pure Stop) ()---- XXX implement in terms of consM?--- cons x = consM (return x)---- | Fuse a pure value at the head of an existing stream::------ >>> s = 1 `Stream.cons` Stream.fromList [2,3]--- >>> Stream.fold Fold.toList s--- [1,2,3]------ This function should not be used to dynamically construct a stream. If a--- stream is constructed by successive use of this function it would take--- O(n^2) time to consume the stream.------ This function should only be used to statically fuse an element with a--- stream. Do not use this recursively or where it cannot be inlined.------ See "Streamly.Data.StreamK" for a 'cons' that can be used to--- construct a stream recursively.------ Definition:------ >>> cons x xs = return x `Stream.consM` xs----{-# INLINE_NORMAL cons #-}-cons :: Applicative m => a -> Stream m a -> Stream m a-cons x (Stream step state) = Stream step1 Nothing-    where-    {-# INLINE_LATE step1 #-}-    step1 _ Nothing = pure $ Yield x (Just state)-    step1 gst (Just st) = do-          (\case-            Yield a s -> Yield a (Just s)-            Skip  s   -> Skip (Just s)-            Stop      -> Stop) <$> step gst st----------------------------------------------------------------------------------- Unfolding----------------------------------------------------------------------------------- Adapted from vector package---- | Build a stream by unfolding a /monadic/ step function starting from a--- seed.  The step function returns the next element in the stream and the next--- seed value. When it is done it returns 'Nothing' and the stream ends. For--- example,------ >>> :{--- let f b =---         if b > 2---         then return Nothing---         else return (Just (b, b + 1))--- in Stream.fold Fold.toList $ Stream.unfoldrM f 0--- :}--- [0,1,2]----{-# INLINE_NORMAL unfoldrM #-}-unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-unfoldrM next = unfold (Unfold.unfoldrM next)-#else-unfoldrM next = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ st = do-        r <- next st-        return $ case r of-            Just (x, s) -> Yield x s-            Nothing     -> Stop-#endif---- |--- >>> :{--- unfoldr step s =---     case step s of---         Nothing -> Stream.nil---         Just (a, b) -> a `Stream.cons` unfoldr step b--- :}------ Build a stream by unfolding a /pure/ step function @step@ starting from a--- seed @s@.  The step function returns the next element in the stream and the--- next seed value. When it is done it returns 'Nothing' and the stream ends.--- For example,------ >>> :{--- let f b =---         if b > 2---         then Nothing---         else Just (b, b + 1)--- in Stream.fold Fold.toList $ Stream.unfoldr f 0--- :}--- [0,1,2]----{-# INLINE_LATE unfoldr #-}-unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a-unfoldr f = unfoldrM (return . f)----------------------------------------------------------------------------------- From values----------------------------------------------------------------------------------- |--- >>> repeatM = Stream.sequence . Stream.repeat--- >>> repeatM = fix . Stream.consM--- >>> repeatM = cycle1 . Stream.fromEffect------ Generate a stream by repeatedly executing a monadic action forever.------ >>> :{--- repeatAction =---        Stream.repeatM (threadDelay 1000000 >> print 1)---      & Stream.take 10---      & Stream.fold Fold.drain--- :}----{-# INLINE_NORMAL repeatM #-}-repeatM :: Monad m => m a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-repeatM = unfold Unfold.repeatM-#else-repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) ()-#endif---- |--- Generate an infinite stream by repeating a pure value.------ >>> repeat x = Stream.repeatM (pure x)----{-# INLINE_NORMAL repeat #-}-repeat :: Monad m => a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-repeat x = repeatM (pure x)-#else-repeat x = Stream (\_ _ -> return $ Yield x ()) ()-#endif---- Adapted from the vector package---- |--- >>> replicateM n = Stream.sequence . Stream.replicate n------ Generate a stream by performing a monadic action @n@ times.-{-# INLINE_NORMAL replicateM #-}-replicateM :: Monad m => Int -> m a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-replicateM n p = unfold Unfold.replicateM (n, p)-#else-replicateM n p = Stream step n-  where-    {-# INLINE_LATE step #-}-    step _ (i :: Int)-      | i <= 0    = return Stop-      | otherwise = do-          x <- p-          return $ Yield x (i - 1)-#endif---- |--- >>> replicate n = Stream.take n . Stream.repeat--- >>> replicate n x = Stream.replicateM n (pure x)------ Generate a stream of length @n@ by repeating a value @n@ times.----{-# INLINE_NORMAL replicate #-}-replicate :: Monad m => Int -> a -> Stream m a-replicate n x = replicateM n (return x)----------------------------------------------------------------------------------- Enumeration of Num----------------------------------------------------------------------------------- | For floating point numbers if the increment is less than the precision then--- it just gets lost. Therefore we cannot always increment it correctly by just--- repeated addition.--- 9007199254740992 + 1 + 1 :: Double => 9.007199254740992e15--- 9007199254740992 + 2     :: Double => 9.007199254740994e15------ Instead we accumulate the increment counter and compute the increment--- every time before adding it to the starting number.------ This works for Integrals as well as floating point numbers, but--- enumerateFromStepIntegral is faster for integrals.-{-# INLINE_NORMAL enumerateFromStepNum #-}-enumerateFromStepNum :: (Monad m, Num a) => a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromStepNum from stride =-    unfold Unfold.enumerateFromStepNum (from, stride)-#else-enumerateFromStepNum from stride = Stream step 0-    where-    {-# INLINE_LATE step #-}-    step _ !i = return $ (Yield $! (from + i * stride)) $! (i + 1)-#endif--{-# INLINE_NORMAL enumerateFromNum #-}-enumerateFromNum :: (Monad m, Num a) => a -> Stream m a-enumerateFromNum from = enumerateFromStepNum from 1--{-# INLINE_NORMAL enumerateFromThenNum #-}-enumerateFromThenNum :: (Monad m, Num a) => a -> a -> Stream m a-enumerateFromThenNum from next = enumerateFromStepNum from (next - from)----------------------------------------------------------------------------------- Enumeration of Integrals---------------------------------------------------------------------------------#ifndef USE_UNFOLDS_EVERYWHERE-data EnumState a = EnumInit | EnumYield a a a | EnumStop--{-# INLINE_NORMAL enumerateFromThenToIntegralUp #-}-enumerateFromThenToIntegralUp-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegralUp from next to = Stream step EnumInit-    where-    {-# INLINE_LATE step #-}-    step _ EnumInit =-        return $-            if to < next-            then if to < from-                 then Stop-                 else Yield from EnumStop-            else -- from <= next <= to-                let stride = next - from-                in Skip $ EnumYield from stride (to - stride)--    step _ (EnumYield x stride toMinus) =-        return $-            if x > toMinus-            then Yield x EnumStop-            else Yield x $ EnumYield (x + stride) stride toMinus--    step _ EnumStop = return Stop--{-# INLINE_NORMAL enumerateFromThenToIntegralDn #-}-enumerateFromThenToIntegralDn-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-enumerateFromThenToIntegralDn from next to = Stream step EnumInit-    where-    {-# INLINE_LATE step #-}-    step _ EnumInit =-        return $ if to > next-            then if to > from-                 then Stop-                 else Yield from EnumStop-            else -- from >= next >= to-                let stride = next - from-                in Skip $ EnumYield from stride (to - stride)--    step _ (EnumYield x stride toMinus) =-        return $-            if x < toMinus-            then Yield x EnumStop-            else Yield x $ EnumYield (x + stride) stride toMinus--    step _ EnumStop = return Stop-#endif---- XXX This can perhaps be simplified and written in terms of--- enumeratFromStepIntegral as we have done in unfolds.---- | Enumerate an 'Integral' type in steps up to a given limit.--- @enumerateFromThenToIntegral from then to@ generates a finite stream whose--- first element is @from@, the second element is @then@ and the successive--- elements are in increments of @then - from@ up to @to@.------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 2 6--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToIntegral 0 (-2) (-6)--- [0,-2,-4,-6]----{-# INLINE_NORMAL enumerateFromThenToIntegral #-}-enumerateFromThenToIntegral-    :: (Monad m, Integral a)-    => a -> a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromThenToIntegral from next to =-    unfold Unfold.enumerateFromThenToIntegral (from, next, to)-#else-enumerateFromThenToIntegral from next to-    | next >= from = enumerateFromThenToIntegralUp from next to-    | otherwise    = enumerateFromThenToIntegralDn from next to-#endif---- | Enumerate an 'Integral' type in steps. @enumerateFromThenIntegral from--- then@ generates a stream whose first element is @from@, the second element--- is @then@ and the successive elements are in increments of @then - from@.--- The stream is bounded by the size of the 'Integral' type.------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenIntegral (0 :: Int) (-2)--- [0,-2,-4,-6]----{-# INLINE_NORMAL enumerateFromThenIntegral #-}-enumerateFromThenIntegral-    :: (Monad m, Integral a, Bounded a)-    => a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromThenIntegral from next =-    unfold Unfold.enumerateFromThenIntegralBounded (from, next)-#else-enumerateFromThenIntegral from next =-    if next > from-    then enumerateFromThenToIntegralUp from next maxBound-    else enumerateFromThenToIntegralDn from next minBound-#endif---- | @enumerateFromStepIntegral from step@ generates an infinite stream whose--- first element is @from@ and the successive elements are in increments of--- @step@.------ CAUTION: This function is not safe for finite integral types. It does not--- check for overflow, underflow or bounds.------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromStepIntegral 0 2--- [0,2,4,6]------ >>> Stream.fold Fold.toList $ Stream.take 3 $ Stream.enumerateFromStepIntegral 0 (-2)--- [0,-2,-4]----{-# INLINE_NORMAL enumerateFromStepIntegral #-}-enumerateFromStepIntegral :: (Integral a, Monad m) => a -> a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-enumerateFromStepIntegral from stride =-    unfold Unfold.enumerateFromStepIntegral (from, stride)-#else-enumerateFromStepIntegral from stride =-    from `seq` stride `seq` Stream step from-    where-        {-# INLINE_LATE step #-}-        step _ !x = return $ Yield x $! (x + stride)-#endif---- | Enumerate an 'Integral' type up to a given limit.--- @enumerateFromToIntegral from to@ generates a finite stream whose first--- element is @from@ and successive elements are in increments of @1@ up to--- @to@.------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToIntegral 0 4--- [0,1,2,3,4]----{-# INLINE enumerateFromToIntegral #-}-enumerateFromToIntegral :: (Monad m, Integral a) => a -> a -> Stream m a-enumerateFromToIntegral from to =-    takeWhile (<= to) $ enumerateFromStepIntegral from 1---- | Enumerate an 'Integral' type. @enumerateFromIntegral from@ generates a--- stream whose first element is @from@ and the successive elements are in--- increments of @1@. The stream is bounded by the size of the 'Integral' type.------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromIntegral (0 :: Int)--- [0,1,2,3]----{-# INLINE enumerateFromIntegral #-}-enumerateFromIntegral :: (Monad m, Integral a, Bounded a) => a -> Stream m a-enumerateFromIntegral from = enumerateFromToIntegral from maxBound----------------------------------------------------------------------------------- Enumeration of Fractionals----------------------------------------------------------------------------------- We cannot write a general function for Num.  The only way to write code--- portable between the two is to use a 'Real' constraint and convert between--- Fractional and Integral using fromRational which is horribly slow.---- Even though the underlying implementation of enumerateFromFractional and--- enumerateFromThenFractional works for any 'Num' we have restricted these to--- 'Fractional' because these do not perform any bounds check, in contrast to--- integral versions and are therefore not equivalent substitutes for those.---- | Numerically stable enumeration from a 'Fractional' number in steps of size--- @1@. @enumerateFromFractional from@ generates a stream whose first element--- is @from@ and the successive elements are in increments of @1@.  No overflow--- or underflow checks are performed.------ This is the equivalent to 'enumFrom' for 'Fractional' types. For example:------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromFractional 1.1--- [1.1,2.1,3.1,4.1]----{-# INLINE enumerateFromFractional #-}-enumerateFromFractional :: (Monad m, Fractional a) => a -> Stream m a-enumerateFromFractional = enumerateFromNum---- | Numerically stable enumeration from a 'Fractional' number in steps.--- @enumerateFromThenFractional from then@ generates a stream whose first--- element is @from@, the second element is @then@ and the successive elements--- are in increments of @then - from@.  No overflow or underflow checks are--- performed.------ This is the equivalent of 'enumFromThen' for 'Fractional' types. For--- example:------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 2.1--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThenFractional 1.1 (-2.1)--- [1.1,-2.1,-5.300000000000001,-8.500000000000002]----{-# INLINE enumerateFromThenFractional #-}-enumerateFromThenFractional-    :: (Monad m, Fractional a)-    => a -> a -> Stream m a-enumerateFromThenFractional = enumerateFromThenNum---- | Numerically stable enumeration from a 'Fractional' number to a given--- limit.  @enumerateFromToFractional from to@ generates a finite stream whose--- first element is @from@ and successive elements are in increments of @1@ up--- to @to@.------ This is the equivalent of 'enumFromTo' for 'Fractional' types. For--- example:------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4--- [1.1,2.1,3.1,4.1]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromToFractional 1.1 4.6--- [1.1,2.1,3.1,4.1,5.1]------ Notice that the last element is equal to the specified @to@ value after--- rounding to the nearest integer.----{-# INLINE_NORMAL enumerateFromToFractional #-}-enumerateFromToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> Stream m a-enumerateFromToFractional from to =-    takeWhile (<= to + 1 / 2) $ enumerateFromStepNum from 1---- | Numerically stable enumeration from a 'Fractional' number in steps up to a--- given limit.  @enumerateFromThenToFractional from then to@ generates a--- finite stream whose first element is @from@, the second element is @then@--- and the successive elements are in increments of @then - from@ up to @to@.------ This is the equivalent of 'enumFromThenTo' for 'Fractional' types. For--- example:------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 2 6--- [0.1,2.0,3.9,5.799999999999999]------ >>> Stream.fold Fold.toList $ Stream.enumerateFromThenToFractional 0.1 (-2) (-6)--- [0.1,-2.0,-4.1000000000000005,-6.200000000000001]----{-# INLINE_NORMAL enumerateFromThenToFractional #-}-enumerateFromThenToFractional-    :: (Monad m, Fractional a, Ord a)-    => a -> a -> a -> Stream m a-enumerateFromThenToFractional from next to =-    takeWhile predicate $ enumerateFromThenFractional from next-    where-    mid = (next - from) / 2-    predicate | next >= from  = (<= to + mid)-              | otherwise     = (>= to + mid)------------------------------------------------------------------------------------ Enumeration of Enum types not larger than Int-------------------------------------------------------------------------------------- | 'enumerateFromTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromToSmall #-}-enumerateFromToSmall :: (Monad m, Enum a) => a -> a -> Stream m a-enumerateFromToSmall from to =-      fmap toEnum-    $ enumerateFromToIntegral (fromEnum from) (fromEnum to)---- | 'enumerateFromThenTo' for 'Enum' types not larger than 'Int'.----{-# INLINE enumerateFromThenToSmall #-}-enumerateFromThenToSmall :: (Monad m, Enum a)-    => a -> a -> a -> Stream m a-enumerateFromThenToSmall from next to =-          fmap toEnum-        $ enumerateFromThenToIntegral-            (fromEnum from) (fromEnum next) (fromEnum to)---- | 'enumerateFromThen' for 'Enum' types not larger than 'Int'.------ Note: We convert the 'Enum' to 'Int' and enumerate the 'Int'. If a--- type is bounded but does not have a 'Bounded' instance then we can go on--- enumerating it beyond the legal values of the type, resulting in the failure--- of 'toEnum' when converting back to 'Enum'. Therefore we require a 'Bounded'--- instance for this function to be safely used.----{-# INLINE enumerateFromThenSmallBounded #-}-enumerateFromThenSmallBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> a -> Stream m a-enumerateFromThenSmallBounded from next =-    if fromEnum next >= fromEnum from-    then enumerateFromThenTo from next maxBound-    else enumerateFromThenTo from next minBound------------------------------------------------------------------------------------ Enumerable type class-------------------------------------------------------------------------------------- NOTE: We would like to rewrite calls to fromList [1..] etc. to stream--- enumerations like this:------ {-# RULES "fromList enumFrom" [1]---     forall (a :: Int). D.fromList (enumFrom a) = D.enumerateFromIntegral a #-}------ But this does not work because enumFrom is a class method and GHC rewrites--- it quickly, so we do not get a chance to have our rule fired.---- | Types that can be enumerated as a stream. The operations in this type--- class are equivalent to those in the 'Enum' type class, except that these--- generate a stream instead of a list. Use the functions in--- "Streamly.Internal.Data.Stream.Enumeration" module to define new instances.----class Enum a => Enumerable a where-    -- | @enumerateFrom from@ generates a stream starting with the element-    -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or-    -- generating an infinite stream when the type is not 'Bounded'.-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom (0 :: Int)-    -- [0,1,2,3]-    ---    -- For 'Fractional' types, enumeration is numerically stable. However, no-    -- overflow or underflow checks are performed.-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFrom 1.1-    -- [1.1,2.1,3.1,4.1]-    ---    enumerateFrom :: (Monad m) => a -> Stream m a--    -- | Generate a finite stream starting with the element @from@, enumerating-    -- the type up to the value @to@. If @to@ is smaller than @from@ then an-    -- empty stream is returned.-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 0 4-    -- [0,1,2,3,4]-    ---    -- For 'Fractional' types, the last element is equal to the specified @to@-    -- value after rounding to the nearest integral value.-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4-    -- [1.1,2.1,3.1,4.1]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromTo 1.1 4.6-    -- [1.1,2.1,3.1,4.1,5.1]-    ---    enumerateFromTo :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThen from then@ generates a stream whose first element-    -- is @from@, the second element is @then@ and the successive elements are-    -- in increments of @then - from@.  Enumeration can occur downwards or-    -- upwards depending on whether @then@ comes before or after @from@. For-    -- 'Bounded' types the stream ends when 'maxBound' is reached, for-    -- unbounded types it keeps enumerating infinitely.-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 2-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.enumerateFromThen 0 (-2)-    -- [0,-2,-4,-6]-    ---    enumerateFromThen :: (Monad m) => a -> a -> Stream m a--    -- | @enumerateFromThenTo from then to@ generates a finite stream whose-    -- first element is @from@, the second element is @then@ and the successive-    -- elements are in increments of @then - from@ up to @to@. Enumeration can-    -- occur downwards or upwards depending on whether @then@ comes before or-    -- after @from@.-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 2 6-    -- [0,2,4,6]-    ---    -- >>> Stream.fold Fold.toList $ Stream.enumerateFromThenTo 0 (-2) (-6)-    -- [0,-2,-4,-6]-    ---    enumerateFromThenTo :: (Monad m) => a -> a -> a -> Stream m a---- MAYBE: Sometimes it is more convenient to know the count rather then the--- ending or starting element. For those cases we can define the folllowing--- APIs. All of these will work only for bounded types if we represent the--- count by Int.------ enumerateN--- enumerateFromN--- enumerateToN--- enumerateFromStep--- enumerateFromStepN------------------------------------------------------------------------------------ Convenient functions for bounded types-------------------------------------------------------------------------------------- |--- > enumerate = enumerateFrom minBound------ Enumerate a 'Bounded' type from its 'minBound' to 'maxBound'----{-# INLINE enumerate #-}-enumerate :: (Monad m, Bounded a, Enumerable a) => Stream m a-enumerate = enumerateFrom minBound---- |--- >>> enumerateTo = Stream.enumerateFromTo minBound------ Enumerate a 'Bounded' type from its 'minBound' to specified value.----{-# INLINE enumerateTo #-}-enumerateTo :: (Monad m, Bounded a, Enumerable a) => a -> Stream m a-enumerateTo = enumerateFromTo minBound---- |--- >>> enumerateFromBounded from = Stream.enumerateFromTo from maxBound------ 'enumerateFrom' for 'Bounded' 'Enum' types.----{-# INLINE enumerateFromBounded #-}-enumerateFromBounded :: (Monad m, Enumerable a, Bounded a)-    => a -> Stream m a-enumerateFromBounded from = enumerateFromTo from maxBound------------------------------------------------------------------------------------ Enumerable Instances-------------------------------------------------------------------------------------- For Enum types smaller than or equal to Int size.-#define ENUMERABLE_BOUNDED_SMALL(SMALL_TYPE)           \-instance Enumerable SMALL_TYPE where {                 \-    {-# INLINE enumerateFrom #-};                      \-    enumerateFrom = enumerateFromBounded;              \-    {-# INLINE enumerateFromThen #-};                  \-    enumerateFromThen = enumerateFromThenSmallBounded; \-    {-# INLINE enumerateFromTo #-};                    \-    enumerateFromTo = enumerateFromToSmall;            \-    {-# INLINE enumerateFromThenTo #-};                \-    enumerateFromThenTo = enumerateFromThenToSmall }--ENUMERABLE_BOUNDED_SMALL(())-ENUMERABLE_BOUNDED_SMALL(Bool)-ENUMERABLE_BOUNDED_SMALL(Ordering)-ENUMERABLE_BOUNDED_SMALL(Char)---- For bounded Integral Enum types, may be larger than Int.-#define ENUMERABLE_BOUNDED_INTEGRAL(INTEGRAL_TYPE)  \-instance Enumerable INTEGRAL_TYPE where {           \-    {-# INLINE enumerateFrom #-};                   \-    enumerateFrom = enumerateFromIntegral;          \-    {-# INLINE enumerateFromThen #-};               \-    enumerateFromThen = enumerateFromThenIntegral;  \-    {-# INLINE enumerateFromTo #-};                 \-    enumerateFromTo = enumerateFromToIntegral;      \-    {-# INLINE enumerateFromThenTo #-};             \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_BOUNDED_INTEGRAL(Int)-ENUMERABLE_BOUNDED_INTEGRAL(Int8)-ENUMERABLE_BOUNDED_INTEGRAL(Int16)-ENUMERABLE_BOUNDED_INTEGRAL(Int32)-ENUMERABLE_BOUNDED_INTEGRAL(Int64)-ENUMERABLE_BOUNDED_INTEGRAL(Word)-ENUMERABLE_BOUNDED_INTEGRAL(Word8)-ENUMERABLE_BOUNDED_INTEGRAL(Word16)-ENUMERABLE_BOUNDED_INTEGRAL(Word32)-ENUMERABLE_BOUNDED_INTEGRAL(Word64)---- For unbounded Integral Enum types.-#define ENUMERABLE_UNBOUNDED_INTEGRAL(INTEGRAL_TYPE)              \-instance Enumerable INTEGRAL_TYPE where {                         \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom from = enumerateFromStepIntegral from 1;        \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen from next =                                 \-        enumerateFromStepIntegral from (next - from);             \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToIntegral;                    \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToIntegral }--ENUMERABLE_UNBOUNDED_INTEGRAL(Integer)-ENUMERABLE_UNBOUNDED_INTEGRAL(Natural)--#define ENUMERABLE_FRACTIONAL(FRACTIONAL_TYPE,CONSTRAINT)         \-instance (CONSTRAINT) => Enumerable FRACTIONAL_TYPE where {     \-    {-# INLINE enumerateFrom #-};                                 \-    enumerateFrom = enumerateFromFractional;                      \-    {-# INLINE enumerateFromThen #-};                             \-    enumerateFromThen = enumerateFromThenFractional;              \-    {-# INLINE enumerateFromTo #-};                               \-    enumerateFromTo = enumerateFromToFractional;                  \-    {-# INLINE enumerateFromThenTo #-};                           \-    enumerateFromThenTo = enumerateFromThenToFractional }--ENUMERABLE_FRACTIONAL(Float,)-ENUMERABLE_FRACTIONAL(Double,)-ENUMERABLE_FRACTIONAL((Fixed a),HasResolution a)-ENUMERABLE_FRACTIONAL((Ratio a),Integral a)--instance Enumerable a => Enumerable (Identity a) where-    {-# INLINE enumerateFrom #-}-    enumerateFrom (Identity from) =-        fmap Identity $ enumerateFrom from-    {-# INLINE enumerateFromThen #-}-    enumerateFromThen (Identity from) (Identity next) =-        fmap Identity $ enumerateFromThen from next-    {-# INLINE enumerateFromTo #-}-    enumerateFromTo (Identity from) (Identity to) =-        fmap Identity $ enumerateFromTo from to-    {-# INLINE enumerateFromThenTo #-}-    enumerateFromThenTo (Identity from) (Identity next) (Identity to) =-          fmap Identity-        $ enumerateFromThenTo from next to---- TODO-{--instance Enumerable a => Enumerable (Last a)-instance Enumerable a => Enumerable (First a)-instance Enumerable a => Enumerable (Max a)-instance Enumerable a => Enumerable (Min a)-instance Enumerable a => Enumerable (Const a b)-instance Enumerable (f a) => Enumerable (Alt f a)-instance Enumerable (f a) => Enumerable (Ap f a)--}---------------------------------------------------------------------------------- Time Enumeration----------------------------------------------------------------------------------- | @timesWith g@ returns a stream of time value tuples. The first component--- of the tuple is an absolute time reference (epoch) denoting the start of the--- stream and the second component is a time relative to the reference.------ The argument @g@ specifies the granularity of the relative time in seconds.--- A lower granularity clock gives higher precision but is more expensive in--- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.------ >>> import Control.Concurrent (threadDelay)--- >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.timesWith 0.01--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE_NORMAL timesWith #-}-timesWith :: MonadIO m => Double -> Stream m (AbsTime, RelTime64)-timesWith g = Stream step Nothing--    where--    {-# INLINE_LATE step #-}-    step _ Nothing = do-        clock <- liftIO $ asyncClock Monotonic g-        a <- liftIO $ readClock clock-        return $ Skip $ Just (clock, a)--    step _ s@(Just (clock, t0)) = do-        a <- liftIO $ readClock clock-        -- XXX we can perhaps use an AbsTime64 using a 64 bit Int for-        -- efficiency.  or maybe we can use a representation using Double for-        -- floating precision time-        return $ Yield (toAbsTime t0, toRelTime64 (a - t0)) s---- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage.  Any granularity lower than 1 ms is treated--- as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimesWith 0.01--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimesWith #-}-absTimesWith :: MonadIO m => Double -> Stream m AbsTime-absTimesWith = fmap (uncurry addToAbsTime64) . timesWith---- | @relTimesWith g@ returns a stream of relative time values starting from 0,--- using a clock of granularity @g@ specified in seconds. A low granularity--- clock is more expensive in terms of CPU usage.  Any granularity lower than 1--- ms is treated as 1 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimesWith 0.01--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimesWith #-}-relTimesWith :: MonadIO m => Double -> Stream m RelTime64-relTimesWith = fmap snd . timesWith---- | @times@ returns a stream of time value tuples with clock of 10 ms--- granularity. The first component of the tuple is an absolute time reference--- (epoch) denoting the start of the stream and the second component is a time--- relative to the reference.------ >>> f = Fold.drainMapM (\x -> print x >> threadDelay 1000000)--- >>> Stream.fold f $ Stream.take 3 $ Stream.times--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))--- (AbsTime (TimeSpec {sec = ..., nsec = ...}),RelTime64 (NanoSecond64 ...))------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE times #-}-times :: MonadIO m => Stream m (AbsTime, RelTime64)-times = timesWith 0.01---- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms--- granularity.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.absTimes--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})--- AbsTime (TimeSpec {sec = ..., nsec = ...})------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE absTimes #-}-absTimes :: MonadIO m => Stream m AbsTime-absTimes = fmap (uncurry addToAbsTime64) times---- | @relTimes@ returns a stream of relative time values starting from 0,--- using a clock of granularity 10 ms.------ >>> f = Fold.drainMapM print--- >>> Stream.fold f $ Stream.delayPre 1 $ Stream.take 3 $ Stream.relTimes--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)--- RelTime64 (NanoSecond64 ...)------ Note: This API is not safe on 32-bit machines.------ /Pre-release/----{-# INLINE relTimes #-}-relTimes ::  MonadIO m => Stream m RelTime64-relTimes = fmap snd times---- | @durations g@ returns a stream of relative time values measuring the time--- elapsed since the immediate predecessor element of the stream was generated.--- The first element of the stream is always 0. @durations@ uses a clock of--- granularity @g@ specified in seconds. A low granularity clock is more--- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.--- Durations lower than 1 ms will be 0.------ Note: This API is not safe on 32-bit machines.------ /Unimplemented/----{-# INLINE durations #-}-durations :: -- Monad m =>-    Double -> t m RelTime64-durations = undefined---- | Generate a singleton event at or after the specified absolute time. Note--- that this is different from a threadDelay, a threadDelay starts from the--- time when the action is evaluated, whereas if we use AbsTime based timeout--- it will immediately expire if the action is evaluated too late.------ /Unimplemented/----{-# INLINE timeout #-}-timeout :: -- Monad m =>-    AbsTime -> t m ()-timeout = undefined------------------------------------------------------------------------------------ From Generators----------------------------------------------------------------------------------{-# INLINE_NORMAL fromIndicesM #-}-fromIndicesM :: Monad m => (Int -> m a) -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-fromIndicesM gen = unfold (Unfold.fromIndicesM gen) 0-#else-fromIndicesM gen = Stream step 0-  where-    {-# INLINE_LATE step #-}-    step _ i = do-       x <- gen i-       return $ Yield x (i + 1)-#endif--{-# INLINE fromIndices #-}-fromIndices :: Monad m => (Int -> a) -> Stream m a-fromIndices gen = fromIndicesM (return . gen)---- Adapted from the vector package-{-# INLINE_NORMAL generateM #-}-generateM :: Monad m => Int -> (Int -> m a) -> Stream m a-generateM n gen = n `seq` Stream step 0-  where-    {-# INLINE_LATE step #-}-    step _ i | i < n     = do-                           x <- gen i-                           return $ Yield x (i + 1)-             | otherwise = return Stop--{-# INLINE generate #-}-generate :: Monad m => Int -> (Int -> a) -> Stream m a-generate n gen = generateM n (return . gen)------------------------------------------------------------------------------------ Iteration------------------------------------------------------------------------------------ |--- >>> iterateM f m = m >>= \a -> return a `Stream.consM` iterateM f (f a)------ Generate an infinite stream with the first element generated by the action--- @m@ and each successive element derived by applying the monadic function--- @f@ on the previous element.------ >>> :{--- Stream.iterateM (\x -> print x >> return (x + 1)) (return 0)---     & Stream.take 3---     & Stream.fold Fold.toList--- :}--- 0--- 1--- [0,1,2]----{-# INLINE_NORMAL iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-iterateM step = unfold (Unfold.iterateM step)-#else-iterateM step = Stream (\_ st -> st >>= \(!x) -> return $ Yield x (step x))-#endif---- |--- >>> iterate f x = x `Stream.cons` iterate f x------ Generate an infinite stream with @x@ as the first element and each--- successive element derived by applying the function @f@ on the previous--- element.------ >>> Stream.fold Fold.toList $ Stream.take 5 $ Stream.iterate (+1) 1--- [1,2,3,4,5]----{-# INLINE_NORMAL iterate #-}-iterate :: Monad m => (a -> a) -> a -> Stream m a-iterate step st = iterateM (return . step) (return st)------------------------------------------------------------------------------------ From containers------------------------------------------------------------------------------------ | Convert a list of monadic actions to a 'Stream'-{-# INLINE_LATE fromListM #-}-fromListM :: Monad m => [m a] -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-fromListM = unfold Unfold.fromListM-#else-fromListM = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (m:ms) = m >>= \x -> return $ Yield x ms-    step _ []     = return Stop-#endif---- |--- >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil------ Construct a stream from a 'Foldable' containing pure values:------ /WARNING: O(n^2), suitable only for a small number of--- elements in the stream/----{-# INLINE fromFoldable #-}-fromFoldable :: (Monad m, Foldable f) => f a -> Stream m a-fromFoldable = Prelude.foldr cons nil---- |--- >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil------ Construct a stream from a 'Foldable' containing pure values:------ /WARNING: O(n^2), suitable only for a small number of--- elements in the stream/----{-# INLINE fromFoldableM #-}-fromFoldableM :: (Monad m, Foldable f) => f (m a) -> Stream m a-fromFoldableM = Prelude.foldr consM nil------------------------------------------------------------------------------------ From pointers------------------------------------------------------------------------------------ | Keep reading 'Storable' elements from 'Ptr' onwards.------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtr #-}-fromPtr :: forall m a. (MonadIO m, Storable a) => Ptr a -> Stream m a-fromPtr = Stream step--    where--    {-# INLINE_LATE step #-}-    step _ p = do-        x <- liftIO $ peek p-        return $ Yield x (PTR_NEXT(p, a))---- | Take @n@ 'Storable' elements starting from 'Ptr' onwards.------ >>> fromPtrN n = Stream.take n . Stream.fromPtr------ /Unsafe:/ The caller is responsible for safe addressing.------ /Pre-release/-{-# INLINE fromPtrN #-}-fromPtrN :: (MonadIO m, Storable a) => Int -> Ptr a -> Stream m a-fromPtrN n = take n . fromPtr---- | Read bytes from an 'Addr#' until a 0 byte is encountered, the 0 byte is--- not included in the stream.------ >>> :set -XMagicHash--- >>> fromByteStr# addr = Stream.takeWhile (/= 0) $ Stream.fromPtr $ Ptr addr------ /Unsafe:/ The caller is responsible for safe addressing.------ Note that this is completely safe when reading from Haskell string--- literals because they are guaranteed to be NULL terminated:------ >>> Stream.fold Fold.toList $ Stream.fromByteStr# "\1\2\3\0"#--- [1,2,3]----{-# INLINE fromByteStr# #-}-fromByteStr# :: MonadIO m => Addr# -> Stream m Word8-fromByteStr# addr =-    takeWhile (/= 0) $ fromPtr $ Ptr addr
− src/Streamly/Internal/Data/Stream/StreamD/Lift.hs 
@@ -1,129 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Lift--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Transform the underlying monad of a stream.--module Streamly.Internal.Data.Stream.StreamD.Lift-    (-    -- * Generalize Inner Monad-      morphInner-    , generalizeInner--    -- * Transform Inner Monad-    , liftInnerWith-    , runInnerWith-    , runInnerWithState-    )-where--#include "inline.hs"--import Data.Functor.Identity (Identity(..))-import Streamly.Internal.Data.SVar.Type (adaptState)--import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"------------------------------------------------------------------------------------ Generalize Inner Monad------------------------------------------------------------------------------------ | Transform the inner monad of a stream using a natural transformation.------ Example, generalize the inner monad from Identity to any other:------ >>> generalizeInner = Stream.morphInner (return . runIdentity)------ Also known as hoist.----{-# INLINE_NORMAL morphInner #-}-morphInner :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a-morphInner f (Stream step state) = Stream step' state-    where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- f $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip  s   -> Skip s-            Stop      -> Stop---- | Generalize the inner monad of the stream from 'Identity' to any monad.------ Definition:------ >>> generalizeInner = Stream.morphInner (return . runIdentity)----{-# INLINE generalizeInner #-}-generalizeInner :: Monad m => Stream Identity a -> Stream m a-generalizeInner = morphInner (return . runIdentity)------------------------------------------------------------------------------------ Transform Inner Monad------------------------------------------------------------------------------------ | Lift the inner monad @m@ of a stream @Stream m a@ to @t m@ using the--- supplied lift function.----{-# INLINE_NORMAL liftInnerWith #-}-liftInnerWith :: (Monad (t m)) =>-    (forall b. m b -> t m b) -> Stream m a -> Stream (t m) a-liftInnerWith lift (Stream step state) = Stream step1 state--    where--    {-# INLINE_LATE step1 #-}-    step1 gst st = do-        r <- lift $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip s    -> Skip s-            Stop      -> Stop---- | Evaluate the inner monad of a stream using the supplied runner function.----{-# INLINE_NORMAL runInnerWith #-}-runInnerWith :: Monad m =>-    (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a-runInnerWith run (Stream step state) = Stream step1 state--    where--    {-# INLINE_LATE step1 #-}-    step1 gst st = do-        r <- run $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip s -> Skip s-            Stop -> Stop---- | Evaluate the inner monad of a stream using the supplied stateful runner--- function and the initial state. The state returned by an invocation of the--- runner is supplied as input state to the next invocation.----{-# INLINE_NORMAL runInnerWithState #-}-runInnerWithState :: Monad m =>-    (forall b. s -> t m b -> m (b, s))-    -> m s-    -> Stream (t m) a-    -> Stream m (s, a)-runInnerWithState run initial (Stream step state) =-    Stream step1 (state, initial)--    where--    {-# INLINE_LATE step1 #-}-    step1 gst (st, action) = do-        sv <- action-        (r, !sv1) <- run sv (step (adaptState gst) st)-        return $ case r of-            Yield x s -> Yield (sv1, x) (s, return sv1)-            Skip s -> Skip (s, return sv1)-            Stop -> Stop
− src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs 
@@ -1,3111 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Nesting--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ This module contains transformations involving multiple streams, unfolds or--- folds. There are two types of transformations generational or eliminational.--- Generational transformations are like the "Generate" module but they--- generate a stream by combining streams instead of elements. Eliminational--- transformations are like the "Eliminate" module but they transform a stream--- by eliminating parts of the stream instead of eliminating the whole stream.------ These combinators involve transformation, generation, elimination so can be--- classified under any of those.------ Ultimately these operations should be supported by Unfolds, Pipes and Folds,--- and this module may become redundant.---- The zipWithM combinator in this module has been adapted from the vector--- package (c) Roman Leshchinskiy.----module Streamly.Internal.Data.Stream.StreamD.Nesting-    (-    -- * Generate-    -- | Combining streams to generate streams.--    -- ** Combine Two Streams-    -- | Functions ending in the shape:-    ---    -- @t m a -> t m a -> t m a@.--    -- *** Appending-    -- | Append a stream after another. A special case of concatMap or-    -- unfoldMany.-      AppendState(..)-    , append--    -- *** Interleaving-    -- | Interleave elements from two streams alternately. A special case of-    -- unfoldInterleave.-    , InterleaveState(..)-    , interleave-    , interleaveMin-    , interleaveFst-    , interleaveFstSuffix--    -- *** Scheduling-    -- | Execute streams alternately irrespective of whether they generate-    -- elements or not. Note 'interleave' would execute a stream until it-    -- yields an element. A special case of unfoldRoundRobin.-    , roundRobin -- interleaveFair?/ParallelFair--    -- *** Zipping-    -- | Zip corresponding elements of two streams.-    , zipWith-    , zipWithM--    -- *** Merging-    -- | Interleave elements from two streams based on a condition.-    , mergeBy-    , mergeByM-    , mergeMinBy-    , mergeFstBy--    -- ** Combine N Streams-    -- | Functions generally ending in these shapes:-    ---    -- @-    -- concat: f (t m a) -> t m a-    -- concatMap: (a -> t m b) -> t m a -> t m b-    -- unfoldMany: Unfold m a b -> t m a -> t m b-    -- @--    -- *** ConcatMap-    -- | Generate streams by mapping a stream generator on each element of an-    -- input stream, append the resulting streams and flatten.-    , concatMap-    , concatMapM--    -- *** ConcatUnfold-    -- | Generate streams by using an unfold on each element of an input-    -- stream, append the resulting streams and flatten. A special case of-    -- gintercalate.-    , unfoldMany-    , ConcatUnfoldInterleaveState (..)-    , unfoldInterleave-    , unfoldRoundRobin--    -- *** Interpose-    -- | Like unfoldMany but intersperses an effect between the streams. A-    -- special case of gintercalate.-    , interpose-    , interposeM-    , interposeSuffix-    , interposeSuffixM--    -- *** Intercalate-    -- | Like unfoldMany but intersperses streams from another source between-    -- the streams from the first source.-    , gintercalate-    , gintercalateSuffix-    , intercalate-    , intercalateSuffix--    -- * Eliminate-    -- | Folding and Parsing chunks of streams to eliminate nested streams.-    -- Functions generally ending in these shapes:-    ---    -- @-    -- f (Fold m a b) -> t m a -> t m b-    -- f (Parser a m b) -> t m a -> t m b-    -- @--    -- ** Folding-    -- | Apply folds on a stream.-    , foldMany-    , refoldMany-    , foldSequence-    , foldIterateM-    , refoldIterateM--    -- ** Parsing-    -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or-    -- unfoldMany. concatMap generates a stream from single values in a-    -- stream and flattens, parseMany does the opposite of flattening by-    -- splitting the stream and then folds each such split to single value in-    -- the output stream.-    , parseMany-    , parseManyD-    , parseSequence-    , parseManyTill-    , parseIterate-    , parseIterateD--    -- ** Grouping-    -- | Group segments of a stream and fold. Special case of parsing.-    , groupsOf-    , groupsBy-    , groupsRollingBy--    -- ** Splitting-    -- | A special case of parsing.-    , wordsBy-    , splitOnSeq-    , splitOnSuffixSeq-    , sliceOnSuffix--    -- XXX Implement these as folds or parsers instead.-    , splitOnSuffixSeqAny-    , splitOnPrefix-    , splitOnAny--    -- * Transform (Nested Containers)-    -- | Opposite to compact in ArrayStream-    , splitInnerBy-    , splitInnerBySuffix-    , intersectBySorted--    -- * Reduce By Streams-    , dropPrefix-    , dropInfix-    , dropSuffix-    )-where--#include "inline.hs"-#include "ArrayMacros.h"--import Control.Exception (assert)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Bits (shiftR, shiftL, (.|.), (.&.))-import Data.Proxy (Proxy(..))-import Data.Word (Word32)-import Foreign.Storable (Storable, peek)-import Fusion.Plugin.Types (Fuse(..))-import GHC.Types (SPEC(..))--import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Fold.Step (Step(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Parser (ParseError(..))-import Streamly.Internal.Data.Refold.Type (Refold(..))-import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unboxed (Unbox, sizeOf)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Parser as PR-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-import qualified Streamly.Internal.Data.Ring.Unboxed as RB--import Streamly.Internal.Data.Stream.StreamD.Transform-    (intersperse, intersperseMSuffix)-import Streamly.Internal.Data.Stream.StreamD.Type--import Prelude hiding (concatMap, mapM, zipWith)--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Appending---------------------------------------------------------------------------------data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2---- | Fuses two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ >>> s1 = Stream.fromList [1,2]--- >>> s2 = Stream.fromList [3,4]--- >>> Stream.fold Fold.toList $ s1 `Stream.append` s2--- [1,2,3,4]------ This function should not be used to dynamically construct a stream. If a--- stream is constructed by successive use of this function it would take--- quadratic time complexity to consume the stream.------ This function should only be used to statically fuse a stream with another--- stream. Do not use this recursively or where it cannot be inlined.------ See "Streamly.Data.StreamK" for an 'append' that can be used to--- construct a stream recursively.----{-# INLINE_NORMAL append #-}-append :: Monad m => Stream m a -> Stream m a -> Stream m a-append (Stream step1 state1) (Stream step2 state2) =-    Stream step (AppendFirst state1)--    where--    {-# INLINE_LATE step #-}-    step gst (AppendFirst st) = do-        r <- step1 gst st-        return $ case r of-            Yield a s -> Yield a (AppendFirst s)-            Skip s -> Skip (AppendFirst s)-            Stop -> Skip (AppendSecond state2)--    step gst (AppendSecond st) = do-        r <- step2 gst st-        return $ case r of-            Yield a s -> Yield a (AppendSecond s)-            Skip s -> Skip (AppendSecond s)-            Stop -> Stop----------------------------------------------------------------------------------- Interleaving---------------------------------------------------------------------------------data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2-    | InterleaveSecondOnly s2 | InterleaveFirstOnly s1---- | Interleaves two streams, yielding one element from each stream--- alternately.  When one stream stops the rest of the other stream is used in--- the output stream.------ When joining many streams in a left associative manner earlier streams will--- get exponential priority than the ones joining later. Because of exponential--- weighting it can be used with 'concatMapWith' even on a large number of--- streams.----{-# INLINE_NORMAL interleave #-}-interleave :: Monad m => Stream m a -> Stream m a -> Stream m a-interleave (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveFirst s st2)-            Stop -> Skip (InterleaveSecondOnly st2)--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveSecond st1 s)-            Stop -> Skip (InterleaveFirstOnly st1)--    step gst (InterleaveFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveFirstOnly s)-            Skip s -> Skip (InterleaveFirstOnly s)-            Stop -> Stop--    step gst (InterleaveSecondOnly st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveSecondOnly s)-            Skip s -> Skip (InterleaveSecondOnly s)-            Stop -> Stop---- | Like `interleave` but stops interleaving as soon as any of the two streams--- stops.----{-# INLINE_NORMAL interleaveMin #-}-interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveMin (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveFirst s st2)-            Stop -> Stop--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveSecond st1 s)-            Stop -> Stop--    step _ (InterleaveFirstOnly _) =  undefined-    step _ (InterleaveSecondOnly _) =  undefined---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream. As soon as the first stream--- finishes, the output stops, discarding the remaining part of the second--- stream. In this case, the last element in the resulting stream would be from--- the second stream. If the second stream finishes early then the first stream--- still continues to yield elements until it finishes.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFstSuffix "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c,"--- >>> Stream.interleaveFstSuffix "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFstSuffix' is a dual of 'interleaveFst'.------ Do not use dynamically.------ /Pre-release/-{-# INLINE_NORMAL interleaveFstSuffix #-}-interleaveFstSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveFstSuffix (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveFirst s st2)-            Stop -> Stop--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveSecond st1 s)-            Stop -> Skip (InterleaveFirstOnly st1)--    step gst (InterleaveFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveFirstOnly s)-            Skip s -> Skip (InterleaveFirstOnly s)-            Stop -> Stop--    step _ (InterleaveSecondOnly _) =  undefined--data InterleaveInfixState s1 s2 a-    = InterleaveInfixFirst s1 s2-    | InterleaveInfixSecondBuf s1 s2-    | InterleaveInfixSecondYield s1 s2 a-    | InterleaveInfixFirstYield s1 s2 a-    | InterleaveInfixFirstOnly s1---- | Interleaves the outputs of two streams, yielding elements from each stream--- alternately, starting from the first stream and ending at the first stream.--- If the second stream is longer than the first, elements from the second--- stream are infixed with elements from the first stream. If the first stream--- is longer then it continues yielding elements even after the second stream--- has finished.------ >>> :set -XOverloadedStrings--- >>> import Data.Functor.Identity (Identity)--- >>> Stream.interleaveFst "abc" ",,,," :: Stream Identity Char--- fromList "a,b,c"--- >>> Stream.interleaveFst "abc" "," :: Stream Identity Char--- fromList "a,bc"------ 'interleaveFst' is a dual of 'interleaveFstSuffix'.------ Do not use dynamically.------ /Pre-release/-{-# INLINE_NORMAL interleaveFst #-}-interleaveFst :: Monad m => Stream m a -> Stream m a -> Stream m a-interleaveFst (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveInfixFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveInfixFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)-            Skip s -> Skip (InterleaveInfixFirst s st2)-            Stop -> Stop--    step gst (InterleaveInfixSecondBuf st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)-            Skip s -> Skip (InterleaveInfixSecondBuf st1 s)-            Stop -> Skip (InterleaveInfixFirstOnly st1)--    step gst (InterleaveInfixSecondYield st1 st2 x) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)-            Skip s -> Skip (InterleaveInfixSecondYield s st2 x)-            Stop -> Stop--    step _ (InterleaveInfixFirstYield st1 st2 x) = do-        return $ Yield x (InterleaveInfixSecondBuf st1 st2)--    step gst (InterleaveInfixFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveInfixFirstOnly s)-            Skip s -> Skip (InterleaveInfixFirstOnly s)-            Stop -> Stop----------------------------------------------------------------------------------- Scheduling----------------------------------------------------------------------------------- | Schedule the execution of two streams in a fair round-robin manner,--- executing each stream once, alternately. Execution of a stream may not--- necessarily result in an output, a stream may choose to @Skip@ producing an--- element until later giving the other stream a chance to run. Therefore, this--- combinator fairly interleaves the execution of two streams rather than--- fairly interleaving the output of the two streams. This can be useful in--- co-operative multitasking without using explicit threads. This can be used--- as an alternative to `async`.------ Do not use dynamically.------ /Pre-release/-{-# INLINE_NORMAL roundRobin #-}-roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a-roundRobin (Stream step1 state1) (Stream step2 state2) =-    Stream step (InterleaveFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (InterleaveFirst st1 st2) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveSecond s st2)-            Skip s -> Skip (InterleaveSecond s st2)-            Stop -> Skip (InterleaveSecondOnly st2)--    step gst (InterleaveSecond st1 st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveFirst st1 s)-            Skip s -> Skip (InterleaveFirst st1 s)-            Stop -> Skip (InterleaveFirstOnly st1)--    step gst (InterleaveSecondOnly st2) = do-        r <- step2 gst st2-        return $ case r of-            Yield a s -> Yield a (InterleaveSecondOnly s)-            Skip s -> Skip (InterleaveSecondOnly s)-            Stop -> Stop--    step gst (InterleaveFirstOnly st1) = do-        r <- step1 gst st1-        return $ case r of-            Yield a s -> Yield a (InterleaveFirstOnly s)-            Skip s -> Skip (InterleaveFirstOnly s)-            Stop -> Stop----------------------------------------------------------------------------------- Merging----------------------------------------------------------------------------------- | Like 'mergeBy' but with a monadic comparison function.------ Merge two streams randomly:------ @--- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT--- > Stream.toList $ Stream.mergeByM randomly (Stream.fromList [1,1,1,1]) (Stream.fromList [2,2,2,2])--- [2,1,2,2,2,1,1,1]--- @------ Merge two streams in a proportion of 2:1:------ >>> :{--- do---  let s1 = Stream.fromList [1,1,1,1,1,1]---      s2 = Stream.fromList [2,2,2]---  let proportionately m n = do---       ref <- newIORef $ cycle $ Prelude.concat [Prelude.replicate m LT, Prelude.replicate n GT]---       return $ \_ _ -> do---          r <- readIORef ref---          writeIORef ref $ Prelude.tail r---          return $ Prelude.head r---  f <- proportionately 2 1---  xs <- Stream.fold Fold.toList $ Stream.mergeByM f s1 s2---  print xs--- :}--- [1,1,2,1,1,2,1,1,2]----{-# INLINE_NORMAL mergeByM #-}-mergeByM-    :: (Monad m)-    => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeByM cmp (Stream stepa ta) (Stream stepb tb) =-    Stream step (Just ta, Just tb, Nothing, Nothing)-  where-    {-# INLINE_LATE step #-}--    -- one of the values is missing, and the corresponding stream is running-    step gst (Just sa, sb, Nothing, b) = do-        r <- stepa gst sa-        return $ case r of-            Yield a sa' -> Skip (Just sa', sb, Just a, b)-            Skip sa'    -> Skip (Just sa', sb, Nothing, b)-            Stop        -> Skip (Nothing, sb, Nothing, b)--    step gst (sa, Just sb, a, Nothing) = do-        r <- stepb gst sb-        return $ case r of-            Yield b sb' -> Skip (sa, Just sb', a, Just b)-            Skip sb'    -> Skip (sa, Just sb', a, Nothing)-            Stop        -> Skip (sa, Nothing, a, Nothing)--    -- both the values are available-    step _ (sa, sb, Just a, Just b) = do-        res <- cmp a b-        return $ case res of-            GT -> Yield b (sa, sb, Just a, Nothing)-            _  -> Yield a (sa, sb, Nothing, Just b)--    -- one of the values is missing, corresponding stream is done-    step _ (Nothing, sb, Nothing, Just b) =-            return $ Yield b (Nothing, sb, Nothing, Nothing)--    step _ (sa, Nothing, Just a, Nothing) =-            return $ Yield a (sa, Nothing, Nothing, Nothing)--    step _ (Nothing, Nothing, Nothing, Nothing) = return Stop---- | Merge two streams using a comparison function. The head elements of both--- the streams are compared and the smaller of the two elements is emitted, if--- both elements are equal then the element from the first stream is used--- first.------ If the streams are sorted in ascending order, the resulting stream would--- also remain sorted in ascending order.------ >>> s1 = Stream.fromList [1,3,5]--- >>> s2 = Stream.fromList [2,4,6,8]--- >>> Stream.fold Fold.toList $ Stream.mergeBy compare s1 s2--- [1,2,3,4,5,6,8]----{-# INLINE mergeBy #-}-mergeBy-    :: (Monad m)-    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeBy cmp = mergeByM (\a b -> return $ cmp a b)---- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.------ /Unimplemented/-{-# INLINABLE mergeMinBy #-}-mergeMinBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeMinBy _f _m1 _m2 = undefined-    -- fromStreamD $ D.mergeMinBy f (toStreamD m1) (toStreamD m2)---- | Like 'mergeByM' but stops merging as soon as the first stream stops.------ /Unimplemented/-{-# INLINABLE mergeFstBy #-}-mergeFstBy :: -- Monad m =>-    (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a-mergeFstBy _f _m1 _m2 = undefined-    -- fromStreamK $ D.mergeFstBy f (toStreamD m1) (toStreamD m2)------------------------------------------------------------------------------------ Intersection of sorted streams------------------------------------------------------------------------------------ Assuming the streams are sorted in ascending order-{-# INLINE_NORMAL intersectBySorted #-}-intersectBySorted :: Monad m-    => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-intersectBySorted cmp (Stream stepa ta) (Stream stepb tb) =-    Stream step-        ( ta -- left stream state-        , tb -- right stream state-        , Nothing -- left value-        , Nothing -- right value-        )--    where--    {-# INLINE_LATE step #-}-    -- step 1, fetch the first value-    step gst (sa, sb, Nothing, b) = do-        r <- stepa gst sa-        return $ case r of-            Yield a sa' -> Skip (sa', sb, Just a, b) -- step 2/3-            Skip sa'    -> Skip (sa', sb, Nothing, b)-            Stop        -> Stop--    -- step 2, fetch the second value-    step gst (sa, sb, a@(Just _), Nothing) = do-        r <- stepb gst sb-        return $ case r of-            Yield b sb' -> Skip (sa, sb', a, Just b) -- step 3-            Skip sb'    -> Skip (sa, sb', a, Nothing)-            Stop        -> Stop--    -- step 3, compare the two values-    step _ (sa, sb, Just a, Just b) = do-        let res = cmp a b-        return $ case res of-            GT -> Skip (sa, sb, Just a, Nothing) -- step 2-            LT -> Skip (sa, sb, Nothing, Just b) -- step 1-            EQ -> Yield a (sa, sb, Nothing, Just b) -- step 1----------------------------------------------------------------------------------- Combine N Streams - unfoldMany---------------------------------------------------------------------------------data ConcatUnfoldInterleaveState o i =-      ConcatUnfoldInterleaveOuter o [i]-    | ConcatUnfoldInterleaveInner o [i]-    | ConcatUnfoldInterleaveInnerL [i] [i]-    | ConcatUnfoldInterleaveInnerR [i] [i]---- XXX use arrays to store state instead of lists?------ XXX In general we can use different scheduling strategies e.g. how to--- schedule the outer vs inner loop or assigning weights to different streams--- or outer and inner loops.---- After a yield, switch to the next stream. Do not switch streams on Skip.--- Yield from outer stream switches to the inner stream.------ There are two choices here, (1) exhaust the outer stream first and then--- start yielding from the inner streams, this is much simpler to implement,--- (2) yield at least one element from an inner stream before going back to--- outer stream and opening the next stream from it.------ Ideally, we need some scheduling bias to inner streams vs outer stream.--- Maybe we can configure the behavior.------ XXX Instead of using "concatPairsWith wSerial" we can implement an N-way--- interleaving CPS combinator which behaves like unfoldInterleave. Instead--- of pairing up the streams we just need to go yielding one element from each--- stream and storing the remaining streams and then keep doing rounds through--- those in a round robin fashion. This would be much like wAsync.---- | This does not pair streams like mergeMapWith, instead, it goes through--- each stream one by one and yields one element from each stream. After it--- goes to the last stream it reverses the traversal to come back to the first--- stream yielding elements from each stream on its way back to the first--- stream and so on.------ >>> lists = Stream.fromList [[1,1],[2,2],[3,3],[4,4],[5,5]]--- >>> interleaved = Stream.unfoldInterleave Unfold.fromList lists--- >>> Stream.fold Fold.toList interleaved--- [1,2,3,4,5,5,4,3,2,1]------ Note that this is order of magnitude more efficient than "mergeMapWith--- interleave" because of fusion.----{-# INLINE_NORMAL unfoldInterleave #-}-unfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldInterleave (Unfold istep inject) (Stream ostep ost) =-    Stream step (ConcatUnfoldInterleaveOuter ost [])--    where--    {-# INLINE_LATE step #-}-    step gst (ConcatUnfoldInterleaveOuter o ls) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a o' -> do-                i <- inject a-                i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))-            Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)-            Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInner _ []) = undefined-    step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))-            Skip s    -> Skip (ConcatUnfoldInterleaveInner o (s:ls))-            Stop      -> Skip (ConcatUnfoldInterleaveOuter o ls)--    step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerL [] rs) =-        return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)--    step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)-            Stop      -> Skip (ConcatUnfoldInterleaveInnerL ls rs)--    step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerR ls []) =-        return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))-            Stop      -> Skip (ConcatUnfoldInterleaveInnerR ls rs)---- XXX In general we can use different scheduling strategies e.g. how to--- schedule the outer vs inner loop or assigning weights to different streams--- or outer and inner loops.------ This could be inefficient if the tasks are too small.------ Compared to unfoldInterleave this one switches streams on Skips.---- | 'unfoldInterleave' switches to the next stream whenever a value from a--- stream is yielded, it does not switch on a 'Skip'. So if a stream keeps--- skipping for long time other streams won't get a chance to run.--- 'unfoldRoundRobin' switches on Skip as well. So it basically schedules each--- stream fairly irrespective of whether it produces a value or not.----{-# INLINE_NORMAL unfoldRoundRobin #-}-unfoldRoundRobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldRoundRobin (Unfold istep inject) (Stream ostep ost) =-    Stream step (ConcatUnfoldInterleaveOuter ost [])-  where-    {-# INLINE_LATE step #-}-    step gst (ConcatUnfoldInterleaveOuter o ls) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a o' -> do-                i <- inject a-                i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))-            Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)-            Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInner o []) =-            return $ Skip (ConcatUnfoldInterleaveOuter o [])--    step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))-            Skip s    -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))-            Stop      -> Skip (ConcatUnfoldInterleaveOuter o ls)--    step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerL [] rs) =-        return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)--    step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))-            Stop      -> Skip (ConcatUnfoldInterleaveInnerL ls rs)--    step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop-    step _ (ConcatUnfoldInterleaveInnerR ls []) =-        return $ Skip (ConcatUnfoldInterleaveInnerL ls [])--    step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do-        r <- istep st-        return $ case r of-            Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)-            Skip s    -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)-            Stop      -> Skip (ConcatUnfoldInterleaveInnerR ls rs)----------------------------------------------------------------------------------- Combine N Streams - interpose---------------------------------------------------------------------------------{-# ANN type InterposeSuffixState Fuse #-}-data InterposeSuffixState s1 i1 =-      InterposeSuffixFirst s1-    -- | InterposeSuffixFirstYield s1 i1-    | InterposeSuffixFirstInner s1 i1-    | InterposeSuffixSecond s1---- Note that if an unfolded layer turns out to be nil we still emit the--- separator effect. An alternate behavior could be to emit the separator--- effect only if at least one element has been yielded by the unfolding.--- However, that becomes a bit complicated, so we have chosen the former--- behvaior for now.-{-# INLINE_NORMAL interposeSuffixM #-}-interposeSuffixM-    :: Monad m-    => m c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffixM-    action-    (Unfold istep1 inject1) (Stream step1 state1) =-    Stream step (InterposeSuffixFirst state1)--    where--    {-# INLINE_LATE step #-}-    step gst (InterposeSuffixFirst s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (InterposeSuffixFirstInner s i))-                -- i `seq` return (Skip (InterposeSuffixFirstYield s i))-            Skip s -> return $ Skip (InterposeSuffixFirst s)-            Stop -> return Stop--    {--    step _ (InterposeSuffixFirstYield s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')-            Skip i'    -> Skip (InterposeSuffixFirstYield s1 i')-            Stop       -> Skip (InterposeSuffixFirst s1)-    -}--    step _ (InterposeSuffixFirstInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')-            Skip i'    -> Skip (InterposeSuffixFirstInner s1 i')-            Stop       -> Skip (InterposeSuffixSecond s1)--    step _ (InterposeSuffixSecond s1) = do-        r <- action-        return $ Yield r (InterposeSuffixFirst s1)---- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)---- | Unfold the elements of a stream, append the given element after each--- unfolded stream and then concat them into a single stream.------ >>> unlines = Stream.interposeSuffix '\n'------ /Pre-release/-{-# INLINE interposeSuffix #-}-interposeSuffix :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interposeSuffix x = interposeSuffixM (return x)--{-# ANN type InterposeState Fuse #-}-data InterposeState s1 i1 a =-      InterposeFirst s1-    -- | InterposeFirstYield s1 i1-    | InterposeFirstInner s1 i1-    | InterposeFirstInject s1-    -- | InterposeFirstBuf s1 i1-    | InterposeSecondYield s1 i1-    -- -- | InterposeSecondYield s1 i1 a-    -- -- | InterposeFirstResume s1 i1 a---- Note that this only interposes the pure values, we may run many effects to--- generate those values as some effects may not generate anything (Skip).-{-# INLINE_NORMAL interposeM #-}-interposeM :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c-interposeM-    action-    (Unfold istep1 inject1) (Stream step1 state1) =-    Stream step (InterposeFirst state1)--    where--    {-# INLINE_LATE step #-}-    step gst (InterposeFirst s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (InterposeFirstInner s i))-                -- i `seq` return (Skip (InterposeFirstYield s i))-            Skip s -> return $ Skip (InterposeFirst s)-            Stop -> return Stop--    {--    step _ (InterposeFirstYield s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeFirstInner s1 i')-            Skip i'    -> Skip (InterposeFirstYield s1 i')-            Stop       -> Skip (InterposeFirst s1)-    -}--    step _ (InterposeFirstInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (InterposeFirstInner s1 i')-            Skip i'    -> Skip (InterposeFirstInner s1 i')-            Stop       -> Skip (InterposeFirstInject s1)--    step gst (InterposeFirstInject s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                -- i `seq` return (Skip (InterposeFirstBuf s i))-                i `seq` return (Skip (InterposeSecondYield s i))-            Skip s -> return $ Skip (InterposeFirstInject s)-            Stop -> return Stop--    {--    step _ (InterposeFirstBuf s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Skip (InterposeSecondYield s1 i' x)-            Skip i'    -> Skip (InterposeFirstBuf s1 i')-            Stop       -> Stop-    -}--    {--    step _ (InterposeSecondYield s1 i1 v) = do-        r <- action-        return $ Yield r (InterposeFirstResume s1 i1 v)-    -}-    step _ (InterposeSecondYield s1 i1) = do-        r <- action-        return $ Yield r (InterposeFirstInner s1 i1)--    {--    step _ (InterposeFirstResume s1 i1 v) = do-        return $ Yield v (InterposeFirstInner s1 i1)-    -}---- > interpose x unf str = gintercalate unf str UF.identity (repeat x)---- | Unfold the elements of a stream, intersperse the given element between the--- unfolded streams and then concat them into a single stream.------ >>> unwords = Stream.interpose ' '------ /Pre-release/-{-# INLINE interpose #-}-interpose :: Monad m-    => c -> Unfold m b c -> Stream m b -> Stream m c-interpose x = interposeM (return x)----------------------------------------------------------------------------------- Combine N Streams - intercalate---------------------------------------------------------------------------------data ICUState s1 s2 i1 i2 =-      ICUFirst s1 s2-    | ICUSecond s1 s2-    | ICUSecondOnly s2-    | ICUFirstOnly s1-    | ICUFirstInner s1 s2 i1-    | ICUSecondInner s1 s2 i2-    | ICUFirstOnlyInner s1 i1-    | ICUSecondOnlyInner s2 i2---- | 'interleaveFstSuffix' followed by unfold and concat.------ /Pre-release/-{-# INLINE_NORMAL gintercalateSuffix #-}-gintercalateSuffix-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalateSuffix-    (Unfold istep1 inject1) (Stream step1 state1)-    (Unfold istep2 inject2) (Stream step2 state2) =-    Stream step (ICUFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (ICUFirst s1 s2) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICUFirstInner s s2 i))-            Skip s -> return $ Skip (ICUFirst s s2)-            Stop -> return Stop--    step gst (ICUFirstOnly s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICUFirstOnlyInner s i))-            Skip s -> return $ Skip (ICUFirstOnly s)-            Stop -> return Stop--    step _ (ICUFirstInner s1 s2 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICUFirstInner s1 s2 i')-            Skip i'    -> Skip (ICUFirstInner s1 s2 i')-            Stop       -> Skip (ICUSecond s1 s2)--    step _ (ICUFirstOnlyInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')-            Skip i'    -> Skip (ICUFirstOnlyInner s1 i')-            Stop       -> Skip (ICUFirstOnly s1)--    step gst (ICUSecond s1 s2) = do-        r <- step2 (adaptState gst) s2-        case r of-            Yield a s -> do-                i <- inject2 a-                i `seq` return (Skip (ICUSecondInner s1 s i))-            Skip s -> return $ Skip (ICUSecond s1 s)-            Stop -> return $ Skip (ICUFirstOnly s1)--    step _ (ICUSecondInner s1 s2 i2) = do-        r <- istep2 i2-        return $ case r of-            Yield x i' -> Yield x (ICUSecondInner s1 s2 i')-            Skip i'    -> Skip (ICUSecondInner s1 s2 i')-            Stop       -> Skip (ICUFirst s1 s2)--    step _ (ICUSecondOnly _s2) = undefined-    step _ (ICUSecondOnlyInner _s2 _i2) = undefined--data ICALState s1 s2 i1 i2 a =-      ICALFirst s1 s2-    -- | ICALFirstYield s1 s2 i1-    | ICALFirstInner s1 s2 i1-    | ICALFirstOnly s1-    | ICALFirstOnlyInner s1 i1-    | ICALSecondInject s1 s2-    | ICALFirstInject s1 s2 i2-    -- | ICALFirstBuf s1 s2 i1 i2-    | ICALSecondInner s1 s2 i1 i2-    -- -- | ICALSecondInner s1 s2 i1 i2 a-    -- -- | ICALFirstResume s1 s2 i1 i2 a---- XXX we can swap the order of arguments to gintercalate so that the--- definition of unfoldMany becomes simpler? The first stream should be--- infixed inside the second one. However, if we change the order in--- "interleave" as well similarly, then that will make it a bit unintuitive.------ > unfoldMany unf str =--- >     gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())---- | 'interleaveFst' followed by unfold and concat.------ /Pre-release/-{-# INLINE_NORMAL gintercalate #-}-gintercalate-    :: Monad m-    => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c-gintercalate-    (Unfold istep1 inject1) (Stream step1 state1)-    (Unfold istep2 inject2) (Stream step2 state2) =-    Stream step (ICALFirst state1 state2)--    where--    {-# INLINE_LATE step #-}-    step gst (ICALFirst s1 s2) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICALFirstInner s s2 i))-                -- i `seq` return (Skip (ICALFirstYield s s2 i))-            Skip s -> return $ Skip (ICALFirst s s2)-            Stop -> return Stop--    {--    step _ (ICALFirstYield s1 s2 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')-            Skip i'    -> Skip (ICALFirstYield s1 s2 i')-            Stop       -> Skip (ICALFirst s1 s2)-    -}--    step _ (ICALFirstInner s1 s2 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICALFirstInner s1 s2 i')-            Skip i'    -> Skip (ICALFirstInner s1 s2 i')-            Stop       -> Skip (ICALSecondInject s1 s2)--    step gst (ICALFirstOnly s1) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICALFirstOnlyInner s i))-            Skip s -> return $ Skip (ICALFirstOnly s)-            Stop -> return Stop--    step _ (ICALFirstOnlyInner s1 i1) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')-            Skip i'    -> Skip (ICALFirstOnlyInner s1 i')-            Stop       -> Skip (ICALFirstOnly s1)--    -- We inject the second stream even before checking if the first stream-    -- would yield any more elements. There is no clear choice whether we-    -- should do this before or after that. Doing it after may make the state-    -- machine a bit simpler though.-    step gst (ICALSecondInject s1 s2) = do-        r <- step2 (adaptState gst) s2-        case r of-            Yield a s -> do-                i <- inject2 a-                i `seq` return (Skip (ICALFirstInject s1 s i))-            Skip s -> return $ Skip (ICALSecondInject s1 s)-            Stop -> return $ Skip (ICALFirstOnly s1)--    step gst (ICALFirstInject s1 s2 i2) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield a s -> do-                i <- inject1 a-                i `seq` return (Skip (ICALSecondInner s s2 i i2))-                -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))-            Skip s -> return $ Skip (ICALFirstInject s s2 i2)-            Stop -> return Stop--    {--    step _ (ICALFirstBuf s1 s2 i1 i2) = do-        r <- istep1 i1-        return $ case r of-            Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)-            Skip i'    -> Skip (ICALFirstBuf s1 s2 i' i2)-            Stop       -> Stop--    step _ (ICALSecondInner s1 s2 i1 i2 v) = do-        r <- istep2 i2-        return $ case r of-            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)-            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i' v)-            Stop       -> Skip (ICALFirstResume s1 s2 i1 i2 v)-    -}--    step _ (ICALSecondInner s1 s2 i1 i2) = do-        r <- istep2 i2-        return $ case r of-            Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')-            Skip i'    -> Skip (ICALSecondInner s1 s2 i1 i')-            Stop       -> Skip (ICALFirstInner s1 s2 i1)-            -- Stop       -> Skip (ICALFirstResume s1 s2 i1 i2)--    {--    step _ (ICALFirstResume s1 s2 i1 i2 x) = do-        return $ Yield x (ICALFirstInner s1 s2 i1 i2)-    -}---- > intercalateSuffix unf seed str = gintercalateSuffix unf str unf (repeatM seed)---- | 'intersperseMSuffix' followed by unfold and concat.------ >>> intercalateSuffix u a = Stream.unfoldMany u . Stream.intersperseMSuffix a--- >>> intersperseMSuffix = Stream.intercalateSuffix Unfold.identity--- >>> unlines = Stream.intercalateSuffix Unfold.fromList "\n"------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalateSuffix Unfold.fromList "\n" input--- "abc\ndef\nghi\n"----{-# INLINE intercalateSuffix #-}-intercalateSuffix :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalateSuffix unf seed = unfoldMany unf . intersperseMSuffix (return seed)---- > intercalate unf seed str = gintercalate unf str unf (repeatM seed)---- | 'intersperse' followed by unfold and concat.------ >>> intercalate u a = Stream.unfoldMany u . Stream.intersperse a--- >>> intersperse = Stream.intercalate Unfold.identity--- >>> unwords = Stream.intercalate Unfold.fromList " "------ >>> input = Stream.fromList ["abc", "def", "ghi"]--- >>> Stream.fold Fold.toList $ Stream.intercalate Unfold.fromList " " input--- "abc def ghi"----{-# INLINE intercalate #-}-intercalate :: Monad m-    => Unfold m b c -> b -> Stream m b -> Stream m c-intercalate unf seed str = unfoldMany unf $ intersperse seed str----------------------------------------------------------------------------------- Folding----------------------------------------------------------------------------------- | Apply a stream of folds to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE foldSequence #-}-foldSequence-       :: -- Monad m =>-       Stream m (Fold m a b)-    -> Stream m a-    -> Stream m b-foldSequence _f _m = undefined--{-# ANN type FIterState Fuse #-}-data FIterState s f m a b-    = FIterInit s f-    | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)-    | FIterYield b (FIterState s f m a b)-    | FIterStop---- | Iterate a fold generator on a stream. The initial value @b@ is used to--- generate the first fold, the fold is applied on the stream and the result of--- the fold is used to generate the next fold and so on.------ >>> import Data.Monoid (Sum(..))--- >>> f x = return (Fold.take 2 (Fold.sconcat x))--- >>> s = fmap Sum $ Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.foldIterateM f (pure 0) s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- folds where next fold is dependent on the previous fold.------ /Pre-release/----{-# INLINE_NORMAL foldIterateM #-}-foldIterateM ::-       Monad m => (b -> m (FL.Fold m a b)) -> m b -> Stream m a -> Stream m b-foldIterateM func seed0 (Stream step state) =-    Stream stepOuter (FIterInit state seed0)--    where--    {-# INLINE iterStep #-}-    iterStep from st fstep extract = do-        res <- from-        return-            $ Skip-            $ case res of-                  FL.Partial fs -> FIterStream st fstep fs extract-                  FL.Done fb -> FIterYield fb $ FIterInit st (return fb)--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (FIterInit st seed) = do-        (FL.Fold fstep initial extract) <- seed >>= func-        iterStep initial st fstep extract-    stepOuter gst (FIterStream st fstep fs extract) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                iterStep (fstep fs x) s fstep extract-            Skip s -> return $ Skip $ FIterStream s fstep fs extract-            Stop -> do-                b <- extract fs-                return $ Skip $ FIterYield b FIterStop-    stepOuter _ (FIterYield a next) = return $ Yield a next-    stepOuter _ FIterStop = return Stop--{-# ANN type CIterState Fuse #-}-data CIterState s f fs b-    = CIterInit s f-    | CIterConsume s fs-    | CIterYield b (CIterState s f fs b)-    | CIterStop---- | Like 'foldIterateM' but using the 'Refold' type instead. This could be--- much more efficient due to stream fusion.------ /Internal/-{-# INLINE_NORMAL refoldIterateM #-}-refoldIterateM ::-       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b-refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =-    Stream stepOuter (CIterInit state initial)--    where--    {-# INLINE iterStep #-}-    iterStep st action = do-        res <- action-        return-            $ Skip-            $ case res of-                  FL.Partial fs -> CIterConsume st fs-                  FL.Done fb -> CIterYield fb $ CIterInit st (return fb)--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (CIterInit st action) = do-        iterStep st (action >>= finject)-    stepOuter gst (CIterConsume st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> iterStep s (fstep fs x)-            Skip s -> return $ Skip $ CIterConsume s fs-            Stop -> do-                b <- fextract fs-                return $ Skip $ CIterYield b CIterStop-    stepOuter _ (CIterYield a next) = return $ Yield a next-    stepOuter _ CIterStop = return Stop---- "n" elements at the end are dropped by the fold.-{-# INLINE sliceBy #-}-sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)-sliceBy (Fold step1 initial1 extract1) n = Refold step inject extract--    where--    inject (i, len) = do-        r <- initial1-        return $ case r of-            Partial s -> Partial $ Tuple' (i + len + n) s-            Done l -> Done (i, l)--    step (Tuple' i s) x = do-        r <- step1 s x-        return $ case r of-            Partial s1 -> Partial $ Tuple' i s1-            Done len -> Done (i, len)--    extract (Tuple' i s) = (i,) <$> extract1 s--{-# INLINE sliceOnSuffix #-}-sliceOnSuffix :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)-sliceOnSuffix predicate =-    -- Scan the stream with the given refold-    refoldIterateM-        (sliceBy (FL.takeEndBy_ predicate FL.length) 1)-        (return (-1, 0))----------------------------------------------------------------------------------- Parsing---------------------------------------------------------------------------------{-# ANN type ParseChunksState Fuse #-}-data ParseChunksState x inpBuf st pst =-      ParseChunksInit inpBuf st-    | ParseChunksInitBuf inpBuf-    | ParseChunksInitLeftOver inpBuf-    | ParseChunksStream st inpBuf !pst-    | ParseChunksStop inpBuf !pst-    | ParseChunksBuf inpBuf st inpBuf !pst-    | ParseChunksExtract inpBuf inpBuf !pst-    | ParseChunksYield x (ParseChunksState x inpBuf st pst)---- XXX return the remaining stream as part of the error.--- XXX This is in fact parseMany1 (a la foldMany1). Do we need a parseMany as--- well?-{-# INLINE_NORMAL parseManyD #-}-parseManyD-    :: Monad m-    => PRD.Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseManyD (PRD.Parser pstep initial extract) (Stream step state) =-    Stream stepOuter (ParseChunksInit [] state)--    where--    {-# INLINE_LATE stepOuter #-}-    -- Buffer is empty, get the first element from the stream, initialize the-    -- fold and then go to stream processing loop.-    stepOuter gst (ParseChunksInit [] st) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                res <- initial-                case res of-                    PRD.IPartial ps ->-                        return $ Skip $ ParseChunksBuf [x] s [] ps-                    PRD.IDone pb ->-                        let next = ParseChunksInit [x] s-                         in return $ Skip $ ParseChunksYield (Right pb) next-                    PRD.IError err ->-                        return-                            $ Skip-                            $ ParseChunksYield-                                (Left (ParseError err))-                                (ParseChunksInitLeftOver [])-            Skip s -> return $ Skip $ ParseChunksInit [] s-            Stop   -> return Stop--    -- Buffer is not empty, go to buffered processing loop-    stepOuter _ (ParseChunksInit src st) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ParseChunksBuf src st [] ps-            PRD.IDone pb ->-                let next = ParseChunksInit src st-                 in return $ Skip $ ParseChunksYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- This is simplified ParseChunksInit-    stepOuter _ (ParseChunksInitBuf src) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ParseChunksExtract src [] ps-            PRD.IDone pb ->-                let next = ParseChunksInitBuf src-                 in return $ Skip $ ParseChunksYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- XXX we just discard any leftover input at the end-    stepOuter _ (ParseChunksInitLeftOver _) = return Stop--    -- Buffer is empty, process elements from the stream-    stepOuter gst (ParseChunksStream st buf pst) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 ->-                        return $ Skip $ ParseChunksStream s [] pst1-                    PR.Partial n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ParseChunksBuf src s [] pst1-                    PR.Continue 0 pst1 ->-                        return $ Skip $ ParseChunksStream s (x:buf) pst1-                    PR.Continue n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let (src0, buf1) = splitAt n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ParseChunksBuf src s buf1 pst1-                    PR.Done 0 b -> do-                        return $ Skip $-                            ParseChunksYield (Right b) (ParseChunksInit [] s)-                    PR.Done n b -> do-                        assert (n <= length (x:buf)) (return ())-                        let src = Prelude.reverse (Prelude.take n (x:buf))-                        return $ Skip $-                            ParseChunksYield (Right b) (ParseChunksInit src s)-                    PR.Error err ->-                        return-                            $ Skip-                            $ ParseChunksYield-                                (Left (ParseError err))-                                (ParseChunksInitLeftOver [])-            Skip s -> return $ Skip $ ParseChunksStream s buf pst-            Stop -> return $ Skip $ ParseChunksStop buf pst--    -- go back to stream processing mode-    stepOuter _ (ParseChunksBuf [] s buf pst) =-        return $ Skip $ ParseChunksStream s buf pst--    -- buffered processing loop-    stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ParseChunksBuf xs s [] pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksBuf src s [] pst1-            PR.Continue 0 pst1 ->-                return $ Skip $ ParseChunksBuf xs s (x:buf) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksBuf src s buf1 pst1-            PR.Done 0 b ->-                return-                    $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit xs s)-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInit src s)-            PR.Error err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- This is simplified ParseChunksBuf-    stepOuter _ (ParseChunksExtract [] buf pst) =-        return $ Skip $ ParseChunksStop buf pst--    stepOuter _ (ParseChunksExtract (x:xs) buf pst) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ParseChunksExtract xs [] pst1-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksExtract src [] pst1-            PR.Continue 0 pst1 ->-                return $ Skip $ ParseChunksExtract xs (x:buf) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b ->-                return-                    $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf xs)-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return-                    $ Skip-                    $ ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    -- This is simplified ParseChunksExtract-    stepOuter _ (ParseChunksStop buf pst) = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseMany: Partial in extract"-            PR.Continue 0 pst1 ->-                return $ Skip $ ParseChunksStop buf pst1-            PR.Continue n pst1 -> do-                assert (n <= length buf) (return ())-                let (src0, buf1) = splitAt n buf-                    src  = Prelude.reverse src0-                return $ Skip $ ParseChunksExtract src buf1 pst1-            PR.Done 0 b -> do-                return $ Skip $-                    ParseChunksYield (Right b) (ParseChunksInitLeftOver [])-            PR.Done n b -> do-                assert (n <= length buf) (return ())-                let src = Prelude.reverse (Prelude.take n buf)-                return $ Skip $-                    ParseChunksYield (Right b) (ParseChunksInitBuf src)-            PR.Error err ->-                return-                    $ Skip-                    $ ParseChunksYield-                        (Left (ParseError err))-                        (ParseChunksInitLeftOver [])--    stepOuter _ (ParseChunksYield a next) = return $ Yield a next---- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the--- output stream.------ Example:------ >>> s = Stream.fromList [1..10]--- >>> parser = Parser.takeBetween 0 2 Fold.sum--- >>> Stream.fold Fold.toList $ Stream.parseMany parser s--- [Right 3,Right 7,Right 11,Right 15,Right 19]------ This is the streaming equivalent of the 'Streamly.Data.Parser.many' parse--- combinator.------ Known Issues: When the parser fails there is no way to get the remaining--- stream.----{-# INLINE parseMany #-}-parseMany-    :: Monad m-    => PR.Parser a m b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseMany = parseManyD---- | Apply a stream of parsers to an input stream and emit the results in the--- output stream.------ /Unimplemented/----{-# INLINE parseSequence #-}-parseSequence-       :: -- Monad m =>-       Stream m (PR.Parser a m b)-    -> Stream m a-    -> Stream m b-parseSequence _f _m = undefined---- XXX Change the parser arguments' order---- | @parseManyTill collect test stream@ tries the parser @test@ on the input,--- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds--- @test@ is tried again and so on. The parser stops when @test@ succeeds.  The--- output of @test@ is discarded and the output of @collect@ is emitted in the--- output stream. The parser fails if @collect@ fails.------ /Unimplemented/----{-# INLINE parseManyTill #-}-parseManyTill ::-    -- MonadThrow m =>-       PR.Parser a m b-    -> PR.Parser a m x-    -> Stream m a-    -> Stream m b-parseManyTill = undefined--{-# ANN type ConcatParseState Fuse #-}-data ConcatParseState c b inpBuf st p m a =-      ConcatParseInit inpBuf st p-    | ConcatParseInitBuf inpBuf p-    | ConcatParseInitLeftOver inpBuf-    | forall s. ConcatParseStop-        inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | forall s. ConcatParseStream-        st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | forall s. ConcatParseBuf-        inpBuf st inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | forall s. ConcatParseExtract-        inpBuf inpBuf (s -> a -> m (PRD.Step s b)) s (s -> m (PRD.Step s b))-    | ConcatParseYield c (ConcatParseState c b inpBuf st p m a)---- XXX Review the changes-{-# INLINE_NORMAL parseIterateD #-}-parseIterateD-    :: Monad m-    => (b -> PRD.Parser a m b)-    -> b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseIterateD func seed (Stream step state) =-    Stream stepOuter (ConcatParseInit [] state (func seed))--    where--    {-# INLINE_LATE stepOuter #-}-    -- Buffer is empty, go to stream processing loop-    stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ConcatParseStream st [] pstep ps extract-            PRD.IDone pb ->-                let next = ConcatParseInit [] st (func pb)-                 in return $ Skip $ ConcatParseYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- Buffer is not empty, go to buffered processing loop-    stepOuter _ (ConcatParseInit src st-                    (PRD.Parser pstep initial extract)) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ConcatParseBuf src st [] pstep ps extract-            PRD.IDone pb ->-                let next = ConcatParseInit src st (func pb)-                 in return $ Skip $ ConcatParseYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- This is simplified ConcatParseInit-    stepOuter _ (ConcatParseInitBuf src-                    (PRD.Parser pstep initial extract)) = do-        res <- initial-        case res of-            PRD.IPartial ps ->-                return $ Skip $ ConcatParseExtract src [] pstep ps extract-            PRD.IDone pb ->-                let next = ConcatParseInitBuf src (func pb)-                 in return $ Skip $ ConcatParseYield (Right pb) next-            PRD.IError err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- XXX we just discard any leftover input at the end-    stepOuter _ (ConcatParseInitLeftOver _) = return Stop--    -- Buffer is empty process elements from the stream-    stepOuter gst (ConcatParseStream st buf pstep pst extract) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                pRes <- pstep pst x-                case pRes of-                    PR.Partial 0 pst1 ->-                        return $ Skip $ ConcatParseStream s [] pstep pst1 extract-                    PR.Partial n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract-                    -- PR.Continue 0 pst1 ->-                    --     return $ Skip $ ConcatParseStream s (x:buf) pst1-                    PR.Continue n pst1 -> do-                        assert (n <= length (x:buf)) (return ())-                        let (src0, buf1) = splitAt n (x:buf)-                            src  = Prelude.reverse src0-                        return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract-                    -- XXX Specialize for Stop 0 common case?-                    PR.Done n b -> do-                        assert (n <= length (x:buf)) (return ())-                        let src = Prelude.reverse (Prelude.take n (x:buf))-                        return $ Skip $-                            ConcatParseYield (Right b) (ConcatParseInit src s (func b))-                    PR.Error err ->-                        return-                            $ Skip-                            $ ConcatParseYield-                                (Left (ParseError err))-                                (ConcatParseInitLeftOver [])-            Skip s -> return $ Skip $ ConcatParseStream s buf pstep pst extract-            Stop -> return $ Skip $ ConcatParseStop buf pstep pst extract--    -- go back to stream processing mode-    stepOuter _ (ConcatParseBuf [] s buf pstep ps extract) =-        return $ Skip $ ConcatParseStream s buf pstep ps extract--    -- buffered processing loop-    stepOuter _ (ConcatParseBuf (x:xs) s buf pstep pst extract) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ConcatParseBuf xs s [] pstep pst1 extract-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseBuf src s [] pstep pst1 extract-         -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseBuf src s buf1 pstep pst1 extract-            -- XXX Specialize for Stop 0 common case?-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return $ Skip $ ConcatParseYield (Right b)-                                    (ConcatParseInit src s (func b))-            PR.Error err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- This is simplified ConcatParseBuf-    stepOuter _ (ConcatParseExtract [] buf pstep pst extract) =-        return $ Skip $ ConcatParseStop buf pstep pst extract--    stepOuter _ (ConcatParseExtract (x:xs) buf pstep pst extract) = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 pst1 ->-                return $ Skip $ ConcatParseExtract xs [] pstep pst1 extract-            PR.Partial n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseExtract src [] pstep pst1 extract-            PR.Continue 0 pst1 ->-                return $ Skip $ ConcatParseExtract xs (x:buf) pstep pst1 extract-            PR.Continue n pst1 -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract-            PR.Done 0 b ->-                 return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf xs (func b))-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs-                return $ Skip $ ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))-            PR.Error err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    -- This is simplified ConcatParseExtract-    stepOuter _ (ConcatParseStop buf pstep pst extract) = do-        pRes <- extract pst-        case pRes of-            PR.Partial _ _ -> error "Bug: parseIterate: Partial in extract"-            PR.Continue 0 pst1 ->-                return $ Skip $ ConcatParseStop buf pstep pst1 extract-            PR.Continue n pst1 -> do-                assert (n <= length buf) (return ())-                let (src0, buf1) = splitAt n buf-                    src  = Prelude.reverse src0-                return $ Skip $ ConcatParseExtract src buf1 pstep pst1 extract-            PR.Done 0 b -> do-                return $ Skip $-                    ConcatParseYield (Right b) (ConcatParseInitLeftOver [])-            PR.Done n b -> do-                assert (n <= length buf) (return ())-                let src = Prelude.reverse (Prelude.take n buf)-                return $ Skip $-                    ConcatParseYield (Right b) (ConcatParseInitBuf src (func b))-            PR.Error err ->-                return-                    $ Skip-                    $ ConcatParseYield-                        (Left (ParseError err))-                        (ConcatParseInitLeftOver [])--    stepOuter _ (ConcatParseYield a next) = return $ Yield a next---- | Iterate a parser generating function on a stream. The initial value @b@ is--- used to generate the first parser, the parser is applied on the stream and--- the result is used to generate the next parser and so on.------ >>> import Data.Monoid (Sum(..))--- >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ fmap getSum $ Stream.catRights $ Stream.parseIterate (\b -> Parser.takeBetween 0 2 (Fold.sconcat b)) (Sum 0) $ fmap Sum s--- [3,10,21,36,55,55]------ This is the streaming equivalent of monad like sequenced application of--- parsers where next parser is dependent on the previous parser.------ /Pre-release/----{-# INLINE parseIterate #-}-parseIterate-    :: Monad m-    => (b -> PR.Parser a m b)-    -> b-    -> Stream m a-    -> Stream m (Either ParseError b)-parseIterate = parseIterateD----------------------------------------------------------------------------------- Grouping---------------------------------------------------------------------------------data GroupByState st fs a b-    = GroupingInit st-    | GroupingDo st !fs-    | GroupingInitWith st !a-    | GroupingDoWith st !fs !a-    | GroupingYield !b (GroupByState st fs a b)-    | GroupingDone--{-# INLINE_NORMAL groupsBy #-}-groupsBy :: Monad m-    => (a -> a -> Bool)-    -> Fold m a b-    -> Stream m a-    -> Stream m b-{--groupsBy eq fld = parseMany (PRD.groupBy eq fld)--}-groupsBy cmp (Fold fstep initial done) (Stream step state) =-    Stream stepOuter (GroupingInit state)--    where--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (GroupingInit st) = do-        -- XXX Note that if the stream stops without yielding a single element-        -- in the group we discard the "initial" effect.-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ GroupingDo st s-                  FL.Done b -> Yield b $ GroupingInit st-    stepOuter gst (GroupingDo st fs) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep fs x-                case r of-                    FL.Partial fs1 -> go SPEC x s fs1-                    FL.Done b -> return $ Yield b (GroupingInit s)-            Skip s -> return $ Skip $ GroupingDo s fs-            Stop -> return Stop--        where--        go !_ prev stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp x prev-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC prev s fs1-                            FL.Done b -> return $ Yield b (GroupingInit s)-                    else do-                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                Skip s -> go SPEC prev s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingInitWith st x) = do-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ GroupingDoWith st s x-                  FL.Done b -> Yield b $ GroupingInitWith st x-    stepOuter gst (GroupingDoWith st fs prev) = do-        res <- fstep fs prev-        case res of-            FL.Partial fs1 -> go SPEC st fs1-            FL.Done b -> return $ Yield b (GroupingInit st)--        where--        -- XXX code duplicated from the previous equation-        go !_ stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp x prev-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC s fs1-                            FL.Done b -> return $ Yield b (GroupingInit s)-                    else do-                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                Skip s -> go SPEC s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingYield _ _) = error "groupsBy: Unreachable"-    stepOuter _ GroupingDone = return Stop--{-# INLINE_NORMAL groupsRollingBy #-}-groupsRollingBy :: Monad m-    => (a -> a -> Bool)-    -> Fold m a b-    -> Stream m a-    -> Stream m b-{--groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)--}-groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =-    Stream stepOuter (GroupingInit state)--    where--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (GroupingInit st) = do-        -- XXX Note that if the stream stops without yielding a single element-        -- in the group we discard the "initial" effect.-        res <- initial-        return-            $ case res of-                  FL.Partial fs -> Skip $ GroupingDo st fs-                  FL.Done fb -> Yield fb $ GroupingInit st-    stepOuter gst (GroupingDo st fs) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep fs x-                case r of-                    FL.Partial fs1 -> go SPEC x s fs1-                    FL.Done fb -> return $ Yield fb (GroupingInit s)-            Skip s -> return $ Skip $ GroupingDo s fs-            Stop -> return Stop--        where--        go !_ prev stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp prev x-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC x s fs1-                            FL.Done b -> return $ Yield b (GroupingInit s)-                    else do-                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                Skip s -> go SPEC prev s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingInitWith st x) = do-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ GroupingDoWith st s x-                  FL.Done b -> Yield b $ GroupingInitWith st x-    stepOuter gst (GroupingDoWith st fs previous) = do-        res <- fstep fs previous-        case res of-            FL.Partial s -> go SPEC previous st s-            FL.Done b -> return $ Yield b (GroupingInit st)--        where--        -- XXX GHC: groupsBy has one less parameter in this go loop and it-        -- fuses. However, groupsRollingBy does not fuse, removing the prev-        -- parameter makes it fuse. Something needs to be fixed in GHC. The-        -- workaround for this is noted in the comments below.-        go !_ prev !stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if cmp prev x-                    then do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC x s fs1-                            FL.Done b -> return $ Yield b (GroupingInit st)-                    else do-                        {--                        r <- done acc-                        return $ Yield r (GroupingInitWith s x)-                        -}-                        -- The code above does not let groupBy fuse. We use the-                        -- alternative code below instead.  Instead of jumping-                        -- to GroupingInitWith state, we unroll the code of-                        -- GroupingInitWith state here to help GHC with stream-                        -- fusion.-                        result <- initial-                        r <- done acc-                        return-                            $ Yield r-                            $ case result of-                                  FL.Partial fsi -> GroupingDoWith s fsi x-                                  FL.Done b -> GroupingYield b (GroupingInit s)-                Skip s -> go SPEC prev s acc-                Stop -> done acc >>= \r -> return $ Yield r GroupingDone-    stepOuter _ (GroupingYield r next) = return $ Yield r next-    stepOuter _ GroupingDone = return Stop----------------------------------------------------------------------------------- Splitting - by a predicate---------------------------------------------------------------------------------data WordsByState st fs b-    = WordsByInit st-    | WordsByDo st !fs-    | WordsByDone-    | WordsByYield !b (WordsByState st fs b)--{-# INLINE_NORMAL wordsBy #-}-wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-wordsBy predicate (Fold fstep initial done) (Stream step state) =-    Stream stepOuter (WordsByInit state)--    where--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ (WordsByInit st) = do-        res <- initial-        return-            $ case res of-                  FL.Partial s -> Skip $ WordsByDo st s-                  FL.Done b -> Yield b (WordsByInit st)--    stepOuter gst (WordsByDo st fs) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                if predicate x-                then do-                    resi <- initial-                    return-                        $ case resi of-                              FL.Partial fs1 -> Skip $ WordsByDo s fs1-                              FL.Done b -> Yield b (WordsByInit s)-                else do-                    r <- fstep fs x-                    case r of-                        FL.Partial fs1 -> go SPEC s fs1-                        FL.Done b -> return $ Yield b (WordsByInit s)-            Skip s    -> return $ Skip $ WordsByDo s fs-            Stop      -> return Stop--        where--        go !_ stt !acc = do-            res <- step (adaptState gst) stt-            case res of-                Yield x s -> do-                    if predicate x-                    then do-                        {--                        r <- done acc-                        return $ Yield r (WordsByInit s)-                        -}-                        -- The above code does not fuse well. Need to check why-                        -- GHC is not able to simplify it well.  Using the code-                        -- below, instead of jumping through the WordsByInit-                        -- state always, we directly go to WordsByDo state in-                        -- the common case of Partial.-                        resi <- initial-                        r <- done acc-                        return-                            $ Yield r-                            $ case resi of-                                  FL.Partial fs1 -> WordsByDo s fs1-                                  FL.Done b -> WordsByYield b (WordsByInit s)-                    else do-                        r <- fstep acc x-                        case r of-                            FL.Partial fs1 -> go SPEC s fs1-                            FL.Done b -> return $ Yield b (WordsByInit s)-                Skip s -> go SPEC s acc-                Stop -> done acc >>= \r -> return $ Yield r WordsByDone--    stepOuter _ WordsByDone = return Stop--    stepOuter _ (WordsByYield b next) = return $ Yield b next----------------------------------------------------------------------------------- Splitting on a sequence----------------------------------------------------------------------------------- String search algorithms:--- http://www-igm.univ-mlv.fr/~lecroq/string/index.html--{---- TODO can we unify the splitting operations using a splitting configuration--- like in the split package.----data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)-data SplitOptions = SplitOptions-    { style    :: SplitStyle-    , withSep  :: Bool  -- ^ keep the separators in output-    -- , compact  :: Bool  -- ^ treat multiple consecutive separators as one-    -- , trimHead :: Bool  -- ^ drop blank at head-    -- , trimTail :: Bool  -- ^ drop blank at tail-    }--}---- XXX using "fs" as the last arg in Constructors may simplify the code a bit,--- because we can use the constructor directly without having to create "jump"--- functions.-{-# ANN type SplitOnSeqState Fuse #-}-data SplitOnSeqState rb rh ck w fs s b x =-      SplitOnSeqInit-    | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)-    | SplitOnSeqDone--    | SplitOnSeqEmpty !fs s--    | SplitOnSeqSingle !fs s x--    | SplitOnSeqWordInit !fs s-    | SplitOnSeqWordLoop !w s !fs-    | SplitOnSeqWordDone Int !fs !w--    | SplitOnSeqKRInit Int !fs s rb !rh-    | SplitOnSeqKRLoop fs s rb !rh !ck-    | SplitOnSeqKRCheck fs s rb !rh-    | SplitOnSeqKRDone Int !fs rb !rh--    | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)--{-# INLINE_NORMAL splitOnSeq #-}-splitOnSeq-    :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)-    => Array a-    -> Fold m a b-    -> Stream m a-    -> Stream m b-splitOnSeq patArr (Fold fstep initial done) (Stream step state) =-    Stream stepOuter SplitOnSeqInit--    where--    patLen = A.length patArr-    maxIndex = patLen - 1-    elemBits = SIZE_OF(a) * 8--    -- For word pattern case-    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    elemMask :: Word-    elemMask = (1 `shiftL` elemBits) - 1--    wordPat :: Word-    wordPat = wordMask .&. A.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    patHash = A.foldl' addCksum 0 patArr--    skip = return . Skip--    nextAfterInit nextGen stepRes =-        case stepRes of-            FL.Partial s -> nextGen s-            FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)--    {-# INLINE yieldProceed #-}-    yieldProceed nextGen fs =-        initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ SplitOnSeqInit = do-        res <- initial-        case res of-            FL.Partial acc ->-                if patLen == 0-                then return $ Skip $ SplitOnSeqEmpty acc state-                else if patLen == 1-                     then do-                         pat <- liftIO $ A.unsafeIndexIO 0 patArr-                         return $ Skip $ SplitOnSeqSingle acc state pat-                     else if SIZE_OF(a) * patLen-                               <= sizeOf (Proxy :: Proxy Word)-                          then return $ Skip $ SplitOnSeqWordInit acc state-                          else do-                              (rb, rhead) <- liftIO $ RB.new patLen-                              skip $ SplitOnSeqKRInit 0 acc state rb rhead-            FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit--    stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next--    ----------------------------    -- Checkpoint-    -----------------------------    stepOuter _ (SplitOnSeqReinit nextGen) =-        initial >>= skip . nextAfterInit nextGen--    ----------------------------    -- Empty pattern-    -----------------------------    stepOuter gst (SplitOnSeqEmpty acc st) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep acc x-                b1 <--                    case r of-                        FL.Partial acc1 -> done acc1-                        FL.Done b -> return b-                let jump c = SplitOnSeqEmpty c s-                 in yieldProceed jump b1-            Skip s -> skip (SplitOnSeqEmpty acc s)-            Stop -> return Stop--    ------------------    -- Done-    -------------------    stepOuter _ SplitOnSeqDone = return Stop--    ------------------    -- Single Pattern-    -------------------    stepOuter gst (SplitOnSeqSingle fs st pat) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                let jump c = SplitOnSeqSingle c s pat-                if pat == x-                then done fs >>= yieldProceed jump-                else do-                    r <- fstep fs x-                    case r of-                        FL.Partial fs1 -> skip $ jump fs1-                        FL.Done b -> yieldProceed jump b-            Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat-            Stop -> do-                r <- done fs-                return $ Skip $ SplitOnSeqYield r SplitOnSeqDone--    ----------------------------    -- Short Pattern - Shift Or-    -----------------------------    stepOuter _ (SplitOnSeqWordDone 0 fs _) = do-        r <- done fs-        skip $ SplitOnSeqYield r SplitOnSeqDone-    stepOuter _ (SplitOnSeqWordDone n fs wrd) = do-        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))-        r <- fstep fs (toEnum $ fromIntegral old)-        case r of-            FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd-            FL.Done b -> do-                 let jump c = SplitOnSeqWordDone (n - 1) c wrd-                 yieldProceed jump b--    stepOuter gst (SplitOnSeqWordInit fs st0) =-        go SPEC 0 0 st0--        where--        {-# INLINE go #-}-        go !_ !idx !wrd !st = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let wrd1 = addToWord wrd x-                    if idx == maxIndex-                    then do-                        if wrd1 .&. wordMask == wordPat-                        then do-                            let jump c = SplitOnSeqWordInit c s-                            done fs >>= yieldProceed jump-                        else skip $ SplitOnSeqWordLoop wrd1 s fs-                    else go SPEC (idx + 1) wrd1 s-                Skip s -> go SPEC idx wrd s-                Stop -> do-                    if idx /= 0-                    then skip $ SplitOnSeqWordDone idx fs wrd-                    else do-                        r <- done fs-                        skip $ SplitOnSeqYield r SplitOnSeqDone--    stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =-        go SPEC wrd0 st0 fs0--        where--        {-# INLINE go #-}-        go !_ !wrd !st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let jump c = SplitOnSeqWordInit c s-                        wrd1 = addToWord wrd x-                        old = (wordMask .&. wrd)-                                `shiftR` (elemBits * (patLen - 1))-                    r <- fstep fs (toEnum $ fromIntegral old)-                    case r of-                        FL.Partial fs1 -> do-                            if wrd1 .&. wordMask == wordPat-                            then done fs1 >>= yieldProceed jump-                            else go SPEC wrd1 s fs1-                        FL.Done b -> yieldProceed jump b-                Skip s -> go SPEC wrd s fs-                Stop -> skip $ SplitOnSeqWordDone patLen fs wrd--    --------------------------------    -- General Pattern - Karp Rabin-    ---------------------------------    stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                rh1 <- liftIO $ RB.unsafeInsert rb rh x-                if idx == maxIndex-                then do-                    let fld = RB.unsafeFoldRing (RB.ringBound rb)-                    let !ringHash = fld addCksum 0 rb-                    if ringHash == patHash-                    then skip $ SplitOnSeqKRCheck fs s rb rh1-                    else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash-                else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1-            Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh-            Stop -> do-                skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)--    -- XXX The recursive "go" is more efficient than the state based recursion-    -- code commented out below. Perhaps its more efficient because of-    -- factoring out "rb" outside the loop.-    ---    stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =-        go SPEC fs0 st0 rh0 cksum0--        where--        go !_ !fs !st !rh !cksum = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    old <- liftIO $ peek rh-                    let cksum1 = deltaCksum cksum old x-                    r <- fstep fs old-                    case r of-                        FL.Partial fs1 -> do-                            rh1 <- liftIO (RB.unsafeInsert rb rh x)-                            if cksum1 == patHash-                            then skip $ SplitOnSeqKRCheck fs1 s rb rh1-                            else go SPEC fs1 s rh1 cksum1-                        FL.Done b -> do-                            let rst = RB.startOf rb-                                jump c = SplitOnSeqKRInit 0 c s rb rst-                            yieldProceed jump b-                Skip s -> go SPEC fs s rh cksum-                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh--    -- XXX The following code is 5 times slower compared to the recursive loop-    -- based code above. Need to investigate why. One possibility is that the-    -- go loop above does not thread around the ring buffer (rb). This code may-    -- be causing the state to bloat and getting allocated on each iteration.-    -- We can check the cmm/asm code to confirm.  If so a good GHC solution to-    -- such problem is needed. One way to avoid this could be to use unboxed-    -- mutable state?-    {--    stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    old <- liftIO $ peek rh-                    let cksum1 = deltaCksum cksum old x-                    fs1 <- fstep fs old-                    if (cksum1 == patHash)-                    then do-                        r <- done fs1-                        skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh-                    else do-                        rh1 <- liftIO (RB.unsafeInsert rb rh x)-                        skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1-                Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum-                Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh-    -}--    stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do-        if RB.unsafeEqArray rb rh patArr-        then do-            r <- done fs-            let rst = RB.startOf rb-                jump c = SplitOnSeqKRInit 0 c st rb rst-            yieldProceed jump r-        else skip $ SplitOnSeqKRLoop fs st rb rh patHash--    stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do-        r <- done fs-        skip $ SplitOnSeqYield r SplitOnSeqDone-    stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do-        old <- liftIO $ peek rh-        let rh1 = RB.advance rb rh-        r <- fstep fs old-        case r of-            FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1-            FL.Done b -> do-                 let jump c = SplitOnSeqKRDone (n - 1) c rb rh1-                 yieldProceed jump b--{-# ANN type SplitOnSuffixSeqState Fuse #-}-data SplitOnSuffixSeqState rb rh ck w fs s b x =-      SplitOnSuffixSeqInit-    | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)-    | SplitOnSuffixSeqDone--    | SplitOnSuffixSeqEmpty !fs s--    | SplitOnSuffixSeqSingleInit !fs s x-    | SplitOnSuffixSeqSingle !fs s x--    | SplitOnSuffixSeqWordInit !fs s-    | SplitOnSuffixSeqWordLoop !w s !fs-    | SplitOnSuffixSeqWordDone Int !fs !w--    | SplitOnSuffixSeqKRInit Int !fs s rb !rh-    | SplitOnSuffixSeqKRInit1 !fs s rb !rh-    | SplitOnSuffixSeqKRLoop fs s rb !rh !ck-    | SplitOnSuffixSeqKRCheck fs s rb !rh-    | SplitOnSuffixSeqKRDone Int !fs rb !rh--    | SplitOnSuffixSeqReinit-          (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)--{-# INLINE_NORMAL splitOnSuffixSeq #-}-splitOnSuffixSeq-    :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a)-    => Bool-    -> Array a-    -> Fold m a b-    -> Stream m a-    -> Stream m b-splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =-    Stream stepOuter SplitOnSuffixSeqInit--    where--    patLen = A.length patArr-    maxIndex = patLen - 1-    elemBits = SIZE_OF(a) * 8--    -- For word pattern case-    wordMask :: Word-    wordMask = (1 `shiftL` (elemBits * patLen)) - 1--    elemMask :: Word-    elemMask = (1 `shiftL` elemBits) - 1--    wordPat :: Word-    wordPat = wordMask .&. A.foldl' addToWord 0 patArr--    addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)--    nextAfterInit nextGen stepRes =-        case stepRes of-            FL.Partial s -> nextGen s-            FL.Done b ->-                SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)--    {-# INLINE yieldProceed #-}-    yieldProceed nextGen fs =-        initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen--    -- For single element pattern case-    {-# INLINE processYieldSingle #-}-    processYieldSingle pat x s fs = do-        let jump c = SplitOnSuffixSeqSingleInit c s pat-        if pat == x-        then do-            r <- if withSep then fstep fs x else return $ FL.Partial fs-            b1 <--                case r of-                    FL.Partial fs1 -> done fs1-                    FL.Done b -> return b-            yieldProceed jump b1-        else do-            r <- fstep fs x-            case r of-                FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat-                FL.Done b -> yieldProceed jump b--    -- For Rabin-Karp search-    k = 2891336453 :: Word32-    coeff = k ^ patLen--    addCksum cksum a = cksum * k + fromIntegral (fromEnum a)--    deltaCksum cksum old new =-        addCksum cksum new - coeff * fromIntegral (fromEnum old)--    -- XXX shall we use a random starting hash or 1 instead of 0?-    patHash = A.foldl' addCksum 0 patArr--    skip = return . Skip--    {-# INLINE_LATE stepOuter #-}-    stepOuter _ SplitOnSuffixSeqInit = do-        res <- initial-        case res of-            FL.Partial fs ->-                if patLen == 0-                then skip $ SplitOnSuffixSeqEmpty fs state-                else if patLen == 1-                     then do-                         pat <- liftIO $ A.unsafeIndexIO 0 patArr-                         skip $ SplitOnSuffixSeqSingleInit fs state pat-                     else if SIZE_OF(a) * patLen-                               <= sizeOf (Proxy :: Proxy Word)-                          then skip $ SplitOnSuffixSeqWordInit fs state-                          else do-                              (rb, rhead) <- liftIO $ RB.new patLen-                              skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead-            FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit--    stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next--    ----------------------------    -- Reinit-    -----------------------------    stepOuter _ (SplitOnSuffixSeqReinit nextGen) =-        initial >>= skip . nextAfterInit nextGen--    ----------------------------    -- Empty pattern-    -----------------------------    stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> do-                let jump c = SplitOnSuffixSeqEmpty c s-                r <- fstep acc x-                b1 <--                    case r of-                        FL.Partial fs -> done fs-                        FL.Done b -> return b-                yieldProceed jump b1-            Skip s -> skip (SplitOnSuffixSeqEmpty acc s)-            Stop -> return Stop--    ------------------    -- Done-    -------------------    stepOuter _ SplitOnSuffixSeqDone = return Stop--    ------------------    -- Single Pattern-    -------------------    stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> processYieldSingle pat x s fs-            Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat-            Stop -> return Stop--    stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do-        res <- step (adaptState gst) st-        case res of-            Yield x s -> processYieldSingle pat x s fs-            Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat-            Stop -> do-                r <- done fs-                skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone--    ----------------------------    -- Short Pattern - Shift Or-    -----------------------------    stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do-        r <- done fs-        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-    stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do-        let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))-        r <- fstep fs (toEnum $ fromIntegral old)-        case r of-            FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd-            FL.Done b -> do-                let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd-                yieldProceed jump b--    stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do-        res <- step (adaptState gst) st0-        case res of-            Yield x s -> do-                let wrd = addToWord 0 x-                r <- if withSep then fstep fs0 x else return $ FL.Partial fs0-                case r of-                    FL.Partial fs1 -> go SPEC 1 wrd s fs1-                    FL.Done b -> do-                        let jump c = SplitOnSuffixSeqWordInit c s-                        yieldProceed jump b-            Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)-            Stop -> return Stop--        where--        {-# INLINE go #-}-        go !_ !idx !wrd !st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let jump c = SplitOnSuffixSeqWordInit c s-                    let wrd1 = addToWord wrd x-                    r <- if withSep then fstep fs x else return $ FL.Partial fs-                    case r of-                        FL.Partial fs1 ->-                            if idx /= maxIndex-                            then go SPEC (idx + 1) wrd1 s fs1-                            else if wrd1 .&. wordMask /= wordPat-                            then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1-                            else do done fs >>= yieldProceed jump-                        FL.Done b -> yieldProceed jump b-                Skip s -> go SPEC idx wrd s fs-                Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd--    stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =-        go SPEC wrd0 st0 fs0--        where--        {-# INLINE go #-}-        go !_ !wrd !st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    let jump c = SplitOnSuffixSeqWordInit c s-                        wrd1 = addToWord wrd x-                        old = (wordMask .&. wrd)-                                `shiftR` (elemBits * (patLen - 1))-                    r <--                        if withSep-                        then fstep fs x-                        else fstep fs (toEnum $ fromIntegral old)-                    case r of-                        FL.Partial fs1 ->-                            if wrd1 .&. wordMask == wordPat-                            then done fs1 >>= yieldProceed jump-                            else go SPEC wrd1 s fs1-                        FL.Done b -> yieldProceed jump b-                Skip s -> go SPEC wrd s fs-                Stop ->-                    if wrd .&. wordMask == wordPat-                    then return Stop-                    else if withSep-                    then do-                        r <- done fs-                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-                    else skip $ SplitOnSuffixSeqWordDone patLen fs wrd--    --------------------------------    -- General Pattern - Karp Rabin-    ---------------------------------    stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do-        res <- step (adaptState gst) st0-        case res of-            Yield x s -> do-                rh1 <- liftIO $ RB.unsafeInsert rb rh0 x-                r <- if withSep then fstep fs x else return $ FL.Partial fs-                case r of-                    FL.Partial fs1 ->-                        skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1-                    FL.Done b -> do-                        let rst = RB.startOf rb-                            jump c = SplitOnSuffixSeqKRInit 0 c s rb rst-                        yieldProceed jump b-            Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0-            Stop -> return Stop--    stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do-        go SPEC 1 rh0 st0 fs0--        where--        go !_ !idx !rh st !fs = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    rh1 <- liftIO (RB.unsafeInsert rb rh x)-                    r <- if withSep then fstep fs x else return $ FL.Partial fs-                    case r of-                        FL.Partial fs1 ->-                            if idx /= maxIndex-                            then go SPEC (idx + 1) rh1 s fs1-                            else skip $-                                let fld = RB.unsafeFoldRing (RB.ringBound rb)-                                    !ringHash = fld addCksum 0 rb-                                 in if ringHash == patHash-                                    then SplitOnSuffixSeqKRCheck fs1 s rb rh1-                                    else SplitOnSuffixSeqKRLoop-                                            fs1 s rb rh1 ringHash-                        FL.Done b -> do-                            let rst = RB.startOf rb-                                jump c = SplitOnSuffixSeqKRInit 0 c s rb rst-                            yieldProceed jump b-                Skip s -> go SPEC idx rh s fs-                Stop -> do-                    -- do not issue a blank segment when we end at pattern-                    if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr-                    then return Stop-                    else if withSep-                    then do-                        r <- done fs-                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-                    else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)--    stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =-        go SPEC fs0 st0 rh0 cksum0--        where--        go !_ !fs !st !rh !cksum = do-            res <- step (adaptState gst) st-            case res of-                Yield x s -> do-                    old <- liftIO $ peek rh-                    rh1 <- liftIO (RB.unsafeInsert rb rh x)-                    let cksum1 = deltaCksum cksum old x-                    r <- if withSep then fstep fs x else fstep fs old-                    case r of-                        FL.Partial fs1 ->-                            if cksum1 /= patHash-                            then go SPEC fs1 s rh1 cksum1-                            else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1-                        FL.Done b -> do-                            let rst = RB.startOf rb-                                jump c = SplitOnSuffixSeqKRInit 0 c s rb rst-                            yieldProceed jump b-                Skip s -> go SPEC fs s rh cksum-                Stop ->-                    if RB.unsafeEqArray rb rh patArr-                    then return Stop-                    else if withSep-                    then do-                        r <- done fs-                        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-                    else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh--    stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do-        if RB.unsafeEqArray rb rh patArr-        then do-            r <- done fs-            let rst = RB.startOf rb-                jump c = SplitOnSuffixSeqKRInit 0 c st rb rst-            yieldProceed jump r-        else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash--    stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do-        r <- done fs-        skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone-    stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do-        old <- liftIO $ peek rh-        let rh1 = RB.advance rb rh-        r <- fstep fs old-        case r of-            FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1-            FL.Done b -> do-                let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1-                yieldProceed jump b---- Implement this as a fold or a parser instead.--- This can be implemented easily using Rabin Karp--- | Split post any one of the given patterns.------ /Unimplemented/-{-# INLINE splitOnSuffixSeqAny #-}-splitOnSuffixSeqAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnSuffixSeqAny _subseq _f _m = undefined-    -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)---- | Split on a prefixed separator element, dropping the separator.  The--- supplied 'Fold' is applied on the split segments.------ @--- > splitOnPrefix' p xs = Stream.toList $ Stream.splitOnPrefix p (Fold.toList) (Stream.fromList xs)--- > splitOnPrefix' (== '.') ".a.b"--- ["a","b"]--- @------ An empty stream results in an empty output stream:--- @--- > splitOnPrefix' (== '.') ""--- []--- @------ An empty segment consisting of only a prefix is folded to the default output--- of the fold:------ @--- > splitOnPrefix' (== '.') "."--- [""]------ > splitOnPrefix' (== '.') ".a.b."--- ["a","b",""]------ > splitOnPrefix' (== '.') ".a..b"--- ["a","","b"]------ @------ A prefix is optional at the beginning of the stream:------ @--- > splitOnPrefix' (== '.') "a"--- ["a"]------ > splitOnPrefix' (== '.') "a.b"--- ["a","b"]--- @------ 'splitOnPrefix' is an inverse of 'intercalatePrefix' with a single element:------ > Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList . Stream.splitOnPrefix (== '.') Fold.toList === id------ Assuming the input stream does not contain the separator:------ > Stream.splitOnPrefix (== '.') Fold.toList . Stream.intercalatePrefix (Stream.fromPure '.') Unfold.fromList === id------ /Unimplemented/-{-# INLINE splitOnPrefix #-}-splitOnPrefix :: -- (IsStream t, MonadCatch m) =>-    (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-splitOnPrefix _predicate _f = undefined-    -- parseMany (Parser.sliceBeginBy predicate f)---- Int list examples for splitOn:------ >>> splitList [] [1,2,3,3,4]--- > [[1],[2],[3],[3],[4]]------ >>> splitList [5] [1,2,3,3,4]--- > [[1,2,3,3,4]]------ >>> splitList [1] [1,2,3,3,4]--- > [[],[2,3,3,4]]------ >>> splitList [4] [1,2,3,3,4]--- > [[1,2,3,3],[]]------ >>> splitList [2] [1,2,3,3,4]--- > [[1],[3,3,4]]------ >>> splitList [3] [1,2,3,3,4]--- > [[1,2],[],[4]]------ >>> splitList [3,3] [1,2,3,3,4]--- > [[1,2],[4]]------ >>> splitList [1,2,3,3,4] [1,2,3,3,4]--- > [[],[]]---- This can be implemented easily using Rabin Karp--- | Split on any one of the given patterns.------ /Unimplemented/----{-# INLINE splitOnAny #-}-splitOnAny :: -- (Monad m, Unboxed a, Integral a) =>-    [Array a] -> Fold m a b -> Stream m a -> Stream m b-splitOnAny _subseq _f _m =-    undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)----------------------------------------------------------------------------------- Nested Container Transformation---------------------------------------------------------------------------------{-# ANN type SplitState Fuse #-}-data SplitState s arr-    = SplitInitial s-    | SplitBuffering s arr-    | SplitSplitting s arr-    | SplitYielding arr (SplitState s arr)-    | SplitFinishing---- XXX An alternative approach would be to use a partial fold (Fold m a b) to--- split using a splitBy like combinator. The Fold would consume upto the--- separator and return any leftover which can then be fed to the next fold.------ We can revisit this once we have partial folds/parsers.------ | Performs infix separator style splitting.-{-# INLINE_NORMAL splitInnerBy #-}-splitInnerBy-    :: Monad m-    => (f a -> m (f a, Maybe (f a)))  -- splitter-    -> (f a -> f a -> m (f a))        -- joiner-    -> Stream m (f a)-    -> Stream m (f a)-splitInnerBy splitter joiner (Stream step1 state1) =-    Stream step (SplitInitial state1)--    where--    {-# INLINE_LATE step #-}-    step gst (SplitInitial st) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s x1)-                    Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitInitial s)-            Stop -> return Stop--    step gst (SplitBuffering st buf) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                buf' <- joiner buf x1-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s buf')-                    Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitBuffering s buf)-            Stop -> return $ Skip (SplitYielding buf SplitFinishing)--    step _ (SplitSplitting st buf) = do-        (x1, mx2) <- splitter buf-        return $ case mx2 of-                Nothing -> Skip $ SplitBuffering st x1-                Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)--    step _ (SplitYielding x next) = return $ Yield x next-    step _ SplitFinishing = return Stop---- | Performs infix separator style splitting.-{-# INLINE_NORMAL splitInnerBySuffix #-}-splitInnerBySuffix-    :: (Monad m, Eq (f a), Monoid (f a))-    => (f a -> m (f a, Maybe (f a)))  -- splitter-    -> (f a -> f a -> m (f a))        -- joiner-    -> Stream m (f a)-    -> Stream m (f a)-splitInnerBySuffix splitter joiner (Stream step1 state1) =-    Stream step (SplitInitial state1)--    where--    {-# INLINE_LATE step #-}-    step gst (SplitInitial st) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s x1)-                    Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitInitial s)-            Stop -> return Stop--    step gst (SplitBuffering st buf) = do-        r <- step1 gst st-        case r of-            Yield x s -> do-                (x1, mx2) <- splitter x-                buf' <- joiner buf x1-                return $ case mx2 of-                    Nothing -> Skip (SplitBuffering s buf')-                    Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))-            Skip s -> return $ Skip (SplitBuffering s buf)-            Stop -> return $-                if buf == mempty-                then Stop-                else Skip (SplitYielding buf SplitFinishing)--    step _ (SplitSplitting st buf) = do-        (x1, mx2) <- splitter buf-        return $ case mx2 of-                Nothing -> Skip $ SplitBuffering st x1-                Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)--    step _ (SplitYielding x next) = return $ Yield x next-    step _ SplitFinishing = return Stop----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Drop prefix from the input stream if present.------ Space: @O(1)@------ /Unimplemented/-{-# INLINE dropPrefix #-}-dropPrefix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropPrefix = error "Not implemented yet!"---- | Drop all matching infix from the input stream if present. Infix stream--- may be consumed multiple times.------ Space: @O(n)@ where n is the length of the infix.------ /Unimplemented/-{-# INLINE dropInfix #-}-dropInfix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropInfix = error "Not implemented yet!"---- | Drop suffix from the input stream if present. Suffix stream may be--- consumed multiple times.------ Space: @O(n)@ where n is the length of the suffix.------ /Unimplemented/-{-# INLINE dropSuffix #-}-dropSuffix ::-    -- (Monad m, Eq a) =>-    Stream m a -> Stream m a -> Stream m a-dropSuffix = error "Not implemented yet!"
− src/Streamly/Internal/Data/Stream/StreamD/Step.hs 
@@ -1,39 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Step--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.StreamD.Step-    (-    -- * The stream type-      Step (..)-    )-where--import Fusion.Plugin.Types (Fuse(..))---- | A stream is a succession of 'Step's. A 'Yield' produces a single value and--- the next state of the stream. 'Stop' indicates there are no more values in--- the stream.-{-# ANN type Step Fuse #-}-data Step s a = Yield a s | Skip s | Stop--instance Functor (Step s) where-    {-# INLINE fmap #-}-    fmap f (Yield x s) = Yield (f x) s-    fmap _ (Skip s) = Skip s-    fmap _ Stop = Stop--{--fromPure :: Monad m => a -> s -> m (Step s a)-fromPure a = return . Yield a--skip :: Monad m => s -> m (Step s a)-skip = return . Skip--stop :: Monad m => m (Step s a)-stop = return Stop--}
− src/Streamly/Internal/Data/Stream/StreamD/Top.hs 
@@ -1,353 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Top--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Top level module that can depend on all other lower level Stream modules.--module Streamly.Internal.Data.Stream.StreamD.Top-    (-    -- * Transformation-    -- ** Sampling-    -- | Value agnostic filtering.-      strideFromThen--    -- * Nesting-    -- ** Set like operations-    -- | These are not exactly set operations because streams are not-    -- necessarily sets, they may have duplicated elements. These operations-    -- are generic i.e. they work on streams of unconstrained types, therefore,-    -- they have quadratic performance characterstics. For better performance-    -- using Set structures see the Streamly.Internal.Data.Stream.Container-    -- module.-    , filterInStreamGenericBy-    , deleteInStreamGenericBy-    , unionWithStreamGenericBy--    -- ** Set like operations on sorted streams-    , filterInStreamAscBy-    , deleteInStreamAscBy-    , unionWithStreamAscBy--    -- ** Join operations-    , joinInnerGeneric--    -- * Joins on sorted stream-    , joinInnerAscBy-    , joinLeftAscBy-    , joinOuterAscBy-    )-where--#include "inline.hs"--import Control.Monad.IO.Class (MonadIO(..))-import Data.IORef (newIORef, readIORef, modifyIORef')-import Streamly.Internal.Data.Fold.Type (Fold)-import Streamly.Internal.Data.Stream.Common ()-import Streamly.Internal.Data.Stream.StreamD.Type (Stream, cross)--import qualified Data.List as List-import qualified Streamly.Internal.Data.Fold as Fold-import qualified Streamly.Internal.Data.Stream.StreamD.Type as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Nesting as Stream-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as Stream--import Prelude hiding (filter, zipWith, concatMap, concat)--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Sampling----------------------------------------------------------------------------------- XXX We can implement this using addition instead of "mod" to make it more--- efficient.---- | @strideFromthen offset stride@ takes the element at @offset@ index and--- then every element at strides of @stride@.------ >>> Stream.fold Fold.toList $ Stream.strideFromThen 2 3 $ Stream.enumerateFromTo 0 10--- [2,5,8]----{-# INLINE strideFromThen #-}-strideFromThen :: Monad m => Int -> Int -> Stream m a -> Stream m a-strideFromThen offset stride =-    Stream.with Stream.indexed Stream.filter-        (\(i, _) -> i >= offset && (i - offset) `mod` stride == 0)----------------------------------------------------------------------------------- SQL Joins------------------------------------------------------------------------------------- Some references:--- * https://en.wikipedia.org/wiki/Relational_algebra--- * https://en.wikipedia.org/wiki/Join_(SQL)---- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only--- constraint, the best would be to use an Array with linear search. If the--- second stream is sorted we can also use a binary search, using Ord--- constraint or an ordering function.------ For Storables we can cache the second stream into an unboxed array for--- possibly faster access/compact representation?------ If we do not want to keep the stream in memory but always read it from the--- source (disk/network) every time we iterate through it then we can do that--- too by reading the stream every time, the stream must have immutable state--- in that case and the user is responsible for the behavior if the stream--- source changes during iterations. We can also use an Unfold instead of--- stream. We probably need a way to distinguish streams that can be read--- mutliple times without any interference (e.g. unfolding a stream using an--- immutable handle would work i.e. using pread/pwrite instead of maintaining--- an offset in the handle).---- XXX We can do this concurrently.--- XXX If the second stream is sorted and passed as an Array we could use--- binary search if we have an Ord instance or Ordering returning function. The--- time complexity would then become (m x log n).---- | Like 'cross' but emits only those tuples where @a == b@ using the--- supplied equality predicate.------ Definition:------ >>> joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ Stream.cross s1 s2------ You should almost always prefer @joinInnerOrd@ over 'joinInnerGeneric' if--- possible. @joinInnerOrd@ is an order of magnitude faster but may take more--- space for caching the second stream.------ See 'Streamly.Internal.Data.Unfold.joinInnerGeneric' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE joinInnerGeneric #-}-joinInnerGeneric :: Monad m =>-    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)-joinInnerGeneric eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ cross s1 s2-{--joinInnerGeneric eq s1 s2 = do-    -- ConcatMap works faster than bind-    Stream.concatMap (\a ->-        Stream.concatMap (\b ->-            if a `eq` b-            then Stream.fromPure (a, b)-            else Stream.nil-            ) s2-        ) s1--}---- | A more efficient 'joinInner' for sorted streams.------ Space: O(1)------ Time: O(m + n)------ /Unimplemented/-{-# INLINE joinInnerAscBy #-}-joinInnerAscBy ::-    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)-joinInnerAscBy = undefined---- | A more efficient 'joinLeft' for sorted streams.------ Space: O(1)------ Time: O(m + n)------ /Unimplemented/-{-# INLINE joinLeftAscBy #-}-joinLeftAscBy :: -- Monad m =>-    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)-joinLeftAscBy _eq _s1 _s2 = undefined---- | A more efficient 'joinOuter' for sorted streams.------ Space: O(1)------ Time: O(m + n)------ /Unimplemented/-{-# INLINE joinOuterAscBy #-}-joinOuterAscBy :: -- Monad m =>-       (a -> b -> Ordering)-    -> Stream m a-    -> Stream m b-    -> Stream m (Maybe a, Maybe b)-joinOuterAscBy _eq _s1 _s2 = undefined----------------------------------------------------------------------------------- Set operations (special joins)------------------------------------------------------------------------------------- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only constraint--- the best would be to use an Array with linear search. If the second stream--- is sorted we can also use a binary search, using Ord constraint.---- | Keep only those elements in the second stream that are present in the--- first stream too. The first stream is folded to a container using the--- supplied fold and then the elements in the container are looked up using the--- supplied lookup function.------ The first stream must be finite and must not block.-{-# INLINE filterStreamWith #-}-filterStreamWith :: Monad m =>-       Fold m a (f a)-    -> (a -> f a -> Bool)-    -> Stream m a-    -> Stream m a-    -> Stream m a-filterStreamWith fld member s1 s2 =-    Stream.concatEffect-        $ do-            xs <- Stream.fold fld s1-            return $ Stream.filter (`member` xs) s2---- | 'filterInStreamGenericBy' retains only those elements in the second stream that--- are present in the first stream.------ >>> Stream.fold Fold.toList $ Stream.filterInStreamGenericBy (==) (Stream.fromList [1,2,2,4]) (Stream.fromList [2,1,1,3])--- [2,1,1]------ >>> Stream.fold Fold.toList $ Stream.filterInStreamGenericBy (==) (Stream.fromList [2,1,1,3]) (Stream.fromList [1,2,2,4])--- [1,2,2]------ Similar to the list intersectBy operation but with the stream argument order--- flipped.------ The first stream must be finite and must not block. Second stream is--- processed only after the first stream is fully realized.------ Space: O(n) where @n@ is the number of elements in the second stream.------ Time: O(m x n) where @m@ is the number of elements in the first stream and--- @n@ is the number of elements in the second stream.------ /Pre-release/-{-# INLINE filterInStreamGenericBy #-}-filterInStreamGenericBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-filterInStreamGenericBy eq =-    -- XXX Use an (unboxed) array instead.-    filterStreamWith-        (Fold.scanMaybe (Fold.uniqBy eq) Fold.toListRev)-        (List.any . eq)---- | Like 'filterInStreamGenericBy' but assumes that the input streams are sorted in--- ascending order. To use it on streams sorted in descending order pass an--- inverted comparison function returning GT for less than and LT for greater--- than.------ Space: O(1)------ Time: O(m+n)------ /Pre-release/-{-# INLINE filterInStreamAscBy #-}-filterInStreamAscBy :: Monad m =>-    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-filterInStreamAscBy eq s1 s2 = Stream.intersectBySorted eq s2 s1---- | Delete all elements of the first stream from the seconds stream. If an--- element occurs multiple times in the first stream as many occurrences of it--- are deleted from the second stream.------ >>> Stream.fold Fold.toList $ Stream.deleteInStreamGenericBy (==) (Stream.fromList [1,2,3]) (Stream.fromList [1,2,2])--- [2]------ The following laws hold:------ > deleteInStreamGenericBy (==) s1 (s1 `append` s2) === s2--- > deleteInStreamGenericBy (==) s1 (s1 `interleave` s2) === s2------ Same as the list 'Data.List.//' operation but with argument order flipped.------ The first stream must be finite and must not block. Second stream is--- processed only after the first stream is fully realized.------ Space: O(m) where @m@ is the number of elements in the first stream.------ Time: O(m x n) where @m@ is the number of elements in the first stream and--- @n@ is the number of elements in the second stream.------ /Pre-release/-{-# INLINE deleteInStreamGenericBy #-}-deleteInStreamGenericBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-deleteInStreamGenericBy eq s1 s2 =-    Stream.concatEffect-        $ do-            -- This may work well if s1 is small-            -- If s1 is big we can go through s1, deleting elements from s2 and-            -- not emitting an element if it was successfully deleted from s2.-            -- we will need a deleteBy that can return whether the element was-            -- deleted or not.-            xs <- Stream.fold Fold.toList s2-            let f = Fold.foldl' (flip (List.deleteBy eq)) xs-            fmap Stream.fromList $ Stream.fold f s1---- | A more efficient 'deleteInStreamGenericBy' for streams sorted in ascending order.------ Space: O(1)------ /Unimplemented/-{-# INLINE deleteInStreamAscBy #-}-deleteInStreamAscBy :: -- (Monad m) =>-    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-deleteInStreamAscBy _eq _s1 _s2 = undefined---- XXX Remove the MonadIO constraint. We can just cache one stream and then--- implement using differenceEqBy.---- | This essentially appends to the second stream all the occurrences of--- elements in the first stream that are not already present in the second--- stream.------ Equivalent to the following except that @s2@ is evaluated only once:------ >>> unionWithStreamGenericBy eq s1 s2 = s2 `Stream.append` (Stream.deleteInStreamGenericBy eq s2 s1)------ Example:------ >>> Stream.fold Fold.toList $ Stream.unionWithStreamGenericBy (==) (Stream.fromList [1,1,2,3]) (Stream.fromList [1,2,2,4])--- [1,2,2,4,3]------ Space: O(n)------ Time: O(m x n)------ /Pre-release/-{-# INLINE unionWithStreamGenericBy #-}-unionWithStreamGenericBy :: MonadIO m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a-unionWithStreamGenericBy eq s1 s2 =-    Stream.concatEffect-        $ do-            xs <- Stream.fold Fold.toList  s1-            -- XXX we can use postscanlMAfter' instead of IORef-            ref <- liftIO $ newIORef $! List.nubBy eq xs-            let f x = do-                    liftIO $ modifyIORef' ref (List.deleteBy eq x)-                    return x-                s3 = Stream.concatEffect-                        $ do-                            xs1 <- liftIO $ readIORef ref-                            return $ Stream.fromList xs1-            return $ Stream.mapM f s2 `Stream.append` s3---- | A more efficient 'unionWithStreamGenericBy' for sorted streams.------ Space: O(1)------ /Unimplemented/-{-# INLINE unionWithStreamAscBy #-}-unionWithStreamAscBy :: -- (Monad m) =>-    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a-unionWithStreamAscBy _eq _s1 _s2 = undefined
− src/Streamly/Internal/Data/Stream/StreamD/Transform.hs 
@@ -1,1945 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Transform--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ "Streamly.Internal.Data.Pipe" might ultimately replace this module.---- A few functions in this module have been adapted from the vector package--- (c) Roman Leshchinskiy. See the notes in specific combinators.--module Streamly.Internal.Data.Stream.StreamD.Transform-    (-    -- * Piping-    -- | Pass through a 'Pipe'.-      transform--    -- * Mapping-    -- | Stateless one-to-one maps.-    , map-    , mapM-    , sequence--    -- * Mapping Effects-    , tap-    , tapOffsetEvery-    , trace-    , trace_--    -- * Folding-    , foldrS-    , foldlS--    -- * Scanning By 'Fold'-    , postscan-    , scan-    , scanMany--    -- * Splitting-    , splitOn--    -- * Scanning-    -- | Left scans. Stateful, mostly one-to-one maps.-    , scanlM'-    , scanlMAfter'-    , scanl'-    , scanlM-    , scanl-    , scanl1M'-    , scanl1'-    , scanl1M-    , scanl1--    , prescanl'-    , prescanlM'--    , postscanl-    , postscanlM-    , postscanl'-    , postscanlM'-    , postscanlMAfter'--    , postscanlx'-    , postscanlMx'-    , scanlMx'-    , scanlx'--    -- * Filtering-    -- | Produce a subset of the stream.-    , with-    , scanMaybe-    , filter-    , filterM-    , deleteBy-    , uniqBy-    , uniq-    , prune-    , repeated--    -- * Trimming-    -- | Produce a subset of the stream trimmed at ends.-    , take-    , takeWhile-    , takeWhileM-    , takeWhileLast-    , takeWhileAround-    , drop-    , dropWhile-    , dropWhileM-    , dropLast-    , dropWhileLast-    , dropWhileAround--    -- * Inserting Elements-    -- | Produce a superset of the stream.-    , insertBy-    , intersperse-    , intersperseM-    , intersperseMWith-    , intersperseMSuffix-    , intersperseMSuffixWith--    -- * Inserting Side Effects-    , intersperseM_-    , intersperseMSuffix_-    , intersperseMPrefix_--    , delay-    , delayPre-    , delayPost--    -- * Reordering-    -- | Produce strictly the same set but reordered.-    , reverse-    , reverseUnbox-    , reassembleBy--    -- * Position Indexing-    , indexed-    , indexedR--    -- * Time Indexing-    , timestampWith-    , timestamped-    , timeIndexWith-    , timeIndexed--    -- * Searching-    , findIndices-    , elemIndices-    , slicesBy--    -- * Rolling map-    -- | Map using the previous element.-    , rollingMap-    , rollingMapM-    , rollingMap2--    -- * Maybe Streams-    , mapMaybe-    , mapMaybeM-    , catMaybes--    -- * Either Streams-    , catLefts-    , catRights-    , catEithers-    )-where--#include "inline.hs"--import Control.Concurrent (threadDelay)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Data.Either (fromLeft, isLeft, isRight, fromRight)-import Data.Functor ((<&>))-import Data.Maybe (fromJust, isJust)-import Fusion.Plugin.Types (Fuse(..))--import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Pipe.Type (Pipe(..), PipeState(..))-import Streamly.Internal.Data.SVar.Type (adaptState)-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64)-import Streamly.Internal.Data.Unboxed (Unbox)-import Streamly.Internal.System.IO (defaultChunkSize)---- import qualified Data.List as List-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Fold as FL-import qualified Streamly.Internal.Data.Pipe.Type as Pipe-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K--import Prelude hiding-       ( drop, dropWhile, filter, map, mapM, reverse-       , scanl, scanl1, sequence, take, takeWhile, zipWith)--import Streamly.Internal.Data.Stream.StreamD.Generate-    (absTimesWith, relTimesWith)-import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- Piping----------------------------------------------------------------------------------- | Use a 'Pipe' to transform a stream.------ /Pre-release/----{-# INLINE_NORMAL transform #-}-transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b-transform (Pipe pstep1 pstep2 pstate) (Stream step state) =-    Stream step' (Consume pstate, state)--  where--    {-# INLINE_LATE step' #-}--    step' gst (Consume pst, st) = pst `seq` do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                res <- pstep1 pst x-                case res of-                    Pipe.Yield b pst' -> return $ Yield b (pst', s)-                    Pipe.Continue pst' -> return $ Skip (pst', s)-            Skip s -> return $ Skip (Consume pst, s)-            Stop   -> return Stop--    step' _ (Produce pst, st) = pst `seq` do-        res <- pstep2 pst-        case res of-            Pipe.Yield b pst' -> return $ Yield b (pst', st)-            Pipe.Continue pst' -> return $ Skip (pst', st)----------------------------------------------------------------------------------- Transformation Folds----------------------------------------------------------------------------------- Note, this is going to have horrible performance, because of the nature of--- the stream type (i.e. direct stream vs CPS). Its only for reference, it is--- likely be practically unusable.-{-# INLINE_NORMAL foldlS #-}-foldlS :: Monad m-    => (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b-foldlS fstep begin (Stream step state) = Stream step' (Left (state, begin))-  where-    step' gst (Left (st, acc)) = do-        r <- step (adaptState gst) st-        return $ case r of-            Yield x s -> Skip (Left (s, fstep acc x))-            Skip s -> Skip (Left (s, acc))-            Stop   -> Skip (Right acc)--    step' gst (Right (Stream stp stt)) = do-        r <- stp (adaptState gst) stt-        return $ case r of-            Yield x s -> Yield x (Right (Stream stp s))-            Skip s -> Skip (Right (Stream stp s))-            Stop   -> Stop----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- |--- >>> sequence = Stream.mapM id------ Replace the elements of a stream of monadic actions with the outputs of--- those actions.------ >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"]--- >>> Stream.fold Fold.drain $ Stream.sequence s--- abc----{-# INLINE_NORMAL sequence #-}-sequence :: Monad m => Stream m (m a) -> Stream m a-sequence (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-         r <- step (adaptState gst) st-         case r of-             Yield x s -> x >>= \a -> return (Yield a s)-             Skip s    -> return $ Skip s-             Stop      -> return Stop----------------------------------------------------------------------------------- Mapping side effects---------------------------------------------------------------------------------data TapState fs st a-    = TapInit | Tapping !fs st | TapDone st---- XXX Multiple yield points---- | Tap the data flowing through a stream into a 'Fold'. For example, you may--- add a tap to log the contents flowing through the stream. The fold is used--- only for effects, its result is discarded.------ @---                   Fold m a b---                       |--- -----stream m a ---------------stream m a----------- @------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s--- 1--- 2------ Compare with 'trace'.----{-# INLINE tap #-}-tap :: Monad m => Fold m a b -> Stream m a -> Stream m a-tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit--    where--    step' _ TapInit = do-        res <- initial-        return-            $ Skip-            $ case res of-                  FL.Partial s -> Tapping s state-                  FL.Done _ -> TapDone state-    step' gst (Tapping acc st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                res <- fstep acc x-                return-                    $ Yield x-                    $ case res of-                          FL.Partial fs -> Tapping fs s-                          FL.Done _ -> TapDone s-            Skip s -> return $ Skip (Tapping acc s)-            Stop -> do-                void $ extract acc-                return Stop-    step' gst (TapDone st) = do-        r <- step gst st-        return-            $ case r of-                  Yield x s -> Yield x (TapDone s)-                  Skip s -> Skip (TapDone s)-                  Stop -> Stop--data TapOffState fs s a-    = TapOffInit-    | TapOffTapping !fs s Int-    | TapOffDone s---- XXX Multiple yield points-{-# INLINE_NORMAL tapOffsetEvery #-}-tapOffsetEvery :: Monad m-    => Int -> Int -> Fold m a b -> Stream m a -> Stream m a-tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =-    Stream step' TapOffInit--    where--    {-# INLINE_LATE step' #-}-    step' _ TapOffInit = do-        res <- initial-        return-            $ Skip-            $ case res of-                  FL.Partial s -> TapOffTapping s state (offset `mod` n)-                  FL.Done _ -> TapOffDone state-    step' gst (TapOffTapping acc st count) = do-        r <- step gst st-        case r of-            Yield x s -> do-                next <--                    if count <= 0-                    then do-                        res <- fstep acc x-                        return-                            $ case res of-                                  FL.Partial sres ->-                                    TapOffTapping sres s (n - 1)-                                  FL.Done _ -> TapOffDone s-                    else return $ TapOffTapping acc s (count - 1)-                return $ Yield x next-            Skip s -> return $ Skip (TapOffTapping acc s count)-            Stop -> do-                void $ extract acc-                return Stop-    step' gst (TapOffDone st) = do-        r <- step gst st-        return-            $ case r of-                  Yield x s -> Yield x (TapOffDone s)-                  Skip s -> Skip (TapOffDone s)-                  Stop -> Stop---- | Apply a monadic function to each element flowing through the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace print s--- 1--- 2------ Compare with 'tap'.----{-# INLINE trace #-}-trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a-trace f = mapM (\x -> void (f x) >> return x)---- | Perform a side effect before yielding each element of the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s--- "got here"--- "got here"------ Same as 'intersperseMPrefix_' but always serial.------ See also: 'trace'------ /Pre-release/-{-# INLINE trace_ #-}-trace_ :: Monad m => m b -> Stream m a -> Stream m a-trace_ eff = mapM (\x -> eff >> return x)----------------------------------------------------------------------------------- Scanning with a Fold---------------------------------------------------------------------------------data ScanState s f = ScanInit s | ScanDo s !f | ScanDone---- | Postscan a stream using the given monadic fold.------ The following example extracts the input stream up to a point where the--- running average of elements is no more than 10:------ >>> import Data.Maybe (fromJust)--- >>> let avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)--- >>> s = Stream.enumerateFromTo 1.0 100.0--- >>> :{---  Stream.fold Fold.toList---   $ fmap (fromJust . fst)---   $ Stream.takeWhile (\(_,x) -> x <= 10)---   $ Stream.postscan (Fold.tee Fold.latest avg) s--- :}--- [1.0,2.0,3.0,4.0,5.0,6.0,7.0,8.0,9.0,10.0,11.0,12.0,13.0,14.0,15.0,16.0,17.0,18.0,19.0]----{-# INLINE_NORMAL postscan #-}-postscan :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b-postscan (FL.Fold fstep initial extract) (Stream sstep state) =-    Stream step (ScanInit state)--    where--    {-# INLINE_LATE step #-}-    step _ (ScanInit st) = do-        res <- initial-        return-            $ case res of-                  FL.Partial fs -> Skip $ ScanDo st fs-                  FL.Done b -> Yield b ScanDone-    step gst (ScanDo st fs) = do-        res <- sstep (adaptState gst) st-        case res of-            Yield x s -> do-                r <- fstep fs x-                case r of-                    FL.Partial fs1 -> do-                        !b <- extract fs1-                        return $ Yield b $ ScanDo s fs1-                    FL.Done b -> return $ Yield b ScanDone-            Skip s -> return $ Skip $ ScanDo s fs-            Stop -> return Stop-    step _ ScanDone = return Stop--{-# INLINE scanWith #-}-scanWith :: Monad m-    => Bool -> Fold m a b -> Stream m a -> Stream m b-scanWith restart (Fold fstep initial extract) (Stream sstep state) =-    Stream step (ScanInit state)--    where--    {-# INLINE runStep #-}-    runStep st action = do-        res <- action-        case res of-            FL.Partial fs -> do-                !b <- extract fs-                return $ Yield b $ ScanDo st fs-            FL.Done b ->-                let next = if restart then ScanInit st else ScanDone-                 in return $ Yield b next--    {-# INLINE_LATE step #-}-    step _ (ScanInit st) = runStep st initial-    step gst (ScanDo st fs) = do-        res <- sstep (adaptState gst) st-        case res of-            Yield x s -> runStep s (fstep fs x)-            Skip s -> return $ Skip $ ScanDo s fs-            Stop -> return Stop-    step _ ScanDone = return Stop---- XXX It may be useful to have a version of scan where we can keep the--- accumulator independent of the value emitted. So that we do not necessarily--- have to keep a value in the accumulator which we are not using. We can pass--- an extraction function that will take the accumulator and the current value--- of the element and emit the next value in the stream. That will also make it--- possible to modify the accumulator after using it. In fact, the step function--- can return new accumulator and the value to be emitted. The signature would--- be more like mapAccumL.---- | Strict left scan. Scan a stream using the given monadic fold.------ >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s--- [0,1,3,6]------ See also: 'usingStateT'------- EXPLANATION:--- >>> scanl' step z = Stream.scan (Fold.foldl' step z)------ Like 'map', 'scanl'' too is a one to one transformation,--- however it adds an extra element.------ >>> s = Stream.fromList [1,2,3,4]--- >>> Stream.fold Fold.toList $ scanl' (+) 0 s--- [0,1,3,6,10]------ >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s--- [[],[1],[2,1],[3,2,1],[4,3,2,1]]------ The output of 'scanl'' is the initial value of the accumulator followed by--- all the intermediate steps and the final result of 'foldl''.------ By streaming the accumulated state after each fold step, we can share the--- state across multiple stages of stream composition. Each stage can modify or--- extend the state, do some processing with it and emit it for the next stage,--- thus modularizing the stream processing. This can be useful in--- stateful or event-driven programming.------ Consider the following monolithic example, computing the sum and the product--- of the elements in a stream in one go using a @foldl'@:------ >>> foldl' step z = Stream.fold (Fold.foldl' step z)--- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s--- (10,24)------ Using @scanl'@ we can make it modular by computing the sum in the first--- stage and passing it down to the next stage for computing the product:------ >>> :{---   foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)---   $ scanl' (\(s, _) x -> (s + x, x)) (0,1)---   $ Stream.fromList [1,2,3,4]--- :}--- (10,24)------ IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building--- lazy expressions inside the accumulator, it is recommended that a strict--- data structure is used for accumulator.----{-# INLINE_NORMAL scan #-}-scan :: Monad m-    => FL.Fold m a b -> Stream m a -> Stream m b-scan = scanWith False---- | Like 'scan' but restarts scanning afresh when the scanning fold--- terminates.----{-# INLINE_NORMAL scanMany #-}-scanMany :: Monad m-    => FL.Fold m a b -> Stream m a -> Stream m b-scanMany = scanWith True----------------------------------------------------------------------------------- Scanning - Prescans----------------------------------------------------------------------------------- Adapted from the vector package.------ XXX Is a prescan useful, discarding the last step does not sound useful?  I--- am not sure about the utility of this function, so this is implemented but--- not exposed. We can expose it if someone provides good reasons why this is--- useful.------ XXX We have to execute the stream one step ahead to know that we are at the--- last step.  The vector implementation of prescan executes the last fold step--- but does not yield the result. This means we have executed the effect but--- discarded value. This does not sound right. In this implementation we are--- not executing the last fold step.-{-# INLINE_NORMAL prescanlM' #-}-prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-prescanlM' f mz (Stream step state) = Stream step' (state, mz)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, prev) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                acc <- prev-                return $ Yield acc (s, f acc x)-            Skip s -> return $ Skip (s, prev)-            Stop   -> return Stop--{-# INLINE prescanl' #-}-prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)----------------------------------------------------------------------------------- Monolithic postscans (postscan followed by a map)----------------------------------------------------------------------------------- The performance of a modular postscan followed by a map seems to be--- equivalent to this monolithic scan followed by map therefore we may not need--- this implementation. We just have it for performance comparison and in case--- modular version does not perform well in some situation.----{-# INLINE_NORMAL postscanlMx' #-}-postscanlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b-postscanlMx' fstep begin done (Stream step state) = do-    Stream step' (state, begin)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, acc) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                old <- acc-                y <- fstep old x-                v <- done y-                v `seq` y `seq` return (Yield v (s, return y))-            Skip s -> return $ Skip (s, acc)-            Stop   -> return Stop--{-# INLINE_NORMAL postscanlx' #-}-postscanlx' :: Monad m-    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b-postscanlx' fstep begin done =-    postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)---- XXX do we need consM strict to evaluate the begin value?-{-# INLINE scanlMx' #-}-scanlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b-scanlMx' fstep begin done s =-    (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s--{-# INLINE scanlx' #-}-scanlx' :: Monad m-    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b-scanlx' fstep begin done =-    scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)----------------------------------------------------------------------------------- postscans----------------------------------------------------------------------------------- Adapted from the vector package.-{-# INLINE_NORMAL postscanlM' #-}-postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-postscanlM' fstep begin (Stream step state) =-    Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        !x <- begin-        return $ Skip (Just (state, x))--    step' gst (Just (st, acc)) =  do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                !y <- fstep acc x-                return $ Yield y (Just (s, y))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop--{-# INLINE_NORMAL postscanl' #-}-postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a-postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)--{-# ANN type PScanAfterState Fuse #-}-data PScanAfterState m st acc =-      PScanAfterStep st (m acc)-    | PScanAfterYield acc (PScanAfterState m st acc)-    | PScanAfterStop---- We can possibly have the "done" function as a Maybe to provide an option to--- emit or not emit the accumulator when the stream stops.------ TBD: use a single Yield point----{-# INLINE_NORMAL postscanlMAfter' #-}-postscanlMAfter' :: Monad m-    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b-postscanlMAfter' fstep initial done (Stream step1 state1) = do-    Stream step (PScanAfterStep state1 initial)--    where--    {-# INLINE_LATE step #-}-    step gst (PScanAfterStep st acc) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield x s -> do-                !old <- acc-                !y <- fstep old x-                return (Skip $ PScanAfterYield y (PScanAfterStep s (return y)))-            Skip s -> return $ Skip $ PScanAfterStep s acc-            -- Strictness is important for fusion-            Stop -> do-                !v <- acc-                !res <- done v-                return (Skip $ PScanAfterYield res PScanAfterStop)-    step _ (PScanAfterYield acc next) = return $ Yield acc next-    step _ PScanAfterStop = return Stop--{-# INLINE_NORMAL postscanlM #-}-postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-postscanlM fstep begin (Stream step state) = Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        r <- begin-        return $ Skip (Just (state, r))--    step' gst (Just (st, acc)) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                y <- fstep acc x-                return (Yield y (Just (s, y)))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop--{-# INLINE_NORMAL postscanl #-}-postscanl :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a-postscanl f seed = postscanlM (\a b -> return (f a b)) (return seed)---- | Like 'scanl'' but with a monadic step function and a monadic seed.----{-# INLINE_NORMAL scanlM' #-}-scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-scanlM' fstep begin (Stream step state) = Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        !x <- begin-        return $ Yield x (Just (state, x))-    step' gst (Just (st, acc)) =  do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                !y <- fstep acc x-                return $ Yield y (Just (s, y))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop---- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except--- that it provides an additional @done@ function to be applied on the--- accumulator when the stream stops. The result of @done@ is also emitted in--- the stream.------ This function can be used to allocate a resource in the beginning of the--- scan and release it when the stream ends or to flush the internal state of--- the scan at the end.------ /Pre-release/----{-# INLINE scanlMAfter' #-}-scanlMAfter' :: Monad m-    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b-scanlMAfter' fstep initial done s =-    initial `consM` postscanlMAfter' fstep initial done s---- >>> scanl' f z xs = z `Stream.cons` postscanl' f z xs---- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,--- however it adds an extra element.------ >>> Stream.toList $ Stream.scanl' (+) 0 $ Stream.fromList [1,2,3,4]--- [0,1,3,6,10]------ >>> Stream.toList $ Stream.scanl' (flip (:)) [] $ Stream.fromList [1,2,3,4]--- [[],[1],[2,1],[3,2,1],[4,3,2,1]]------ The output of 'scanl'' is the initial value of the accumulator followed by--- all the intermediate steps and the final result of 'foldl''.------ By streaming the accumulated state after each fold step, we can share the--- state across multiple stages of stream composition. Each stage can modify or--- extend the state, do some processing with it and emit it for the next stage,--- thus modularizing the stream processing. This can be useful in--- stateful or event-driven programming.------ Consider the following monolithic example, computing the sum and the product--- of the elements in a stream in one go using a @foldl'@:------ >>> Stream.fold (Fold.foldl' (\(s, p) x -> (s + x, p * x)) (0,1)) $ Stream.fromList [1,2,3,4]--- (10,24)------ Using @scanl'@ we can make it modular by computing the sum in the first--- stage and passing it down to the next stage for computing the product:------ >>> :{---   Stream.fold (Fold.foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1))---   $ Stream.scanl' (\(s, _) x -> (s + x, x)) (0,1)---   $ Stream.fromList [1,2,3,4]--- :}--- (10,24)------ IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building--- lazy expressions inside the accumulator, it is recommended that a strict--- data structure is used for accumulator.------ >>> scanl' step z = Stream.scan (Fold.foldl' step z)--- >>> scanl' f z xs = Stream.scanlM' (\a b -> return (f a b)) (return z) xs------ See also: 'usingStateT'----{-# INLINE scanl' #-}-scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-scanl' f seed = scanlM' (\a b -> return (f a b)) (return seed)--{-# INLINE_NORMAL scanlM #-}-scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b-scanlM fstep begin (Stream step state) = Stream step' Nothing-  where-    {-# INLINE_LATE step' #-}-    step' _ Nothing = do-        x <- begin-        return $ Yield x (Just (state, x))-    step' gst (Just (st, acc)) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                y <- fstep acc x-                return $ Yield y (Just (s, y))-            Skip s -> return $ Skip (Just (s, acc))-            Stop   -> return Stop--{-# INLINE scanl #-}-scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b-scanl f seed = scanlM (\a b -> return (f a b)) (return seed)---- Adapted from the vector package-{-# INLINE_NORMAL scanl1M #-}-scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a-scanl1M fstep (Stream step state) = Stream step' (state, Nothing)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, Nothing) = do-        r <- step gst st-        case r of-            Yield x s -> return $ Yield x (s, Just x)-            Skip s -> return $ Skip (s, Nothing)-            Stop   -> return Stop--    step' gst (st, Just acc) = do-        r <- step gst st-        case r of-            Yield y s -> do-                z <- fstep acc y-                return $ Yield z (s, Just z)-            Skip s -> return $ Skip (s, Just acc)-            Stop   -> return Stop--{-# INLINE scanl1 #-}-scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a-scanl1 f = scanl1M (\x y -> return (f x y))---- Adapted from the vector package---- | Like 'scanl1'' but with a monadic step function.----{-# INLINE_NORMAL scanl1M' #-}-scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a-scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, Nothing) = do-        r <- step gst st-        case r of-            Yield x s -> x `seq` return $ Yield x (s, Just x)-            Skip s -> return $ Skip (s, Nothing)-            Stop   -> return Stop--    step' gst (st, Just acc) = acc `seq` do-        r <- step gst st-        case r of-            Yield y s -> do-                z <- fstep acc y-                z `seq` return $ Yield z (s, Just z)-            Skip s -> return $ Skip (s, Just acc)-            Stop   -> return Stop---- | Like 'scanl'' but for a non-empty stream. The first element of the stream--- is used as the initial value of the accumulator. Does nothing if the stream--- is empty.------ >>> Stream.toList $ Stream.scanl1' (+) $ Stream.fromList [1,2,3,4]--- [1,3,6,10]----{-# INLINE scanl1' #-}-scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a-scanl1' f = scanl1M' (\x y -> return (f x y))------------------------------------------------------------------------------------ Filtering------------------------------------------------------------------------------------ | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a--- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a--- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with--- index or time.------ >>> filterWithIndex = Stream.with Stream.indexed Stream.filter------ /Pre-release/-{-# INLINE with #-}-with :: Monad m =>-       (Stream m a -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m a -> Stream m a)-with f comb g = fmap snd . comb g . f---- Adapted from the vector package---- | Same as 'filter' but with a monadic predicate.------ >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing--- >>> filterM p = Stream.mapMaybeM (f p)----{-# INLINE_NORMAL filterM #-}-filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-filterM f (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                return $ if b-                         then Yield x s-                         else Skip s-            Skip s -> return $ Skip s-            Stop   -> return Stop---- | Include only those elements that pass a predicate.------ >>> filter p = Stream.filterM (return . p)--- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing)--- >>> filter p = Stream.scanMaybe (Fold.filtering p)----{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-filter f = filterM (return . f)--- filter p = scanMaybe (FL.filtering p)---- | Drop repeated elements that are adjacent to each other using the supplied--- comparison function.------ >>> uniq = Stream.uniqBy (==)------ To strip duplicate path separators:------ >>> input = Stream.fromList "//a//b"--- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.uniqBy f input--- "/a/b"------ Space: @O(1)@------ /Pre-release/----{-# INLINE uniqBy #-}-uniqBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a--- uniqBy eq = scanMaybe (FL.uniqBy eq)-uniqBy eq = catMaybes . rollingMap f--    where--    f pre curr =-        case pre of-            Nothing -> Just curr-            Just x -> if x `eq` curr then Nothing else Just curr---- Adapted from the vector package---- | Drop repeated elements that are adjacent to each other.------ >>> uniq = Stream.uniqBy (==)----{-# INLINE_NORMAL uniq #-}-uniq :: (Eq a, Monad m) => Stream m a -> Stream m a--- uniq = scanMaybe FL.uniq-uniq (Stream step state) = Stream step' (Nothing, state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (Nothing, st) = do-        r <- step gst st-        case r of-            Yield x s -> return $ Yield x (Just x, s)-            Skip  s   -> return $ Skip  (Nothing, s)-            Stop      -> return Stop-    step' gst (Just x, st)  = do-         r <- step gst st-         case r of-             Yield y s | x == y   -> return $ Skip (Just x, s)-                       | otherwise -> return $ Yield y (Just y, s)-             Skip  s   -> return $ Skip (Just x, s)-             Stop      -> return Stop---- | Deletes the first occurrence of the element in the stream that satisfies--- the given equality predicate.------ >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input--- [1,3,5]----{-# INLINE_NORMAL deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a--- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x)-deleteBy eq x (Stream step state) = Stream step' (state, False)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, False) = do-        r <- step gst st-        case r of-            Yield y s -> return $-                if eq x y then Skip (s, True) else Yield y (s, False)-            Skip s -> return $ Skip (s, False)-            Stop   -> return Stop--    step' gst (st, True) = do-        r <- step gst st-        case r of-            Yield y s -> return $ Yield y (s, True)-            Skip s -> return $ Skip (s, True)-            Stop   -> return Stop---- | Strip all leading and trailing occurrences of an element passing a--- predicate and make all other consecutive occurrences uniq.------ >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)------ @--- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")--- "hello world!"------ @------ Space: @O(1)@------ /Unimplemented/-{-# INLINE prune #-}-prune ::-    -- (Monad m, Eq a) =>-    (a -> Bool) -> Stream m a -> Stream m a-prune = error "Not implemented yet!"---- Possible implementation:--- @repeated =---      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@------ 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a--- single element.---- | Emit only repeated elements, once.------ /Unimplemented/-repeated :: -- (Monad m, Eq a) =>-    Stream m a -> Stream m a-repeated = undefined----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Take all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements taken.------ /Unimplemented/-{-# INLINE takeWhileLast #-}-takeWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m---- | Like 'takeWhile' and 'takeWhileLast' combined.------ O(n) space, where n is the number elements taken from the end.------ /Unimplemented/-{-# INLINE takeWhileAround #-}-takeWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m---- Adapted from the vector package---- | Discard first 'n' elements from the stream and take the rest.----{-# INLINE_NORMAL drop #-}-drop :: Monad m => Int -> Stream m a -> Stream m a-drop n (Stream step state) = Stream step' (state, Just n)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, Just i)-      | i > 0 = do-          r <- step gst st-          return $-            case r of-              Yield _ s -> Skip (s, Just (i - 1))-              Skip s    -> Skip (s, Just i)-              Stop      -> Stop-      | otherwise = return $ Skip (st, Nothing)--    step' gst (st, Nothing) = do-      r <- step gst st-      return $-        case r of-          Yield x s -> Yield x (s, Nothing)-          Skip  s   -> Skip (s, Nothing)-          Stop      -> Stop---- Adapted from the vector package-data DropWhileState s a-    = DropWhileDrop s-    | DropWhileYield a s-    | DropWhileNext s---- | Same as 'dropWhile' but with a monadic predicate.----{-# INLINE_NORMAL dropWhileM #-}-dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- dropWhileM p = scanMaybe (FL.droppingWhileM p)-dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (DropWhileDrop st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                if b-                then return $ Skip (DropWhileDrop s)-                else return $ Skip (DropWhileYield x s)-            Skip s -> return $ Skip (DropWhileDrop s)-            Stop -> return Stop--    step' gst (DropWhileNext st) =  do-        r <- step gst st-        case r of-            Yield x s -> return $ Skip (DropWhileYield x s)-            Skip s    -> return $ Skip (DropWhileNext s)-            Stop      -> return Stop--    step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)---- | Drop elements in the stream as long as the predicate succeeds and then--- take the rest of the stream.----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- dropWhile p = scanMaybe (FL.droppingWhile p)-dropWhile f = dropWhileM (return . f)---- | Drop @n@ elements at the end of the stream.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropLast #-}-dropLast :: -- Monad m =>-    Int -> Stream m a -> Stream m a-dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m---- | Drop all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropWhileLast #-}-dropWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m---- | Like 'dropWhile' and 'dropWhileLast' combined.------ O(n) space, where n is the number elements dropped from the end.------ /Unimplemented/-{-# INLINE dropWhileAround #-}-dropWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m----------------------------------------------------------------------------------- Inserting Elements----------------------------------------------------------------------------------- | @insertBy cmp elem stream@ inserts @elem@ before the first element in--- @stream@ that is less than @elem@ when compared using @cmp@.------ >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x)------ >>> input = Stream.fromList [1,3,5]--- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input--- [1,2,3,5]----{-# INLINE_NORMAL insertBy #-}-insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a-insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, False, _) = do-        r <- step gst st-        case r of-            Yield x s -> case cmp a x of-                GT -> return $ Yield x (s, False, Nothing)-                _  -> return $ Yield a (s, True, Just x)-            Skip s -> return $ Skip (s, False, Nothing)-            Stop   -> return $ Yield a (st, True, Nothing)--    step' _ (_, True, Nothing) = return Stop--    step' gst (st, True, Just prev) = do-        r <- step gst st-        case r of-            Yield x s -> return $ Yield prev (s, True, Just x)-            Skip s    -> return $ Skip (s, True, Just prev)-            Stop      -> return $ Yield prev (st, True, Nothing)--data LoopState x s = FirstYield s-                   | InterspersingYield s-                   | YieldAndCarry x s---- intersperseM = intersperseMWith 1---- | Insert an effect and its output before consuming an element of a stream--- except the first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseM (putChar '.' >> return ',') input--- h.,e.,l.,l.,o"h,e,l,l,o"------ Be careful about the order of effects. In the above example we used trace--- after the intersperse, if we use it before the intersperse the output would--- be he.l.l.o."h,e,l,l,o".------ >>> Stream.fold Fold.toList $ Stream.intersperseM (putChar '.' >> return ',') $ Stream.trace putChar input--- he.l.l.o."h,e,l,l,o"----{-# INLINE_NORMAL intersperseM #-}-intersperseM :: Monad m => m a -> Stream m a -> Stream m a-intersperseM m (Stream step state) = Stream step' (FirstYield state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (FirstYield st) = do-        r <- step gst st-        return $-            case r of-                Yield x s -> Skip (YieldAndCarry x s)-                Skip s -> Skip (FirstYield s)-                Stop -> Stop--    step' gst (InterspersingYield st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                a <- m-                return $ Yield a (YieldAndCarry x s)-            Skip s -> return $ Skip $ InterspersingYield s-            Stop -> return Stop--    step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st)---- | Insert a pure value between successive elements of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input--- "h,e,l,l,o"----{-# INLINE intersperse #-}-intersperse :: Monad m => a -> Stream m a -> Stream m a-intersperse a = intersperseM (return a)---- | Insert a side effect before consuming an element of a stream except the--- first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input--- h.e.l.l.o------ /Pre-release/-{-# INLINE_NORMAL intersperseM_ #-}-intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1))-  where-    {-# INLINE_LATE step #-}-    step gst (Left (eff, st)) = do-        r <- step1 gst st-        case r of-            Yield x s -> eff >> return (Yield x (Right s))-            Skip s -> return $ Skip (Left (eff, s))-            Stop -> return Stop--    step _ (Right st) = return $ Skip $ Left (void m, st)---- | Intersperse a monadic action into the input stream after every @n@--- elements.------ >> input = Stream.fromList "hello"--- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input--- "he,ll,o"------ /Unimplemented/-{-# INLINE intersperseMWith #-}-intersperseMWith :: -- Monad m =>-    Int -> m a -> Stream m a -> Stream m a-intersperseMWith _n _f _xs = undefined--data SuffixState s a-    = SuffixElem s-    | SuffixSuffix s-    | SuffixYield a (SuffixState s a)---- | Insert an effect and its output after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMSuffix (putChar '.' >> return ',') input--- h.,e.,l.,l.,o.,"h,e,l,l,o,"------ /Pre-release/-{-# INLINE_NORMAL intersperseMSuffix #-}-intersperseMSuffix :: forall m a. Monad m => m a -> Stream m a -> Stream m a-intersperseMSuffix action (Stream step state) = Stream step' (SuffixElem state)-    where-    {-# INLINE_LATE step' #-}-    step' gst (SuffixElem st) = do-        r <- step gst st-        return $ case r of-            Yield x s -> Skip (SuffixYield x (SuffixSuffix s))-            Skip s -> Skip (SuffixElem s)-            Stop -> Stop--    step' _ (SuffixSuffix st) = do-        action >>= \r -> return $ Skip (SuffixYield r (SuffixElem st))--    step' _ (SuffixYield x next) = return $ Yield x next---- | Insert a side effect after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input--- "hello"------ /Pre-release/----{-# INLINE_NORMAL intersperseMSuffix_ #-}-intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMSuffix_ m (Stream step1 state1) = Stream step (Left state1)-  where-    {-# INLINE_LATE step #-}-    step gst (Left st) = do-        r <- step1 gst st-        case r of-            Yield x s -> return $ Yield x (Right s)-            Skip s -> return $ Skip $ Left s-            Stop -> return Stop--    step _ (Right st) = m >> return (Skip (Left st))--data SuffixSpanState s a-    = SuffixSpanElem s Int-    | SuffixSpanSuffix s-    | SuffixSpanYield a (SuffixSpanState s a)-    | SuffixSpanLast-    | SuffixSpanStop---- | Like 'intersperseMSuffix' but intersperses an effectful action into the--- input stream after every @n@ elements and after the last element.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input--- "he,ll,o,"------ /Pre-release/----{-# INLINE_NORMAL intersperseMSuffixWith #-}-intersperseMSuffixWith :: forall m a. Monad m-    => Int -> m a -> Stream m a -> Stream m a-intersperseMSuffixWith n action (Stream step state) =-    Stream step' (SuffixSpanElem state n)-    where-    {-# INLINE_LATE step' #-}-    step' gst (SuffixSpanElem st i) | i > 0 = do-        r <- step gst st-        return $ case r of-            Yield x s -> Skip (SuffixSpanYield x (SuffixSpanElem s (i - 1)))-            Skip s -> Skip (SuffixSpanElem s i)-            Stop -> if i == n then Stop else Skip SuffixSpanLast-    step' _ (SuffixSpanElem st _) = return $ Skip (SuffixSpanSuffix st)--    step' _ (SuffixSpanSuffix st) = do-        action >>= \r -> return $ Skip (SuffixSpanYield r (SuffixSpanElem st n))--    step' _ SuffixSpanLast = do-        action >>= \r -> return $ Skip (SuffixSpanYield r SuffixSpanStop)--    step' _ (SuffixSpanYield x next) = return $ Yield x next--    step' _ SuffixSpanStop = return Stop---- | Insert a side effect before consuming an element of a stream.------ Definition:------ >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x)------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') input--- .h.e.l.l.o"hello"------ Same as 'trace_'.------ /Pre-release/----{-# INLINE intersperseMPrefix_ #-}-intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMPrefix_ m = mapM (\x -> void m >> return x)----------------------------------------------------------------------------------- Inserting Time----------------------------------------------------------------------------------- XXX This should be in Prelude, should we export this as a helper function?---- | Block the current thread for specified number of seconds.-{-# INLINE sleep #-}-sleep :: MonadIO m => Double -> m ()-sleep n = liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds between elements of the stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delay = Stream.intersperseM_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input--- 1--- 2--- 3----{-# INLINE delay #-}-delay :: MonadIO m => Double -> Stream m a -> Stream m a-delay = intersperseM_ . sleep---- | Introduce a delay of specified seconds after consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPost = Stream.intersperseMSuffix_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPost #-}-delayPost :: MonadIO m => Double -> Stream m a -> Stream m a-delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds before consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPre = Stream.intersperseMPrefix_. sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPre #-}-delayPre :: MonadIO m => Double -> Stream m a -> Stream m a-delayPre = intersperseMPrefix_. sleep----------------------------------------------------------------------------------- Reordering----------------------------------------------------------------------------------- | Returns the elements of the stream in reverse order.  The stream must be--- finite. Note that this necessarily buffers the entire stream in memory.------ Definition:------ >>> reverse m = Stream.concatEffect $ Stream.fold Fold.toListRev m >>= return . Stream.fromList----{-# INLINE_NORMAL reverse #-}-reverse :: Monad m => Stream m a -> Stream m a-reverse m = concatEffect $ fold FL.toListRev m <&> fromList-{--reverse m = Stream step Nothing-    where-    {-# INLINE_LATE step #-}-    step _ Nothing = do-        xs <- foldl' (flip (:)) [] m-        return $ Skip (Just xs)-    step _ (Just (x:xs)) = return $ Yield x (Just xs)-    step _ (Just []) = return Stop--}---- | Like 'reverse' but several times faster, requires an 'Unbox' instance.------ /O(n) space/------ /Pre-release/-{-# INLINE reverseUnbox #-}-reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a-reverseUnbox =-    A.flattenArraysRev -- unfoldMany A.readRev-        . fromStreamK-        . K.reverse-        . toStreamK-        . A.chunksOf defaultChunkSize---- | Buffer until the next element in sequence arrives. The function argument--- determines the difference in sequence numbers. This could be useful in--- implementing sequenced streams, for example, TCP reassembly.------ /Unimplemented/----{-# INLINE reassembleBy #-}-reassembleBy-    :: -- Monad m =>-       Fold m a b-    -> (a -> a -> Int)-    -> Stream m a-    -> Stream m b-reassembleBy = undefined----------------------------------------------------------------------------------- Position Indexing----------------------------------------------------------------------------------- Adapted from the vector package---- |--- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined)--- >>> indexed = Stream.postscan f--- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0)--- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed------ Pair each element in a stream with its index, starting from index 0.------ >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello"--- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]----{-# INLINE_NORMAL indexed #-}-indexed :: Monad m => Stream m a -> Stream m (Int, a)--- indexed = scanMaybe FL.indexing-indexed (Stream step state) = Stream step' (state, 0)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = i `seq` do-         r <- step (adaptState gst) st-         case r of-             Yield x s -> return $ Yield (i, x) (s, i+1)-             Skip    s -> return $ Skip (s, i)-             Stop      -> return Stop---- Adapted from the vector package---- |--- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)--- >>> indexedR n = Stream.postscan (f n)------ >>> s n = Stream.enumerateFromThen n (n - 1)--- >>> indexedR n = Stream.zipWith (,) (s n)------ Pair each element in a stream with its index, starting from the--- given index @n@ and counting down.------ >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello"--- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]----{-# INLINE_NORMAL indexedR #-}-indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)--- indexedR n = scanMaybe (FL.indexingRev n)-indexedR m (Stream step state) = Stream step' (state, m)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = i `seq` do-         r <- step (adaptState gst) st-         case r of-             Yield x s -> let i' = i - 1-                          in return $ Yield (i, x) (s, i')-             Skip    s -> return $ Skip (s, i)-             Stop      -> return Stop------------------------------------------------------------------------------------ Time Indexing------------------------------------------------------------------------------------ Note: The timestamp stream must be the second stream in the zip so that the--- timestamp is generated after generating the stream element and not before.--- If we do not do that then the following example will generate the same--- timestamp for first two elements:------ Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3---- | Pair each element in a stream with an absolute timestamp, using a clock of--- specified granularity.  The timestamp is generated just before the element--- is consumed.------ >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)]------ /Pre-release/----{-# INLINE timestampWith #-}-timestampWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (AbsTime, a)-timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)---- TBD: check performance vs a custom implementation without using zipWith.------ /Pre-release/----{-# INLINE timestamped #-}-timestamped :: (MonadIO m)-    => Stream m a -> Stream m (AbsTime, a)-timestamped = timestampWith 0.01---- | Pair each element in a stream with relative times starting from 0, using a--- clock with the specified granularity. The time is measured just before the--- element is consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/----{-# INLINE timeIndexWith #-}-timeIndexWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (RelTime64, a)-timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)---- | Pair each element in a stream with relative times starting from 0, using a--- 10 ms granularity clock. The time is measured just before the element is--- consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/----{-# INLINE timeIndexed #-}-timeIndexed :: (MonadIO m)-    => Stream m a -> Stream m (RelTime64, a)-timeIndexed = timeIndexWith 0.01----------------------------------------------------------------------------------- Searching----------------------------------------------------------------------------------- | Find all the indices where the element in the stream satisfies the given--- predicate.------ >>> findIndices p = Stream.scanMaybe (Fold.findIndices p)----{-# INLINE_NORMAL findIndices #-}-findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int-findIndices p (Stream step state) = Stream step' (state, 0)-  where-    {-# INLINE_LATE step' #-}-    step' gst (st, i) = i `seq` do-      r <- step (adaptState gst) st-      return $ case r of-          Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)-          Skip s -> Skip (s, i)-          Stop   -> Stop---- | Find all the indices where the value of the element in the stream is equal--- to the given value.------ >>> elemIndices a = Stream.findIndices (== a)----{-# INLINE elemIndices #-}-elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int-elemIndices a = findIndices (== a)--{-# INLINE_NORMAL slicesBy #-}-slicesBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m (Int, Int)-slicesBy p (Stream step1 state1) = Stream step (Just (state1, 0, 0))--    where--    {-# INLINE_LATE step #-}-    step gst (Just (st, i, len)) = i `seq` len `seq` do-      r <- step1 (adaptState gst) st-      return-        $ case r of-              Yield x s ->-                if p x-                then Yield (i, len + 1) (Just (s, i + len + 1, 0))-                else Skip (Just (s, i, len + 1))-              Skip s -> Skip (Just (s, i, len))-              Stop -> if len == 0 then Stop else Yield (i, len) Nothing-    step _ Nothing = return Stop----------------------------------------------------------------------------------- Rolling map---------------------------------------------------------------------------------data RollingMapState s a = RollingMapGo s a---- | Like 'rollingMap' but with an effectful map function.------ /Pre-release/----{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b--- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f)-rollingMapM f (Stream step1 state1) = Stream step (RollingMapGo state1 Nothing)--    where--    step gst (RollingMapGo s1 curr) = do-        r <- step1 (adaptState gst) s1-        case r of-            Yield x s -> do-                !res <- f curr x-                return $ Yield res $ RollingMapGo s (Just x)-            Skip s -> return $ Skip $ RollingMapGo s curr-            Stop   -> return Stop---- rollingMap is a special case of an incremental sliding fold. It can be--- written as:------ > fld f = slidingWindow 1 (Fold.foldl' (\_ (x,y) -> f y x)--- > rollingMap f = Stream.postscan (fld f) undefined---- | Apply a function on every two successive elements of a stream. The first--- argument of the map function is the previous element and the second argument--- is the current element. When the current element is the first element, the--- previous element is 'Nothing'.------ /Pre-release/----{-# INLINE rollingMap #-}-rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b--- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f)-rollingMap f = rollingMapM (\x y -> return $ f x y)---- | Like 'rollingMap' but requires at least two elements in the stream,--- returns an empty stream otherwise.------ This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.------ /Pre-release/----{-# INLINE rollingMap2 #-}-rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b-rollingMap2 f = catMaybes . rollingMap g--    where--    g Nothing _ = Nothing-    g (Just x) y = Just (f x y)----------------------------------------------------------------------------------- Maybe Streams----------------------------------------------------------------------------------- XXX Will this always fuse properly?---- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'--- elements, and return a stream of values extracted from 'Just'.------ Equivalent to:------ >>> mapMaybe f = Stream.catMaybes . fmap f----{-# INLINE_NORMAL mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b-mapMaybe f = fmap fromJust . filter isJust . map f---- | Like 'mapMaybe' but maps a monadic function.------ Equivalent to:------ >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f------ >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x)----{-# INLINE_NORMAL mapMaybeM #-}-mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f---- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.------ >>> catMaybes = Stream.mapMaybe id--- >>> catMaybes = fmap fromJust . Stream.filter isJust------ /Pre-release/----{-# INLINE catMaybes #-}-catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a--- catMaybes = fmap fromJust . filter isJust-catMaybes (Stream step state) = Stream step1 state--    where--    {-# INLINE_LATE step1 #-}-    step1 gst st = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> do-                return-                    $ case x of-                        Just a -> Yield a s-                        Nothing -> Skip s-            Skip s -> return $ Skip s-            Stop -> return Stop---- | Use a filtering fold on a stream.------ >>> scanMaybe f = Stream.catMaybes . Stream.postscan f----{-# INLINE scanMaybe #-}-scanMaybe :: Monad m => Fold m a (Maybe b) -> Stream m a -> Stream m b-scanMaybe f = catMaybes . postscan f----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.------ >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft------ /Pre-release/----{-# INLINE catLefts #-}-catLefts :: Monad m => Stream m (Either a b) -> Stream m a-catLefts = fmap (fromLeft undefined) . filter isLeft---- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.------ >>> catRights = fmap (fromRight undefined) . Stream.filter isRight------ /Pre-release/----{-# INLINE catRights #-}-catRights :: Monad m => Stream m (Either a b) -> Stream m b-catRights = fmap (fromRight undefined) . filter isRight---- | Remove the either wrapper and flatten both lefts and as well as rights in--- the output stream.------ >>> catEithers = fmap (either id id)------ /Pre-release/----{-# INLINE catEithers #-}-catEithers :: Monad m => Stream m (Either a a) -> Stream m a-catEithers = fmap (either id id)----------------------------------------------------------------------------------- Splitting----------------------------------------------------------------------------------- | Split on an infixed separator element, dropping the separator.  The--- supplied 'Fold' is applied on the split segments.  Splits the stream on--- separator elements determined by the supplied predicate, separator is--- considered as infixed between two segments:------ >>> splitOn' p xs = Stream.fold Fold.toList $ Stream.splitOn p Fold.toList (Stream.fromList xs)--- >>> splitOn' (== '.') "a.b"--- ["a","b"]------ An empty stream is folded to the default value of the fold:------ >>> splitOn' (== '.') ""--- [""]------ If one or both sides of the separator are missing then the empty segment on--- that side is folded to the default output of the fold:------ >>> splitOn' (== '.') "."--- ["",""]------ >>> splitOn' (== '.') ".a"--- ["","a"]------ >>> splitOn' (== '.') "a."--- ["a",""]------ >>> splitOn' (== '.') "a..b"--- ["a","","b"]------ splitOn is an inverse of intercalating single element:------ > Stream.intercalate (Stream.fromPure '.') Unfold.fromList . Stream.splitOn (== '.') Fold.toList === id------ Assuming the input stream does not contain the separator:------ > Stream.splitOn (== '.') Fold.toList . Stream.intercalate (Stream.fromPure '.') Unfold.fromList === id----{-# INLINE splitOn #-}-splitOn :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b-splitOn predicate f =-    -- We can express the infix splitting in terms of optional suffix split-    -- fold.  After applying a suffix split fold repeatedly if the last segment-    -- ends with a suffix then we need to return the default output of the fold-    -- after that to make it an infix split.-    ---    -- Alternately, we can also express it using an optional prefix split fold.-    -- If the first segment starts with a prefix then we need to emit the-    -- default output of the fold before that to make it an infix split, and-    -- then apply prefix split fold repeatedly.-    ---    -- Since a suffix split fold can be easily expressed using a-    -- non-backtracking fold, we use that.-    foldManyPost (FL.takeEndBy_ predicate f)
− src/Streamly/Internal/Data/Stream/StreamD/Transformer.hs 
@@ -1,182 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Transformer--- Copyright   : (c) 2018 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ Transform the underlying monad of a stream using a monad transfomer.--module Streamly.Internal.Data.Stream.StreamD.Transformer-    (-      foldlT-    , foldrT--    -- * Transform Inner Monad-    , liftInner-    , runReaderT-    , usingReaderT-    , evalStateT-    , runStateT-    , usingStateT-    )-where--#include "inline.hs"--import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.Reader (ReaderT)-import Control.Monad.Trans.State.Strict (StateT)-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.SVar.Type (defState, adaptState)--import qualified Control.Monad.Trans.Reader as Reader-import qualified Control.Monad.Trans.State.Strict as State--import Streamly.Internal.Data.Stream.StreamD.Type--#include "DocTestDataStream.hs"---- | Lazy left fold to a transformer monad.----{-# INLINE_NORMAL foldlT #-}-foldlT :: (Monad m, Monad (s m), MonadTrans s)-    => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b-foldlT fstep begin (Stream step state) = go SPEC begin state-  where-    go !_ acc st = do-        r <- lift $ step defState st-        case r of-            Yield x s -> go SPEC (fstep acc x) s-            Skip s -> go SPEC acc s-            Stop   -> acc---- | Right fold to a transformer monad.  This is the most general right fold--- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'--- implementation can be more efficient:------ >>> foldrS = Stream.foldrT------ >>> step f x xs = lift $ f x (runIdentityT xs)--- >>> foldrM f z s = runIdentityT $ Stream.foldrT (step f) (lift z) s------ 'foldrT' can be used to translate streamly streams to other transformer--- monads e.g.  to a different streaming type.------ /Pre-release/-{-# INLINE_NORMAL foldrT #-}-foldrT :: (Monad m, Monad (t m), MonadTrans t)-    => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b-foldrT f final (Stream step state) = go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = do-          r <- lift $ step defState st-          case r of-            Yield x s -> f x (go SPEC s)-            Skip s    -> go SPEC s-            Stop      -> final------------------------------------------------------------------------------------ Transform Inner Monad------------------------------------------------------------------------------------ | Lift the inner monad @m@ of @Stream m a@ to @t m@ where @t@ is a monad--- transformer.----{-# INLINE_NORMAL liftInner #-}-liftInner :: (Monad m, MonadTrans t, Monad (t m))-    => Stream m a -> Stream (t m) a-liftInner (Stream step state) = Stream step' state-    where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- lift $ step (adaptState gst) st-        return $ case r of-            Yield x s -> Yield x s-            Skip s    -> Skip s-            Stop      -> Stop----------------------------------------------------------------------------------- Sharing read only state in a stream----------------------------------------------------------------------------------- | Evaluate the inner monad of a stream as 'ReaderT'.----{-# INLINE_NORMAL runReaderT #-}-runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a-runReaderT env (Stream step state) = Stream step' (state, env)-    where-    {-# INLINE_LATE step' #-}-    step' gst (st, action) = do-        sv <- action-        r <- Reader.runReaderT (step (adaptState gst) st) sv-        return $ case r of-            Yield x s -> Yield x (s, return sv)-            Skip  s   -> Skip (s, return sv)-            Stop      -> Stop---- | Run a stream transformation using a given environment.----{-# INLINE usingReaderT #-}-usingReaderT-    :: Monad m-    => m r-    -> (Stream (ReaderT r m) a -> Stream (ReaderT r m) a)-    -> Stream m a-    -> Stream m a-usingReaderT r f xs = runReaderT r $ f $ liftInner xs----------------------------------------------------------------------------------- Sharing read write state in a stream----------------------------------------------------------------------------------- | Evaluate the inner monad of a stream as 'StateT'.------ >>> evalStateT s = fmap snd . Stream.runStateT s----{-# INLINE_NORMAL evalStateT #-}-evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a-evalStateT initial (Stream step state) = Stream step' (state, initial)-    where-    {-# INLINE_LATE step' #-}-    step' gst (st, action) = do-        sv <- action-        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv-        return $ case r of-            Yield x s -> Yield x (s, return sv')-            Skip  s   -> Skip (s, return sv')-            Stop      -> Stop---- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting--- state and value pair after each step.----{-# INLINE_NORMAL runStateT #-}-runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)-runStateT initial (Stream step state) = Stream step' (state, initial)-    where-    {-# INLINE_LATE step' #-}-    step' gst (st, action) = do-        sv <- action-        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv-        return $ case r of-            Yield x s -> Yield (sv', x) (s, return sv')-            Skip  s   -> Skip (s, return sv')-            Stop      -> Stop---- | Run a stateful (StateT) stream transformation using a given state.------ >>> usingStateT s f = Stream.evalStateT s . f . Stream.liftInner------ See also: 'scan'----{-# INLINE usingStateT #-}-usingStateT-    :: Monad m-    => m s-    -> (Stream (StateT s m) a -> Stream (StateT s m) a)-    -> Stream m a-    -> Stream m a-usingStateT s f = evalStateT s . f . liftInner
− src/Streamly/Internal/Data/Stream/StreamD/Type.hs 
@@ -1,2074 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.StreamD.Type--- Copyright   : (c) 2018 Composewell Technologies---               (c) Roman Leshchinskiy 2008-2010--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC---- The stream type is inspired by the vector package.  A few functions in this--- module have been originally adapted from the vector package (c) Roman--- Leshchinskiy. See the notes in specific functions.--module Streamly.Internal.Data.Stream.StreamD.Type-    (-    -- * The stream type-      Step (..)-    -- XXX UnStream is exported to avoid a performance issue in some-    -- combinators if we use the pattern synonym "Stream".-    , Stream (Stream, UnStream)--    -- * CrossStream type wrapper-    , CrossStream-    , unCross-    , mkCross--    -- * Conversion to StreamK-    , fromStreamK-    , toStreamK--    -- * From Unfold-    , unfold--    -- * Construction-    -- ** Primitives-    , nilM-    , consM--    -- ** From Values-    , fromPure-    , fromEffect--    -- ** From Containers-    , Streamly.Internal.Data.Stream.StreamD.Type.fromList--    -- * Elimination-    -- ** Primitives-    , uncons--    -- ** Strict Left Folds-    , Streamly.Internal.Data.Stream.StreamD.Type.fold-    , foldBreak-    , foldAddLazy-    , foldAdd-    , foldEither--    , Streamly.Internal.Data.Stream.StreamD.Type.foldl'-    , foldlM'-    , foldlx'-    , foldlMx'--    -- ** Lazy Right Folds-    , foldrM-    , foldrMx-    , Streamly.Internal.Data.Stream.StreamD.Type.foldr-    , foldrS--    -- ** Specific Folds-    , drain-    , Streamly.Internal.Data.Stream.StreamD.Type.toList--    -- * Mapping-    , map-    , mapM--    -- * Stateful Filters-    , take-    , takeWhile-    , takeWhileM-    , takeEndBy-    , takeEndByM--    -- * Combining Two Streams-    -- ** Zipping-    , zipWithM-    , zipWith--    -- ** Cross Product-    , crossApply-    , crossApplyFst-    , crossApplySnd-    , crossWith-    , cross--    -- * Unfold Many-    , ConcatMapUState (..)-    , unfoldMany--    -- * Concat-    , concatEffect-    , concatMap-    , concatMapM-    , concat--    -- * Unfold Iterate-    , unfoldIterateDfs-    , unfoldIterateBfs-    , unfoldIterateBfsRev--    -- * Concat Iterate-    , concatIterateScan-    , concatIterateDfs-    , concatIterateBfs-    , concatIterateBfsRev--    -- * Fold Many-    , FoldMany (..) -- for inspection testing-    , FoldManyPost (..)-    , foldMany-    , foldManyPost-    , groupsOf-    , refoldMany--    -- * Fold Iterate-    , reduceIterateBfs-    , foldIterateBfs--    -- * Multi-stream folds-    , eqBy-    , cmpBy-    )-where--#include "inline.hs"--import Control.Applicative (liftA2)-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.IO.Class (MonadIO(..))-import Data.Foldable (Foldable(foldl'), fold, foldr)-import Data.Functor (($>))-import Data.Functor.Identity (Identity(..))-import Data.Maybe (fromMaybe)-import Data.Semigroup (Endo(..))-import Fusion.Plugin.Types (Fuse(..))-import GHC.Base (build)-import GHC.Exts (IsList(..), IsString(..), oneShot)-import GHC.Types (SPEC(..))-import Prelude hiding (map, mapM, take, concatMap, takeWhile, zipWith, concat)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import Streamly.Internal.BaseCompat ((#.))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.Refold.Type (Refold(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step (..))-import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)-import Streamly.Internal.Data.Unfold.Type (Unfold(..))--import qualified Streamly.Internal.Data.Fold.Type as FL hiding (foldr)-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K-#ifdef USE_UNFOLDS_EVERYWHERE-import qualified Streamly.Internal.Data.Unfold.Type as Unfold-#endif--#include "DocTestDataStream.hs"----------------------------------------------------------------------------------- The direct style stream type----------------------------------------------------------------------------------- gst = global state---- | A stream consists of a step function that generates the next step given a--- current state, and the current state.-data Stream m a =-    forall s. UnStream (State K.StreamK m a -> s -> m (Step s a)) s---- XXX This causes perf trouble when pattern matching with "Stream"  in a--- recursive way, e.g. in uncons, foldBreak, concatMap. We need to get rid of--- this.-unShare :: Stream m a -> Stream m a-unShare (UnStream step state) = UnStream step' state-    where step' gst = step (adaptState gst)--pattern Stream :: (State K.StreamK m a -> s -> m (Step s a)) -> s -> Stream m a-pattern Stream step state <- (unShare -> UnStream step state)-    where Stream = UnStream--{-# COMPLETE Stream #-}----------------------------------------------------------------------------------- Primitives----------------------------------------------------------------------------------- | A stream that terminates without producing any output, but produces a side--- effect.------ >>> Stream.fold Fold.toList (Stream.nilM (print "nil"))--- "nil"--- []------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Applicative m => m b -> Stream m a-nilM m = Stream (\_ _ -> m $> Stop) ()---- | Like 'cons' but fuses an effect instead of a pure value.-{-# INLINE_NORMAL consM #-}-consM :: Applicative m => m a -> Stream m a -> Stream m a-consM m (Stream step state) = Stream step1 Nothing--    where--    {-# INLINE_LATE step1 #-}-    step1 _ Nothing = (`Yield` Just state) <$> m-    step1 gst (Just st) = do-          (\case-            Yield a s -> Yield a (Just s)-            Skip  s   -> Skip (Just s)-            Stop      -> Stop) <$> step gst st---- | Decompose a stream into its head and tail. If the stream is empty, returns--- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is--- the head of the stream and @ma@ its tail.------ Properties:------ >>> Nothing <- Stream.uncons Stream.nil--- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil)------ This can be used to consume the stream in an imperative manner one element--- at a time, as it just breaks down the stream into individual elements and we--- can loop over them as we deem fit. For example, this can be used to convert--- a streamly stream into other stream types.------ All the folds in this module can be expressed in terms of 'uncons', however,--- this is generally less efficient than specific folds because it takes apart--- the stream one element at a time, therefore, does not take adavantage of--- stream fusion.------ 'foldBreak' is a more general way of consuming a stream piecemeal.------ >>> :{--- uncons xs = do---     r <- Stream.foldBreak Fold.one xs---     return $ case r of---         (Nothing, _) -> Nothing---         (Just h, t) -> Just (h, t)--- :}----{-# INLINE_NORMAL uncons #-}-uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons (UnStream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield x s -> return $ Just (x, Stream step s)-            Skip  s   -> go SPEC s-            Stop      -> return Nothing----------------------------------------------------------------------------------- From 'Unfold'---------------------------------------------------------------------------------data UnfoldState s = UnfoldNothing | UnfoldJust s---- | Convert an 'Unfold' into a stream by supplying it an input seed.------ >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello")--- >>> Stream.fold Fold.drain s--- hello--- hello--- hello----{-# INLINE_NORMAL unfold #-}-unfold :: Applicative m => Unfold m a b -> a -> Stream m b-unfold (Unfold ustep inject) seed = Stream step UnfoldNothing--    where--    {-# INLINE_LATE step #-}-    step _ UnfoldNothing = Skip . UnfoldJust <$> inject seed-    step _ (UnfoldJust st) = do-        (\case-            Yield x s -> Yield x (UnfoldJust s)-            Skip s    -> Skip (UnfoldJust s)-            Stop      -> Stop) <$> ustep st----------------------------------------------------------------------------------- From Values----------------------------------------------------------------------------------- | Create a singleton stream from a pure value.------ >>> fromPure a = a `Stream.cons` Stream.nil--- >>> fromPure = pure--- >>> fromPure = Stream.fromEffect . pure----{-# INLINE_NORMAL fromPure #-}-fromPure :: Applicative m => a -> Stream m a-fromPure x = Stream (\_ s -> pure $ step undefined s) True-  where-    {-# INLINE_LATE step #-}-    step _ True  = Yield x False-    step _ False = Stop---- | Create a singleton stream from a monadic action.------ >>> fromEffect m = m `Stream.consM` Stream.nil--- >>> fromEffect = Stream.sequence . Stream.fromPure------ >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello")--- hello----{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Applicative m => m a -> Stream m a-fromEffect m = Stream step True--    where--    {-# INLINE_LATE step #-}-    step _ True  = (`Yield` False) <$> m-    step _ False = pure Stop----------------------------------------------------------------------------------- From Containers----------------------------------------------------------------------------------- Adapted from the vector package.---- | Construct a stream from a list of pure values.-{-# INLINE_LATE fromList #-}-fromList :: Applicative m => [a] -> Stream m a-#ifdef USE_UNFOLDS_EVERYWHERE-fromList = unfold Unfold.fromList-#else-fromList = Stream step-  where-    {-# INLINE_LATE step #-}-    step _ (x:xs) = pure $ Yield x xs-    step _ []     = pure Stop-#endif----------------------------------------------------------------------------------- Conversions From/To----------------------------------------------------------------------------------- | Convert a CPS encoded StreamK to direct style step encoded StreamD-{-# INLINE_LATE fromStreamK #-}-fromStreamK :: Applicative m => K.StreamK m a -> Stream m a-fromStreamK = Stream step-    where-    step gst m1 =-        let stop       = pure Stop-            single a   = pure $ Yield a K.nil-            yieldk a r = pure $ Yield a r-         in K.foldStreamShared gst yieldk single stop m1---- | Convert a direct style step encoded StreamD to a CPS encoded StreamK-{-# INLINE_LATE toStreamK #-}-toStreamK :: Monad m => Stream m a -> K.StreamK m a-toStreamK (Stream step state) = go state-    where-    go st = K.MkStream $ \gst yld _ stp ->-      let go' ss = do-           r <- step gst ss-           case r of-               Yield x s -> yld x (go s)-               Skip  s   -> go' s-               Stop      -> stp-      in go' st--#ifndef DISABLE_FUSION-{-# RULES "fromStreamK/toStreamK fusion"-    forall s. toStreamK (fromStreamK s) = s #-}-{-# RULES "toStreamK/fromStreamK fusion"-    forall s. fromStreamK (toStreamK s) = s #-}-#endif----------------------------------------------------------------------------------- Running a 'Fold'----------------------------------------------------------------------------------- >>> fold f = Fold.extractM . Stream.foldAddLazy f--- >>> fold f = Stream.fold Fold.one . Stream.foldManyPost f--- >>> fold f = Fold.extractM <=< Stream.foldAdd f---- | Fold a stream using the supplied left 'Fold' and reducing the resulting--- expression strictly at each step. The behavior is similar to 'foldl''. A--- 'Fold' can terminate early without consuming the full stream. See the--- documentation of individual 'Fold's for termination behavior.------ Definitions:------ >>> fold f = fmap fst . Stream.foldBreak f--- >>> fold f = Stream.parse (Parser.fromFold f)------ Example:------ >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)--- 5050----{-# INLINE_NORMAL fold #-}-fold :: Monad m => Fold m a b -> Stream m a -> m b-fold fld strm = do-    (b, _) <- foldBreak fld strm-    return b---- | Fold resulting in either breaking the stream or continuation of the fold.--- Instead of supplying the input stream in one go we can run the fold multiple--- times, each time supplying the next segment of the input stream. If the fold--- has not yet finished it returns a fold that can be run again otherwise it--- returns the fold result and the residual stream.------ /Internal/-{-# INLINE_NORMAL foldEither #-}-foldEither :: Monad m =>-    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))-foldEither (Fold fstep begin done) (UnStream step state) = do-    res <- begin-    case res of-        FL.Partial fs -> go SPEC fs state-        FL.Done fb -> return $! Right (fb, Stream step state)--    where--    {-# INLINE go #-}-    go !_ !fs st = do-        r <- step defState st-        case r of-            Yield x s -> do-                res <- fstep fs x-                case res of-                    FL.Done b -> return $! Right (b, Stream step s)-                    FL.Partial fs1 -> go SPEC fs1 s-            Skip s -> go SPEC fs s-            Stop -> return $! Left (Fold fstep (return $ FL.Partial fs) done)---- | Like 'fold' but also returns the remaining stream. The resulting stream--- would be 'Stream.nil' if the stream finished before the fold.----{-# INLINE_NORMAL foldBreak #-}-foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)-foldBreak fld strm = do-    r <- foldEither fld strm-    case r of-        Right res -> return res-        Left (Fold _ initial extract) -> do-            res <- initial-            case res of-                FL.Done _ -> error "foldBreak: unreachable state"-                FL.Partial s -> do-                    b <- extract s-                    return (b, nil)--    where--    nil = Stream (\_ _ -> return Stop) ()---- | Append a stream to a fold lazily to build an accumulator incrementally.------ Example, to continue folding a list of streams on the same sum fold:------ >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]]--- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams--- >>> Stream.fold f Stream.nil--- 55----{-# INLINE_NORMAL foldAddLazy #-}-foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b-foldAddLazy (Fold fstep finitial fextract) (Stream sstep state) =-    Fold fstep initial fextract--    where--    initial = do-        res <- finitial-        case res of-            FL.Partial fs -> go SPEC fs state-            FL.Done fb -> return $ FL.Done fb--    {-# INLINE go #-}-    go !_ !fs st = do-        r <- sstep defState st-        case r of-            Yield x s -> do-                res <- fstep fs x-                case res of-                    FL.Done b -> return $ FL.Done b-                    FL.Partial fs1 -> go SPEC fs1 s-            Skip s -> go SPEC fs s-            Stop -> return $ FL.Partial fs---- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce---- |--- >>> foldAdd = flip Fold.addStream----foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)-foldAdd f =-    Streamly.Internal.Data.Stream.StreamD.Type.fold (FL.duplicate f)----------------------------------------------------------------------------------- Right Folds----------------------------------------------------------------------------------- Adapted from the vector package.------ XXX Use of SPEC constructor in folds causes 2x performance degradation in--- one shot operations, but helps immensely in operations composed of multiple--- combinators or the same combinator many times. There seems to be an--- opportunity to optimize here, can we get both, better perf for single ops--- as well as composed ops? Without SPEC, all single operation benchmarks--- become 2x faster.---- The way we want a left fold to be strict, dually we want the right fold to--- be lazy.  The correct signature of the fold function to keep it lazy must be--- (a -> m b -> m b) instead of (a -> b -> m b). We were using the latter--- earlier, which is incorrect. In the latter signature we have to feed the--- value to the fold function after evaluating the monadic action, depending on--- the bind behavior of the monad, the action may get evaluated immediately--- introducing unnecessary strictness to the fold. If the implementation is--- lazy the following example, must work:------ S.foldrM (\x t -> if x then return t else return False) (return True)---  (S.fromList [False,undefined] :: Stream IO Bool)---- | Right associative/lazy pull fold. @foldrM build final stream@ constructs--- an output structure using the step function @build@. @build@ is invoked with--- the next input element and the remaining (lazy) tail of the output--- structure. It builds a lazy output expression using the two. When the "tail--- structure" in the output expression is evaluated it calls @build@ again thus--- lazily consuming the input @stream@ until either the output expression built--- by @build@ is free of the "tail" or the input is exhausted in which case--- @final@ is used as the terminating case for the output structure. For more--- details see the description in the previous section.------ Example, determine if any element is 'odd' in a stream:------ >>> s = Stream.fromList (2:4:5:undefined)--- >>> step x xs = if odd x then return True else xs--- >>> Stream.foldrM step (return False) s--- True----{-# INLINE_NORMAL foldrM #-}-foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-foldrM f z (Stream step state) = go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = do-          r <- step defState st-          case r of-            Yield x s -> f x (go SPEC s)-            Skip s    -> go SPEC s-            Stop      -> z--{-# INLINE_NORMAL foldrMx #-}-foldrMx :: Monad m-    => (a -> m x -> m x) -> m x -> (m x -> m b) -> Stream m a -> m b-foldrMx fstep final convert (Stream step state) = convert $ go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = do-          r <- step defState st-          case r of-            Yield x s -> fstep x (go SPEC s)-            Skip s    -> go SPEC s-            Stop      -> final---- XXX Should we make all argument strict wherever we use SPEC?---- Note that foldr works on pure values, therefore it becomes necessarily--- strict when the monad m is strict. In that case it cannot terminate early,--- it would evaluate all of its input.  Though, this should work fine with lazy--- monads. For example, if "any" is implemented using "foldr" instead of--- "foldrM" it performs the same with Identity monad but performs 1000x slower--- with IO monad.---- | Right fold, lazy for lazy monads and pure streams, and strict for strict--- monads.------ Please avoid using this routine in strict monads like IO unless you need a--- strict right fold. This is provided only for use in lazy monads (e.g.--- Identity) or pure streams. Note that with this signature it is not possible--- to implement a lazy foldr when the monad @m@ is strict. In that case it--- would be strict in its accumulator and therefore would necessarily consume--- all its input.------ >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z)------ Note: This is similar to Fold.foldr' (the right fold via left fold), but--- could be more efficient.----{-# INLINE_NORMAL foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b-foldr f z = foldrM (liftA2 f . return) (return z)---- this performs horribly, should not be used-{-# INLINE_NORMAL foldrS #-}-foldrS-    :: Monad m-    => (a -> Stream m b -> Stream m b)-    -> Stream m b-    -> Stream m a-    -> Stream m b-foldrS f final (Stream step state) = go SPEC state-  where-    {-# INLINE_LATE go #-}-    go !_ st = concatEffect $ fmap g $ step defState st--    g r =-        case r of-          Yield x s -> f x (go SPEC s)-          Skip s    -> go SPEC s-          Stop      -> final----------------------------------------------------------------------------------- Left Folds----------------------------------------------------------------------------------- XXX run begin action only if the stream is not empty.-{-# INLINE_NORMAL foldlMx' #-}-foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b-foldlMx' fstep begin done (Stream step state) =-    begin >>= \x -> go SPEC x state-  where-    -- XXX !acc?-    {-# INLINE_LATE go #-}-    go !_ acc st = acc `seq` do-        r <- step defState st-        case r of-            Yield x s -> do-                acc' <- fstep acc x-                go SPEC acc' s-            Skip s -> go SPEC acc s-            Stop   -> done acc--{-# INLINE foldlx' #-}-foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b-foldlx' fstep begin done =-    foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done)---- Adapted from the vector package.--- XXX implement in terms of foldlMx'?-{-# INLINE_NORMAL foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b-foldlM' fstep mbegin (Stream step state) = do-    begin <- mbegin-    go SPEC begin state-  where-    {-# INLINE_LATE go #-}-    go !_ acc st = acc `seq` do-        r <- step defState st-        case r of-            Yield x s -> do-                acc' <- fstep acc x-                go SPEC acc' s-            Skip s -> go SPEC acc s-            Stop   -> return acc--{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b-foldl' fstep begin = foldlM' (\b a -> return (fstep b a)) (return begin)----------------------------------------------------------------------------------- Special folds----------------------------------------------------------------------------------- >>> drain = mapM_ (\_ -> return ())---- |--- Definitions:------ >>> drain = Stream.fold Fold.drain--- >>> drain = Stream.foldrM (\_ xs -> xs) (return ())------ Run a stream, discarding the results.----{-# INLINE_LATE drain #-}-drain :: Monad m => Stream m a -> m ()--- drain = foldrM (\_ xs -> xs) (return ())-drain (Stream step state) = go SPEC state-  where-    go !_ st = do-        r <- step defState st-        case r of-            Yield _ s -> go SPEC s-            Skip s    -> go SPEC s-            Stop      -> return ()----------------------------------------------------------------------------------- To Containers----------------------------------------------------------------------------------- This toList impl is faster (30% on streaming-benchmarks) than the--- corresponding left fold. The left fold retains an additional argument in the--- recursive loop.------ Core for the right fold loop:------ main_$s$wgo1---   = \ sc_s3e6 sc1_s3e5 ->---       case ># sc1_s3e5 100000# of {---         __DEFAULT ->---           case main_$s$wgo1 sc_s3e6 (+# sc1_s3e5 1#) of------ Core for the left fold loop:------  main_$s$wgo1---   = \ sc_s3oT sc1_s3oS sc2_s3oR ->---       case sc2_s3oR of fs2_a2lw { __DEFAULT ->---       case ># sc1_s3oS 100000# of {---         __DEFAULT ->---           let { wild_a2og = I# sc1_s3oS } in---           main_$s$wgo1---             sc_s3oT (+# sc1_s3oS 1#) (\ x_X9 -> fs2_a2lw (: wild_a2og x_X9));---- |--- Definitions:------ >>> toList = Stream.foldr (:) []--- >>> toList = Stream.fold Fold.toList------ Convert a stream into a list in the underlying monad. The list can be--- consumed lazily in a lazy monad (e.g. 'Identity'). In a strict monad (e.g.--- IO) the whole list is generated and buffered before it can be consumed.------ /Warning!/ working on large lists accumulated as buffers in memory could be--- very inefficient, consider using "Streamly.Data.Array" instead.------ Note that this could a bit more efficient compared to @Stream.fold--- Fold.toList@, and it can fuse with pure list consumers.----{-# INLINE_NORMAL toList #-}-toList :: Monad m => Stream m a -> m [a]-toList = Streamly.Internal.Data.Stream.StreamD.Type.foldr (:) []---- Use foldr/build fusion to fuse with list consumers--- This can be useful when using the IsList instance-{-# INLINE_LATE toListFB #-}-toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b-toListFB c n (Stream step state) = go state-  where-    go st = case runIdentity (step defState st) of-             Yield x s -> x `c` go s-             Skip s    -> go s-             Stop      -> n--{-# RULES "toList Identity" Streamly.Internal.Data.Stream.StreamD.Type.toList = toListId #-}-{-# INLINE_EARLY toListId #-}-toListId :: Stream Identity a -> Identity [a]-toListId s = Identity $ build (\c n -> toListFB c n s)----------------------------------------------------------------------------------- Multi-stream folds----------------------------------------------------------------------------------- Adapted from the vector package.---- | Compare two streams for equality-{-# INLINE_NORMAL eqBy #-}-eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool-eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2-  where-    eq_loop0 !_ s1 s2 = do-      r <- step1 defState s1-      case r of-        Yield x s1' -> eq_loop1 SPEC x s1' s2-        Skip    s1' -> eq_loop0 SPEC   s1' s2-        Stop        -> eq_null s2--    eq_loop1 !_ x s1 s2 = do-      r <- step2 defState s2-      case r of-        Yield y s2'-          | eq x y    -> eq_loop0 SPEC   s1 s2'-          | otherwise -> return False-        Skip    s2'   -> eq_loop1 SPEC x s1 s2'-        Stop          -> return False--    eq_null s2 = do-      r <- step2 defState s2-      case r of-        Yield _ _ -> return False-        Skip s2'  -> eq_null s2'-        Stop      -> return True---- Adapted from the vector package.---- | Compare two streams lexicographically.-{-# INLINE_NORMAL cmpBy #-}-cmpBy-    :: Monad m-    => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering-cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2-  where-    cmp_loop0 !_ s1 s2 = do-      r <- step1 defState s1-      case r of-        Yield x s1' -> cmp_loop1 SPEC x s1' s2-        Skip    s1' -> cmp_loop0 SPEC   s1' s2-        Stop        -> cmp_null s2--    cmp_loop1 !_ x s1 s2 = do-      r <- step2 defState s2-      case r of-        Yield y s2' -> case x `cmp` y of-                         EQ -> cmp_loop0 SPEC s1 s2'-                         c  -> return c-        Skip    s2' -> cmp_loop1 SPEC x s1 s2'-        Stop        -> return GT--    cmp_null s2 = do-      r <- step2 defState s2-      case r of-        Yield _ _ -> return LT-        Skip s2'  -> cmp_null s2'-        Stop      -> return EQ----------------------------------------------------------------------------------- Transformations----------------------------------------------------------------------------------- Adapted from the vector package.---- |--- >>> mapM f = Stream.sequence . fmap f------ Apply a monadic function to each element of the stream and replace it with--- the output of the resulting action.------ >>> s = Stream.fromList ["a", "b", "c"]--- >>> Stream.fold Fold.drain $ Stream.mapM putStr s--- abc----{-# INLINE_NORMAL mapM #-}-mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-mapM f (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> f x >>= \a -> return $ Yield a s-            Skip s    -> return $ Skip s-            Stop      -> return Stop--{-# INLINE map #-}-map :: Monad m => (a -> b) -> Stream m a -> Stream m b-map f = mapM (return . f)---- (Functor m) based implementation of fmap does not fuse well in--- streaming-benchmarks. XXX need to investigate why.-instance Monad m => Functor (Stream m) where-    {-# INLINE fmap #-}-    fmap = map--    {-# INLINE (<$) #-}-    (<$) = fmap . const----------------------------------------------------------------------------------- Lists----------------------------------------------------------------------------------- XXX Show instance is 10x slower compared to read, we can do much better.--- The list show instance itself is really slow.---- XXX The default definitions of "<" in the Ord instance etc. do not perform--- well, because they do not get inlined. Need to add INLINE in Ord class in--- base?--instance IsList (Stream Identity a) where-    type (Item (Stream Identity a)) = a--    {-# INLINE fromList #-}-    fromList = Streamly.Internal.Data.Stream.StreamD.Type.fromList--    {-# INLINE toList #-}-    toList = runIdentity . Streamly.Internal.Data.Stream.StreamD.Type.toList--instance Eq a => Eq (Stream Identity a) where-    {-# INLINE (==) #-}-    (==) xs ys = runIdentity $ eqBy (==) xs ys--instance Ord a => Ord (Stream Identity a) where-    {-# INLINE compare #-}-    compare xs ys = runIdentity $ cmpBy compare xs ys--    {-# INLINE (<) #-}-    x < y =-        case compare x y of-            LT -> True-            _ -> False--    {-# INLINE (<=) #-}-    x <= y =-        case compare x y of-            GT -> False-            _ -> True--    {-# INLINE (>) #-}-    x > y =-        case compare x y of-            GT -> True-            _ -> False--    {-# INLINE (>=) #-}-    x >= y =-        case compare x y of-            LT -> False-            _ -> True--    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y--instance Show a => Show (Stream Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (GHC.Exts.toList dl)--instance Read a => Read (Stream Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        Streamly.Internal.Data.Stream.StreamD.Type.fromList <$> readPrec--    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (Stream Identity a) where-    {-# INLINE fromString #-}-    fromString = Streamly.Internal.Data.Stream.StreamD.Type.fromList------------------------------------------------------------------------------------ Foldable------------------------------------------------------------------------------------ The default Foldable instance has several issues:--- 1) several definitions do not have INLINE on them, so we provide---    re-implementations with INLINE pragmas.--- 2) the definitions of sum/product/maximum/minimum are inefficient as they---    use right folds, they cannot run in constant memory. We provide---    implementations using strict left folds here.---- There is no Traversable instance because, there is no scalable cons for--- StreamD, use toList and fromList instead.--instance (Foldable m, Monad m) => Foldable (Stream m) where--    {-# INLINE foldMap #-}-    foldMap f =-        Data.Foldable.fold-            . Streamly.Internal.Data.Stream.StreamD.Type.foldr (mappend . f) mempty--    {-# INLINE foldr #-}-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    {-# INLINE foldl' #-}-    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0-        where f' x k = oneShot $ \z -> k $! f z x--    {-# INLINE length #-}-    length = Data.Foldable.foldl' (\n _ -> n + 1) 0--    {-# INLINE elem #-}-    elem = any . (==)--    {-# INLINE maximum #-}-    maximum =-          fromMaybe (errorWithoutStackTrace "maximum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMax Nothing'--        where--        getMax Nothing' x = Just' x-        getMax (Just' mx) x = Just' $! max mx x--    {-# INLINE minimum #-}-    minimum =-          fromMaybe (errorWithoutStackTrace "minimum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMin Nothing'--        where--        getMin Nothing' x = Just' x-        getMin (Just' mn) x = Just' $! min mn x--    {-# INLINE sum #-}-    sum = Data.Foldable.foldl' (+) 0--    {-# INLINE product #-}-    product = Data.Foldable.foldl' (*) 1------------------------------------------------------------------------------------ Filtering------------------------------------------------------------------------------------ Adapted from the vector package.---- | Take first 'n' elements from the stream and discard the rest.----{-# INLINE_NORMAL take #-}-take :: Applicative m => Int -> Stream m a -> Stream m a-take n (Stream step state) = n `seq` Stream step' (state, 0)--    where--    {-# INLINE_LATE step' #-}-    step' gst (st, i) | i < n = do-        (\case-            Yield x s -> Yield x (s, i + 1)-            Skip s    -> Skip (s, i)-            Stop      -> Stop) <$> step gst st-    step' _ (_, _) = pure Stop---- Adapted from the vector package.---- | Same as 'takeWhile' but with a monadic predicate.----{-# INLINE_NORMAL takeWhileM #-}-takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x))-takeWhileM f (Stream step state) = Stream step' state-  where-    {-# INLINE_LATE step' #-}-    step' gst st = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                return $ if b then Yield x s else Stop-            Skip s -> return $ Skip s-            Stop   -> return Stop---- | End the stream as soon as the predicate fails on an element.----{-# INLINE takeWhile #-}-takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-takeWhile f = takeWhileM (return . f)---- Like takeWhile but with an inverted condition and also taking--- the matching element.--{-# INLINE_NORMAL takeEndByM #-}-takeEndByM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-takeEndByM f (Stream step state) = Stream step' (Just state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (Just st) = do-        r <- step gst st-        case r of-            Yield x s -> do-                b <- f x-                return $-                    if not b-                    then Yield x (Just s)-                    else Yield x Nothing-            Skip s -> return $ Skip (Just s)-            Stop   -> return Stop--    step' _ Nothing = return Stop--{-# INLINE takeEndBy #-}-takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a-takeEndBy f = takeEndByM (return . f)----------------------------------------------------------------------------------- Zipping----------------------------------------------------------------------------------- | Like 'zipWith' but using a monadic zipping function.----{-# INLINE_NORMAL zipWithM #-}-zipWithM :: Monad m-    => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c-zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)-  where-    {-# INLINE_LATE step #-}-    step gst (sa, sb, Nothing) = do-        r <- stepa (adaptState gst) sa-        return $-          case r of-            Yield x sa' -> Skip (sa', sb, Just x)-            Skip sa'    -> Skip (sa', sb, Nothing)-            Stop        -> Stop--    step gst (sa, sb, Just x) = do-        r <- stepb (adaptState gst) sb-        case r of-            Yield y sb' -> do-                z <- f x y-                return $ Yield z (sa, sb', Nothing)-            Skip sb' -> return $ Skip (sa, sb', Just x)-            Stop     -> return Stop--{-# RULES "zipWithM xs xs"-    forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}---- | Stream @a@ is evaluated first, followed by stream @b@, the resulting--- elements @a@ and @b@ are then zipped using the supplied zip function and the--- result @c@ is yielded to the consumer.------ If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends--- first, the element @a@ from previous evaluation of stream @a@ is discarded.------ >>> s1 = Stream.fromList [1,2,3]--- >>> s2 = Stream.fromList [4,5,6]--- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2--- [5,7,9]----{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-zipWith f = zipWithM (\a b -> return (f a b))----------------------------------------------------------------------------------- Combine N Streams - concatAp----------------------------------------------------------------------------------- | Apply a stream of functions to a stream of values and flatten the results.------ Note that the second stream is evaluated multiple times.------ >>> crossApply = Stream.crossWith id----{-# INLINE_NORMAL crossApply #-}-crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b-crossApply (Stream stepa statea) (Stream stepb stateb) =-    Stream step' (Left statea)--    where--    {-# INLINE_LATE step' #-}-    step' gst (Left st) = fmap-        (\case-            Yield f s -> Skip (Right (f, s, stateb))-            Skip    s -> Skip (Left s)-            Stop      -> Stop)-        (stepa (adaptState gst) st)-    step' gst (Right (f, os, st)) = fmap-        (\case-            Yield a s -> Yield (f a) (Right (f, os, s))-            Skip s    -> Skip (Right (f,os, s))-            Stop      -> Skip (Left os))-        (stepb (adaptState gst) st)--{-# INLINE_NORMAL crossApplySnd #-}-crossApplySnd :: Functor f => Stream f a -> Stream f b -> Stream f b-crossApplySnd (Stream stepa statea) (Stream stepb stateb) =-    Stream step (Left statea)--    where--    {-# INLINE_LATE step #-}-    step gst (Left st) =-        fmap-            (\case-                 Yield _ s -> Skip (Right (s, stateb))-                 Skip s -> Skip (Left s)-                 Stop -> Stop)-            (stepa (adaptState gst) st)-    step gst (Right (ostate, st)) =-        fmap-            (\case-                 Yield b s -> Yield b (Right (ostate, s))-                 Skip s -> Skip (Right (ostate, s))-                 Stop -> Skip (Left ostate))-            (stepb gst st)--{-# INLINE_NORMAL crossApplyFst #-}-crossApplyFst :: Functor f => Stream f a -> Stream f b -> Stream f a-crossApplyFst (Stream stepa statea) (Stream stepb stateb) =-    Stream step (Left statea)--    where--    {-# INLINE_LATE step #-}-    step gst (Left st) =-        fmap-            (\case-                 Yield b s -> Skip (Right (s, stateb, b))-                 Skip s -> Skip (Left s)-                 Stop -> Stop)-            (stepa gst st)-    step gst (Right (ostate, st, b)) =-        fmap-            (\case-                 Yield _ s -> Yield b (Right (ostate, s, b))-                 Skip s -> Skip (Right (ostate, s, b))-                 Stop -> Skip (Left ostate))-            (stepb (adaptState gst) st)--{--instance Applicative f => Applicative (Stream f) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (*>) = crossApplySnd--    {-# INLINE (<*) #-}-    (<*) = crossApplyFst--}---- |--- Definition:------ >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2------ Note that the second stream is evaluated multiple times.----{-# INLINE crossWith #-}-crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-crossWith f m1 m2 = fmap f m1 `crossApply` m2---- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible--- combinations of the tuple @(a, b)@.------ Definition:------ >>> cross = Stream.crossWith (,)------ The second stream is evaluated multiple times. If that is not desired it can--- be cached in an 'Data.Array.Array' and then generated from the array before--- calling this function. Caching may also improve performance if the stream is--- expensive to evaluate.------ See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE cross #-}-cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)-cross = crossWith (,)----------------------------------------------------------------------------------- Combine N Streams - unfoldMany---------------------------------------------------------------------------------{-# ANN type ConcatMapUState Fuse #-}-data ConcatMapUState o i =-      ConcatMapUOuter o-    | ConcatMapUInner o i---- | @unfoldMany unfold stream@ uses @unfold@ to map the input stream elements--- to streams and then flattens the generated streams into a single output--- stream.---- This is like 'concatMap' but uses an unfold with an explicit state to--- generate the stream instead of a 'Stream' type generator. This allows better--- optimization via fusion.  This can be many times more efficient than--- 'concatMap'.---- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike--- 'concatMap' this can fuse the 'Unfold' code with the inner loop and--- therefore provide many times better performance.----{-# INLINE_NORMAL unfoldMany #-}-unfoldMany :: Monad m => Unfold m a b -> Stream m a -> Stream m b-unfoldMany (Unfold istep inject) (Stream ostep ost) =-    Stream step (ConcatMapUOuter ost)-  where-    {-# INLINE_LATE step #-}-    step gst (ConcatMapUOuter o) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a o' -> do-                i <- inject a-                i `seq` return (Skip (ConcatMapUInner o' i))-            Skip o' -> return $ Skip (ConcatMapUOuter o')-            Stop -> return Stop--    step _ (ConcatMapUInner o i) = do-        r <- istep i-        return $ case r of-            Yield x i' -> Yield x (ConcatMapUInner o i')-            Skip i'    -> Skip (ConcatMapUInner o i')-            Stop       -> Skip (ConcatMapUOuter o)----------------------------------------------------------------------------------- Combine N Streams - concatMap----------------------------------------------------------------------------------- Adapted from the vector package.---- | Map a stream producing monadic function on each element of the stream--- and then flatten the results into a single stream. Since the stream--- generation function is monadic, unlike 'concatMap', it can produce an--- effect at the beginning of each iteration of the inner loop.------ See 'unfoldMany' for a fusible alternative.----{-# INLINE_NORMAL concatMapM #-}-concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b-concatMapM f (Stream step state) = Stream step' (Left state)-  where-    {-# INLINE_LATE step' #-}-    step' gst (Left st) = do-        r <- step (adaptState gst) st-        case r of-            Yield a s -> do-                b_stream <- f a-                return $ Skip (Right (b_stream, s))-            Skip s -> return $ Skip (Left s)-            Stop -> return Stop--    -- XXX flattenArrays is 5x faster than "concatMap fromArray". if somehow we-    -- can get inner_step to inline and fuse here we can perhaps get the same-    -- performance using "concatMap fromArray".-    ---    -- XXX using the pattern synonym "Stream" causes a major performance issue-    -- here even if the synonym does not include an adaptState call. Need to-    -- find out why. Is that something to be fixed in GHC?-    step' gst (Right (UnStream inner_step inner_st, st)) = do-        r <- inner_step (adaptState gst) inner_st-        case r of-            Yield b inner_s ->-                return $ Yield b (Right (Stream inner_step inner_s, st))-            Skip inner_s ->-                return $ Skip (Right (Stream inner_step inner_s, st))-            Stop -> return $ Skip (Left st)---- | Map a stream producing function on each element of the stream and then--- flatten the results into a single stream.------ >>> concatMap f = Stream.concatMapM (return . f)--- >>> concatMap f = Stream.concat . fmap f--- >>> concatMap f = Stream.unfoldMany (Unfold.lmap f Unfold.fromStream)------ See 'unfoldMany' for a fusible alternative.----{-# INLINE concatMap #-}-concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b-concatMap f = concatMapM (return . f)---- | Flatten a stream of streams to a single stream.------ >>> concat = Stream.concatMap id------ /Pre-release/-{-# INLINE concat #-}-concat :: Monad m => Stream m (Stream m a) -> Stream m a-concat = concatMap id---- XXX The idea behind this rule is to rewrite any calls to "concatMap--- fromArray" automatically to flattenArrays which is much faster.  However, we--- need an INLINE_EARLY on concatMap for this rule to fire. But if we use--- INLINE_EARLY on concatMap or fromArray then direct uses of--- "concatMap fromArray" (without the RULE) become much slower, this means--- "concatMap f" in general would become slower. Need to find a solution to--- this.------ {-# RULES "concatMap Array.toStreamD"---      concatMap Array.toStreamD = Array.flattenArray #-}---- >>> concatEffect = Stream.concat . lift    -- requires (MonadTrans t)--- >>> concatEffect = join . lift             -- requires (MonadTrans t, Monad (Stream m))---- | Given a stream value in the underlying monad, lift and join the underlying--- monad with the stream monad.------ >>> concatEffect = Stream.concat . Stream.fromEffect--- >>> concatEffect eff = Stream.concatMapM (\() -> eff) (Stream.fromPure ())------ See also: 'concat', 'sequence'----{-# INLINE concatEffect #-}-concatEffect :: Monad m => m (Stream m a) -> Stream m a-concatEffect generator = concatMapM (\() -> generator) (fromPure ())--{---- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,--- the monad instance does not seem to be significantly faster.-instance Monad m => Monad (Stream m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--    {-# INLINE (>>) #-}-    (>>) = (*>)--}----------------------------------------------------------------------------------- Traversing a tree top down----------------------------------------------------------------------------------- Next stream is to be generated by the return value of the previous stream. A--- general intuitive way of doing that could be to use an appending monad--- instance for streams where the result of the previous stream is used to--- generate the next one. In the first pass we can just emit the values in the--- stream and keep building a buffered list/stream, once done we can then--- process the buffered stream.---- | Generate a stream from an initial state, scan and concat the stream,--- generate a stream again from the final state of the previous scan and repeat--- the process.-{-# INLINE_NORMAL concatIterateScan #-}-concatIterateScan :: Monad m =>-       (b -> a -> m b)-    -> (b -> m (Maybe (b, Stream m a)))-    -> b-    -> Stream m a-concatIterateScan scanner generate initial = Stream step (Left initial)--    where--    {-# INLINE_LATE step #-}-    step _ (Left acc) = do-        r <- generate acc-        case r of-            Nothing -> return Stop-            Just v -> return $ Skip (Right v)--    step gst (Right (st, UnStream inner_step inner_st)) = do-        r <- inner_step (adaptState gst) inner_st-        case r of-            Yield b inner_s -> do-                acc <- scanner st b-                return $ Yield b (Right (acc, Stream inner_step inner_s))-            Skip inner_s ->-                return $ Skip (Right (st, Stream inner_step inner_s))-            Stop -> return $ Skip (Left st)---- Note: The iterate function returns a Maybe Stream instead of returning a nil--- stream for indicating a leaf node. This is to optimize so that we do not--- have to store any state. This makes the stored state proportional to the--- number of non-leaf nodes rather than total number of nodes.---- | Same as 'concatIterateBfs' except that the traversal of the last--- element on a level is emitted first and then going backwards up to the first--- element (reversed ordering). This may be slightly faster than--- 'concatIterateBfs'.----{-# INLINE_NORMAL concatIterateBfsRev #-}-concatIterateBfsRev :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfsRev f stream = Stream step (stream, [])--    where--    {-# INLINE_LATE step #-}-    step gst (UnStream step1 st, xs) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield a s -> do-                let xs1 =-                        case f a of-                            Nothing -> xs-                            Just x -> x:xs-                return $ Yield a (Stream step1 s, xs1)-            Skip s -> return $ Skip (Stream step1 s, xs)-            Stop ->-                case xs of-                    (y:ys) -> return $ Skip (y, ys)-                    [] -> return Stop---- | Similar to 'concatIterateDfs' except that it traverses the stream in--- breadth first style (BFS). First, all the elements in the input stream are--- emitted, and then their traversals are emitted.------ Example, list a directory tree using BFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateBfs f input------ /Pre-release/-{-# INLINE_NORMAL concatIterateBfs #-}-concatIterateBfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateBfs f stream = Stream step (stream, [], [])--    where--    {-# INLINE_LATE step #-}-    step gst (UnStream step1 st, xs, ys) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield a s -> do-                let ys1 =-                        case f a of-                            Nothing -> ys-                            Just y -> y:ys-                return $ Yield a (Stream step1 s, xs, ys1)-            Skip s -> return $ Skip (Stream step1 s, xs, ys)-            Stop ->-                case xs of-                    (x:xs1) -> return $ Skip (x, xs1, ys)-                    [] ->-                        case reverse ys of-                            (x:xs1) -> return $ Skip (x, xs1, [])-                            [] -> return Stop---- | Traverse the stream in depth first style (DFS). Map each element in the--- input stream to a stream and flatten, recursively map the resulting elements--- as well to a stream and flatten until no more streams are generated.------ Example, list a directory tree using DFS:------ >>> f = either (Just . Dir.readEitherPaths) (const Nothing)--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.concatIterateDfs f input------ This is equivalent to using @concatIterateWith StreamK.append@.------ /Pre-release/-{-# INLINE_NORMAL concatIterateDfs #-}-concatIterateDfs :: Monad m =>-       (a -> Maybe (Stream m a))-    -> Stream m a-    -> Stream m a-concatIterateDfs f stream = Stream step (stream, [])--    where--    {-# INLINE_LATE step #-}-    step gst (UnStream step1 st, xs) = do-        r <- step1 (adaptState gst) st-        case r of-            Yield a s -> do-                let st1 =-                        case f a of-                            Nothing -> (Stream step1 s, xs)-                            Just x -> (x, Stream step1 s:xs)-                return $ Yield a st1-            Skip s -> return $ Skip (Stream step1 s, xs)-            Stop ->-                case xs of-                    (y:ys) -> return $ Skip (y, ys)-                    [] -> return Stop--{-# ANN type IterateUnfoldState Fuse #-}-data IterateUnfoldState o i =-      IterateUnfoldOuter o-    | IterateUnfoldInner o i [i]---- | Same as @concatIterateDfs@ but more efficient due to stream fusion.------ Example, list a directory tree using DFS:------ >>> f = Unfold.either Dir.eitherReaderPaths Unfold.nil--- >>> input = Stream.fromPure (Left ".")--- >>> ls = Stream.unfoldIterateDfs f input------ /Pre-release/-{-# INLINE_NORMAL unfoldIterateDfs #-}-unfoldIterateDfs :: Monad m =>-       Unfold m a a-    -> Stream m a-    -> Stream m a-unfoldIterateDfs (Unfold istep inject) (Stream ostep ost) =-    Stream step (IterateUnfoldOuter ost)--    where--    {-# INLINE_LATE step #-}-    step gst (IterateUnfoldOuter o) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a s -> do-                i <- inject a-                i `seq` return (Yield a (IterateUnfoldInner s i []))-            Skip s -> return $ Skip (IterateUnfoldOuter s)-            Stop -> return Stop--    step _ (IterateUnfoldInner o i ii) = do-        r <- istep i-        case r of-            Yield x s -> do-                i1 <- inject x-                i1 `seq` return $ Yield x (IterateUnfoldInner o i1 (s:ii))-            Skip s -> return $ Skip (IterateUnfoldInner o s ii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldInner o y ys)-                    [] -> return $ Skip (IterateUnfoldOuter o)--{-# ANN type IterateUnfoldBFSRevState Fuse #-}-data IterateUnfoldBFSRevState o i =-      IterateUnfoldBFSRevOuter o [i]-    | IterateUnfoldBFSRevInner i [i]---- | Like 'unfoldIterateBfs' but processes the children in reverse order,--- therefore, may be slightly faster.------ /Pre-release/-{-# INLINE_NORMAL unfoldIterateBfsRev #-}-unfoldIterateBfsRev :: Monad m =>-       Unfold m a a-    -> Stream m a-    -> Stream m a-unfoldIterateBfsRev (Unfold istep inject) (Stream ostep ost) =-    Stream step (IterateUnfoldBFSRevOuter ost [])--    where--    {-# INLINE_LATE step #-}-    step gst (IterateUnfoldBFSRevOuter o ii) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a s -> do-                i <- inject a-                i `seq` return (Yield a (IterateUnfoldBFSRevOuter s (i:ii)))-            Skip s -> return $ Skip (IterateUnfoldBFSRevOuter s ii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)-                    [] -> return Stop--    step _ (IterateUnfoldBFSRevInner i ii) = do-        r <- istep i-        case r of-            Yield x s -> do-                i1 <- inject x-                i1 `seq` return $ Yield x (IterateUnfoldBFSRevInner s (i1:ii))-            Skip s -> return $ Skip (IterateUnfoldBFSRevInner s ii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)-                    [] -> return Stop--{-# ANN type IterateUnfoldBFSState Fuse #-}-data IterateUnfoldBFSState o i =-      IterateUnfoldBFSOuter o [i]-    | IterateUnfoldBFSInner i [i] [i]---- | Like 'unfoldIterateDfs' but uses breadth first style traversal.------ /Pre-release/-{-# INLINE_NORMAL unfoldIterateBfs #-}-unfoldIterateBfs :: Monad m =>-       Unfold m a a-    -> Stream m a-    -> Stream m a-unfoldIterateBfs (Unfold istep inject) (Stream ostep ost) =-    Stream step (IterateUnfoldBFSOuter ost [])--    where--    {-# INLINE_LATE step #-}-    step gst (IterateUnfoldBFSOuter o rii) = do-        r <- ostep (adaptState gst) o-        case r of-            Yield a s -> do-                i <- inject a-                i `seq` return (Yield a (IterateUnfoldBFSOuter s (i:rii)))-            Skip s -> return $ Skip (IterateUnfoldBFSOuter s rii)-            Stop ->-                case reverse rii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])-                    [] -> return Stop--    step _ (IterateUnfoldBFSInner i ii rii) = do-        r <- istep i-        case r of-            Yield x s -> do-                i1 <- inject x-                i1 `seq` return $ Yield x (IterateUnfoldBFSInner s ii (i1:rii))-            Skip s -> return $ Skip (IterateUnfoldBFSInner s ii rii)-            Stop ->-                case ii of-                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys rii)-                    [] ->-                        case reverse rii of-                            (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])-                            [] -> return Stop----------------------------------------------------------------------------------- Folding a tree bottom up----------------------------------------------------------------------------------- | Binary BFS style reduce, folds a level entirely using the supplied fold--- function, collecting the outputs as next level of the tree, then repeats the--- same process on the next level. The last elements of a previously folded--- level are folded first.-{-# INLINE_NORMAL reduceIterateBfs #-}-reduceIterateBfs :: Monad m =>-    (a -> a -> m a) -> Stream m a -> m (Maybe a)-reduceIterateBfs f (Stream step state) = go SPEC state [] Nothing--    where--    go _ st xs Nothing = do-        r <- step defState st-        case r of-            Yield x1 s -> go SPEC s xs (Just x1)-            Skip s -> go SPEC s xs Nothing-            Stop ->-                case xs of-                    [] -> return Nothing-                    _ -> goBuf SPEC xs []-    go _ st xs (Just x1) = do-        r2 <- step defState st-        case r2 of-            Yield x2 s -> do-                x <- f x1 x2-                go SPEC s (x:xs) Nothing-            Skip s -> go SPEC s xs (Just x1)-            Stop ->-                case xs of-                    [] -> return (Just x1)-                    _ -> goBuf SPEC (x1:xs) []--    goBuf _ [] ys = goBuf SPEC ys []-    goBuf _ [x1] ys = do-        case ys of-            [] -> return (Just x1)-            (x2:xs) -> do-                y <- f x1 x2-                goBuf SPEC xs [y]-    goBuf _ (x1:x2:xs) ys = do-        y <- f x1 x2-        goBuf SPEC xs (y:ys)---- | N-Ary BFS style iterative fold, if the input stream finished before the--- fold then it returns Left otherwise Right. If the fold returns Left we--- terminate.------ /Unimplemented/-foldIterateBfs ::-    Fold m a (Either a a) -> Stream m a -> m (Maybe a)-foldIterateBfs = undefined----------------------------------------------------------------------------------- Grouping/Splitting----------------------------------------------------------------------------------- s = stream state, fs = fold state-{-# ANN type FoldManyPost Fuse #-}-data FoldManyPost s fs b a-    = FoldManyPostStart s-    | FoldManyPostLoop s fs-    | FoldManyPostYield b (FoldManyPost s fs b a)-    | FoldManyPostDone---- XXX Need a more intuitive name, and need to reconcile the names--- foldMany/fold/parse/parseMany/parseManyPost etc.---- XXX foldManyPost keeps the last fold always partial. if the last fold is--- complete then another fold is applied on empty input. This is used for--- applying folds like takeEndBy such that the last element is not the--- separator (infix style). But that looks like a hack. We should remove this--- and use a custom combinator for infix parsing.---- | Like 'foldMany' but evaluates the fold even if the fold did not receive--- any input, therefore, always results in a non-empty output even on an empty--- stream (default result of the fold).------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f--- >>> fmany $ Stream.fromList []--- [0]------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7,0]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream without consuming the input.------ /Pre-release/----{-# INLINE_NORMAL foldManyPost #-}-foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b-foldManyPost (Fold fstep initial extract) (Stream step state) =-    Stream step' (FoldManyPostStart state)--    where--    {-# INLINE consume #-}-    consume x s fs = do-        res <- fstep fs x-        return-            $ Skip-            $ case res of-                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart s)-                  FL.Partial ps -> FoldManyPostLoop s ps--    {-# INLINE_LATE step' #-}-    step' _ (FoldManyPostStart st) = do-        r <- initial-        return-            $ Skip-            $ case r of-                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart st)-                  FL.Partial fs -> FoldManyPostLoop st fs-    step' gst (FoldManyPostLoop st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyPostLoop s fs)-            Stop -> do-                b <- extract fs-                return $ Skip (FoldManyPostYield b FoldManyPostDone)-    step' _ (FoldManyPostYield b next) = return $ Yield b next-    step' _ FoldManyPostDone = return Stop--{-# ANN type FoldMany Fuse #-}-data FoldMany s fs b a-    = FoldManyStart s-    | FoldManyFirst fs s-    | FoldManyLoop s fs-    | FoldManyYield b (FoldMany s fs b a)-    | FoldManyDone---- XXX Nested foldMany does not fuse.---- | Apply a 'Fold' repeatedly on a stream and emit the results in the output--- stream.------ Definition:------ >>> foldMany f = Stream.parseMany (Parser.fromFold f)------ Example, empty stream:------ >>> f = Fold.take 2 Fold.sum--- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f--- >>> fmany $ Stream.fromList []--- []------ Example, last fold empty:------ >>> fmany $ Stream.fromList [1..4]--- [3,7]------ Example, last fold non-empty:------ >>> fmany $ Stream.fromList [1..5]--- [3,7,5]------ Note that using a closed fold e.g. @Fold.take 0@, would result in an--- infinite stream on a non-empty input stream.----{-# INLINE_NORMAL foldMany #-}-foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b-foldMany (Fold fstep initial extract) (Stream step state) =-    Stream step' (FoldManyStart state)--    where--    {-# INLINE consume #-}-    consume x s fs = do-        res <- fstep fs x-        return-            $ Skip-            $ case res of-                  FL.Done b -> FoldManyYield b (FoldManyStart s)-                  FL.Partial ps -> FoldManyLoop s ps--    {-# INLINE_LATE step' #-}-    step' _ (FoldManyStart st) = do-        r <- initial-        return-            $ Skip-            $ case r of-                  FL.Done b -> FoldManyYield b (FoldManyStart st)-                  FL.Partial fs -> FoldManyFirst fs st-    step' gst (FoldManyFirst fs st) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyFirst fs s)-            Stop -> return Stop-    step' gst (FoldManyLoop st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyLoop s fs)-            Stop -> do-                b <- extract fs-                return $ Skip (FoldManyYield b FoldManyDone)-    step' _ (FoldManyYield b next) = return $ Yield b next-    step' _ FoldManyDone = return Stop--{-# INLINE groupsOf #-}-groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b-groupsOf n f = foldMany (FL.take n f)---- Keep the argument order consistent with refoldIterateM.---- | Like 'foldMany' but for the 'Refold' type.  The supplied action is used as--- the initial value for each refold.------ /Internal/-{-# INLINE_NORMAL refoldMany #-}-refoldMany :: Monad m => Refold m x a b -> m x -> Stream m a -> Stream m b-refoldMany (Refold fstep inject extract) action (Stream step state) =-    Stream step' (FoldManyStart state)--    where--    {-# INLINE consume #-}-    consume x s fs = do-        res <- fstep fs x-        return-            $ Skip-            $ case res of-                  FL.Done b -> FoldManyYield b (FoldManyStart s)-                  FL.Partial ps -> FoldManyLoop s ps--    {-# INLINE_LATE step' #-}-    step' _ (FoldManyStart st) = do-        r <- action >>= inject-        return-            $ Skip-            $ case r of-                  FL.Done b -> FoldManyYield b (FoldManyStart st)-                  FL.Partial fs -> FoldManyFirst fs st-    step' gst (FoldManyFirst fs st) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyFirst fs s)-            Stop -> return Stop-    step' gst (FoldManyLoop st fs) = do-        r <- step (adaptState gst) st-        case r of-            Yield x s -> consume x s fs-            Skip s -> return $ Skip (FoldManyLoop s fs)-            Stop -> do-                b <- extract fs-                return $ Skip (FoldManyYield b FoldManyDone)-    step' _ (FoldManyYield b next) = return $ Yield b next-    step' _ FoldManyDone = return Stop----------------------------------------------------------------------------------- Stream with a cross product style monad instance----------------------------------------------------------------------------------- XXX CrossStream performs better than the CrossStreamK when nesting two--- loops, however, CrossStreamK seems to be better for more than two nestings,--- need to do more perf investigation.---- | A newtype wrapper for the 'Stream' type with a cross product style monad--- instance.------ A 'Monad' bind behaves like a @for@ loop:------ >>> :{--- Stream.fold Fold.toList $ Stream.unCross $ do---     x <- Stream.mkCross $ Stream.fromList [1,2]---     -- Perform the following actions for each x in the stream---     return x--- :}--- [1,2]------ Nested monad binds behave like nested @for@ loops:------ >>> :{--- Stream.fold Fold.toList $ Stream.unCross $ do---     x <- Stream.mkCross $ Stream.fromList [1,2]---     y <- Stream.mkCross $ Stream.fromList [3,4]---     -- Perform the following actions for each x, for each y---     return (x, y)--- :}--- [(1,3),(1,4),(2,3),(2,4)]----newtype CrossStream m a = CrossStream {unCrossStream :: Stream m a}-        deriving (Functor, Foldable)--{-# INLINE mkCross #-}-mkCross :: Stream m a -> CrossStream m a-mkCross = CrossStream--{-# INLINE unCross #-}-unCross :: CrossStream m a -> Stream m a-unCross = unCrossStream---- Pure (Identity monad) stream instances-deriving instance IsList (CrossStream Identity a)-deriving instance (a ~ Char) => IsString (CrossStream Identity a)-deriving instance Eq a => Eq (CrossStream Identity a)-deriving instance Ord a => Ord (CrossStream Identity a)---- Do not use automatic derivation for this to show as "fromList" rather than--- "fromList Identity".-instance Show a => Show (CrossStream Identity a) where-    {-# INLINE show #-}-    show (CrossStream xs) = show xs--instance Read a => Read (CrossStream Identity a) where-    {-# INLINE readPrec #-}-    readPrec = fmap CrossStream readPrec----------------------------------------------------------------------------------- Applicative----------------------------------------------------------------------------------- Note: we need to define all the typeclass operations because we want to--- INLINE them.-instance Monad m => Applicative (CrossStream m) where-    {-# INLINE pure #-}-    pure x = CrossStream (fromPure x)--    {-# INLINE (<*>) #-}-    (CrossStream s1) <*> (CrossStream s2) =-        CrossStream (crossApply s1 s2)--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (CrossStream s1) *> (CrossStream s2) =-        CrossStream (crossApplySnd s1 s2)--    {-# INLINE (<*) #-}-    (CrossStream s1) <* (CrossStream s2) =-        CrossStream (crossApplyFst s1 s2)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (CrossStream m) where-    return = pure--    -- Benchmarks better with StreamD bind and pure:-    -- toList, filterAllout, *>, *<, >> (~2x)-    ----    -- Benchmarks better with CPS bind and pure:-    -- Prime sieve (25x)-    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)-    ---    {-# INLINE (>>=) #-}-    (>>=) (CrossStream m) f = CrossStream (concatMap (unCrossStream . f) m)--    {-# INLINE (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- Transformers---------------------------------------------------------------------------------instance (MonadIO m) => MonadIO (CrossStream m) where-    liftIO x = CrossStream (fromEffect $ liftIO x)--instance MonadTrans CrossStream where-    {-# INLINE lift #-}-    lift x = CrossStream (fromEffect x)--instance (MonadThrow m) => MonadThrow (CrossStream m) where-    throwM = lift . throwM
− src/Streamly/Internal/Data/Stream/StreamDK.hs 
@@ -1,52 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamDK--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--------- This module has the following problems due to rewrite rules:------ * Rewrite rules lead to optimization problems, blocking fusion in some--- cases, specifically when combining multiple operations e.g. (filter . drop).--- * Rewrite rules lead to problems when calling a function recursively. For--- example, the StreamD version of foldBreak cannot be used recursively when--- wrapped in rewrite rules because each recursive call adds a roundtrip--- conversion from D to K and back to D. We can use the StreamK versions of--- these though because the rewrite rule gets eliminated in that case.--- * If we have a unified module, we need two different versions of several--- operations e.g. appendK and appendD, both are useful in different cases.----module Streamly.Internal.Data.Stream.StreamDK-    ( module Streamly.Internal.Data.Stream.Type-    , module Streamly.Internal.Data.Stream.Bottom-    , module Streamly.Internal.Data.Stream.Eliminate-    , module Streamly.Internal.Data.Stream.Exception-    , module Streamly.Internal.Data.Stream.Expand-    , module Streamly.Internal.Data.Stream.Generate-    , module Streamly.Internal.Data.Stream.Lift-    , module Streamly.Internal.Data.Stream.Reduce-    , module Streamly.Internal.Data.Stream.Transform-    , module Streamly.Internal.Data.Stream.Cross-    , module Streamly.Internal.Data.Stream.Zip--    -- modules having dependencies on libraries other than base-    , module Streamly.Internal.Data.Stream.Transformer-    )-where--import Streamly.Internal.Data.Stream.Bottom-import Streamly.Internal.Data.Stream.Cross-import Streamly.Internal.Data.Stream.Eliminate-import Streamly.Internal.Data.Stream.Exception-import Streamly.Internal.Data.Stream.Expand-import Streamly.Internal.Data.Stream.Generate-import Streamly.Internal.Data.Stream.Lift-import Streamly.Internal.Data.Stream.Reduce-import Streamly.Internal.Data.Stream.Transform-import Streamly.Internal.Data.Stream.Type-import Streamly.Internal.Data.Stream.Zip--import Streamly.Internal.Data.Stream.Transformer
− src/Streamly/Internal/Data/Stream/StreamK.hs 
@@ -1,1372 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamK--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.StreamK-    (-    -- * Setup-    -- | To execute the code examples provided in this module in ghci, please-    -- run the following commands first.-    ---    -- $setup--    -- * The stream type-      Stream-    , StreamK(..)-    , fromStream-    , toStream--    , CrossStreamK-    , unCross-    , mkCross--    -- * Construction Primitives-    , mkStream-    , nil-    , nilM-    , cons-    , (.:)--    -- * Elimination Primitives-    , foldStream-    , foldStreamShared--    -- * Transformation Primitives-    , unShare--    -- * Deconstruction-    , uncons--    -- * Generation-    -- ** Unfolds-    , unfoldr-    , unfoldrM--    -- ** Specialized Generation-    , repeat-    , repeatM-    , replicate-    , replicateM-    , fromIndices-    , fromIndicesM-    , iterate-    , iterateM--    -- ** Conversions-    , fromPure-    , fromEffect-    , fromFoldable-    , fromList--    -- * foldr/build-    , foldrS-    , foldrSM-    , buildS-    , augmentS--    -- * Elimination-    -- ** General Folds-    , foldr-    , foldr1-    , foldrM--    , foldl'-    , foldlM'-    , foldlS-    , foldlx'-    , foldlMx'-    , fold-    , foldBreak-    , foldEither-    , foldConcat-    , parseDBreak-    , parseD-    , parseBreakChunks-    , parseChunks--    -- ** Specialized Folds-    , drain-    , null-    , head-    , tail-    , init-    , elem-    , notElem-    , all-    , any-    , last-    , minimum-    , minimumBy-    , maximum-    , maximumBy-    , findIndices-    , lookup-    , findM-    , find-    , (!!)--    -- ** Map and Fold-    , mapM_--    -- ** Conversions-    , toList-    , hoist--    -- * Transformation-    -- ** By folding (scans)-    , scanl'-    , scanlx'--    -- ** Filtering-    , filter-    , take-    , takeWhile-    , drop-    , dropWhile--    -- ** Mapping-    , map-    , mapM-    , sequence--    -- ** Inserting-    , intersperseM-    , intersperse-    , insertBy--    -- ** Deleting-    , deleteBy--    -- ** Reordering-    , reverse-    , sortBy--    -- ** Map and Filter-    , mapMaybe--    -- ** Zipping-    , zipWith-    , zipWithM--    -- ** Merging-    , mergeBy-    , mergeByM--    -- ** Nesting-    , crossApplyWith-    , crossApply-    , crossApplySnd-    , crossApplyFst-    , crossWith--    , concatMapWith-    , concatMap-    , concatEffect-    , bindWith-    , concatIterateWith-    , concatIterateLeftsWith-    , concatIterateScanWith--    , mergeMapWith-    , mergeIterateWith--    -- ** Transformation comprehensions-    , the--    -- * Semigroup Style Composition-    , append-    , interleave--    -- * Utilities-    , consM-    , mfix-    )-where--#include "ArrayMacros.h"-#include "inline.hs"-#include "assert.hs"--import Control.Monad (void, join)-import Data.Proxy (Proxy(..))-import GHC.Types (SPEC(..))-import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Fold.Type (Fold(..))-import Streamly.Internal.Data.Producer.Type (Producer(..))-import Streamly.Internal.Data.SVar.Type (adaptState, defState)-import Streamly.Internal.Data.Unboxed (sizeOf, Unbox)-import Streamly.Internal.Data.Parser.ParserK.Type (ParserK)--import qualified Streamly.Internal.Data.Array.Type as Array-import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Parser as Parser-import qualified Streamly.Internal.Data.Parser.ParserD.Type as PR-import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Prelude--import Prelude-       hiding (foldl, foldr, last, map, mapM, mapM_, repeat, sequence,-               take, filter, all, any, takeWhile, drop, dropWhile, minimum,-               maximum, elem, notElem, null, head, tail, init, zipWith, lookup,-               foldr1, (!!), replicate, reverse, concatMap, iterate, splitAt)--import Streamly.Internal.Data.Stream.StreamK.Type-import Streamly.Internal.Data.Parser.ParserD (ParseError(..))--#include "DocTestDataStreamK.hs"--{-# INLINE fromStream #-}-fromStream :: Monad m => Stream.Stream m a -> StreamK m a-fromStream = Stream.toStreamK--{-# INLINE toStream #-}-toStream :: Applicative m => StreamK m a -> Stream.Stream m a-toStream = Stream.fromStreamK------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{---- Generalization of concurrent streams/SVar via unfoldr.------ Unfold a value into monadic actions and then run the resulting monadic--- actions to generate a stream. Since the step of generating the monadic--- action and running them are decoupled we can run the monadic actions--- cooncurrently. For example, the seed could be a list of monadic actions or a--- pure stream of monadic actions.------ We can have different flavors of this depending on the stream type t. The--- concurrent version could be async or ahead etc. Depending on how we queue--- back the feedback portion b, it could be DFS or BFS style.----unfoldrA :: (b -> Maybe (m a, b)) -> b -> StreamK m a-unfoldrA = undefined--}------------------------------------------------------------------------------------ Special generation----------------------------------------------------------------------------------repeatM :: Monad m => m a -> StreamK m a-repeatM = repeatMWith consM--{-# INLINE replicateM #-}-replicateM :: Monad m => Int -> m a -> StreamK m a-replicateM = replicateMWith consM-{-# INLINE replicate #-}-replicate :: Int -> a -> StreamK m a-replicate n a = go n-    where-    go cnt = if cnt <= 0 then nil else a `cons` go (cnt - 1)--{-# INLINE fromIndicesM #-}-fromIndicesM :: Monad m => (Int -> m a) -> StreamK m a-fromIndicesM = fromIndicesMWith consM-{-# INLINE fromIndices #-}-fromIndices :: (Int -> a) -> StreamK m a-fromIndices gen = go 0-  where-    go n = gen n `cons` go (n + 1)--{-# INLINE iterate #-}-iterate :: (a -> a) -> a -> StreamK m a-iterate step = go-    where-        go !s = cons s (go (step s))--{-# INLINE iterateM #-}-iterateM :: Monad m => (a -> m a) -> m a -> StreamK m a-iterateM = iterateMWith consM------------------------------------------------------------------------------------ Conversions----------------------------------------------------------------------------------{-# INLINE fromList #-}-fromList :: [a] -> StreamK m a-fromList = fromFoldable------------------------------------------------------------------------------------ Elimination by Folding----------------------------------------------------------------------------------{-# INLINE foldr1 #-}-foldr1 :: Monad m => (a -> a -> a) -> StreamK m a -> m (Maybe a)-foldr1 step m = do-    r <- uncons m-    case r of-        Nothing -> return Nothing-        Just (h, t) -> fmap Just (go h t)-    where-    go p m1 =-        let stp = return p-            single a = return $ step a p-            yieldk a r = fmap (step p) (go a r)-         in foldStream defState yieldk single stp m1---- XXX replace the recursive "go" with explicit continuations.--- | Like 'foldx', but with a monadic step function.-{-# INLINABLE foldlMx' #-}-foldlMx' :: Monad m-    => (x -> a -> m x) -> m x -> (x -> m b) -> StreamK m a -> m b-foldlMx' step begin done = go begin-    where-    go !acc m1 =-        let stop = acc >>= done-            single a = acc >>= \b -> step b a >>= done-            yieldk a r = acc >>= \b -> step b a >>= \x -> go (return x) r-         in foldStream defState yieldk single stop m1---- | Fold a stream using the supplied left 'Fold' and reducing the resulting--- expression strictly at each step. The behavior is similar to 'foldl''. A--- 'Fold' can terminate early without consuming the full stream. See the--- documentation of individual 'Fold's for termination behavior.------ Definitions:------ >>> fold f = fmap fst . StreamK.foldBreak f--- >>> fold f = StreamK.parseD (Parser.fromFold f)------ Example:------ >>> StreamK.fold Fold.sum $ StreamK.fromStream $ Stream.enumerateFromTo 1 100--- 5050----{-# INLINABLE fold #-}-fold :: Monad m => FL.Fold m a b -> StreamK m a -> m b-fold (FL.Fold step begin done) m = do-    res <- begin-    case res of-        FL.Partial fs -> go fs m-        FL.Done fb -> return fb--    where-    go !acc m1 =-        let stop = done acc-            single a = step acc a-              >>= \case-                        FL.Partial s -> done s-                        FL.Done b1 -> return b1-            yieldk a r = step acc a-              >>= \case-                        FL.Partial s -> go s r-                        FL.Done b1 -> return b1-         in foldStream defState yieldk single stop m1---- | Fold resulting in either breaking the stream or continuation of the fold.--- Instead of supplying the input stream in one go we can run the fold multiple--- times, each time supplying the next segment of the input stream. If the fold--- has not yet finished it returns a fold that can be run again otherwise it--- returns the fold result and the residual stream.------ /Internal/-{-# INLINE foldEither #-}-foldEither :: Monad m =>-    Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))-foldEither (FL.Fold step begin done) m = do-    res <- begin-    case res of-        FL.Partial fs -> go fs m-        FL.Done fb -> return $ Right (fb, m)--    where--    go !acc m1 =-        let stop = return $ Left (Fold step (return $ FL.Partial acc) done)-            single a =-                step acc a-                  >>= \case-                    FL.Partial s ->-                        return $ Left (Fold step (return $ FL.Partial s) done)-                    FL.Done b1 -> return $ Right (b1, nil)-            yieldk a r =-                step acc a-                  >>= \case-                    FL.Partial s -> go s r-                    FL.Done b1 -> return $ Right (b1, r)-         in foldStream defState yieldk single stop m1---- | Like 'fold' but also returns the remaining stream. The resulting stream--- would be 'StreamK.nil' if the stream finished before the fold.----{-# INLINE foldBreak #-}-foldBreak :: Monad m => Fold m a b -> StreamK m a -> m (b, StreamK m a)-foldBreak fld strm = do-    r <- foldEither fld strm-    case r of-        Right res -> return res-        Left (Fold _ initial extract) -> do-            res <- initial-            case res of-                FL.Done _ -> error "foldBreak: unreachable state"-                FL.Partial s -> do-                    b <- extract s-                    return (b, nil)---- XXX Array folds can be implemented using this.--- foldContainers? Specialized to foldArrays.---- | Generate streams from individual elements of a stream and fold the--- concatenation of those streams using the supplied fold. Return the result of--- the fold and residual stream.------ For example, this can be used to efficiently fold an Array Word8 stream--- using Word8 folds.------ /Internal/-{-# INLINE foldConcat #-}-foldConcat :: Monad m =>-    Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)-foldConcat-    (Producer pstep pinject pextract)-    (Fold fstep begin done)-    stream = do--    res <- begin-    case res of-        FL.Partial fs -> go fs stream-        FL.Done fb -> return (fb, stream)--    where--    go !acc m1 = do-        let stop = do-                r <- done acc-                return (r, nil)-            single a = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> do-                        r <- done fs-                        return (r, nil)-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, fromPure x)-            yieldk a r = do-                st <- pinject a-                res <- go1 SPEC acc st-                case res of-                    Left fs -> go fs r-                    Right (b, s) -> do-                        x <- pextract s-                        return (b, x `cons` r)-         in foldStream defState yieldk single stop m1--    {-# INLINE go1 #-}-    go1 !_ !fs st = do-        r <- pstep st-        case r of-            Stream.Yield x s -> do-                res <- fstep fs x-                case res of-                    FL.Done b -> return $ Right (b, s)-                    FL.Partial fs1 -> go1 SPEC fs1 s-            Stream.Skip s -> go1 SPEC fs s-            Stream.Stop -> return $ Left fs---- | Like 'foldl'' but with a monadic step function.-{-# INLINE foldlM' #-}-foldlM' :: Monad m => (b -> a -> m b) -> m b -> StreamK m a -> m b-foldlM' step begin = foldlMx' step begin return----------------------------------------------------------------------------------- Specialized folds---------------------------------------------------------------------------------{-# INLINE head #-}-head :: Monad m => StreamK m a -> m (Maybe a)--- head = foldrM (\x _ -> return $ Just x) (return Nothing)-head m =-    let stop      = return Nothing-        single a  = return (Just a)-        yieldk a _ = return (Just a)-    in foldStream defState yieldk single stop m--{-# INLINE elem #-}-elem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool-elem e = go-    where-    go m1 =-        let stop      = return False-            single a  = return (a == e)-            yieldk a r = if a == e then return True else go r-        in foldStream defState yieldk single stop m1--{-# INLINE notElem #-}-notElem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool-notElem e = go-    where-    go m1 =-        let stop      = return True-            single a  = return (a /= e)-            yieldk a r = if a == e then return False else go r-        in foldStream defState yieldk single stop m1--{-# INLINABLE all #-}-all :: Monad m => (a -> Bool) -> StreamK m a -> m Bool-all p = go-    where-    go m1 =-        let single a   | p a       = return True-                       | otherwise = return False-            yieldk a r | p a       = go r-                       | otherwise = return False-         in foldStream defState yieldk single (return True) m1--{-# INLINABLE any #-}-any :: Monad m => (a -> Bool) -> StreamK m a -> m Bool-any p = go-    where-    go m1 =-        let single a   | p a       = return True-                       | otherwise = return False-            yieldk a r | p a       = return True-                       | otherwise = go r-         in foldStream defState yieldk single (return False) m1---- | Extract the last element of the stream, if any.-{-# INLINE last #-}-last :: Monad m => StreamK m a -> m (Maybe a)-last = foldlx' (\_ y -> Just y) Nothing id--{-# INLINE minimum #-}-minimum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)-minimum = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  =-                if res <= a-                then return (Just res)-                else return (Just a)-            yieldk a r =-                if res <= a-                then go (Just res) r-                else go (Just a) r-        in foldStream defState yieldk single stop m1--{-# INLINE minimumBy #-}-minimumBy-    :: (Monad m)-    => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)-minimumBy cmp = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  = case cmp res a of-                GT -> return (Just a)-                _  -> return (Just res)-            yieldk a r = case cmp res a of-                GT -> go (Just a) r-                _  -> go (Just res) r-        in foldStream defState yieldk single stop m1--{-# INLINE maximum #-}-maximum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)-maximum = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  =-                if res <= a-                then return (Just a)-                else return (Just res)-            yieldk a r =-                if res <= a-                then go (Just a) r-                else go (Just res) r-        in foldStream defState yieldk single stop m1--{-# INLINE maximumBy #-}-maximumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)-maximumBy cmp = go Nothing-    where-    go Nothing m1 =-        let stop      = return Nothing-            single a  = return (Just a)-            yieldk a r = go (Just a) r-        in foldStream defState yieldk single stop m1--    go (Just res) m1 =-        let stop      = return (Just res)-            single a  = case cmp res a of-                GT -> return (Just res)-                _  -> return (Just a)-            yieldk a r = case cmp res a of-                GT -> go (Just res) r-                _  -> go (Just a) r-        in foldStream defState yieldk single stop m1--{-# INLINE (!!) #-}-(!!) :: Monad m => StreamK m a -> Int -> m (Maybe a)-m !! i = go i m-    where-    go n m1 =-      let single a | n == 0 = return $ Just a-                   | otherwise = return Nothing-          yieldk a x | n < 0 = return Nothing-                     | n == 0 = return $ Just a-                     | otherwise = go (n - 1) x-      in foldStream defState yieldk single (return Nothing) m1--{-# INLINE lookup #-}-lookup :: (Monad m, Eq a) => a -> StreamK m (a, b) -> m (Maybe b)-lookup e = go-    where-    go m1 =-        let single (a, b) | a == e = return $ Just b-                          | otherwise = return Nothing-            yieldk (a, b) x | a == e = return $ Just b-                            | otherwise = go x-        in foldStream defState yieldk single (return Nothing) m1--{-# INLINE findM #-}-findM :: Monad m => (a -> m Bool) -> StreamK m a -> m (Maybe a)-findM p = go-    where-    go m1 =-        let single a = do-                b <- p a-                if b then return $ Just a else return Nothing-            yieldk a x = do-                b <- p a-                if b then return $ Just a else go x-        in foldStream defState yieldk single (return Nothing) m1--{-# INLINE find #-}-find :: Monad m => (a -> Bool) -> StreamK m a -> m (Maybe a)-find p = findM (return . p)--{-# INLINE findIndices #-}-findIndices :: (a -> Bool) -> StreamK m a -> StreamK m Int-findIndices p = go 0-    where-    go offset m1 = mkStream $ \st yld sng stp ->-        let single a | p a = sng offset-                     | otherwise = stp-            yieldk a x | p a = yld offset $ go (offset + 1) x-                       | otherwise = foldStream (adaptState st) yld sng stp $-                            go (offset + 1) x-        in foldStream (adaptState st) yieldk single stp m1----------------------------------------------------------------------------------- Map and Fold----------------------------------------------------------------------------------- | Apply a monadic action to each element of the stream and discard the--- output of the action.-{-# INLINE mapM_ #-}-mapM_ :: Monad m => (a -> m b) -> StreamK m a -> m ()-mapM_ f = go-    where-    go m1 =-        let stop = return ()-            single a = void (f a)-            yieldk a r = f a >> go r-         in foldStream defState yieldk single stop m1--{-# INLINE mapM #-}-mapM :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b-mapM = mapMWith consM----------------------------------------------------------------------------------- Converting folds---------------------------------------------------------------------------------{-# INLINABLE toList #-}-toList :: Monad m => StreamK m a -> m [a]-toList = foldr (:) []---- Based on suggestions by David Feuer and Pranay Sashank-{-# INLINE hoist #-}-hoist :: (Monad m, Monad n)-    => (forall x. m x -> n x) -> StreamK m a -> StreamK n a-hoist f str =-    mkStream $ \st yld sng stp ->-            let single = return . sng-                yieldk a s = return $ yld a (hoist f s)-                stop = return stp-                state = adaptState st-             in join . f $ foldStreamShared state yieldk single stop str------------------------------------------------------------------------------------ Transformation by folding (Scans)----------------------------------------------------------------------------------{-# INLINE scanlx' #-}-scanlx' :: (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> StreamK m b-scanlx' step begin done m =-    cons (done begin) $ go m begin-    where-    go m1 !acc = mkStream $ \st yld sng stp ->-        let single a = sng (done $ step acc a)-            yieldk a r =-                let s = step acc a-                in yld (done s) (go r s)-        in foldStream (adaptState st) yieldk single stp m1--{-# INLINE scanl' #-}-scanl' :: (b -> a -> b) -> b -> StreamK m a -> StreamK m b-scanl' step begin = scanlx' step begin id------------------------------------------------------------------------------------ Filtering----------------------------------------------------------------------------------{-# INLINE filter #-}-filter :: (a -> Bool) -> StreamK m a -> StreamK m a-filter p = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a   | p a       = sng a-                       | otherwise = stp-            yieldk a r | p a       = yld a (go r)-                       | otherwise = foldStream st yieldk single stp r-         in foldStream st yieldk single stp m1--{-# INLINE take #-}-take :: Int -> StreamK m a -> StreamK m a-take = go-    where-    go n1 m1 = mkStream $ \st yld sng stp ->-        let yieldk a r = yld a (go (n1 - 1) r)-        in if n1 <= 0-           then stp-           else foldStream st yieldk sng stp m1--{-# INLINE takeWhile #-}-takeWhile :: (a -> Bool) -> StreamK m a -> StreamK m a-takeWhile p = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a   | p a       = sng a-                       | otherwise = stp-            yieldk a r | p a       = yld a (go r)-                       | otherwise = stp-         in foldStream st yieldk single stp m1--{-# INLINE drop #-}-drop :: Int -> StreamK m a -> StreamK m a-drop n m = unShare (go n m)-    where-    go n1 m1 = mkStream $ \st yld sng stp ->-        let single _ = stp-            yieldk _ r = foldStreamShared st yld sng stp $ go (n1 - 1) r-        -- Somehow "<=" check performs better than a ">"-        in if n1 <= 0-           then foldStreamShared st yld sng stp m1-           else foldStreamShared st yieldk single stp m1--{-# INLINE dropWhile #-}-dropWhile :: (a -> Bool) -> StreamK m a -> StreamK m a-dropWhile p = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a   | p a       = stp-                       | otherwise = sng a-            yieldk a r | p a = foldStream st yieldk single stp r-                       | otherwise = yld a r-         in foldStream st yieldk single stp m1------------------------------------------------------------------------------------ Mapping------------------------------------------------------------------------------------ Be careful when modifying this, this uses a consM (|:) deliberately to allow--- other stream types to overload it.-{-# INLINE sequence #-}-sequence :: Monad m => StreamK m (m a) -> StreamK m a-sequence = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single ma = ma >>= sng-            yieldk ma r = foldStreamShared st yld sng stp $ ma `consM` go r-         in foldStream (adaptState st) yieldk single stp m1------------------------------------------------------------------------------------ Inserting----------------------------------------------------------------------------------{-# INLINE intersperseM #-}-intersperseM :: Monad m => m a -> StreamK m a -> StreamK m a-intersperseM a = prependingStart-    where-    prependingStart m1 = mkStream $ \st yld sng stp ->-        let yieldk i x =-                foldStreamShared st yld sng stp $ return i `consM` go x-         in foldStream st yieldk sng stp m1-    go m2 = mkStream $ \st yld sng stp ->-        let single i = foldStreamShared st yld sng stp $ a `consM` fromPure i-            yieldk i x =-                foldStreamShared-                    st yld sng stp $ a `consM` return i `consM` go x-         in foldStream st yieldk single stp m2--{-# INLINE intersperse #-}-intersperse :: Monad m => a -> StreamK m a -> StreamK m a-intersperse a = intersperseM (return a)--{-# INLINE insertBy #-}-insertBy :: (a -> a -> Ordering) -> a -> StreamK m a -> StreamK m a-insertBy cmp x = go-  where-    go m1 = mkStream $ \st yld _ _ ->-        let single a = case cmp x a of-                GT -> yld a (fromPure x)-                _  -> yld x (fromPure a)-            stop = yld x nil-            yieldk a r = case cmp x a of-                GT -> yld a (go r)-                _  -> yld x (a `cons` r)-         in foldStream st yieldk single stop m1----------------------------------------------------------------------------------- Deleting---------------------------------------------------------------------------------{-# INLINE deleteBy #-}-deleteBy :: (a -> a -> Bool) -> a -> StreamK m a -> StreamK m a-deleteBy eq x = go-  where-    go m1 = mkStream $ \st yld sng stp ->-        let single a = if eq x a then stp else sng a-            yieldk a r = if eq x a-              then foldStream st yld sng stp r-              else yld a (go r)-         in foldStream st yieldk single stp m1------------------------------------------------------------------------------------ Map and Filter----------------------------------------------------------------------------------{-# INLINE mapMaybe #-}-mapMaybe :: (a -> Maybe b) -> StreamK m a -> StreamK m b-mapMaybe f = go-  where-    go m1 = mkStream $ \st yld sng stp ->-        let single a = maybe stp sng (f a)-            yieldk a r = case f a of-                Just b  -> yld b $ go r-                Nothing -> foldStream (adaptState st) yieldk single stp r-        in foldStream (adaptState st) yieldk single stp m1----------------------------------------------------------------------------------- Serial Zipping----------------------------------------------------------------------------------- | Zip two streams serially using a pure zipping function.----{-# INLINE zipWith #-}-zipWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c-zipWith f = zipWithM (\a b -> return (f a b))---- | Zip two streams serially using a monadic zipping function.----{-# INLINE zipWithM #-}-zipWithM :: Monad m =>-    (a -> b -> m c) -> StreamK m a -> StreamK m b -> StreamK m c-zipWithM f = go--    where--    go mx my = mkStream $ \st yld sng stp -> do-        let merge a ra =-                let single2 b   = f a b >>= sng-                    yield2 b rb = f a b >>= \x -> yld x (go ra rb)-                 in foldStream (adaptState st) yield2 single2 stp my-        let single1 a = merge a nil-            yield1 = merge-        foldStream (adaptState st) yield1 single1 stp mx----------------------------------------------------------------------------------- Merging---------------------------------------------------------------------------------{-# INLINE mergeByM #-}-mergeByM :: Monad m =>-    (a -> a -> m Ordering) -> StreamK m a -> StreamK m a -> StreamK m a-mergeByM cmp = go--    where--    go mx my = mkStream $ \st yld sng stp -> do-        let stop = foldStream st yld sng stp my-            single x = foldStream st yld sng stp (goX0 x my)-            yield x rx = foldStream st yld sng stp (goX x rx my)-        foldStream st yield single stop mx--    goX0 x my = mkStream $ \st yld sng _ -> do-        let stop = sng x-            single y = do-                r <- cmp x y-                case r of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield y ry = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX0 x ry)-                    _  -> yld x (y `cons` ry)-         in foldStream st yield single stop my--    goX x mx my = mkStream $ \st yld _ _ -> do-        let stop = yld x mx-            single y = do-                r <- cmp x y-                case r of-                    GT -> yld y (x `cons` mx)-                    _  -> yld x (goY0 mx y)-            yield y ry = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX x mx ry)-                    _  -> yld x (goY mx y ry)-         in foldStream st yield single stop my--    goY0 mx y = mkStream $ \st yld sng _ -> do-        let stop = sng y-            single x = do-                r <- cmp x y-                case r of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield x rx = do-                r <- cmp x y-                case r of-                    GT -> yld y (x `cons` rx)-                    _  -> yld x (goY0 rx y)-         in foldStream st yield single stop mx--    goY mx y my = mkStream $ \st yld _ _ -> do-        let stop = yld y my-            single x = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX0 x my)-                    _  -> yld x (y `cons` my)-            yield x rx = do-                r <- cmp x y-                case r of-                    GT -> yld y (goX x rx my)-                    _  -> yld x (goY rx y my)-         in foldStream st yield single stop mx--{-# INLINE mergeBy #-}-mergeBy :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a -> StreamK m a--- XXX GHC: This has slightly worse performance than replacing "r <- cmp x y"--- with "let r = cmp x y" in the monadic version. The definition below is--- exactly the same as mergeByM except this change.--- mergeBy cmp = mergeByM (\a b -> return $ cmp a b)-mergeBy cmp = go--    where--    go mx my = mkStream $ \st yld sng stp -> do-        let stop = foldStream st yld sng stp my-            single x = foldStream st yld sng stp (goX0 x my)-            yield x rx = foldStream st yld sng stp (goX x rx my)-        foldStream st yield single stop mx--    goX0 x my = mkStream $ \st yld sng _ -> do-        let stop = sng x-            single y = do-                case cmp x y of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield y ry = do-                case cmp x y of-                    GT -> yld y (goX0 x ry)-                    _  -> yld x (y `cons` ry)-         in foldStream st yield single stop my--    goX x mx my = mkStream $ \st yld _ _ -> do-        let stop = yld x mx-            single y = do-                case cmp x y of-                    GT -> yld y (x `cons` mx)-                    _  -> yld x (goY0 mx y)-            yield y ry = do-                case cmp x y of-                    GT -> yld y (goX x mx ry)-                    _  -> yld x (goY mx y ry)-         in foldStream st yield single stop my--    goY0 mx y = mkStream $ \st yld sng _ -> do-        let stop = sng y-            single x = do-                case cmp x y of-                    GT -> yld y (fromPure x)-                    _  -> yld x (fromPure y)-            yield x rx = do-                case cmp x y of-                    GT -> yld y (x `cons` rx)-                    _  -> yld x (goY0 rx y)-         in foldStream st yield single stop mx--    goY mx y my = mkStream $ \st yld _ _ -> do-        let stop = yld y my-            single x = do-                case cmp x y of-                    GT -> yld y (goX0 x my)-                    _  -> yld x (y `cons` my)-            yield x rx = do-                case cmp x y of-                    GT -> yld y (goX x rx my)-                    _  -> yld x (goY rx y my)-         in foldStream st yield single stop mx----------------------------------------------------------------------------------- Transformation comprehensions---------------------------------------------------------------------------------{-# INLINE the #-}-the :: (Eq a, Monad m) => StreamK m a -> m (Maybe a)-the m = do-    r <- uncons m-    case r of-        Nothing -> return Nothing-        Just (h, t) -> go h t-    where-    go h m1 =-        let single a   | h == a    = return $ Just h-                       | otherwise = return Nothing-            yieldk a r | h == a    = go h r-                       | otherwise = return Nothing-         in foldStream defState yieldk single (return $ Just h) m1----------------------------------------------------------------------------------- Alternative & MonadPlus---------------------------------------------------------------------------------_alt :: StreamK m a -> StreamK m a -> StreamK m a-_alt m1 m2 = mkStream $ \st yld sng stp ->-    let stop  = foldStream st yld sng stp m2-    in foldStream st yld sng stop m1----------------------------------------------------------------------------------- MonadError---------------------------------------------------------------------------------{---- XXX handle and test cross thread state transfer-withCatchError-    :: MonadError e m-    => StreamK m a -> (e -> StreamK m a) -> StreamK m a-withCatchError m h =-    mkStream $ \_ stp sng yld ->-        let run x = unStream x Nothing stp sng yieldk-            handle r = r `catchError` \e -> run $ h e-            yieldk a r = yld a (withCatchError r h)-        in handle $ run m--}------------------------------------------------------------------------------------ Parsing------------------------------------------------------------------------------------ Inlined definition.-{-# INLINE splitAt #-}-splitAt :: Int -> [a] -> ([a],[a])-splitAt n ls-  | n <= 0 = ([], ls)-  | otherwise          = splitAt' n ls-    where-        splitAt' :: Int -> [a] -> ([a], [a])-        splitAt' _  []     = ([], [])-        splitAt' 1  (x:xs) = ([x], xs)-        splitAt' m  (x:xs) = (x:xs', xs'')-          where-            (xs', xs'') = splitAt' (m - 1) xs---- | Run a 'Parser' over a stream and return rest of the Stream.-{-# INLINE_NORMAL parseDBreak #-}-parseDBreak-    :: Monad m-    => PR.Parser a m b-    -> StreamK m a-    -> m (Either ParseError b, StreamK m a)-parseDBreak (PR.Parser pstep initial extract) stream = do-    res <- initial-    case res of-        PR.IPartial s -> goStream stream [] s-        PR.IDone b -> return (Right b, stream)-        PR.IError err -> return (Left (ParseError err), stream)--    where--    -- "buf" contains last few items in the stream that we may have to-    -- backtrack to.-    ---    -- XXX currently we are using a dumb list based approach for backtracking-    -- buffer. This can be replaced by a sliding/ring buffer using Data.Array.-    -- That will allow us more efficient random back and forth movement.-    goStream st buf !pst =-        let stop = do-                r <- extract pst-                case r of-                    PR.Error err -> return (Left (ParseError err), nil)-                    PR.Done n b -> do-                        assertM(n <= length buf)-                        let src0 = Prelude.take n buf-                            src  = Prelude.reverse src0-                        return (Right b, fromList src)-                    PR.Partial _ _ -> error "Bug: parseBreak: Partial in extract"-                    PR.Continue 0 s -> goStream nil buf s-                    PR.Continue n s -> do-                        assertM(n <= length buf)-                        let (src0, buf1) = splitAt n buf-                            src = Prelude.reverse src0-                        goBuf nil buf1 src s-            single x = yieldk x nil-            yieldk x r = do-                res <- pstep pst x-                case res of-                    PR.Partial 0 s -> goStream r [] s-                    PR.Partial n s -> do-                        assertM(n <= length (x:buf))-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        goBuf r [] src s-                    PR.Continue 0 s -> goStream r (x:buf) s-                    PR.Continue n s -> do-                        assertM(n <= length (x:buf))-                        let (src0, buf1) = splitAt n (x:buf)-                            src = Prelude.reverse src0-                        goBuf r buf1 src s-                    PR.Done 0 b -> return (Right b, r)-                    PR.Done n b -> do-                        assertM(n <= length (x:buf))-                        let src0 = Prelude.take n (x:buf)-                            src  = Prelude.reverse src0-                        return (Right b, append (fromList src) r)-                    PR.Error err -> return (Left (ParseError err), r)-         in foldStream defState yieldk single stop st--    goBuf st buf [] !pst = goStream st buf pst-    goBuf st buf (x:xs) !pst = do-        pRes <- pstep pst x-        case pRes of-            PR.Partial 0 s -> goBuf st [] xs s-            PR.Partial n s -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                goBuf st [] src s-            PR.Continue 0 s -> goBuf st (x:buf) xs s-            PR.Continue n s -> do-                assert (n <= length (x:buf)) (return ())-                let (src0, buf1) = splitAt n (x:buf)-                    src  = Prelude.reverse src0 ++ xs-                goBuf st buf1 src s-            PR.Done n b -> do-                assert (n <= length (x:buf)) (return ())-                let src0 = Prelude.take n (x:buf)-                    src  = Prelude.reverse src0-                return (Right b, append (fromList src) st)-            PR.Error err -> return (Left (ParseError err), nil)---- Using ParserD or ParserK on StreamK may not make much difference. We should--- perhaps use only chunked parsing on StreamK. We can always convert a stream--- to chunks before parsing. Or just have a ParserK element parser for StreamK--- and convert ParserD to ParserK for element parsing using StreamK.-{-# INLINE parseD #-}-parseD :: Monad m =>-    Parser.Parser a m b -> StreamK m a -> m (Either ParseError b)-parseD f = fmap fst . parseDBreak f------------------------------------------------------------------------------------ Chunked parsing using ParserK------------------------------------------------------------------------------------ The backracking buffer consists of arrays in the most-recent-first order. We--- want to take a total of n array elements from this buffer. Note: when we--- have to take an array partially, we must take the last part of the array.-{-# INLINE backTrack #-}-backTrack :: forall m a. Unbox a =>-       Int-    -> [Array a]-    -> StreamK m (Array a)-    -> (StreamK m (Array a), [Array a])-backTrack = go--    where--    go _ [] stream = (stream, [])-    go n xs stream | n <= 0 = (stream, xs)-    go n (x:xs) stream =-        let len = Array.length x-        in if n > len-           then go (n - len) xs (cons x stream)-           else if n == len-           then (cons x stream, xs)-           else let !(Array contents start end) = x-                    !start1 = end - (n * SIZE_OF(a))-                    arr1 = Array contents start1 end-                    arr2 = Array contents start start1-                 in (cons arr1 stream, arr2:xs)---- | A continuation to extract the result when a CPS parser is done.-{-# INLINE parserDone #-}-parserDone :: Applicative m =>-    ParserK.ParseResult b -> Int -> ParserK.Input a -> m (ParserK.Step a m b)-parserDone (ParserK.Success n b) _ _ = pure $ ParserK.Done n b-parserDone (ParserK.Failure n e) _ _ = pure $ ParserK.Error n e---- XXX parseDBreakChunks may be faster than converting parserD to parserK and--- using parseBreakChunks. We can also use parseBreak as an alternative to the--- monad instance of ParserD.---- | Run a 'ParserK' over a chunked 'StreamK' and return the rest of the Stream.-{-# INLINE_NORMAL parseBreakChunks #-}-parseBreakChunks-    :: (Monad m, Unbox a)-    => ParserK a m b-    -> StreamK m (Array a)-    -> m (Either ParseError b, StreamK m (Array a))-parseBreakChunks parser input = do-    let parserk = ParserK.runParser parser parserDone 0 0-     in go [] parserk input--    where--    {-# INLINE goStop #-}-    goStop backBuf parserk = do-        pRes <- parserk ParserK.None-        case pRes of-            -- If we stop in an alternative, it will try calling the next-            -- parser, the next parser may call initial returning Partial and-            -- then immediately we have to call extract on it.-            ParserK.Partial 0 cont1 ->-                 go [] cont1 nil-            ParserK.Partial n cont1 -> do-                let n1 = negate n-                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))-                let (s1, backBuf1) = backTrack n1 backBuf nil-                 in go backBuf1 cont1 s1-            ParserK.Continue 0 cont1 ->-                go backBuf cont1 nil-            ParserK.Continue n cont1 -> do-                let n1 = negate n-                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))-                let (s1, backBuf1) = backTrack n1 backBuf nil-                 in go backBuf1 cont1 s1-            ParserK.Done 0 b ->-                return (Right b, nil)-            ParserK.Done n b -> do-                let n1 = negate n-                assertM(n1 >= 0 && n1 <= sum (Prelude.map Array.length backBuf))-                let (s1, _) = backTrack n1 backBuf nil-                 in return (Right b, s1)-            ParserK.Error _ err -> return (Left (ParseError err), nil)--    seekErr n len =-        error $ "parseBreak: Partial: forward seek not implemented n = "-            ++ show n ++ " len = " ++ show len--    yieldk backBuf parserk arr stream = do-        pRes <- parserk (ParserK.Chunk arr)-        let len = Array.length arr-        case pRes of-            ParserK.Partial n cont1 ->-                case compare n len of-                    EQ -> go [] cont1 stream-                    LT -> do-                        if n >= 0-                        then yieldk [] cont1 arr stream-                        else do-                            let n1 = negate n-                                bufLen = sum (Prelude.map Array.length backBuf)-                                s = cons arr stream-                            assertM(n1 >= 0 && n1 <= bufLen)-                            let (s1, _) = backTrack n1 backBuf s-                            go [] cont1 s1-                    GT -> seekErr n len-            ParserK.Continue n cont1 ->-                case compare n len of-                    EQ -> go (arr:backBuf) cont1 stream-                    LT -> do-                        if n >= 0-                        then yieldk backBuf cont1 arr stream-                        else do-                            let n1 = negate n-                                bufLen = sum (Prelude.map Array.length backBuf)-                                s = cons arr stream-                            assertM(n1 >= 0 && n1 <= bufLen)-                            let (s1, backBuf1) = backTrack n1 backBuf s-                            go backBuf1 cont1 s1-                    GT -> seekErr n len-            ParserK.Done n b -> do-                let n1 = len - n-                assertM(n1 <= sum (Prelude.map Array.length (arr:backBuf)))-                let (s1, _) = backTrack n1 (arr:backBuf) stream-                 in return (Right b, s1)-            ParserK.Error _ err -> return (Left (ParseError err), nil)--    go backBuf parserk stream = do-        let stop = goStop backBuf parserk-            single a = yieldk backBuf parserk a nil-         in foldStream-                defState (yieldk backBuf parserk) single stop stream--{-# INLINE parseChunks #-}-parseChunks :: (Monad m, Unbox a) =>-    ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b)-parseChunks f = fmap fst . parseBreakChunks f------------------------------------------------------------------------------------ Sorting------------------------------------------------------------------------------------ | Sort the input stream using a supplied comparison function.------ Sorting can be achieved by simply:------ >>> sortBy cmp = StreamK.mergeMapWith (StreamK.mergeBy cmp) StreamK.fromPure------ However, this combinator uses a parser to first split the input stream into--- down and up sorted segments and then merges them to optimize sorting when--- pre-sorted sequences exist in the input stream.------ /O(n) space/----{-# INLINE sortBy #-}-sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a--- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure-sortBy cmp =-    let p =-            Parser.groupByRollingEither-                (\x -> (< GT) . cmp x)-                FL.toStreamKRev-                FL.toStreamK-     in   mergeMapWith (mergeBy cmp) id-        . Stream.toStreamK-        . Stream.catRights -- its a non-failing backtracking parser-        . Stream.parseMany (fmap (either id id) p)-        . Stream.fromStreamK
− src/Streamly/Internal/Data/Stream/StreamK/Alt.hs 
@@ -1,244 +0,0 @@--- |--- Module      : Streamly.StreamDK.Type--- Copyright   : (c) 2019 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ A CPS style stream using a constructor based representation instead of a--- function based representation.------ Streamly internally uses two fundamental stream representations, (1) streams--- with an open or arbitrary control flow (we call it StreamK), (2) streams--- with a structured or closed loop control flow (we call it StreamD). The--- higher level stream types can use any of these representations under the--- hood and can interconvert between the two.------ StreamD:------ StreamD is a non-recursive data type in which the state of the stream and--- the step function are separate. When the step function is called, a stream--- element and the new stream state is yielded. The generated element and the--- state are passed to the next consumer in the loop. The state is threaded--- around in the loop until control returns back to the original step function--- to run the next step. This creates a structured closed loop representation--- (like "for" loops in C) with state of each step being hidden/abstracted or--- existential within that step. This creates a loop representation identical--- to the "for" or "while" loop constructs in imperative languages, the states--- of the steps combined together constitute the state of the loop iteration.------ Internally most combinators use a closed loop representation because it--- provides very high efficiency due to stream fusion. The performance of this--- representation is competitive to the C language implementations.------ Pros and Cons of StreamD:------ 1) stream-fusion: This representation can be optimized very efficiently by--- the compiler because the state is explicitly separated from step functions,--- represented using pure data constructors and visible to the compiler, the--- stream steps can be fused using case-of-case transformations and the state--- can be specialized using spec-constructor optimization, yielding a C like--- tight loop/state machine with no constructors, the state is used unboxed and--- therefore no unnecessary allocation.------ 2) Because of a closed representation consing too many elements in this type--- of stream does not scale, it will have quadratic performance slowdown. Each--- cons creates a layer that needs to return the control back to the caller.--- Another implementation of cons is possible but that will have to box/unbox--- the state and will not fuse. So effectively cons breaks fusion.------ 3) unconsing an item from the stream breaks fusion, we have to "pause" the--- loop, rebox and save the state.------ 3) Exception handling is easy to implement in this model because control--- flow is structured in the loop and cannot be arbitrary. Therefore,--- implementing "bracket" is natural.------ 4) Round-robin scheduling for co-operative multitasking is easy to implement.------ 5) It fuses well with the direct style Fold implementation.------ StreamK/StreamDK:------ StreamDK i.e. the stream defined in this module, like StreamK, is a--- recursive data type which has no explicit state defined using constructors,--- each step yields an element and a computation representing the rest of the--- stream.  Stream state is part of the function representing the rest of the--- stream.  This creates an open computation representation, or essentially a--- continuation passing style computation.  After the stream step is executed,--- the caller is free to consume the produced element and then send the control--- wherever it wants, there is no restriction on the control to return back--- somewhere, the control is free to go anywhere. The caller may decide not to--- consume the rest of the stream. This representation is more like a "goto"--- based implementation in imperative languages.------ Pros and Cons of StreamK:------ 1) The way StreamD can be optimized using stream-fusion, this type can be--- optimized using foldr/build fusion. However, foldr/build has not yet been--- fully implemented for StreamK/StreamDK.------ 2) Using cons is natural in this representation, unlike in StreamD it does--- not have a quadratic slowdown. Currently, we in fact wrap StreamD in StreamK--- to support a better cons operation.------ 3) Similarly, uncons is natural in this representation.------ 4) Exception handling is not easy to implement because of the "goto" nature--- of CPS.------ 5) Composable folds are not implemented/proven, however, intuition says that--- a push style CPS representation should be able to be used along with StreamK--- to efficiently implement composable folds.--module Streamly.Internal.Data.Stream.StreamK.Alt-    (-    -- * Stream Type--      Stream-    , Step (..)--    -- * Construction-    , nil-    , cons-    , consM-    , unfoldr-    , unfoldrM-    , replicateM--    -- * Folding-    , uncons-    , foldrS--    -- * Specific Folds-    , drain-    )-where--#include "inline.hs"---- XXX Use Cons and Nil instead of Yield and Stop?-data Step m a = Yield a (Stream m a) | Stop--newtype Stream m a = Stream (m (Step m a))------------------------------------------------------------------------------------ Construction----------------------------------------------------------------------------------nil :: Monad m => Stream m a-nil = Stream $ return Stop--{-# INLINE_NORMAL cons #-}-cons :: Monad m => a -> Stream m a -> Stream m a-cons x xs = Stream $ return $ Yield x xs--consM :: Monad m => m a -> Stream m a -> Stream m a-consM eff xs = Stream $ eff >>= \x -> return $ Yield x xs--unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a-unfoldrM next state = Stream (step' state)-  where-    step' st = do-        r <- next st-        return $ case r of-            Just (x, s) -> Yield x (Stream (step' s))-            Nothing     -> Stop-{--unfoldrM next s0 = buildM $ \yld stp ->-    let go s = do-            r <- next s-            case r of-                Just (a, b) -> yld a (go b)-                Nothing -> stp-    in go s0--}--{-# INLINE unfoldr #-}-unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a-unfoldr next s0 = build $ \yld stp ->-    let go s =-            case next s of-                Just (a, b) -> yld a (go b)-                Nothing -> stp-    in go s0--replicateM :: Monad m => Int -> a -> Stream m a-replicateM n x = Stream (step n)-    where-    step i = return $-        if i <= 0-        then Stop-        else Yield x (Stream (step (i - 1)))------------------------------------------------------------------------------------ Folding----------------------------------------------------------------------------------uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))-uncons (Stream step) = do-    r <- step-    return $ case r of-        Yield x xs -> Just (x, xs)-        Stop -> Nothing---- | Lazy right associative fold to a stream.-{-# INLINE_NORMAL foldrS #-}-foldrS :: Monad m-       => (a -> Stream m b -> Stream m b)-       -> Stream m b-       -> Stream m a-       -> Stream m b-foldrS f streamb = go-    where-    go (Stream stepa) = Stream $ do-        r <- stepa-        case r of-            Yield x xs -> let Stream step = f x (go xs) in step-            Stop -> let Stream step = streamb in step--{-# INLINE_LATE foldrM #-}-foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b-foldrM fstep acc = go-    where-    go (Stream step) = do-        r <- step-        case r of-            Yield x xs -> fstep x (go xs)-            Stop -> acc--{-# INLINE_NORMAL build #-}-build :: Monad m-    => forall a. (forall b. (a -> b -> b) -> b -> b) -> Stream m a-build g = g cons nil--{-# RULES-"foldrM/build"  forall k z (g :: forall b. (a -> b -> b) -> b -> b).-                foldrM k z (build g) = g k z #-}--{---- To fuse foldrM with unfoldrM we need the type m1 to be polymorphic such that--- it is either Monad m or Stream m.  So that we can use cons/nil as well as--- monadic construction function as its arguments.----{-# INLINE_NORMAL buildM #-}-buildM :: Monad m-    => forall a. (forall b. (a -> m1 b -> m1 b) -> m1 b -> m1 b) -> Stream m a-buildM g = g cons nil--}------------------------------------------------------------------------------------ Specific folds----------------------------------------------------------------------------------{-# INLINE drain #-}-drain :: Monad m => Stream m a -> m ()-drain = foldrM (\_ xs -> xs) (return ())-{--drain (Stream step) = do-    r <- step-    case r of-        Yield _ next -> drain next-        Stop      -> return ()-        -}
− src/Streamly/Internal/Data/Stream/StreamK/Transformer.hs 
@@ -1,79 +0,0 @@--- |--- Module      : Streamly.Internal.Data.Stream.StreamK.Transformer--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.StreamK.Transformer-    (-      foldlT-    , foldrT--    , liftInner-    , evalStateT-    )-where--import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Monad.Trans.State.Strict (StateT)-import Streamly.Internal.Data.Stream.StreamK-    (StreamK, nil, cons, uncons, concatEffect)--import qualified Control.Monad.Trans.State.Strict as State---- | Lazy left fold to an arbitrary transformer monad.-{-# INLINE foldlT #-}-foldlT :: (Monad m, Monad (s m), MonadTrans s)-    => (s m b -> a -> s m b) -> s m b -> StreamK m a -> s m b-foldlT step = go-  where-    go acc m1 = do-        res <- lift $ uncons m1-        case res of-            Just (h, t) -> go (step acc h) t-            Nothing -> acc---- | Right associative fold to an arbitrary transformer monad.-{-# INLINE foldrT #-}-foldrT :: (Monad m, Monad (s m), MonadTrans s)-    => (a -> s m b -> s m b) -> s m b -> StreamK m a -> s m b-foldrT step final = go-  where-    go m1 = do-        res <- lift $ uncons m1-        case res of-            Just (h, t) -> step h (go t)-            Nothing -> final----------------------------------------------------------------------------------- Lifting inner monad---------------------------------------------------------------------------------{-# INLINE evalStateT #-}-evalStateT :: Monad m => m s -> StreamK (StateT s m) a -> StreamK m a-evalStateT = go--    where--    go st m1 = concatEffect $ fmap f (st >>= State.runStateT (uncons m1))--    f (res, s1) =-        case res of-            Just (h, t) -> cons h (go (return s1) t)-            Nothing -> nil--{-# INLINE liftInner #-}-liftInner :: (Monad m, MonadTrans t, Monad (t m)) =>-    StreamK m a -> StreamK (t m) a-liftInner = go--    where--    go m1 = concatEffect $ fmap f $ lift $ uncons m1--    f res =-        case res of-            Just (h, t) -> cons h (go t)-            Nothing -> nil
− src/Streamly/Internal/Data/Stream/StreamK/Type.hs 
@@ -1,2063 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE UndecidableInstances #-}--- |--- Module      : Streamly.Internal.Data.Stream.StreamK.Type--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--------- Continuation passing style (CPS) stream implementation. The symbol 'K' below--- denotes a function as well as a Kontinuation.----module Streamly.Internal.Data.Stream.StreamK.Type-    (-    -- * StreamK type-      Stream-    , StreamK (..)--    -- * CrossStreamK type wrapper-    , CrossStreamK-    , unCross-    , mkCross--    -- * foldr/build Fusion-    , mkStream-    , foldStream-    , foldStreamShared-    , foldrM-    , foldrS-    , foldrSShared-    , foldrSM-    , build-    , buildS-    , buildM-    , buildSM-    , augmentS-    , augmentSM-    , unShare--    -- * Construction-    -- ** Primitives-    , fromStopK-    , fromYieldK-    , consK-    , cons-    , (.:)-    , consM-    , consMBy-    , nil-    , nilM--    -- ** Unfolding-    , unfoldr-    , unfoldrMWith-    , unfoldrM--    -- ** From Values-    , fromEffect-    , fromPure-    , repeat-    , repeatMWith-    , replicateMWith--    -- ** From Indices-    , fromIndicesMWith--    -- ** Iteration-    , iterateMWith--    -- ** From Containers-    , fromFoldable-    , fromFoldableM--    -- ** Cyclic-    , mfix--    -- * Elimination-    -- ** Primitives-    , uncons--    -- ** Strict Left Folds-    , Streamly.Internal.Data.Stream.StreamK.Type.foldl'-    , foldlx'--    -- ** Lazy Right Folds-    , Streamly.Internal.Data.Stream.StreamK.Type.foldr--    -- ** Specific Folds-    , drain-    , null-    , tail-    , init--    -- * Mapping-    , map-    , mapMWith-    , mapMSerial--    -- * Combining Two Streams-    -- ** Appending-    , conjoin-    , append--    -- ** Interleave-    , interleave-    , interleaveFst-    , interleaveMin--    -- ** Cross Product-    , crossApplyWith-    , crossApply-    , crossApplySnd-    , crossApplyFst-    , crossWith-    , cross--    -- * Concat-    , before-    , concatEffect-    , concatMapEffect-    , concatMapWith-    , concatMap-    , bindWith-    , concatIterateWith-    , concatIterateLeftsWith-    , concatIterateScanWith--    -- * Merge-    , mergeMapWith-    , mergeIterateWith--    -- * Buffered Operations-    , foldlS-    , reverse-    )-where--#include "inline.hs"---- import Control.Applicative (liftA2)-import Control.Monad ((>=>))-import Control.Monad.Catch (MonadThrow, throwM)-import Control.Monad.Trans.Class (MonadTrans(lift))-import Control.Applicative (liftA2)-import Control.Monad.IO.Class (MonadIO(..))-import Data.Foldable (Foldable(foldl'), fold, foldr)-import Data.Function (fix)-import Data.Functor.Identity (Identity(..))-import Data.Maybe (fromMaybe)-import Data.Semigroup (Endo(..))-import GHC.Exts (IsList(..), IsString(..), oneShot)-import Streamly.Internal.BaseCompat ((#.))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import qualified Prelude--import Prelude hiding-    (map, mapM, concatMap, foldr, repeat, null, reverse, tail, init)--#include "DocTestDataStreamK.hs"----------------------------------------------------------------------------------- Basic stream type----------------------------------------------------------------------------------- It uses stop, singleton and yield continuations equivalent to the following--- direct style type:------ @--- data StreamK m a = Stop | Singleton a | Yield a (StreamK m a)--- @------ To facilitate parallel composition we maintain a local state in an 'SVar'--- that is shared across and is used for synchronization of the streams being--- composed.------ The singleton case can be expressed in terms of stop and yield but we have--- it as a separate case to optimize composition operations for streams with--- single element.  We build singleton streams in the implementation of 'pure'--- for Applicative and Monad, and in 'lift' for MonadTrans.---- XXX remove the State param.---- | Continuation Passing Style (CPS) version of "Streamly.Data.Stream.Stream".--- Unlike "Streamly.Data.Stream.Stream", 'StreamK' can be composed recursively--- without affecting performance.------ Semigroup instance appends two streams:------ >>> (<>) = Stream.append----{-# DEPRECATED Stream "Please use StreamK instead." #-}-type Stream = StreamK--newtype StreamK m a =-    MkStream (forall r.-               State StreamK m a         -- state-            -> (a -> StreamK m a -> m r) -- yield-            -> (a -> m r)               -- singleton-            -> m r                      -- stop-            -> m r-            )--mkStream-    :: (forall r. State StreamK m a-        -> (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r)-    -> StreamK m a-mkStream = MkStream---- | A terminal function that has no continuation to follow.-type StopK m = forall r. m r -> m r---- | A monadic continuation, it is a function that yields a value of type "a"--- and calls the argument (a -> m r) as a continuation with that value. We can--- also think of it as a callback with a handler (a -> m r).  Category--- theorists call it a codensity type, a special type of right kan extension.-type YieldK m a = forall r. (a -> m r) -> m r--_wrapM :: Monad m => m a -> YieldK m a-_wrapM m = (m >>=)---- | Make an empty stream from a stop function.-fromStopK :: StopK m -> StreamK m a-fromStopK k = mkStream $ \_ _ _ stp -> k stp---- | Make a singleton stream from a callback function. The callback function--- calls the one-shot yield continuation to yield an element.-fromYieldK :: YieldK m a -> StreamK m a-fromYieldK k = mkStream $ \_ _ sng _ -> k sng---- | Add a yield function at the head of the stream.-consK :: YieldK m a -> StreamK m a -> StreamK m a-consK k r = mkStream $ \_ yld _ _ -> k (`yld` r)---- XXX Build a stream from a repeating callback function.----------------------------------------------------------------------------------- Construction---------------------------------------------------------------------------------infixr 5 `cons`---- faster than consM because there is no bind.---- | A right associative prepend operation to add a pure value at the head of--- an existing stream::------ >>> s = 1 `StreamK.cons` 2 `StreamK.cons` 3 `StreamK.cons` StreamK.nil--- >>> Stream.fold Fold.toList (StreamK.toStream s)--- [1,2,3]------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil------ Same as the following but more efficient:------ >>> cons x xs = return x `StreamK.consM` xs----{-# INLINE_NORMAL cons #-}-cons :: a -> StreamK m a -> StreamK m a-cons a r = mkStream $ \_ yield _ _ -> yield a r--infixr 5 .:---- | Operator equivalent of 'cons'.------ @--- > toList $ 1 .: 2 .: 3 .: nil--- [1,2,3]--- @----{-# INLINE (.:) #-}-(.:) :: a -> StreamK m a -> StreamK m a-(.:) = cons---- | A stream that terminates without producing any output or side effect.------ >>> Stream.fold Fold.toList (StreamK.toStream StreamK.nil)--- []----{-# INLINE_NORMAL nil #-}-nil :: StreamK m a-nil = mkStream $ \_ _ _ stp -> stp---- | A stream that terminates without producing any output, but produces a side--- effect.------ >>> Stream.fold Fold.toList (StreamK.toStream (StreamK.nilM (print "nil")))--- "nil"--- []------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Applicative m => m b -> StreamK m a-nilM m = mkStream $ \_ _ _ stp -> m *> stp---- | Create a singleton stream from a pure value.------ >>> fromPure a = a `StreamK.cons` StreamK.nil--- >>> fromPure = pure--- >>> fromPure = StreamK.fromEffect . pure----{-# INLINE_NORMAL fromPure #-}-fromPure :: a -> StreamK m a-fromPure a = mkStream $ \_ _ single _ -> single a---- | Create a singleton stream from a monadic action.------ >>> fromEffect m = m `StreamK.consM` StreamK.nil------ >>> Stream.fold Fold.drain $ StreamK.toStream $ StreamK.fromEffect (putStrLn "hello")--- hello----{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Monad m => m a -> StreamK m a-fromEffect m = mkStream $ \_ _ single _ -> m >>= single--infixr 5 `consM`---- NOTE: specializing the function outside the instance definition seems to--- improve performance quite a bit at times, even if we have the same--- SPECIALIZE in the instance definition.---- | A right associative prepend operation to add an effectful value at the--- head of an existing stream::------ >>> s = putStrLn "hello" `StreamK.consM` putStrLn "world" `StreamK.consM` StreamK.nil--- >>> Stream.fold Fold.drain (StreamK.toStream s)--- hello--- world------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldableM = Prelude.foldr StreamK.consM StreamK.nil------ Same as the following but more efficient:------ >>> consM x xs = StreamK.fromEffect x `StreamK.append` xs----{-# INLINE consM #-}-{-# SPECIALIZE consM :: IO a -> StreamK IO a -> StreamK IO a #-}-consM :: Monad m => m a -> StreamK m a -> StreamK m a-consM m r = MkStream $ \_ yld _ _ -> m >>= (`yld` r)---- XXX specialize to IO?-{-# INLINE consMBy #-}-consMBy :: Monad m =>-    (StreamK m a -> StreamK m a -> StreamK m a) -> m a -> StreamK m a -> StreamK m a-consMBy f m r = fromEffect m `f` r----------------------------------------------------------------------------------- Folding a stream----------------------------------------------------------------------------------- | Fold a stream by providing an SVar, a stop continuation, a singleton--- continuation and a yield continuation. The stream would share the current--- SVar passed via the State.-{-# INLINE_EARLY foldStreamShared #-}-foldStreamShared-    :: State StreamK m a-    -> (a -> StreamK m a -> m r)-    -> (a -> m r)-    -> m r-    -> StreamK m a-    -> m r-foldStreamShared s yield single stop (MkStream k) = k s yield single stop---- | Fold a stream by providing a State, stop continuation, a singleton--- continuation and a yield continuation. The stream will not use the SVar--- passed via State.-{-# INLINE foldStream #-}-foldStream-    :: State StreamK m a-    -> (a -> StreamK m a -> m r)-    -> (a -> m r)-    -> m r-    -> StreamK m a-    -> m r-foldStream s yield single stop (MkStream k) =-    k (adaptState s) yield single stop------------------------------------------------------------------------------------ foldr/build fusion------------------------------------------------------------------------------------ XXX perhaps we can just use foldrSM/buildM everywhere as they are more--- general and cover foldrS/buildS as well.---- | The function 'f' decides how to reconstruct the stream. We could--- reconstruct using a shared state (SVar) or without sharing the state.----{-# INLINE foldrSWith #-}-foldrSWith ::-    (forall r. State StreamK m b-        -> (b -> StreamK m b -> m r)-        -> (b -> m r)-        -> m r-        -> StreamK m b-        -> m r)-    -> (a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSWith f step final m = go m-    where-    go m1 = mkStream $ \st yld sng stp ->-        let run x = f st yld sng stp x-            stop = run final-            single a = run $ step a final-            yieldk a r = run $ step a (go r)-         -- XXX if type a and b are the same we do not need adaptState, can we-         -- save some perf with that?-         -- XXX since we are using adaptState anyway here we can use-         -- foldStreamShared instead, will that save some perf?-         in foldStream (adaptState st) yieldk single stop m1---- XXX we can use rewrite rules just for foldrSWith, if the function f is the--- same we can rewrite it.---- | Fold sharing the SVar state within the reconstructed stream-{-# INLINE_NORMAL foldrSShared #-}-foldrSShared ::-       (a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSShared = foldrSWith foldStreamShared---- XXX consM is a typeclass method, therefore rewritten already. Instead maybe--- we can make consM polymorphic using rewrite rules.--- {-# RULES "foldrSShared/id"     foldrSShared consM nil = \x -> x #-}-{-# RULES "foldrSShared/nil"-    forall k z. foldrSShared k z nil = z #-}-{-# RULES "foldrSShared/single"-    forall k z x. foldrSShared k z (fromPure x) = k x z #-}--- {-# RULES "foldrSShared/app" [1]---     forall ys. foldrSShared consM ys = \xs -> xs `conjoin` ys #-}---- | Right fold to a streaming monad.------ > foldrS StreamK.cons StreamK.nil === id------ 'foldrS' can be used to perform stateless stream to stream transformations--- like map and filter in general. It can be coupled with a scan to perform--- stateful transformations. However, note that the custom map and filter--- routines can be much more efficient than this due to better stream fusion.------ >>> input = StreamK.fromStream $ Stream.fromList [1..5]--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS StreamK.cons StreamK.nil input--- [1,2,3,4,5]------ Find if any element in the stream is 'True':------ >>> step x xs = if odd x then StreamK.fromPure True else xs--- >>> input = StreamK.fromStream (Stream.fromList (2:4:5:undefined)) :: StreamK IO Int--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step (StreamK.fromPure False) input--- [True]------ Map (+2) on odd elements and filter out the even elements:------ >>> step x xs = if odd x then (x + 2) `StreamK.cons` xs else xs--- >>> input = StreamK.fromStream (Stream.fromList [1..5]) :: StreamK IO Int--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.foldrS step StreamK.nil input--- [3,5,7]------ /Pre-release/-{-# INLINE_NORMAL foldrS #-}-foldrS ::-       (a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrS = foldrSWith foldStream--{-# RULES "foldrS/id"     foldrS cons nil = \x -> x #-}-{-# RULES "foldrS/nil"    forall k z.   foldrS k z nil  = z #-}--- See notes in GHC.Base about this rule--- {-# RULES "foldr/cons"---  forall k z x xs. foldrS k z (x `cons` xs) = k x (foldrS k z xs) #-}-{-# RULES "foldrS/single" forall k z x. foldrS k z (fromPure x) = k x z #-}--- {-# RULES "foldrS/app" [1]---  forall ys. foldrS cons ys = \xs -> xs `conjoin` ys #-}------------------------------------------------------------------------------------ foldrS with monadic cons i.e. consM----------------------------------------------------------------------------------{-# INLINE foldrSMWith #-}-foldrSMWith :: Monad m-    => (forall r. State StreamK m b-        -> (b -> StreamK m b -> m r)-        -> (b -> m r)-        -> m r-        -> StreamK m b-        -> m r)-    -> (m a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSMWith f step final m = go m-    where-    go m1 = mkStream $ \st yld sng stp ->-        let run x = f st yld sng stp x-            stop = run final-            single a = run $ step (return a) final-            yieldk a r = run $ step (return a) (go r)-         in foldStream (adaptState st) yieldk single stop m1--{-# INLINE_NORMAL foldrSM #-}-foldrSM :: Monad m-    => (m a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSM = foldrSMWith foldStream---- {-# RULES "foldrSM/id"     foldrSM consM nil = \x -> x #-}-{-# RULES "foldrSM/nil"    forall k z.   foldrSM k z nil  = z #-}-{-# RULES "foldrSM/single" forall k z x. foldrSM k z (fromEffect x) = k x z #-}--- {-# RULES "foldrSM/app" [1]---  forall ys. foldrSM consM ys = \xs -> xs `conjoin` ys #-}---- Like foldrSM but sharing the SVar state within the recostructed stream.-{-# INLINE_NORMAL foldrSMShared #-}-foldrSMShared :: Monad m-    => (m a -> StreamK m b -> StreamK m b)-    -> StreamK m b-    -> StreamK m a-    -> StreamK m b-foldrSMShared = foldrSMWith foldStreamShared---- {-# RULES "foldrSM/id"     foldrSM consM nil = \x -> x #-}-{-# RULES "foldrSMShared/nil"-    forall k z. foldrSMShared k z nil = z #-}-{-# RULES "foldrSMShared/single"-    forall k z x. foldrSMShared k z (fromEffect x) = k x z #-}--- {-# RULES "foldrSM/app" [1]---  forall ys. foldrSM consM ys = \xs -> xs `conjoin` ys #-}------------------------------------------------------------------------------------ build----------------------------------------------------------------------------------{-# INLINE_NORMAL build #-}-build :: forall m a. (forall b. (a -> b -> b) -> b -> b) -> StreamK m a-build g = g cons nil--{-# RULES "foldrM/build"-    forall k z (g :: forall b. (a -> b -> b) -> b -> b).-    foldrM k z (build g) = g k z #-}--{-# RULES "foldrS/build"-      forall k z (g :: forall b. (a -> b -> b) -> b -> b).-      foldrS k z (build g) = g k z #-}--{-# RULES "foldrS/cons/build"-      forall k z x (g :: forall b. (a -> b -> b) -> b -> b).-      foldrS k z (x `cons` build g) = k x (g k z) #-}--{-# RULES "foldrSShared/build"-      forall k z (g :: forall b. (a -> b -> b) -> b -> b).-      foldrSShared k z (build g) = g k z #-}--{-# RULES "foldrSShared/cons/build"-      forall k z x (g :: forall b. (a -> b -> b) -> b -> b).-      foldrSShared k z (x `cons` build g) = k x (g k z) #-}---- build a stream by applying cons and nil to a build function-{-# INLINE_NORMAL buildS #-}-buildS ::-       ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a-buildS g = g cons nil--{-# RULES "foldrS/buildS"-      forall k z-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrS k z (buildS g) = g k z #-}--{-# RULES "foldrS/cons/buildS"-      forall k z x-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrS k z (x `cons` buildS g) = k x (g k z) #-}--{-# RULES "foldrSShared/buildS"-      forall k z-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrSShared k z (buildS g) = g k z #-}--{-# RULES "foldrSShared/cons/buildS"-      forall k z x-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-      foldrSShared k z (x `cons` buildS g) = k x (g k z) #-}---- build a stream by applying consM and nil to a build function-{-# INLINE_NORMAL buildSM #-}-buildSM :: Monad m-    => ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a-buildSM g = g consM nil--{-# RULES "foldrSM/buildSM"-     forall k z-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-     foldrSM k z (buildSM g) = g k z #-}--{-# RULES "foldrSMShared/buildSM"-     forall k z-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-     foldrSMShared k z (buildSM g) = g k z #-}---- Disabled because this may not fire as consM is a class Op-{--{-# RULES "foldrS/consM/buildSM"-      forall k z x (g :: (m a -> t m a -> t m a) -> t m a -> t m a)-    . foldrSM k z (x `consM` buildSM g)-    = k x (g k z)-#-}--}---- Build using monadic build functions (continuations) instead of--- reconstructing a stream.-{-# INLINE_NORMAL buildM #-}-buildM :: Monad m-    => (forall r. (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )-    -> StreamK m a-buildM g = mkStream $ \st yld sng stp ->-    g (\a r -> foldStream st yld sng stp (return a `consM` r)) sng stp---- | Like 'buildM' but shares the SVar state across computations.-{-# INLINE_NORMAL sharedMWith #-}-sharedMWith :: Monad m-    => (m a -> StreamK m a -> StreamK m a)-    -> (forall r. (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )-    -> StreamK m a-sharedMWith cns g = mkStream $ \st yld sng stp ->-    g (\a r -> foldStreamShared st yld sng stp (return a `cns` r)) sng stp------------------------------------------------------------------------------------ augment----------------------------------------------------------------------------------{-# INLINE_NORMAL augmentS #-}-augmentS ::-       ((a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a-    -> StreamK m a-augmentS g xs = g cons xs--{-# RULES "augmentS/nil"-    forall (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentS g nil = buildS g-    #-}--{-# RULES "foldrS/augmentS"-    forall k z xs-        (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    foldrS k z (augmentS g xs) = g k (foldrS k z xs)-    #-}--{-# RULES "augmentS/buildS"-    forall (g :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-           (h :: (a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentS g (buildS h) = buildS (\c n -> g c (h c n))-    #-}--{-# INLINE_NORMAL augmentSM #-}-augmentSM :: Monad m =>-       ((m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-    -> StreamK m a -> StreamK m a-augmentSM g xs = g consM xs--{-# RULES "augmentSM/nil"-    forall-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentSM g nil = buildSM g-    #-}--{-# RULES "foldrSM/augmentSM"-    forall k z xs-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    foldrSM k z (augmentSM g xs) = g k (foldrSM k z xs)-    #-}--{-# RULES "augmentSM/buildSM"-    forall-        (g :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a)-        (h :: (m a -> StreamK m a -> StreamK m a) -> StreamK m a -> StreamK m a).-    augmentSM g (buildSM h) = buildSM (\c n -> g c (h c n))-    #-}------------------------------------------------------------------------------------ Experimental foldrM/buildM------------------------------------------------------------------------------------ | Lazy right fold with a monadic step function.-{-# INLINE_NORMAL foldrM #-}-foldrM :: (a -> m b -> m b) -> m b -> StreamK m a -> m b-foldrM step acc m = go m-    where-    go m1 =-        let stop = acc-            single a = step a acc-            yieldk a r = step a (go r)-        in foldStream defState yieldk single stop m1--{-# INLINE_NORMAL foldrMKWith #-}-foldrMKWith-    :: (State StreamK m a-        -> (a -> StreamK m a -> m b)-        -> (a -> m b)-        -> m b-        -> StreamK m a-        -> m b)-    -> (a -> m b -> m b)-    -> m b-    -> ((a -> StreamK m a -> m b) -> (a -> m b) -> m b -> m b)-    -> m b-foldrMKWith f step acc = go-    where-    go k =-        let stop = acc-            single a = step a acc-            yieldk a r = step a (go (\yld sng stp -> f defState yld sng stp r))-        in k yieldk single stop--{--{-# RULES "foldrM/buildS"-      forall k z (g :: (a -> t m a -> t m a) -> t m a -> t m a)-    . foldrM k z (buildS g)-    = g k z-#-}--}--- XXX in which case will foldrM/buildM fusion be useful?-{-# RULES "foldrM/buildM"-    forall step acc (g :: (forall r.-           (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )).-    foldrM step acc (buildM g) = foldrMKWith foldStream step acc g-    #-}--{--{-# RULES "foldrM/sharedM"-    forall step acc (g :: (forall r.-           (a -> StreamK m a -> m r)-        -> (a -> m r)-        -> m r-        -> m r-       )).-    foldrM step acc (sharedM g) = foldrMKWith foldStreamShared step acc g-    #-}--}----------------------------------------------------------------------------------- Left fold----------------------------------------------------------------------------------- | Strict left fold with an extraction function. Like the standard strict--- left fold, but applies a user supplied extraction function (the third--- argument) to the folded value at the end. This is designed to work with the--- @foldl@ library. The suffix @x@ is a mnemonic for extraction.------ Note that the accumulator is always evaluated including the initial value.-{-# INLINE foldlx' #-}-foldlx' :: forall m a b x. Monad m-    => (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> m b-foldlx' step begin done m = get $ go m begin-    where-    {-# NOINLINE get #-}-    get :: StreamK m x -> m b-    get m1 =-        -- XXX we are not strictly evaluating the accumulator here. Is this-        -- okay?-        let single = return . done-        -- XXX this is foldSingleton. why foldStreamShared?-         in foldStreamShared undefined undefined single undefined m1--    -- Note, this can be implemented by making a recursive call to "go",-    -- however that is more expensive because of unnecessary recursion-    -- that cannot be tail call optimized. Unfolding recursion explicitly via-    -- continuations is much more efficient.-    go :: StreamK m a -> x -> StreamK m x-    go m1 !acc = mkStream $ \_ yld sng _ ->-        let stop = sng acc-            single a = sng $ step acc a-            -- XXX this is foldNonEmptyStream-            yieldk a r = foldStream defState yld sng undefined $-                go r (step acc a)-        in foldStream defState yieldk single stop m1---- | Strict left associative fold.-{-# INLINE foldl' #-}-foldl' :: Monad m => (b -> a -> b) -> b -> StreamK m a -> m b-foldl' step begin = foldlx' step begin id----------------------------------------------------------------------------------- Specialized folds----------------------------------------------------------------------------------- XXX use foldrM to implement folds where possible--- XXX This (commented) definition of drain and mapM_ perform much better on--- some benchmarks but worse on others. Need to investigate why, may there is--- an optimization opportunity that we can exploit.--- drain = foldrM (\_ xs -> return () >> xs) (return ())---- |--- > drain = foldl' (\_ _ -> ()) ()--- > drain = mapM_ (\_ -> return ())-{-# INLINE drain #-}-drain :: Monad m => StreamK m a -> m ()-drain = foldrM (\_ xs -> xs) (return ())-{--drain = go-    where-    go m1 =-        let stop = return ()-            single _ = return ()-            yieldk _ r = go r-         in foldStream defState yieldk single stop m1--}--{-# INLINE null #-}-null :: Monad m => StreamK m a -> m Bool--- null = foldrM (\_ _ -> return True) (return False)-null m =-    let stop      = return True-        single _  = return False-        yieldk _ _ = return False-    in foldStream defState yieldk single stop m----------------------------------------------------------------------------------- Semigroup---------------------------------------------------------------------------------infixr 6 `append`---- | Appends two streams sequentially, yielding all elements from the first--- stream, and then all elements from the second stream.------ >>> s1 = StreamK.fromStream $ Stream.fromList [1,2]--- >>> s2 = StreamK.fromStream $ Stream.fromList [3,4]--- >>> Stream.fold Fold.toList $ StreamK.toStream $ s1 `StreamK.append` s2--- [1,2,3,4]------ This has O(n) append performance where @n@ is the number of streams. It can--- be used to efficiently fold an infinite lazy container of streams using--- 'concatMapWith' et. al.----{-# INLINE append #-}-append :: StreamK m a -> StreamK m a -> StreamK m a--- XXX This doubles the time of toNullAp benchmark, may not be fusing properly--- serial xs ys = augmentS (\c n -> foldrS c n xs) ys-append m1 m2 = go m1-    where-    go m = mkStream $ \st yld sng stp ->-               let stop       = foldStream st yld sng stp m2-                   single a   = yld a m2-                   yieldk a r = yld a (go r)-               in foldStream st yieldk single stop m---- join/merge/append streams depending on consM-{-# INLINE conjoin #-}-conjoin :: Monad m => StreamK m a -> StreamK m a -> StreamK m a-conjoin xs = augmentSM (\c n -> foldrSM c n xs)--instance Semigroup (StreamK m a) where-    (<>) = append----------------------------------------------------------------------------------- Monoid---------------------------------------------------------------------------------instance Monoid (StreamK m a) where-    mempty = nil-    mappend = (<>)------------------------------------------------------------------------------------ Functor------------------------------------------------------------------------------------ IMPORTANT: This is eta expanded on purpose. This should not be eta--- reduced. This will cause a lot of regressions, probably because of some--- rewrite rules. Ideally don't run hlint on this file.-{-# INLINE_LATE mapFB #-}-mapFB :: forall b m a.-       (b -> StreamK m b -> StreamK m b)-    -> (a -> b)-    -> a-    -> StreamK m b-    -> StreamK m b-mapFB c f = \x ys -> c (f x) ys--{-# RULES-"mapFB/mapFB" forall c f g. mapFB (mapFB c f) g = mapFB c (f . g)-"mapFB/id"    forall c.     mapFB c (\x -> x)   = c-    #-}--{-# INLINE map #-}-map :: (a -> b) -> StreamK m a -> StreamK m b-map f xs = buildS (\c n -> foldrS (mapFB c f) n xs)---- XXX This definition might potentially be more efficient, but the cost in the--- benchmark is dominated by unfoldrM cost so we cannot correctly determine--- differences in the mapping cost. We should perhaps deduct the cost of--- unfoldrM from the benchmarks and then compare.-{--map f m = go m-    where-        go m1 =-            mkStream $ \st yld sng stp ->-            let single     = sng . f-                yieldk a r = yld (f a) (go r)-            in foldStream (adaptState st) yieldk single stp m1--}--{-# INLINE_LATE mapMFB #-}-mapMFB :: Monad m => (m b -> t m b -> t m b) -> (a -> m b) -> m a -> t m b -> t m b-mapMFB c f x = c (x >>= f)--{-# RULES-    "mapMFB/mapMFB" forall c f g. mapMFB (mapMFB c f) g = mapMFB c (f >=> g)-    #-}--- XXX These rules may never fire because pure/return type class rules will--- fire first.-{--"mapMFB/pure"    forall c.     mapMFB c (\x -> pure x)   = c-"mapMFB/return"  forall c.     mapMFB c (\x -> return x) = c--}---- This is experimental serial version supporting fusion.------ XXX what if we do not want to fuse two concurrent mapMs?--- XXX we can combine two concurrent mapM only if the SVar is of the same type--- So for now we use it only for serial streams.--- XXX fusion would be easier for monomoprhic stream types.--- {-# RULES "mapM serial" mapM = mapMSerial #-}-{-# INLINE mapMSerial #-}-mapMSerial :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b-mapMSerial f xs = buildSM (\c n -> foldrSMShared (mapMFB c f) n xs)--{-# INLINE mapMWith #-}-mapMWith ::-       (m b -> StreamK m b -> StreamK m b)-    -> (a -> m b)-    -> StreamK m a-    -> StreamK m b-mapMWith cns f = foldrSShared (\x xs -> f x `cns` xs) nil--{---- See note under map definition above.-mapMWith cns f = go-    where-    go m1 = mkStream $ \st yld sng stp ->-        let single a  = f a >>= sng-            yieldk a r = foldStreamShared st yld sng stp $ f a `cns` go r-         in foldStream (adaptState st) yieldk single stp m1--}---- XXX in fact use the Stream type everywhere and only use polymorphism in the--- high level modules/prelude.-instance Monad m => Functor (StreamK m) where-    fmap = map----------------------------------------------------------------------------------- Lists----------------------------------------------------------------------------------- Serial streams can act like regular lists using the Identity monad---- XXX Show instance is 10x slower compared to read, we can do much better.--- The list show instance itself is really slow.---- XXX The default definitions of "<" in the Ord instance etc. do not perform--- well, because they do not get inlined. Need to add INLINE in Ord class in--- base?--instance IsList (StreamK Identity a) where-    type (Item (StreamK Identity a)) = a--    {-# INLINE fromList #-}-    fromList = fromFoldable--    {-# INLINE toList #-}-    toList = Data.Foldable.foldr (:) []---- XXX Fix these-{--instance Eq a => Eq (StreamK Identity a) where-    {-# INLINE (==) #-}-    (==) xs ys = runIdentity $ eqBy (==) xs ys--instance Ord a => Ord (StreamK Identity a) where-    {-# INLINE compare #-}-    compare xs ys = runIdentity $ cmpBy compare xs ys--    {-# INLINE (<) #-}-    x < y =-        case compare x y of-            LT -> True-            _ -> False--    {-# INLINE (<=) #-}-    x <= y =-        case compare x y of-            GT -> False-            _ -> True--    {-# INLINE (>) #-}-    x > y =-        case compare x y of-            GT -> True-            _ -> False--    {-# INLINE (>=) #-}-    x >= y =-        case compare x y of-            LT -> False-            _ -> True--    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y--}--instance Show a => Show (StreamK Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (toList dl)--instance Read a => Read (StreamK Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        fromList <$> readPrec--    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (StreamK Identity a) where-    {-# INLINE fromString #-}-    fromString = fromList------------------------------------------------------------------------------------ Foldable------------------------------------------------------------------------------------ | Lazy right associative fold.-{-# INLINE foldr #-}-foldr :: Monad m => (a -> b -> b) -> b -> StreamK m a -> m b-foldr step acc = foldrM (\x xs -> xs >>= \b -> return (step x b)) (return acc)---- The default Foldable instance has several issues:--- 1) several definitions do not have INLINE on them, so we provide---    re-implementations with INLINE pragmas.--- 2) the definitions of sum/product/maximum/minimum are inefficient as they---    use right folds, they cannot run in constant memory. We provide---    implementations using strict left folds here.--instance (Foldable m, Monad m) => Foldable (StreamK m) where--    {-# INLINE foldMap #-}-    foldMap f =-          fold-        . Streamly.Internal.Data.Stream.StreamK.Type.foldr (mappend . f) mempty--    {-# INLINE foldr #-}-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    {-# INLINE foldl' #-}-    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0-        where f' x k = oneShot $ \z -> k $! f z x--    {-# INLINE length #-}-    length = Data.Foldable.foldl' (\n _ -> n + 1) 0--    {-# INLINE elem #-}-    elem = any . (==)--    {-# INLINE maximum #-}-    maximum =-          fromMaybe (errorWithoutStackTrace "maximum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMax Nothing'--        where--        getMax Nothing' x = Just' x-        getMax (Just' mx) x = Just' $! max mx x--    {-# INLINE minimum #-}-    minimum =-          fromMaybe (errorWithoutStackTrace "minimum: empty stream")-        . toMaybe-        . Data.Foldable.foldl' getMin Nothing'--        where--        getMin Nothing' x = Just' x-        getMin (Just' mn) x = Just' $! min mn x--    {-# INLINE sum #-}-    sum = Data.Foldable.foldl' (+) 0--    {-# INLINE product #-}-    product = Data.Foldable.foldl' (*) 1------------------------------------------------------------------------------------ Traversable----------------------------------------------------------------------------------instance Traversable (StreamK Identity) where-    {-# INLINE traverse #-}-    traverse f xs =-        runIdentity-            $ Streamly.Internal.Data.Stream.StreamK.Type.foldr-                consA (pure mempty) xs--        where--        consA x ys = liftA2 cons (f x) ys------------------------------------------------------------------------------------ Nesting------------------------------------------------------------------------------------ | Detach a stream from an SVar-{-# INLINE unShare #-}-unShare :: StreamK m a -> StreamK m a-unShare x = mkStream $ \st yld sng stp ->-    foldStream st yld sng stp x---- XXX the function stream and value stream can run in parallel-{-# INLINE crossApplyWith #-}-crossApplyWith ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> StreamK m (a -> b)-    -> StreamK m a-    -> StreamK m b-crossApplyWith par fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single f   = foldShared $ unShare (go2 f stream)-                yieldk f r = foldShared $ unShare (go2 f stream) `par` go1 r-            in foldStream (adaptState st) yieldk single stp m--    go2 f m =-        mkStream $ \st yld sng stp ->-            let single a   = sng (f a)-                yieldk a r = yld (f a) (go2 f r)-            in foldStream (adaptState st) yieldk single stp m---- | Apply a stream of functions to a stream of values and flatten the results.------ Note that the second stream is evaluated multiple times.------ Definition:------ >>> crossApply = StreamK.crossApplyWith StreamK.append--- >>> crossApply = Stream.crossWith id----{-# INLINE crossApply #-}-crossApply ::-       StreamK m (a -> b)-    -> StreamK m a-    -> StreamK m b-crossApply fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single f   = foldShared $ go3 f stream-                yieldk f r = foldShared $ go2 f r stream-            in foldStream (adaptState st) yieldk single stp m--    go2 f r1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ go1 r1-                single a   = yld (f a) (go1 r1)-                yieldk a r = yld (f a) (go2 f r1 r)-            in foldStream (adaptState st) yieldk single stop m--    go3 f m =-        mkStream $ \st yld sng stp ->-            let single a   = sng (f a)-                yieldk a r = yld (f a) (go3 f r)-            in foldStream (adaptState st) yieldk single stp m--{-# INLINE crossApplySnd #-}-crossApplySnd ::-       StreamK m a-    -> StreamK m b-    -> StreamK m b-crossApplySnd fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single _   = foldShared stream-                yieldk _ r = foldShared $ go2 r stream-            in foldStream (adaptState st) yieldk single stp m--    go2 r1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ go1 r1-                single a   = yld a (go1 r1)-                yieldk a r = yld a (go2 r1 r)-            in foldStream st yieldk single stop m--{-# INLINE crossApplyFst #-}-crossApplyFst ::-       StreamK m a-    -> StreamK m b-    -> StreamK m a-crossApplyFst fstream stream = go1 fstream--    where--    go1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single f   = foldShared $ go3 f stream-                yieldk f r = foldShared $ go2 f r stream-            in foldStream st yieldk single stp m--    go2 f r1 m =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ go1 r1-                single _   = yld f (go1 r1)-                yieldk _ r = yld f (go2 f r1 r)-            in foldStream (adaptState st) yieldk single stop m--    go3 f m =-        mkStream $ \st yld sng stp ->-            let single _   = sng f-                yieldk _ r = yld f (go3 f r)-            in foldStream (adaptState st) yieldk single stp m---- |--- Definition:------ >>> crossWith f m1 m2 = fmap f m1 `StreamK.crossApply` m2------ Note that the second stream is evaluated multiple times.----{-# INLINE crossWith #-}-crossWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c-crossWith f m1 m2 = fmap f m1 `crossApply` m2---- | Given a @StreamK m a@ and @StreamK m b@ generate a stream with all possible--- combinations of the tuple @(a, b)@.------ Definition:------ >>> cross = StreamK.crossWith (,)------ The second stream is evaluated multiple times. If that is not desired it can--- be cached in an 'Data.Array.Array' and then generated from the array before--- calling this function. Caching may also improve performance if the stream is--- expensive to evaluate.------ See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE cross #-}-cross :: Monad m => StreamK m a -> StreamK m b -> StreamK m (a, b)-cross = crossWith (,)---- XXX This is just concatMapWith with arguments flipped. We need to keep this--- instead of using a concatMap style definition because the bind--- implementation in Async and WAsync streams show significant perf degradation--- if the argument order is changed.-{-# INLINE bindWith #-}-bindWith ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> StreamK m a-    -> (a -> StreamK m b)-    -> StreamK m b-bindWith par m1 f = go m1-    where-        go m =-            mkStream $ \st yld sng stp ->-                let foldShared = foldStreamShared st yld sng stp-                    single a   = foldShared $ unShare (f a)-                    yieldk a r = foldShared $ unShare (f a) `par` go r-                in foldStream (adaptState st) yieldk single stp m---- XXX express in terms of foldrS?--- XXX can we use a different stream type for the generated stream being--- falttened so that we can combine them differently and keep the resulting--- stream different?--- XXX do we need specialize to IO?--- XXX can we optimize when c and a are same, by removing the forall using--- rewrite rules with type applications?---- | Perform a 'concatMap' using a specified concat strategy. The first--- argument specifies a merge or concat function that is used to merge the--- streams generated by the map function.----{-# INLINE concatMapWith #-}-concatMapWith-    ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> (a -> StreamK m b)-    -> StreamK m a-    -> StreamK m b-concatMapWith par f xs = bindWith par xs f--{-# INLINE concatMap #-}-concatMap :: (a -> StreamK m b) -> StreamK m a -> StreamK m b-concatMap = concatMapWith append--{---- Fused version.--- XXX This fuses but when the stream is nil this performs poorly.--- The filterAllOut benchmark degrades. Need to investigate and fix that.-{-# INLINE concatMap #-}-concatMap :: IsStream t => (a -> t m b) -> t m a -> t m b-concatMap f xs = buildS-    (\c n -> foldrS (\x b -> foldrS c b (f x)) n xs)---- Stream polymorphic concatMap implementation--- XXX need to use buildSM/foldrSMShared for parallel behavior--- XXX unShare seems to degrade the fused performance-{-# INLINE_EARLY concatMap_ #-}-concatMap_ :: IsStream t => (a -> t m b) -> t m a -> t m b-concatMap_ f xs = buildS-     (\c n -> foldrSShared (\x b -> foldrSShared c b (unShare $ f x)) n xs)--}---- | Combine streams in pairs using a binary combinator, the resulting streams--- are then combined again in pairs recursively until we get to a single--- combined stream. The composition would thus form a binary tree.------ For example, you can sort a stream using merge sort like this:------ >>> s = StreamK.fromStream $ Stream.fromList [5,1,7,9,2]--- >>> generate = StreamK.fromPure--- >>> combine = StreamK.mergeBy compare--- >>> Stream.fold Fold.toList $ StreamK.toStream $ StreamK.mergeMapWith combine generate s--- [1,2,5,7,9]------ Note that if the stream length is not a power of 2, the binary tree composed--- by mergeMapWith would not be balanced, which may or may not be important--- depending on what you are trying to achieve.------ /Caution: the stream of streams must be finite/------ /Pre-release/----{-# INLINE mergeMapWith #-}-mergeMapWith-    ::-       (StreamK m b -> StreamK m b -> StreamK m b)-    -> (a -> StreamK m b)-    -> StreamK m a-    -> StreamK m b-mergeMapWith combine f str = go (leafPairs str)--    where--    go stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single a   = foldShared $ unShare a-                yieldk a r = foldShared $ go1 a r-            in foldStream (adaptState st) yieldk single stp stream--    go1 a1 stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                stop = foldShared $ unShare a1-                single a = foldShared $ unShare a1 `combine` a-                yieldk a r =-                    foldShared $ go $ combine a1 a `cons` nonLeafPairs r-            in foldStream (adaptState st) yieldk single stop stream--    -- Exactly the same as "go" except that stop continuation extracts the-    -- stream.-    leafPairs stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single a   = sng (f a)-                yieldk a r = foldShared $ leafPairs1 a r-            in foldStream (adaptState st) yieldk single stp stream--    leafPairs1 a1 stream =-        mkStream $ \st yld sng _ ->-            let stop = sng (f a1)-                single a = sng (f a1 `combine` f a)-                yieldk a r = yld (f a1 `combine` f a) $ leafPairs r-            in foldStream (adaptState st) yieldk single stop stream--    -- Exactly the same as "leafPairs" except that it does not map "f"-    nonLeafPairs stream =-        mkStream $ \st yld sng stp ->-            let foldShared = foldStreamShared st yld sng stp-                single a   = sng a-                yieldk a r = foldShared $ nonLeafPairs1 a r-            in foldStream (adaptState st) yieldk single stp stream--    nonLeafPairs1 a1 stream =-        mkStream $ \st yld sng _ ->-            let stop = sng a1-                single a = sng (a1 `combine` a)-                yieldk a r = yld (a1 `combine` a) $ nonLeafPairs r-            in foldStream (adaptState st) yieldk single stop stream--{--instance Monad m => Applicative (StreamK m) where-    {-# INLINE pure #-}-    pure = fromPure--    {-# INLINE (<*>) #-}-    (<*>) = crossApply--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (*>) = crossApplySnd--    {-# INLINE (<*) #-}-    (<*) = crossApplyFst---- NOTE: even though concatMap for StreamD is 3x faster compared to StreamK,--- the monad instance of StreamD is slower than StreamK after foldr/build--- fusion.-instance Monad m => Monad (StreamK m) where-    {-# INLINE return #-}-    return = pure--    {-# INLINE (>>=) #-}-    (>>=) = flip concatMap--}--{---- Like concatMap but generates stream using an unfold function. Similar to--- unfoldMany but for StreamK.-concatUnfoldr :: IsStream t-    => (b -> t m (Maybe (a, b))) -> t m b -> t m a-concatUnfoldr = undefined--}----------------------------------------------------------------------------------- concatIterate - Map and flatten Trees of Streams----------------------------------------------------------------------------------- | Yield an input element in the output stream, map a stream generator on it--- and repeat the process on the resulting stream. Resulting streams are--- flattened using the 'concatMapWith' combinator. This can be used for a depth--- first style (DFS) traversal of a tree like structure.------ Example, list a directory tree using DFS:------ >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil)--- >>> input = StreamK.fromPure (Left ".")--- >>> ls = StreamK.concatIterateWith StreamK.append f input------ Note that 'iterateM' is a special case of 'concatIterateWith':------ >>> iterateM f = StreamK.concatIterateWith StreamK.append (StreamK.fromEffect . f) . StreamK.fromEffect------ /Pre-release/----{-# INLINE concatIterateWith #-}-concatIterateWith ::-       (StreamK m a -> StreamK m a -> StreamK m a)-    -> (a -> StreamK m a)-    -> StreamK m a-    -> StreamK m a-concatIterateWith combine f = iterateStream--    where--    iterateStream = concatMapWith combine generate--    generate x = x `cons` iterateStream (f x)---- | Like 'concatIterateWith' but uses the pairwise flattening combinator--- 'mergeMapWith' for flattening the resulting streams. This can be used for a--- balanced traversal of a tree like structure.------ Example, list a directory tree using balanced traversal:------ >>> f = StreamK.fromStream . either Dir.readEitherPaths (const Stream.nil)--- >>> input = StreamK.fromPure (Left ".")--- >>> ls = StreamK.mergeIterateWith StreamK.interleave f input------ /Pre-release/----{-# INLINE mergeIterateWith #-}-mergeIterateWith ::-       (StreamK m a -> StreamK m a -> StreamK m a)-    -> (a -> StreamK m a)-    -> StreamK m a-    -> StreamK m a-mergeIterateWith combine f = iterateStream--    where--    iterateStream = mergeMapWith combine generate--    generate x = x `cons` iterateStream (f x)----------------------------------------------------------------------------------- Flattening Graphs----------------------------------------------------------------------------------- To traverse graphs we need a state to be carried around in the traversal.--- For example, we can use a hashmap to store the visited status of nodes.---- | Like 'iterateMap' but carries a state in the stream generation function.--- This can be used to traverse graph like structures, we can remember the--- visited nodes in the state to avoid cycles.------ Note that a combination of 'iterateMap' and 'usingState' can also be used to--- traverse graphs. However, this function provides a more localized state--- instead of using a global state.------ See also: 'mfix'------ /Pre-release/----{-# INLINE concatIterateScanWith #-}-concatIterateScanWith-    :: Monad m-    => (StreamK m a -> StreamK m a -> StreamK m a)-    -> (b -> a -> m (b, StreamK m a))-    -> m b-    -> StreamK m a-    -> StreamK m a-concatIterateScanWith combine f initial stream =-    concatEffect $ do-        b <- initial-        iterateStream (b, stream)--    where--    iterateStream (b, s) = pure $ concatMapWith combine (generate b) s--    generate b a = a `cons` feedback b a--    feedback b a = concatEffect $ f b a >>= iterateStream----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- Keep concating either streams as long as rights are generated, stop as soon--- as a left is generated and concat the left stream.------ See also: 'handle'------ /Unimplemented/----{--concatMapEitherWith-    :: (forall x. t m x -> t m x -> t m x)-    -> (a -> t m (Either (StreamK m b) b))-    -> StreamK m a-    -> StreamK m b-concatMapEitherWith = undefined--}---- XXX We should prefer using the Maybe stream returning signatures over this.--- This API should perhaps be removed in favor of those.---- | In an 'Either' stream iterate on 'Left's.  This is a special case of--- 'concatIterateWith':------ >>> concatIterateLeftsWith combine f = StreamK.concatIterateWith combine (either f (const StreamK.nil))------ To traverse a directory tree:------ >>> input = StreamK.fromPure (Left ".")--- >>> ls = StreamK.concatIterateLeftsWith StreamK.append (StreamK.fromStream . Dir.readEither) input------ /Pre-release/----{-# INLINE concatIterateLeftsWith #-}-concatIterateLeftsWith-    :: (b ~ Either a c)-    => (StreamK m b -> StreamK m b -> StreamK m b)-    -> (a -> StreamK m b)-    -> StreamK m b-    -> StreamK m b-concatIterateLeftsWith combine f =-    concatIterateWith combine (either f (const nil))----------------------------------------------------------------------------------- Interleaving---------------------------------------------------------------------------------infixr 6 `interleave`---- Additionally we can have m elements yield from the first stream and n--- elements yielding from the second stream. We can also have time slicing--- variants of positional interleaving, e.g. run first stream for m seconds and--- run the second stream for n seconds.---- | Interleaves two streams, yielding one element from each stream--- alternately.  When one stream stops the rest of the other stream is used in--- the output stream.------ When joining many streams in a left associative manner earlier streams will--- get exponential priority than the ones joining later. Because of exponential--- weighting it can be used with 'concatMapWith' even on a large number of--- streams.----{-# INLINE interleave #-}-interleave :: StreamK m a -> StreamK m a -> StreamK m a-interleave m1 m2 = mkStream $ \st yld sng stp -> do-    let stop       = foldStream st yld sng stp m2-        single a   = yld a m2-        yieldk a r = yld a (interleave m2 r)-    foldStream st yieldk single stop m1--infixr 6 `interleaveFst`---- | Like `interleave` but stops interleaving as soon as the first stream stops.----{-# INLINE interleaveFst #-}-interleaveFst :: StreamK m a -> StreamK m a -> StreamK m a-interleaveFst m1 m2 = mkStream $ \st yld sng stp -> do-    let yieldFirst a r = yld a (yieldSecond r m2)-     in foldStream st yieldFirst sng stp m1--    where--    yieldSecond s1 s2 = mkStream $ \st yld sng stp -> do-            let stop       = foldStream st yld sng stp s1-                single a   = yld a s1-                yieldk a r = yld a (interleave s1 r)-             in foldStream st yieldk single stop s2--infixr 6 `interleaveMin`---- | Like `interleave` but stops interleaving as soon as any of the two streams--- stops.----{-# INLINE interleaveMin #-}-interleaveMin :: StreamK m a -> StreamK m a -> StreamK m a-interleaveMin m1 m2 = mkStream $ \st yld _ stp -> do-    let stop       = stp-        -- "single a" is defined as "yld a (interleaveMin m2 nil)" instead of-        -- "sng a" to keep the behaviour consistent with the yield-        -- continuation.-        single a   = yld a (interleaveMin m2 nil)-        yieldk a r = yld a (interleaveMin m2 r)-    foldStream st yieldk single stop m1------------------------------------------------------------------------------------ Generation----------------------------------------------------------------------------------{-# INLINE unfoldr #-}-unfoldr :: (b -> Maybe (a, b)) -> b -> StreamK m a-unfoldr next s0 = build $ \yld stp ->-    let go s =-            case next s of-                Just (a, b) -> yld a (go b)-                Nothing -> stp-    in go s0--{-# INLINE unfoldrMWith #-}-unfoldrMWith :: Monad m =>-       (m a -> StreamK m a -> StreamK m a)-    -> (b -> m (Maybe (a, b)))-    -> b-    -> StreamK m a-unfoldrMWith cns step = go--    where--    go s = sharedMWith cns $ \yld _ stp -> do-                r <- step s-                case r of-                    Just (a, b) -> yld a (go b)-                    Nothing -> stp--{-# INLINE unfoldrM #-}-unfoldrM :: Monad m => (b -> m (Maybe (a, b))) -> b -> StreamK m a-unfoldrM = unfoldrMWith consM---- | Generate an infinite stream by repeating a pure value.------ /Pre-release/-{-# INLINE repeat #-}-repeat :: a -> StreamK m a-repeat a = let x = cons a x in x---- | Like 'repeatM' but takes a stream 'cons' operation to combine the actions--- in a stream specific manner. A serial cons would repeat the values serially--- while an async cons would repeat concurrently.------ /Pre-release/-repeatMWith :: (m a -> t m a -> t m a) -> m a -> t m a-repeatMWith cns = go--    where--    go m = m `cns` go m--{-# INLINE replicateMWith #-}-replicateMWith :: (m a -> StreamK m a -> StreamK m a) -> Int -> m a -> StreamK m a-replicateMWith cns n m = go n--    where--    go cnt = if cnt <= 0 then nil else m `cns` go (cnt - 1)--{-# INLINE fromIndicesMWith #-}-fromIndicesMWith ::-    (m a -> StreamK m a -> StreamK m a) -> (Int -> m a) -> StreamK m a-fromIndicesMWith cns gen = go 0--    where--    go i = mkStream $ \st stp sng yld -> do-        foldStreamShared st stp sng yld (gen i `cns` go (i + 1))--{-# INLINE iterateMWith #-}-iterateMWith :: Monad m =>-    (m a -> StreamK m a -> StreamK m a) -> (a -> m a) -> m a -> StreamK m a-iterateMWith cns step = go--    where--    go s = mkStream $ \st stp sng yld -> do-        !next <- s-        foldStreamShared st stp sng yld (return next `cns` go (step next))--{-# INLINE headPartial #-}-headPartial :: Monad m => StreamK m a -> m a-headPartial = foldrM (\x _ -> return x) (error "head of nil")--{-# INLINE tailPartial #-}-tailPartial :: StreamK m a -> StreamK m a-tailPartial m = mkStream $ \st yld sng stp ->-    let stop      = error "tail of nil"-        single _  = stp-        yieldk _ r = foldStream st yld sng stp r-    in foldStream st yieldk single stop m---- | We can define cyclic structures using @let@:------ >>> let (a, b) = ([1, b], head a) in (a, b)--- ([1,1],1)------ The function @fix@ defined as:------ >>> fix f = let x = f x in x------ ensures that the argument of a function and its output refer to the same--- lazy value @x@ i.e.  the same location in memory.  Thus @x@ can be defined--- in terms of itself, creating structures with cyclic references.------ >>> f ~(a, b) = ([1, b], head a)--- >>> fix f--- ([1,1],1)------ 'Control.Monad.mfix' is essentially the same as @fix@ but for monadic--- values.------ Using 'mfix' for streams we can construct a stream in which each element of--- the stream is defined in a cyclic fashion. The argument of the function--- being fixed represents the current element of the stream which is being--- returned by the stream monad. Thus, we can use the argument to construct--- itself.------ In the following example, the argument @action@ of the function @f@--- represents the tuple @(x,y)@ returned by it in a given iteration. We define--- the first element of the tuple in terms of the second.------ >>> import System.IO.Unsafe (unsafeInterleaveIO)------ >>> :{--- main = Stream.fold (Fold.drainMapM print) $ StreamK.toStream $ StreamK.mfix f---     where---     f action = StreamK.unCross $ do---         let incr n act = fmap ((+n) . snd) $ unsafeInterleaveIO act---         x <- StreamK.mkCross $ StreamK.fromStream $ Stream.sequence $ Stream.fromList [incr 1 action, incr 2 action]---         y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [4,5]---         return (x, y)--- :}------ Note: you cannot achieve this by just changing the order of the monad--- statements because that would change the order in which the stream elements--- are generated.------ Note that the function @f@ must be lazy in its argument, that's why we use--- 'unsafeInterleaveIO' on @action@ because IO monad is strict.------ /Pre-release/-{-# INLINE mfix #-}-mfix :: Monad m => (m a -> StreamK m a) -> StreamK m a-mfix f = mkStream $ \st yld sng stp ->-    let single a  = foldStream st yld sng stp $ a `cons` ys-        yieldk a _ = foldStream st yld sng stp $ a `cons` ys-    in foldStream st yieldk single stp xs--    where--    -- fix the head element of the stream-    xs = fix  (f . headPartial)--    -- now fix the tail recursively-    ys = mfix (tailPartial . f)------------------------------------------------------------------------------------ Conversions------------------------------------------------------------------------------------ |--- >>> fromFoldable = Prelude.foldr StreamK.cons StreamK.nil------ Construct a stream from a 'Foldable' containing pure values:----{-# INLINE fromFoldable #-}-fromFoldable :: Foldable f => f a -> StreamK m a-fromFoldable = Prelude.foldr cons nil--{-# INLINE fromFoldableM #-}-fromFoldableM :: (Foldable f, Monad m) => f (m a) -> StreamK m a-fromFoldableM = Prelude.foldr consM nil------------------------------------------------------------------------------------ Deconstruction----------------------------------------------------------------------------------{-# INLINE uncons #-}-uncons :: Applicative m => StreamK m a -> m (Maybe (a, StreamK m a))-uncons m =-    let stop = pure Nothing-        single a = pure (Just (a, nil))-        yieldk a r = pure (Just (a, r))-    in foldStream defState yieldk single stop m--{-# INLINE tail #-}-tail :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))-tail =-    let stop      = pure Nothing-        single _  = pure $ Just nil-        yieldk _ r = pure $ Just r-    in foldStream defState yieldk single stop---- | Extract all but the last element of the stream, if any.------ Note: This will end up buffering the entire stream.------ /Pre-release/-{-# INLINE init #-}-init :: Applicative m => StreamK m a -> m (Maybe (StreamK m a))-init = go1-    where-    go1 m1 = do-        (\case-            Nothing -> Nothing-            Just (h, t) -> Just $ go h t) <$> uncons m1-    go p m1 = mkStream $ \_ yld sng stp ->-        let single _ = sng p-            yieldk a x = yld p $ go a x-         in foldStream defState yieldk single stp m1----------------------------------------------------------------------------------- Reordering----------------------------------------------------------------------------------- | Lazy left fold to a stream.-{-# INLINE foldlS #-}-foldlS ::-    (StreamK m b -> a -> StreamK m b) -> StreamK m b -> StreamK m a -> StreamK m b-foldlS step = go-    where-    go acc rest = mkStream $ \st yld sng stp ->-        let run x = foldStream st yld sng stp x-            stop = run acc-            single a = run $ step acc a-            yieldk a r = run $ go (step acc a) r-         in foldStream (adaptState st) yieldk single stop rest--{-# INLINE reverse #-}-reverse :: StreamK m a -> StreamK m a-reverse = foldlS (flip cons) nil----------------------------------------------------------------------------------- Running effects----------------------------------------------------------------------------------- | Run an action before evaluating the stream.-{-# INLINE before #-}-before :: Monad m => m b -> StreamK m a -> StreamK m a-before action stream =-    mkStream $ \st yld sng stp ->-        action >> foldStreamShared st yld sng stp stream---- | concat . fromEffect-{-# INLINE concatEffect #-}-concatEffect :: Monad m => m (StreamK m a) -> StreamK m a-concatEffect action =-    mkStream $ \st yld sng stp ->-        action >>= foldStreamShared st yld sng stp--{-# INLINE concatMapEffect #-}-concatMapEffect :: Monad m => (b -> StreamK m a) -> m b -> StreamK m a-concatMapEffect f action =-    mkStream $ \st yld sng stp ->-        action >>= foldStreamShared st yld sng stp . f----------------------------------------------------------------------------------- Stream with a cross product style monad instance----------------------------------------------------------------------------------- | A newtype wrapper for the 'StreamK' type adding a cross product style--- monad instance.------ A 'Monad' bind behaves like a @for@ loop:------ >>> :{--- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do---     x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2]---     -- Perform the following actions for each x in the stream---     return x--- :}--- [1,2]------ Nested monad binds behave like nested @for@ loops:------ >>> :{--- Stream.fold Fold.toList $ StreamK.toStream $ StreamK.unCross $ do---     x <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [1,2]---     y <- StreamK.mkCross $ StreamK.fromStream $ Stream.fromList [3,4]---     -- Perform the following actions for each x, for each y---     return (x, y)--- :}--- [(1,3),(1,4),(2,3),(2,4)]----newtype CrossStreamK m a = CrossStreamK {unCrossStreamK :: StreamK m a}-        deriving (Functor, Semigroup, Monoid, Foldable)---- | Wrap the 'StreamK' type in a 'CrossStreamK' newtype to enable cross--- product style applicative and monad instances.------ This is a type level operation with no runtime overhead.-{-# INLINE mkCross #-}-mkCross :: StreamK m a -> CrossStreamK m a-mkCross = CrossStreamK---- | Unwrap the 'StreamK' type from 'CrossStreamK' newtype.------ This is a type level operation with no runtime overhead.-{-# INLINE unCross #-}-unCross :: CrossStreamK m a -> StreamK m a-unCross = unCrossStreamK---- Pure (Identity monad) stream instances-deriving instance Traversable (CrossStreamK Identity)-deriving instance IsList (CrossStreamK Identity a)-deriving instance (a ~ Char) => IsString (CrossStreamK Identity a)--- deriving instance Eq a => Eq (CrossStreamK Identity a)--- deriving instance Ord a => Ord (CrossStreamK Identity a)---- Do not use automatic derivation for this to show as "fromList" rather than--- "fromList Identity".-instance Show a => Show (CrossStreamK Identity a) where-    {-# INLINE show #-}-    show (CrossStreamK xs) = show xs--instance Read a => Read (CrossStreamK Identity a) where-    {-# INLINE readPrec #-}-    readPrec = fmap CrossStreamK readPrec----------------------------------------------------------------------------------- Applicative----------------------------------------------------------------------------------- Note: we need to define all the typeclass operations because we want to--- INLINE them.-instance Monad m => Applicative (CrossStreamK m) where-    {-# INLINE pure #-}-    pure x = CrossStreamK (fromPure x)--    {-# INLINE (<*>) #-}-    (CrossStreamK s1) <*> (CrossStreamK s2) =-        CrossStreamK (crossApply s1 s2)--    {-# INLINE liftA2 #-}-    liftA2 f x = (<*>) (fmap f x)--    {-# INLINE (*>) #-}-    (CrossStreamK s1) *> (CrossStreamK s2) =-        CrossStreamK (crossApplySnd s1 s2)--    {-# INLINE (<*) #-}-    (CrossStreamK s1) <* (CrossStreamK s2) =-        CrossStreamK (crossApplyFst s1 s2)----------------------------------------------------------------------------------- Monad---------------------------------------------------------------------------------instance Monad m => Monad (CrossStreamK m) where-    return = pure--    -- Benchmarks better with CPS bind and pure:-    -- Prime sieve (25x)-    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)-    ---    {-# INLINE (>>=) #-}-    (>>=) (CrossStreamK m) f =-        CrossStreamK (bindWith append m (unCrossStreamK . f))--    {-# INLINE (>>) #-}-    (>>) = (*>)----------------------------------------------------------------------------------- Transformers---------------------------------------------------------------------------------instance (MonadIO m) => MonadIO (CrossStreamK m) where-    liftIO x = CrossStreamK (fromEffect $ liftIO x)--instance MonadTrans CrossStreamK where-    {-# INLINE lift #-}-    lift x = CrossStreamK (fromEffect x)--instance (MonadThrow m) => MonadThrow (CrossStreamK m) where-    throwM = lift . throwM
+ src/Streamly/Internal/Data/Stream/Top.hs view
@@ -0,0 +1,457 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Top+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Top level module that can depend on all other lower level Stream modules.+--+-- 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+    (+    -- * 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+    , sortedIntersectBy+    , sortedDeleteFirstsBy+    , sortedUnionBy++    -- * Cross Joins+    , innerJoin++    -- Joins on sorted stream+    , innerSortedJoin+    , leftSortedJoin+    , outerSortedJoin+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (newIORef, readIORef, modifyIORef')+import Streamly.Internal.Data.Fold.Type (Fold)+import Streamly.Internal.Data.Stream.Type (Stream(..), 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.Transform as Stream++import Prelude hiding (filter, zipWith, concatMap, concat)++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- SQL Joins+------------------------------------------------------------------------------+--+-- Some references:+-- * https://en.wikipedia.org/wiki/Relational_algebra+-- * https://en.wikipedia.org/wiki/Join_(SQL)++-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only+-- constraint, the best would be to use an Array with linear search. If the+-- second stream is sorted we can also use a binary search, using Ord+-- constraint or an ordering function.+--+-- For Storables we can cache the second stream into an unboxed array for+-- possibly faster access/compact representation?+--+-- If we do not want to keep the stream in memory but always read it from the+-- source (disk/network) every time we iterate through it then we can do that+-- too by reading the stream every time, the stream must have immutable state+-- in that case and the user is responsible for the behavior if the stream+-- source changes during iterations. We can also use an Unfold instead of+-- stream. We probably need a way to distinguish streams that can be read+-- mutliple times without any interference (e.g. unfolding a stream using an+-- immutable handle would work i.e. using pread/pwrite instead of maintaining+-- an offset in the handle).++-- XXX We can do this concurrently.+-- XXX If the second stream is sorted and passed as an Array we could use+-- binary search if we have an Ord instance or Ordering returning function. The+-- time complexity would then become (m x log n).++-- | Like 'cross' but emits only those tuples where @a == b@ using the supplied+-- equality predicate. This is essentially a @cross intersection@ of two+-- streams.+--+-- Definition:+--+-- >>> innerJoin eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ Stream.cross s1 s2+--+-- 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.+--+-- 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 innerJoin #-}+innerJoin :: Monad m =>+    (a -> b -> Bool) -> Stream m a -> Stream m b -> Stream m (a, b)+innerJoin eq s1 s2 = Stream.filter (\(a, b) -> a `eq` b) $ cross s1 s2+{-+innerJoin eq s1 s2 = do+    -- ConcatMap works faster than bind+    Stream.concatMap (\a ->+        Stream.concatMap (\b ->+            if a `eq` b+            then Stream.fromPure (a, b)+            else Stream.nil+            ) s2+        ) s1+-}++-- | A more efficient 'innerJoin' for sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE innerSortedJoin #-}+innerSortedJoin ::+    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, b)+innerSortedJoin = undefined++-- | A more efficient 'leftJoin' for sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE leftSortedJoin #-}+leftSortedJoin :: -- Monad m =>+    (a -> b -> Ordering) -> Stream m a -> Stream m b -> Stream m (a, Maybe b)+leftSortedJoin _eq _s1 _s2 = undefined++-- | A more efficient 'outerJoin' for sorted streams.+--+-- Space: O(1)+--+-- Time: O(m + n)+--+-- /Unimplemented/+{-# INLINE outerSortedJoin #-}+outerSortedJoin :: -- Monad m =>+       (a -> b -> Ordering)+    -> Stream m a+    -> Stream m b+    -> Stream m (Maybe a, Maybe b)+outerSortedJoin _eq _s1 _s2 = undefined++------------------------------------------------------------------------------+-- Set operations (special joins)+------------------------------------------------------------------------------+--+-- TODO: OrdSet/IntSet/hashmap based versions of these. With Eq only constraint+-- the best would be to use an Array with linear search. If the second stream+-- is sorted we can also use a binary search, using Ord constraint.++-- | Keep only those elements in the 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.+--+-- The first stream must be finite and must not block.+{-# INLINE filterStreamWith #-}+filterStreamWith :: Monad m =>+       Fold m a (f a)+    -> (a -> f a -> Bool)+    -> Stream m a+    -> Stream m a+    -> Stream m a+filterStreamWith fld member s1 s2 =+    Stream.concatEffect+        $ do+            xs <- Stream.fold fld s2+            return $ Stream.filter (`member` xs) s1++-- 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'.+--+-- >>> 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]+--+-- 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.+--+-- Time: O(m x n) where @m@ is the number of elements in the first stream and+-- @n@ is the number of elements in the second stream.+--+-- /Pre-release/+{-# INLINE intersectBy #-}+intersectBy :: Monad m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+intersectBy eq =+    -- XXX Use an (unboxed) array instead.+    filterStreamWith+        (Fold.postscanlMaybe (Scanl.uniqBy eq) Fold.toListRev)+        (List.any . eq)++-------------------------------------------------------------------------------+-- 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_NORMAL sortedIntersectBy #-}+sortedIntersectBy :: Monad m =>+    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+sortedIntersectBy 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++-- | 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'.+--+-- >>> 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]+--+-- The following holds:+--+-- > deleteFirstsBy (==) (Stream.ordNub s2 `append` s1) s2 === s1+-- > deleteFirstsBy (==) (Stream.ordNub s2 `interleave` s1) s2 === s1+--+-- First stream can be infinite, second stream must be finite.+--+-- Space: O(m) where @m@ is the number of elements in the first stream.+--+-- Time: O(m x n) where @m@ is the number of elements in the first stream and+-- @n@ is the number of elements in the second stream.+--+-- /Pre-release/+{-# INLINE deleteFirstsBy #-}+deleteFirstsBy :: Monad m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+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.++    -- 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 sortedDeleteFirstsBy #-}+sortedDeleteFirstsBy :: -- (Monad m) =>+    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+sortedDeleteFirstsBy _eq _s1 _s2 = undefined++-- XXX Remove the MonadIO constraint. We can just cache one stream and then+-- implement using differenceEqBy.++-- | 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:+--+-- >>> unionBy eq s1 s2 = s1 `Stream.append` Stream.deleteFirstsBy eq s1 (Stream.ordNub s2)+--+-- Example:+--+-- >>> 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 unionBy #-}+unionBy :: MonadIO m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a -> Stream m a+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+            let f x = do+                    liftIO $ modifyIORef' ref (List.deleteBy eq x)+                    return x+                s3 = Stream.concatEffect+                        $ do+                            xs1 <- liftIO $ readIORef ref+                            return $ Stream.fromList xs1+            return $ Stream.mapM f s2 `Stream.append` s3++-- | A more efficient '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 sortedUnionBy #-}+sortedUnionBy :: -- (Monad m) =>+    (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a+sortedUnionBy _eq _s1 _s2 = undefined
src/Streamly/Internal/Data/Stream/Transform.hs view
@@ -1,1056 +1,2289 @@--- |--- Module      : Streamly.Internal.Data.Stream.Transform--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC--module Streamly.Internal.Data.Stream.Transform-    (-    -- * Piping-    -- | Pass through a 'Pipe'.-      transform--    -- * Folding-    , foldrS--    -- * Mapping-    -- | Stateless one-to-one maps.-    , sequence-    , mapM--    -- * Mapping Side Effects (Observation)-    -- | See also the intersperse*_ combinators.-    , trace-    , trace_-    , tap--    -- * Scanning-    , scan-    , scanMany-    , postscan-    , smapM-    , scanlMAfter'--    -- * Filtering-    -- | Produce a subset of the stream using criteria based on the values of-    -- the elements. We can use a concatMap and scan for filtering but these-    -- combinators are more efficient and convenient.--    -- mapMaybeM is a general filtering combinator as we can map the stream to-    -- Just/Nothing using any stateful fold and then use this to filter out.-    , mapMaybeM-    , mapMaybe-    , catMaybes-    , scanMaybe--    , with-    , deleteBy-    , filter-    , filterM--    -- Stateful/scanning filters-    , uniq-    , uniqBy-    , prune-    , repeated--    -- * Trimming-    -- | Produce a subset of the stream trimmed at ends.--    , take-    , takeWhile-    , takeWhileM-    , takeWhileLast-    , takeWhileAround-    , drop-    , dropLast-    , dropWhile-    , dropWhileM-    , dropWhileLast-    , dropWhileAround--    -- * Position Indexing-    , indexed-    , indexedR--      -- * Time Indexing-    , timestamped-    , timestampWith-    , timeIndexed-    , timeIndexWith--    -- * Searching-    , findIndices -- XXX indicesBy-    , elemIndices -- XXX indicesOf--    -- * Rolling map-    -- | Map using the previous element.-    , rollingMapM-    , rollingMap-    , rollingMap2--    -- Merge--    -- * Inserting Elements-    -- | Produce a superset of the stream. This is the opposite of-    -- filtering/sampling.  We can always use concatMap and scan for inserting-    -- but these combinators are more efficient and convenient.--    -- Element agnostic (Opposite of sampling)-    , intersperse-    , intersperseM -- XXX naming-    , intersperseMWith--    , intersperseMSuffix-    , intersperseMSuffixWith--    -- , interspersePrefix-    -- , interspersePrefixBySpan--    -- * Inserting Side Effects/Time-    , intersperseM_ -- XXX naming-    , delay-    , intersperseMSuffix_-    , delayPost-    , intersperseMPrefix_-    , delayPre--    -- * Element Aware Insertion-    -- | Opposite of filtering-    , insertBy-    -- , intersperseByBefore-    -- , intersperseByAfter--    -- Fold and Unfold, Buffering--    -- * Reordering-    , reverse-    , reverse'-    , reassembleBy--    -- * Either Streams-    -- Move these to Streamly.Data.Either.Stream?-    , catLefts-    , catRights-    , catEithers-    )-where--#include "inline.hs"--import Control.Concurrent (threadDelay)-import Control.Monad (void)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Data.Either (fromLeft, isLeft, isRight, fromRight)-import Data.Maybe (isJust, fromJust)--import Streamly.Internal.Data.Fold.Type (Fold)-import Streamly.Internal.Data.Pipe (Pipe)-import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64)--import qualified Streamly.Internal.Data.Fold as FL--- import qualified Streamly.Internal.Data.Fold.Window as Window-import qualified Streamly.Internal.Data.Stream.StreamD.Transform as D-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---import Streamly.Internal.Data.Stream.Bottom-import Streamly.Internal.Data.Stream.Type--import Prelude hiding-       ( filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence-       , reverse, foldr1 , repeat, scanl, scanl1, zipWith)------- $setup--- >>> :m--- >>> import Control.Concurrent (threadDelay)--- >>> import Control.Monad (void)--- >>> import Control.Monad.IO.Class (MonadIO (liftIO))--- >>> import Data.Either (fromLeft, fromRight, isLeft, isRight, either)--- >>> import Data.Function ((&))--- >>> import Data.Maybe (fromJust, isJust)--- >>> import Prelude hiding (filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence, reverse, foldr1 , scanl, scanl1)--- >>> import Streamly.Internal.Data.Stream (Stream)--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Fold as Fold (filtering)--- >>> import qualified Streamly.Internal.Data.Fold.Window as Window--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import System.IO (stdout, hSetBuffering, BufferMode(LineBuffering))------ >>> hSetBuffering stdout LineBuffering---- XXX because of the use of D.cons for appending, folds and scans have--- quadratic complexity when iterated over a stream. We should use StreamK for--- linear performance on iteration.----------------------------------------------------------------------------------- Piping----------------------------------------------------------------------------------- | Use a 'Pipe' to transform a stream.------ /Pre-release/----{-# INLINE transform #-}-transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b-transform pipe xs = fromStreamD $ D.transform pipe (toStreamD xs)----------------------------------------------------------------------------------- Transformation Folds----------------------------------------------------------------------------------- | Right fold to a streaming monad.------ > foldrS Stream.cons Stream.nil === id------ 'foldrS' can be used to perform stateless stream to stream transformations--- like map and filter in general. It can be coupled with a scan to perform--- stateful transformations. However, note that the custom map and filter--- routines can be much more efficient than this due to better stream fusion.------ >>> input = Stream.fromList [1..5]--- >>> Stream.fold Fold.toList $ Stream.foldrS Stream.cons Stream.nil input--- [1,2,3,4,5]------ Find if any element in the stream is 'True':------ >>> step x xs = if odd x then Stream.fromPure True else xs--- >>> input = Stream.fromList (2:4:5:undefined) :: Stream IO Int--- >>> Stream.fold Fold.toList $ Stream.foldrS step (Stream.fromPure False) input--- [True]------ Map (+2) on odd elements and filter out the even elements:------ >>> step x xs = if odd x then (x + 2) `Stream.cons` xs else xs--- >>> input = Stream.fromList [1..5] :: Stream IO Int--- >>> Stream.fold Fold.toList $ Stream.foldrS step Stream.nil input--- [3,5,7]------ /Pre-release/-{-# INLINE foldrS #-}-foldrS ::-     (a -> Stream m b -> Stream m b)-  -> Stream m b-  -> Stream m a-  -> Stream m b-foldrS f z xs =-    fromStreamK-        $ K.foldrS-            (\y ys -> toStreamK $ f y (fromStreamK ys))-            (toStreamK z)-            (toStreamK xs)----------------------------------------------------------------------------------- Transformation by Mapping----------------------------------------------------------------------------------- |--- >>> mapM f = Stream.sequence . fmap f------ Apply a monadic function to each element of the stream and replace it with--- the output of the resulting action.------ >>> s = Stream.fromList ["a", "b", "c"]--- >>> Stream.fold Fold.drain $ Stream.mapM putStr s--- abc----{-# INLINE mapM #-}-mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b-mapM f m = fromStreamK $ D.toStreamK $ D.mapM f $ toStreamD m---- |--- >>> sequence = Stream.mapM id------ Replace the elements of a stream of monadic actions with the outputs of--- those actions.------ >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"]--- >>> Stream.fold Fold.drain $ Stream.sequence s--- abc----{-# INLINE sequence #-}-sequence :: Monad m => Stream m (m a) -> Stream m a-sequence = mapM id----------------------------------------------------------------------------------- Mapping side effects----------------------------------------------------------------------------------- | Tap the data flowing through a stream into a 'Fold'. For example, you may--- add a tap to log the contents flowing through the stream. The fold is used--- only for effects, its result is discarded.------ @---                   Fold m a b---                       |--- -----stream m a ---------------stream m a----------- @------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s--- 1--- 2------ Compare with 'trace'.----{-# INLINE tap #-}-tap :: Monad m => FL.Fold m a b -> Stream m a -> Stream m a-tap f xs = fromStreamD $ D.tap f (toStreamD xs)---- | Apply a monadic function to each element flowing through the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace print s--- 1--- 2------ Compare with 'tap'.----{-# INLINE trace #-}-trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a-trace f = mapM (\x -> void (f x) >> return x)---- | Perform a side effect before yielding each element of the stream and--- discard the results.------ >>> s = Stream.enumerateFromTo 1 2--- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s--- "got here"--- "got here"------ Same as 'intersperseMPrefix_' but always serial.------ See also: 'trace'------ /Pre-release/-{-# INLINE trace_ #-}-trace_ :: Monad m => m b -> Stream m a -> Stream m a-trace_ eff = fromStreamD . D.mapM (\x -> eff >> return x) . toStreamD------------------------------------------------------------------------------------ Scanning------------------------------------------------------------------------------------ | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except--- that it provides an additional @done@ function to be applied on the--- accumulator when the stream stops. The result of @done@ is also emitted in--- the stream.------ This function can be used to allocate a resource in the beginning of the--- scan and release it when the stream ends or to flush the internal state of--- the scan at the end.------ /Pre-release/----{-# INLINE scanlMAfter' #-}-scanlMAfter' ::-       Monad m-    => (b -> a -> m b)-    -> m b-    -> (b -> m b)-    -> Stream m a-    -> Stream m b-scanlMAfter' step initial done stream =-    fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream----------------------------------------------------------------------------------- Scanning with a Fold----------------------------------------------------------------------------------- XXX It may be useful to have a version of scan where we can keep the--- accumulator independent of the value emitted. So that we do not necessarily--- have to keep a value in the accumulator which we are not using. We can pass--- an extraction function that will take the accumulator and the current value--- of the element and emit the next value in the stream. That will also make it--- possible to modify the accumulator after using it. In fact, the step function--- can return new accumulator and the value to be emitted. The signature would--- be more like mapAccumL.---- | Strict left scan. Scan a stream using the given monadic fold.------ >>> s = Stream.fromList [1..10]--- >>> Stream.fold Fold.toList $ Stream.takeWhile (< 10) $ Stream.scan Fold.sum s--- [0,1,3,6]------ See also: 'usingStateT'------- EXPLANATION:--- >>> scanl' step z = Stream.scan (Fold.foldl' step z)------ Like 'map', 'scanl'' too is a one to one transformation,--- however it adds an extra element.------ >>> s = Stream.fromList [1,2,3,4]--- >>> Stream.fold Fold.toList $ scanl' (+) 0 s--- [0,1,3,6,10]------ >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s--- [[],[1],[2,1],[3,2,1],[4,3,2,1]]------ The output of 'scanl'' is the initial value of the accumulator followed by--- all the intermediate steps and the final result of 'foldl''.------ By streaming the accumulated state after each fold step, we can share the--- state across multiple stages of stream composition. Each stage can modify or--- extend the state, do some processing with it and emit it for the next stage,--- thus modularizing the stream processing. This can be useful in--- stateful or event-driven programming.------ Consider the following monolithic example, computing the sum and the product--- of the elements in a stream in one go using a @foldl'@:------ >>> foldl' step z = Stream.fold (Fold.foldl' step z)--- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s--- (10,24)------ Using @scanl'@ we can make it modular by computing the sum in the first--- stage and passing it down to the next stage for computing the product:------ >>> :{---   foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)---   $ scanl' (\(s, _) x -> (s + x, x)) (0,1)---   $ Stream.fromList [1,2,3,4]--- :}--- (10,24)------ IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building--- lazy expressions inside the accumulator, it is recommended that a strict--- data structure is used for accumulator.----{-# INLINE scan #-}-scan :: Monad m => Fold m a b -> Stream m a -> Stream m b-scan fld m = fromStreamD $ D.scan fld $ toStreamD m---- | Like 'scan' but restarts scanning afresh when the scanning fold--- terminates.----{-# INLINE scanMany #-}-scanMany :: Monad m => Fold m a b -> Stream m a -> Stream m b-scanMany fld m = fromStreamD $ D.scanMany fld $ toStreamD m----------------------------------------------------------------------------------- Filtering----------------------------------------------------------------------------------- | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a--- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a--- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with--- index or time.------ >>> filterWithIndex = Stream.with Stream.indexed Stream.filter------ /Pre-release/-{-# INLINE with #-}-with :: Monad m =>-       (Stream m a -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a))-    -> (((s, a) -> b) -> Stream m a -> Stream m a)-with f comb g = fmap snd . comb g . f---- | Include only those elements that pass a predicate.------ >>> filter p = Stream.filterM (return . p)--- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing)--- >>> filter p = Stream.scanMaybe (Fold.filtering p)----{-# INLINE filter #-}-filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- filter p = scanMaybe (FL.filtering p)-filter p m = fromStreamD $ D.filter p $ toStreamD m---- | Same as 'filter' but with a monadic predicate.------ >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing--- >>> filterM p = Stream.mapMaybeM (f p)----{-# INLINE filterM #-}-filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a-filterM p m = fromStreamD $ D.filterM p $ toStreamD m---- | Drop repeated elements that are adjacent to each other using the supplied--- comparison function.------ >>> uniq = Stream.uniqBy (==)------ To strip duplicate path separators:------ >>> input = Stream.fromList "//a//b"--- >>> f x y = x == '/' && y == '/'--- >>> Stream.fold Fold.toList $ Stream.uniqBy f input--- "/a/b"------ Space: @O(1)@------ /Pre-release/----{-# INLINE uniqBy #-}-uniqBy :: Monad m =>-    (a -> a -> Bool) -> Stream m a -> Stream m a--- uniqBy eq = scanMaybe (FL.uniqBy eq)-uniqBy eq = catMaybes . rollingMap f--    where--    f pre curr =-        case pre of-            Nothing -> Just curr-            Just x -> if x `eq` curr then Nothing else Just curr---- | Drop repeated elements that are adjacent to each other.------ >>> uniq = Stream.uniqBy (==)----{-# INLINE uniq #-}-uniq :: (Eq a, Monad m) => Stream m a -> Stream m a--- uniq = scanMaybe FL.uniq-uniq = fromStreamD . D.uniq . toStreamD---- | Strip all leading and trailing occurrences of an element passing a--- predicate and make all other consecutive occurrences uniq.------ >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)------ @--- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")--- "hello world!"------ @------ Space: @O(1)@------ /Unimplemented/-{-# INLINE prune #-}-prune ::-    -- (Monad m, Eq a) =>-    (a -> Bool) -> Stream m a -> Stream m a-prune = error "Not implemented yet!"---- Possible implementation:--- @repeated =---      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@------ 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a--- single element.---- | Emit only repeated elements, once.------ /Unimplemented/-repeated :: -- (Monad m, Eq a) =>-    Stream m a -> Stream m a-repeated = undefined---- | Deletes the first occurrence of the element in the stream that satisfies--- the given equality predicate.------ >>> input = Stream.fromList [1,3,3,5]--- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input--- [1,3,5]----{-# INLINE deleteBy #-}-deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a--- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x)-deleteBy cmp x m = fromStreamD $ D.deleteBy cmp x (toStreamD m)----------------------------------------------------------------------------------- Trimming----------------------------------------------------------------------------------- | Same as 'takeWhile' but with a monadic predicate.----{-# INLINE takeWhileM #-}-takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x))-takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m---- | Take all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements taken.------ /Unimplemented/-{-# INLINE takeWhileLast #-}-takeWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m---- | Like 'takeWhile' and 'takeWhileLast' combined.------ O(n) space, where n is the number elements taken from the end.------ /Unimplemented/-{-# INLINE takeWhileAround #-}-takeWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m---- | Drop elements in the stream as long as the predicate succeeds and then--- take the rest of the stream.----{-# INLINE dropWhile #-}-dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a--- dropWhile p = scanMaybe (FL.droppingWhile p)-dropWhile p m = fromStreamD $ D.dropWhile p $ toStreamD m---- | Same as 'dropWhile' but with a monadic predicate.----{-# INLINE dropWhileM #-}-dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a--- dropWhileM p = scanMaybe (FL.droppingWhileM p)-dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m---- | Drop @n@ elements at the end of the stream.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropLast #-}-dropLast :: -- Monad m =>-    Int -> Stream m a -> Stream m a-dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m---- | Drop all consecutive elements at the end of the stream for which the--- predicate is true.------ O(n) space, where n is the number elements dropped.------ /Unimplemented/-{-# INLINE dropWhileLast #-}-dropWhileLast :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m---- | Like 'dropWhile' and 'dropWhileLast' combined.------ O(n) space, where n is the number elements dropped from the end.------ /Unimplemented/-{-# INLINE dropWhileAround #-}-dropWhileAround :: -- Monad m =>-    (a -> Bool) -> Stream m a -> Stream m a-dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m----------------------------------------------------------------------------------- Inserting Elements----------------------------------------------------------------------------------- | @insertBy cmp elem stream@ inserts @elem@ before the first element in--- @stream@ that is less than @elem@ when compared using @cmp@.------ >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x)------ >>> input = Stream.fromList [1,3,5]--- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input--- [1,2,3,5]----{-# INLINE insertBy #-}-insertBy ::Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a-insertBy cmp x m = fromStreamD $ D.insertBy cmp x (toStreamD m)---- | Insert a pure value between successive elements of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperse ',' input--- "h,e,l,l,o"----{-# INLINE intersperse #-}-intersperse :: Monad m => a -> Stream m a -> Stream m a-intersperse a = fromStreamD . D.intersperse a . toStreamD---- | Insert a side effect before consuming an element of a stream except the--- first one.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.drain $ Stream.trace putChar $ Stream.intersperseM_ (putChar '.') input--- h.e.l.l.o------ /Pre-release/-{-# INLINE intersperseM_ #-}-intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseM_ m = fromStreamD . D.intersperseM_ m . toStreamD---- | Intersperse a monadic action into the input stream after every @n@--- elements.------ >> input = Stream.fromList "hello"--- >> Stream.fold Fold.toList $ Stream.intersperseMWith 2 (return ',') input--- "he,ll,o"------ /Unimplemented/-{-# INLINE intersperseMWith #-}-intersperseMWith :: -- Monad m =>-    Int -> m a -> Stream m a -> Stream m a-intersperseMWith _n _f _xs = undefined---- | Insert an effect and its output after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMSuffix (putChar '.' >> return ',') input--- h.,e.,l.,l.,o.,"h,e,l,l,o,"------ /Pre-release/-{-# INLINE intersperseMSuffix #-}-intersperseMSuffix :: Monad m => m a -> Stream m a -> Stream m a-intersperseMSuffix m = fromStreamD . D.intersperseMSuffix m . toStreamD---- | Insert a side effect after consuming an element of a stream.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffix_ (threadDelay 1000000) input--- "hello"------ /Pre-release/----{-# INLINE intersperseMSuffix_ #-}-intersperseMSuffix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMSuffix_ m = fromStreamD . D.intersperseMSuffix_ m . toStreamD---- XXX Use an offset argument, like tapOffsetEvery---- | Like 'intersperseMSuffix' but intersperses an effectful action into the--- input stream after every @n@ elements and after the last element.------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.intersperseMSuffixWith 2 (return ',') input--- "he,ll,o,"------ /Pre-release/----{-# INLINE intersperseMSuffixWith #-}-intersperseMSuffixWith :: Monad m-    => Int -> m a -> Stream m a -> Stream m a-intersperseMSuffixWith n eff =-    fromStreamD . D.intersperseMSuffixWith n eff . toStreamD---- | Insert a side effect before consuming an element of a stream.------ Definition:------ >>> intersperseMPrefix_ m = Stream.mapM (\x -> void m >> return x)------ >>> input = Stream.fromList "hello"--- >>> Stream.fold Fold.toList $ Stream.trace putChar $ Stream.intersperseMPrefix_ (putChar '.' >> return ',') input--- .h.e.l.l.o"hello"------ Same as 'trace_'.------ /Pre-release/----{-# INLINE intersperseMPrefix_ #-}-intersperseMPrefix_ :: Monad m => m b -> Stream m a -> Stream m a-intersperseMPrefix_ m = mapM (\x -> void m >> return x)----------------------------------------------------------------------------------- Inserting Time----------------------------------------------------------------------------------- XXX This should be in Prelude, should we export this as a helper function?---- | Block the current thread for specified number of seconds.-{-# INLINE sleep #-}-sleep :: MonadIO m => Double -> m ()-sleep n = liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds between elements of the stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delay = Stream.intersperseM_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input--- 1--- 2--- 3----{-# INLINE delay #-}-delay :: MonadIO m => Double -> Stream m a -> Stream m a-delay = intersperseM_ . sleep---- | Introduce a delay of specified seconds after consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPost = Stream.intersperseMSuffix_ . sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPost #-}-delayPost :: MonadIO m => Double -> Stream m a -> Stream m a-delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000---- | Introduce a delay of specified seconds before consuming an element of a--- stream.------ Definition:------ >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000--- >>> delayPre = Stream.intersperseMPrefix_. sleep------ Example:------ >>> input = Stream.enumerateFromTo 1 3--- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input--- 1--- 2--- 3------ /Pre-release/----{-# INLINE delayPre #-}-delayPre :: MonadIO m => Double -> Stream m a -> Stream m a-delayPre = intersperseMPrefix_. sleep----------------------------------------------------------------------------------- Reorder in sequence----------------------------------------------------------------------------------- | Buffer until the next element in sequence arrives. The function argument--- determines the difference in sequence numbers. This could be useful in--- implementing sequenced streams, for example, TCP reassembly.------ /Unimplemented/----{-# INLINE reassembleBy #-}-reassembleBy-    :: -- Monad m =>-       Fold m a b-    -> (a -> a -> Int)-    -> Stream m a-    -> Stream m b-reassembleBy = undefined----------------------------------------------------------------------------------- Position Indexing----------------------------------------------------------------------------------- |--- >>> f = Fold.foldl' (\(i, _) x -> (i + 1, x)) (-1,undefined)--- >>> indexed = Stream.postscan f--- >>> indexed = Stream.zipWith (,) (Stream.enumerateFrom 0)--- >>> indexedR n = fmap (\(i, a) -> (n - i, a)) . indexed------ Pair each element in a stream with its index, starting from index 0.------ >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello"--- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]----{-# INLINE indexed #-}-indexed :: Monad m => Stream m a -> Stream m (Int, a)--- indexed = scanMaybe FL.indexing-indexed = fromStreamD . D.indexed . toStreamD---- |--- >>> f n = Fold.foldl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)--- >>> indexedR n = Stream.postscan (f n)------ >>> s n = Stream.enumerateFromThen n (n - 1)--- >>> indexedR n = Stream.zipWith (,) (s n)------ Pair each element in a stream with its index, starting from the--- given index @n@ and counting down.------ >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello"--- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]----{-# INLINE indexedR #-}-indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)--- indexedR n = scanMaybe (FL.indexingRev n)-indexedR n = fromStreamD . D.indexedR n . toStreamD------------------------------------------------------------------------------------ Time Indexing------------------------------------------------------------------------------------ Note: The timestamp stream must be the second stream in the zip so that the--- timestamp is generated after generating the stream element and not before.--- If we do not do that then the following example will generate the same--- timestamp for first two elements:------ Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3------ | Pair each element in a stream with an absolute timestamp, using a clock of--- specified granularity.  The timestamp is generated just before the element--- is consumed.------ >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)]------ /Pre-release/----{-# INLINE timestampWith #-}-timestampWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (AbsTime, a)-timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)---- TBD: check performance vs a custom implementation without using zipWith.------ /Pre-release/----{-# INLINE timestamped #-}-timestamped :: (MonadIO m)-    => Stream m a -> Stream m (AbsTime, a)-timestamped = timestampWith 0.01---- | Pair each element in a stream with relative times starting from 0, using a--- clock with the specified granularity. The time is measured just before the--- element is consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/Monad----{-# INLINE timeIndexWith #-}-timeIndexWith :: (MonadIO m)-    => Double -> Stream m a -> Stream m (RelTime64, a)-timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)---- | Pair each element in a stream with relative times starting from 0, using a--- 10 ms granularity clock. The time is measured just before the element is--- consumed.------ >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3--- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]------ /Pre-release/----{-# INLINE timeIndexed #-}-timeIndexed :: (MonadIO m)-    => Stream m a -> Stream m (RelTime64, a)-timeIndexed = timeIndexWith 0.01----------------------------------------------------------------------------------- Searching----------------------------------------------------------------------------------- | Find all the indices where the value of the element in the stream is equal--- to the given value.------ >>> elemIndices a = Stream.findIndices (== a)----{-# INLINE elemIndices #-}-elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int-elemIndices a = findIndices (== a)----------------------------------------------------------------------------------- Rolling map----------------------------------------------------------------------------------- XXX this is not a one-to-one map so calling it map may not be right.--- We can perhaps call it zipWithTail or rollWith.---- | Apply a function on every two successive elements of a stream. The first--- argument of the map function is the previous element and the second argument--- is the current element. When the current element is the first element, the--- previous element is 'Nothing'.------ /Pre-release/----{-# INLINE rollingMap #-}-rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b--- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f)-rollingMap f m = fromStreamD $ D.rollingMap f $ toStreamD m---- | Like 'rollingMap' but with an effectful map function.------ /Pre-release/----{-# INLINE rollingMapM #-}-rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b--- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f)-rollingMapM f m = fromStreamD $ D.rollingMapM f $ toStreamD m---- | Like 'rollingMap' but requires at least two elements in the stream,--- returns an empty stream otherwise.------ This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.------ /Pre-release/----{-# INLINE rollingMap2 #-}-rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b-rollingMap2 f m = fromStreamD $ D.rollingMap2 f $ toStreamD m----------------------------------------------------------------------------------- Maybe Streams----------------------------------------------------------------------------------- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'--- elements, and return a stream of values extracted from 'Just'.------ Equivalent to:------ >>> mapMaybe f = Stream.catMaybes . fmap f----{-# INLINE mapMaybe #-}-mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b-mapMaybe f m = fromStreamD $ D.mapMaybe f $ toStreamD m---- | Like 'mapMaybe' but maps a monadic function.------ Equivalent to:------ >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f------ >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x)----{-# INLINE_EARLY mapMaybeM #-}-mapMaybeM :: Monad m-          => (a -> m (Maybe b)) -> Stream m a -> Stream m b-mapMaybeM f = fmap fromJust . filter isJust . mapM f----------------------------------------------------------------------------------- Either streams----------------------------------------------------------------------------------- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.------ >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft------ /Pre-release/----{-# INLINE catLefts #-}-catLefts :: Monad m => Stream m (Either a b) -> Stream m a-catLefts = fmap (fromLeft undefined) . filter isLeft---- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.------ >>> catRights = fmap (fromRight undefined) . Stream.filter isRight------ /Pre-release/----{-# INLINE catRights #-}-catRights :: Monad m => Stream m (Either a b) -> Stream m b-catRights = fmap (fromRight undefined) . filter isRight---- | Remove the either wrapper and flatten both lefts and as well as rights in--- the output stream.------ >>> catEithers = fmap (either id id)------ /Pre-release/----{-# INLINE catEithers #-}-catEithers :: Monad m => Stream m (Either a a) -> Stream m a-catEithers = fmap (either id id)+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Stream.Transform+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- 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+    (+    -- * Mapping+    -- | Stateless one-to-one maps.+      sequence++    -- * Mapping Effects+    , tap+    , tapOffsetEvery+    , trace+    , trace_++    -- * Folding+    , foldrS+    , foldlS++    -- * Composable Scans+    , postscanl+    , scanl+    , scanlMany+    , scanr+    , pipe++    -- * Splitting+    , splitSepBy_++    -- * Ad-hoc Scans+    -- | Left scans. Stateful, mostly one-to-one maps.+    , scanlM'+    , scanlMAfter'+    , scanl'+    , scanlM+    , scanlBy+    , scanl1M'+    , scanl1'+    , scanl1M+    , scanl1++    , prescanl'+    , prescanlM'++    , postscanlBy+    , postscanlM+    , postscanl'+    , postscanlM'+    , postscanlMAfter'++    , postscanlx'+    , postscanlMx'+    , scanlMx'+    , scanlx'++    -- * Filtering+    -- delete is for once like insert, filter is for many like intersperse.++    -- | Produce a subset of the stream.+    , with+    , postscanlMaybe+    , filter -- retainBy+    , filterM+    , 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.+    , initNonEmpty+    , tailNonEmpty+    , drop+    , dropWhile+    , dropWhileM++    -- * Trimming from end+    -- | RingArray array based or buffering operations.+    --+    , takeWhileLast+    , takeWhileAround+    , dropLast+    , dropWhileLast+    , dropWhileAround++    -- * Inserting Elements+    -- insert is for once like delete, intersperse is for many like filter+    -- | Produce a superset of the stream. Value agnostic insertion.+    , intersperse+    , intersperseM+    , intersperseEveryM+    , intersperseEndByM+    , intersperseEndByEveryM++    -- Value aware insertion.+    , insertBy -- insertCmpBy+    -- insertBeforeBy+    -- insertAfterBy+    -- intersperseBeforeBy+    -- intersperseAfterBy++    -- * Inserting Side Effects+    , intersperseM_+    , intersperseEndByM_+    , intersperseBeginByM_++    , delay+    , delayPre+    , delayPost++    -- * Reordering+    -- | Produce strictly the same set but reordered.+    , reverse+    , reverseUnbox+    , reassembleBy++    -- * Position Indexing+    , indexed+    , indexedR++    -- * Time Indexing+    , timestampWith+    , timestamped+    , timeIndexWith+    , timeIndexed++    -- * Searching+    , findIndices+    , elemIndices++    -- * Rolling map+    -- | Map using the previous element.+    , rollingMap+    , rollingMapM+    , rollingMap2++    -- * Maybe Streams+    , mapMaybe+    , mapMaybeM+    , catMaybes++    -- * Either Streams+    , 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)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Either (fromLeft, isLeft, isRight, fromRight)+import Data.Functor ((<&>))+import Data.Maybe (fromJust, isJust)+import Fusion.Plugin.Types (Fuse(..))++import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Pipe.Type (Pipe(..))+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)+import Streamly.Internal.System.IO (defaultChunkSize)++-- import qualified Data.List as List+import qualified Streamly.Internal.Data.Array.Type as A+import qualified Streamly.Internal.Data.Fold.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, scanr, sequence, take, takeWhile, zipWith)++import Streamly.Internal.Data.Stream.Generate+    (absTimesWith, relTimesWith)+import Streamly.Internal.Data.Stream.Type++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- Piping+------------------------------------------------------------------------------++{-# ANN type PipeState Fuse #-}+data PipeState st sc ps = PipeConsume st sc | PipeProduce st ps++-- | Use a 'Pipe' to transform a stream.+--+{-# 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++    {-# 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)++    {-# INLINE_LATE step #-}+    step gst (PipeConsume st cs) = do+        r <- stream_step (adaptState gst) st+        case r of+            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)++{-# 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+------------------------------------------------------------------------------++-- Note, this is going to have horrible performance, because of the nature of+-- the stream type (i.e. direct stream vs CPS). Its only for reference, it is+-- likely be practically unusable.+{-# INLINE_NORMAL foldlS #-}+foldlS :: Monad m+    => (Stream m b -> a -> Stream m b) -> Stream m b -> Stream m a -> Stream m b+foldlS fstep begin (Stream step state) = Stream step' (Left (state, begin))+  where+    step' gst (Left (st, acc)) = do+        r <- step (adaptState gst) st+        return $ case r of+            Yield x s -> Skip (Left (s, fstep acc x))+            Skip s -> Skip (Left (s, acc))+            Stop   -> Skip (Right acc)++    step' gst (Right (Stream stp stt)) = do+        r <- stp (adaptState gst) stt+        return $ case r of+            Yield x s -> Yield x (Right (Stream stp s))+            Skip s -> Skip (Right (Stream stp s))+            Stop   -> Stop++------------------------------------------------------------------------------+-- Transformation by Mapping+------------------------------------------------------------------------------++-- |+-- >>> sequence = Stream.mapM id+--+-- Replace the elements of a stream of monadic actions with the outputs of+-- those actions.+--+-- >>> s = Stream.fromList [putStr "a", putStr "b", putStrLn "c"]+-- >>> Stream.fold Fold.drain $ Stream.sequence s+-- abc+--+{-# INLINE_NORMAL sequence #-}+sequence :: Monad m => Stream m (m a) -> Stream m a+sequence (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+         r <- step (adaptState gst) st+         case r of+             Yield x s -> x >>= \a -> return (Yield a s)+             Skip s    -> return $ Skip s+             Stop      -> return Stop++------------------------------------------------------------------------------+-- Mapping side effects+------------------------------------------------------------------------------++data TapState fs st a+    = TapInit | Tapping !fs st | TapDone st++-- XXX Multiple yield points++-- | Tap the data flowing through a stream into a 'Fold'. For example, you may+-- add a tap to log the contents flowing through the stream. The fold is used+-- only for effects, its result is discarded.+--+-- @+--                   Fold m a b+--                       |+-- -----stream m a ---------------stream m a-----+--+-- @+--+-- >>> s = Stream.enumerateFromTo 1 2+-- >>> Stream.fold Fold.drain $ Stream.tap (Fold.drainMapM print) s+-- 1+-- 2+--+-- Compare with 'trace'.+--+{-# INLINE tap #-}+tap :: Monad m => Fold m a b -> Stream m a -> Stream m a+tap (Fold fstep initial _ final) (Stream step state) = Stream step' TapInit++    where++    step' _ TapInit = do+        res <- initial+        return+            $ Skip+            $ case res of+                  FL.Partial s -> Tapping s state+                  FL.Done _ -> TapDone state+    step' gst (Tapping acc st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                res <- fstep acc x+                return+                    $ Yield x+                    $ case res of+                          FL.Partial fs -> Tapping fs s+                          FL.Done _ -> TapDone s+            Skip s -> return $ Skip (Tapping acc s)+            Stop -> do+                void $ final acc+                return Stop+    step' gst (TapDone st) = do+        r <- step gst st+        return+            $ case r of+                  Yield x s -> Yield x (TapDone s)+                  Skip s -> Skip (TapDone s)+                  Stop -> Stop++data TapOffState fs s a+    = TapOffInit+    | TapOffTapping !fs s Int+    | TapOffDone s++-- XXX Multiple yield points+{-# INLINE_NORMAL tapOffsetEvery #-}+tapOffsetEvery :: Monad m+    => Int -> Int -> Fold m a b -> Stream m a -> Stream m a+tapOffsetEvery offset n (Fold fstep initial _ final) (Stream step state) =+    Stream step' TapOffInit++    where++    {-# INLINE_LATE step' #-}+    step' _ TapOffInit = do+        res <- initial+        return+            $ Skip+            $ case res of+                  FL.Partial s -> TapOffTapping s state (offset `mod` n)+                  FL.Done _ -> TapOffDone state+    step' gst (TapOffTapping acc st count) = do+        r <- step gst st+        case r of+            Yield x s -> do+                next <-+                    if count <= 0+                    then do+                        res <- fstep acc x+                        return+                            $ case res of+                                  FL.Partial sres ->+                                    TapOffTapping sres s (n - 1)+                                  FL.Done _ -> TapOffDone s+                    else return $ TapOffTapping acc s (count - 1)+                return $ Yield x next+            Skip s -> return $ Skip (TapOffTapping acc s count)+            Stop -> do+                void $ final acc+                return Stop+    step' gst (TapOffDone st) = do+        r <- step gst st+        return+            $ case r of+                  Yield x s -> Yield x (TapOffDone s)+                  Skip s -> Skip (TapOffDone s)+                  Stop -> Stop++-- | Apply a monadic function to each element flowing through the stream and+-- discard the results.+--+-- >>> s = Stream.enumerateFromTo 1 2+-- >>> Stream.fold Fold.drain $ Stream.trace print s+-- 1+-- 2+--+-- Compare with 'tap'.+--+{-# INLINE trace #-}+trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a+trace f = mapM (\x -> void (f x) >> return x)++-- | Perform a side effect before yielding each element of the stream and+-- discard the results.+--+-- >>> s = Stream.enumerateFromTo 1 2+-- >>> Stream.fold Fold.drain $ Stream.trace_ (print "got here") s+-- "got here"+-- "got here"+--+-- Same as 'intersperseMPrefix_' but always serial.+--+-- See also: 'trace'+--+-- /Pre-release/+{-# INLINE trace_ #-}+trace_ :: Monad m => m b -> Stream m a -> Stream m a+trace_ eff = mapM (\x -> eff >> return x)++------------------------------------------------------------------------------+-- Scanning with a Fold+------------------------------------------------------------------------------++data ScanState s f = ScanInit s | ScanDo s !f | ScanDone++-- 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 = 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.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 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++    {-# INLINE_LATE step #-}+    step _ (ScanInit st) = do+        res <- initial+        return+            $ case res of+                  FL.Partial fs -> Skip $ ScanDo st fs+                  FL.Done b -> Yield b ScanDone+    step gst (ScanDo st fs) = do+        res <- sstep (adaptState gst) st+        case res of+            Yield x s -> do+                r <- fstep fs x+                case r of+                    FL.Partial fs1 -> do+                        !b <- extract fs1+                        return $ Yield b $ ScanDo s fs1+                    FL.Done b -> return $ Yield b ScanDone+            Skip s -> return $ Skip $ ScanDo s fs+            Stop -> final fs >> return Stop+    step _ ScanDone = return Stop++{-# 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++    {-# INLINE runStep #-}+    runStep st action = do+        res <- action+        case res of+            FL.Partial fs -> do+                !b <- extract fs+                return $ Yield b $ ScanDo st fs+            FL.Done b ->+                let next = if restart then ScanInit st else ScanDone+                 in return $ Yield b next++    {-# INLINE_LATE step #-}+    step _ (ScanInit st) = runStep st initial+    step gst (ScanDo st fs) = do+        res <- sstep (adaptState gst) st+        case res of+            Yield x s -> runStep s (fstep fs x)+            Skip s -> return $ Skip $ ScanDo s fs+            Stop -> final fs >> return Stop+    step _ ScanDone = return Stop++{-# 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+-- an extraction function that will take the accumulator and the current value+-- of the element and emit the next value in the stream. That will also make it+-- possible to modify the accumulator after using it. In fact, the step function+-- can return new accumulator and the value to be emitted. The signature would+-- be more like mapAccumL.++-- | Strict left scan. Scan a stream using the given 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.scanl Scanl.sum s+-- [0,1,3,6]+--+-- See also: 'usingStateT'+--++-- EXPLANATION:+-- >>> 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.+--+-- >>> s = Stream.fromList [1,2,3,4]+-- >>> Stream.fold Fold.toList $ scanl' (+) 0 s+-- [0,1,3,6,10]+--+-- >>> Stream.fold Fold.toList $ scanl' (flip (:)) [] s+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]+--+-- The output of 'scanl'' is the initial value of the accumulator followed by+-- all the intermediate steps and the final result of 'foldl''.+--+-- By streaming the accumulated state after each fold step, we can share the+-- state across multiple stages of stream composition. Each stage can modify or+-- extend the state, do some processing with it and emit it for the next stage,+-- thus modularizing the stream processing. This can be useful in+-- stateful or event-driven programming.+--+-- Consider the following monolithic example, computing the sum and the product+-- of the elements in a stream in one go using a @foldl'@:+--+-- >>> foldl' step z = Stream.fold (Scanl.mkScanl step z)+-- >>> foldl' (\(s, p) x -> (s + x, p * x)) (0,1) s+-- (10,24)+--+-- Using @scanl'@ we can make it modular by computing the sum in the first+-- stage and passing it down to the next stage for computing the product:+--+-- >>> :{+--   foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1)+--   $ scanl' (\(s, _) x -> (s + x, x)) (0,1)+--   $ Stream.fromList [1,2,3,4]+-- :}+-- (10,24)+--+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building+-- lazy expressions inside the accumulator, it is recommended that a strict+-- data structure is used for accumulator.+--+{-# INLINE_NORMAL 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++{-# DEPRECATED scanMany "Please use scanlMany instead" #-}+{-# INLINE_NORMAL scanMany #-}+scanMany :: Monad m+    => FL.Fold m a b -> Stream m a -> Stream m b+scanMany = scanWith True++------------------------------------------------------------------------------+-- Scanning - Prescans+------------------------------------------------------------------------------++-- Adapted from the vector package.+--+-- XXX Is a prescan useful, discarding the last step does not sound useful?  I+-- am not sure about the utility of this function, so this is implemented but+-- not exposed. We can expose it if someone provides good reasons why this is+-- useful.+--+-- XXX We have to execute the stream one step ahead to know that we are at the+-- last step.  The vector implementation of prescan executes the last fold step+-- but does not yield the result. This means we have executed the effect but+-- discarded value. This does not sound right. In this implementation we are+-- not executing the last fold step.+{-# INLINE_NORMAL prescanlM' #-}+prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+prescanlM' f mz (Stream step state) = Stream step' (state, mz)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, prev) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                acc <- prev+                return $ Yield acc (s, f acc x)+            Skip s -> return $ Skip (s, prev)+            Stop   -> return Stop++{-# INLINE prescanl' #-}+prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)++------------------------------------------------------------------------------+-- Monolithic postscans (postscan followed by a map)+------------------------------------------------------------------------------++-- The performance of a modular postscan followed by a map seems to be+-- equivalent to this monolithic scan followed by map therefore we may not need+-- this implementation. We just have it for performance comparison and in case+-- modular version does not perform well in some situation.+--+{-# INLINE_NORMAL postscanlMx' #-}+postscanlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+postscanlMx' fstep begin done (Stream step state) = do+    Stream step' (state, begin)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, acc) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                old <- acc+                y <- fstep old x+                v <- done y+                v `seq` y `seq` return (Yield v (s, return y))+            Skip s -> return $ Skip (s, acc)+            Stop   -> return Stop++{-# INLINE_NORMAL postscanlx' #-}+postscanlx' :: Monad m+    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+postscanlx' fstep begin done =+    postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)++-- XXX do we need consM strict to evaluate the begin value?+{-# INLINE scanlMx' #-}+scanlMx' :: Monad m+    => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b+scanlMx' fstep begin done s =+    (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s++{-# INLINE scanlx' #-}+scanlx' :: Monad m+    => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b+scanlx' fstep begin done =+    scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done)++------------------------------------------------------------------------------+-- postscans+------------------------------------------------------------------------------++-- Adapted from the vector package.+{-# INLINE_NORMAL postscanlM' #-}+postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+postscanlM' fstep begin (Stream step state) =+    Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        !x <- begin+        return $ Skip (Just (state, x))++    step' gst (Just (st, acc)) =  do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                !y <- fstep acc x+                return $ Yield y (Just (s, y))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++{-# INLINE_NORMAL postscanl' #-}+postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a+postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)++{-# ANN type PScanAfterState Fuse #-}+data PScanAfterState m st acc =+      PScanAfterStep st (m acc)+    | PScanAfterYield acc (PScanAfterState m st acc)+    | PScanAfterStop++-- We can possibly have the "done" function as a Maybe to provide an option to+-- emit or not emit the accumulator when the stream stops.+--+-- TBD: use a single Yield point+--+{-# INLINE_NORMAL postscanlMAfter' #-}+postscanlMAfter' :: Monad m+    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+postscanlMAfter' fstep initial done (Stream step1 state1) = do+    Stream step (PScanAfterStep state1 initial)++    where++    {-# INLINE_LATE step #-}+    step gst (PScanAfterStep st acc) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield x s -> do+                !old <- acc+                !y <- fstep old x+                return (Skip $ PScanAfterYield y (PScanAfterStep s (return y)))+            Skip s -> return $ Skip $ PScanAfterStep s acc+            -- Strictness is important for fusion+            Stop -> do+                !v <- acc+                !res <- done v+                return (Skip $ PScanAfterYield res PScanAfterStop)+    step _ (PScanAfterYield acc next) = return $ Yield acc next+    step _ PScanAfterStop = return Stop++{-# INLINE_NORMAL postscanlM #-}+postscanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+postscanlM fstep begin (Stream step state) = Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        r <- begin+        return $ Skip (Just (state, r))++    step' gst (Just (st, acc)) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                y <- fstep acc x+                return (Yield y (Just (s, y)))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++{-# INLINE_NORMAL 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.+--+{-# INLINE_NORMAL scanlM' #-}+scanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+scanlM' fstep begin (Stream step state) = Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        !x <- begin+        return $ Yield x (Just (state, x))+    step' gst (Just (st, acc)) =  do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                !y <- fstep acc x+                return $ Yield y (Just (s, y))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except+-- that it provides an additional @done@ function to be applied on the+-- accumulator when the stream stops. The result of @done@ is also emitted in+-- the stream.+--+-- This function can be used to allocate a resource in the beginning of the+-- scan and release it when the stream ends or to flush the internal state of+-- the scan at the end.+--+-- /Pre-release/+--+{-# INLINE scanlMAfter' #-}+scanlMAfter' :: Monad m+    => (b -> a -> m b) -> m b -> (b -> m b) -> Stream m a -> Stream m b+scanlMAfter' fstep initial done s =+    initial `consM` postscanlMAfter' fstep initial done s++-- >>> scanl' f z xs = z `Stream.cons` postscanl' f z xs++-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,+-- however it adds an extra element.+--+-- >>> Stream.toList $ Stream.scanl' (+) 0 $ Stream.fromList [1,2,3,4]+-- [0,1,3,6,10]+--+-- >>> Stream.toList $ Stream.scanl' (flip (:)) [] $ Stream.fromList [1,2,3,4]+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]+--+-- The output of 'scanl'' is the initial value of the accumulator followed by+-- all the intermediate steps and the final result of 'foldl''.+--+-- By streaming the accumulated state after each fold step, we can share the+-- state across multiple stages of stream composition. Each stage can modify or+-- extend the state, do some processing with it and emit it for the next stage,+-- thus modularizing the stream processing. This can be useful in+-- stateful or event-driven programming.+--+-- Consider the following monolithic example, computing the sum and the product+-- of the elements in a stream in one go using a @foldl'@:+--+-- >>> Stream.fold (Fold.foldl' (\(s, p) x -> (s + x, p * x)) (0,1)) $ Stream.fromList [1,2,3,4]+-- (10,24)+--+-- Using @scanl'@ we can make it modular by computing the sum in the first+-- stage and passing it down to the next stage for computing the product:+--+-- >>> :{+--   Stream.fold (Fold.foldl' (\(_, p) (s, x) -> (s, p * x)) (0,1))+--   $ Stream.scanl' (\(s, _) x -> (s + x, x)) (0,1)+--   $ Stream.fromList [1,2,3,4]+-- :}+-- (10,24)+--+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF.  To avoid building+-- lazy expressions inside the accumulator, it is recommended that a strict+-- data structure is used for accumulator.+--+-- >>> scanl' step z = Stream.scanl (Scanl.mkScanl step z)+-- >>> scanl' f z xs = Stream.scanlM' (\a b -> return (f a b)) (return z) xs+--+-- See also: 'usingStateT'+--+{-# INLINE scanl' #-}+scanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b+scanl' f seed = scanlM' (\a b -> return (f a b)) (return seed)++{-# INLINE_NORMAL scanlM #-}+scanlM :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b+scanlM fstep begin (Stream step state) = Stream step' Nothing+  where+    {-# INLINE_LATE step' #-}+    step' _ Nothing = do+        x <- begin+        return $ Yield x (Just (state, x))+    step' gst (Just (st, acc)) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                y <- fstep acc x+                return $ Yield y (Just (s, y))+            Skip s -> return $ Skip (Just (s, acc))+            Stop   -> return Stop++{-# INLINE 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 #-}+scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+scanl1M fstep (Stream step state) = Stream step' (state, Nothing)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, Nothing) = do+        r <- step gst st+        case r of+            Yield x s -> return $ Yield x (s, Just x)+            Skip s -> return $ Skip (s, Nothing)+            Stop   -> return Stop++    step' gst (st, Just acc) = do+        r <- step gst st+        case r of+            Yield y s -> do+                z <- fstep acc y+                return $ Yield z (s, Just z)+            Skip s -> return $ Skip (s, Just acc)+            Stop   -> return Stop++{-# INLINE scanl1 #-}+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+scanl1 f = scanl1M (\x y -> return (f x y))++-- Adapted from the vector package++-- | Like 'scanl1'' but with a monadic step function.+--+{-# INLINE_NORMAL scanl1M' #-}+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a+scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, Nothing) = do+        r <- step gst st+        case r of+            Yield x s -> x `seq` return $ Yield x (s, Just x)+            Skip s -> return $ Skip (s, Nothing)+            Stop   -> return Stop++    step' gst (st, Just acc) = acc `seq` do+        r <- step gst st+        case r of+            Yield y s -> do+                z <- fstep acc y+                z `seq` return $ Yield z (s, Just z)+            Skip s -> return $ Skip (s, Just acc)+            Stop   -> return Stop++-- | Like 'scanl'' but for a non-empty stream. The first element of the stream+-- is used as the initial value of the accumulator. Does nothing if the stream+-- is empty.+--+-- >>> Stream.toList $ Stream.scanl1' (+) $ Stream.fromList [1,2,3,4]+-- [1,3,6,10]+--+{-# INLINE scanl1' #-}+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a+scanl1' f = scanl1M' (\x y -> return (f x y))++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++-- | Modify a @Stream m a -> Stream m a@ stream transformation that accepts a+-- predicate @(a -> b)@ to accept @((s, a) -> b)@ instead, provided a+-- transformation @Stream m a -> Stream m (s, a)@. Convenient to filter with+-- index or time.+--+-- >>> filterWithIndex = Stream.with Stream.indexed Stream.filter+--+-- /Pre-release/+{-# INLINE with #-}+with :: Monad m =>+       (Stream m a -> Stream m (s, a))+    -> (((s, a) -> b) -> Stream m (s, a) -> Stream m (s, a))+    -> (((s, a) -> b) -> Stream m a -> Stream m a)+with f comb g = fmap snd . comb g . f++-- Adapted from the vector package++-- | Same as 'filter' but with a monadic predicate.+--+-- >>> f p x = p x >>= \r -> return $ if r then Just x else Nothing+-- >>> filterM p = Stream.mapMaybeM (f p)+--+{-# INLINE_NORMAL filterM #-}+filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+filterM f (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                return $ if b+                         then Yield x s+                         else Skip s+            Skip s -> return $ Skip s+            Stop   -> return Stop++-- | Include only those elements that pass a predicate.+--+-- >>> filter p = Stream.filterM (return . p)+-- >>> filter p = Stream.mapMaybe (\x -> if p x then Just x else Nothing)+-- >>> filter p = Stream.postscanlMaybe (Scanl.filtering p)+--+{-# INLINE filter #-}+filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+filter f = filterM (return . f)+-- filter p = scanMaybe (FL.filtering p)++-- | Drop repeated elements that are adjacent to each other using the supplied+-- comparison function.+--+-- >>> uniq = Stream.uniqBy (==)+--+-- To strip duplicate path separators:+--+-- >>> input = Stream.fromList "//a//b"+-- >>> f x y = x == '/' && y == '/'+-- >>> Stream.fold Fold.toList $ Stream.uniqBy f input+-- "/a/b"+--+-- Space: @O(1)@+--+-- /Pre-release/+--+{-# INLINE uniqBy #-}+uniqBy :: Monad m =>+    (a -> a -> Bool) -> Stream m a -> Stream m a+-- uniqBy eq = scanMaybe (FL.uniqBy eq)+uniqBy eq = catMaybes . rollingMap f++    where++    f pre curr =+        case pre of+            Nothing -> Just curr+            Just x -> if x `eq` curr then Nothing else Just curr++-- Adapted from the vector package++-- | Drop repeated elements that are adjacent to each other.+--+-- >>> uniq = Stream.uniqBy (==)+--+{-# INLINE_NORMAL uniq #-}+uniq :: (Eq a, Monad m) => Stream m a -> Stream m a+-- uniq = scanMaybe FL.uniq+uniq (Stream step state) = Stream step' (Nothing, state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (Nothing, st) = do+        r <- step gst st+        case r of+            Yield x s -> return $ Yield x (Just x, s)+            Skip  s   -> return $ Skip  (Nothing, s)+            Stop      -> return Stop+    step' gst (Just x, st)  = do+         r <- step gst st+         case r of+             Yield y s | x == y   -> return $ Skip (Just x, s)+                       | otherwise -> return $ Yield y (Just y, s)+             Skip  s   -> return $ Skip (Just x, s)+             Stop      -> return Stop++-- | Deletes the first occurrence of the element in the stream that satisfies+-- the given equality predicate.+--+-- >>> input = Stream.fromList [1,3,3,5]+-- >>> Stream.fold Fold.toList $ Stream.deleteBy (==) 3 input+-- [1,3,5]+--+{-# INLINE_NORMAL deleteBy #-}+deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a+-- deleteBy cmp x = scanMaybe (FL.deleteBy cmp x)+deleteBy eq x (Stream step state) = Stream step' (state, False)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, False) = do+        r <- step gst st+        case r of+            Yield y s -> return $+                if eq x y then Skip (s, True) else Yield y (s, False)+            Skip s -> return $ Skip (s, False)+            Stop   -> return Stop++    step' gst (st, True) = do+        r <- step gst st+        case r of+            Yield y s -> return $ Yield y (s, True)+            Skip s -> return $ Skip (s, True)+            Stop   -> return Stop++-- | Strip all leading and trailing occurrences of an element passing a+-- predicate and make all other consecutive occurrences uniq.+--+-- >> prune p = Stream.dropWhileAround p $ Stream.uniqBy (x y -> p x && p y)+--+-- @+-- > Stream.prune isSpace (Stream.fromList "  hello      world!   ")+-- "hello world!"+--+-- @+--+-- Space: @O(1)@+--+-- /Unimplemented/+{-# INLINE prune #-}+prune ::+    -- (Monad m, Eq a) =>+    (a -> Bool) -> Stream m a -> Stream m a+prune = error "Not implemented yet!"++-- Possible implementation:+-- @repeated =+--      Stream.catMaybes . Stream.parseMany (Parser.groupBy (==) Fold.repeated)@+--+-- 'Fold.repeated' should return 'Just' when repeated, and 'Nothing' for a+-- single element.++-- | Emit only repeated elements, once.+--+-- /Unimplemented/+repeated :: -- (Monad m, Eq a) =>+    Stream m a -> Stream m a+repeated = undefined++------------------------------------------------------------------------------+-- 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.+--+-- O(n) space, where n is the number elements taken.+--+-- /Unimplemented/+{-# INLINE takeWhileLast #-}+takeWhileLast :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+takeWhileLast = undefined -- fromStreamD $ D.takeWhileLast n $ toStreamD m++-- | Like 'takeWhile' and 'takeWhileLast' combined.+--+-- O(n) space, where n is the number elements taken from the end.+--+-- /Unimplemented/+{-# INLINE takeWhileAround #-}+takeWhileAround :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+takeWhileAround = undefined -- fromStreamD $ D.takeWhileAround n $ toStreamD m++-- Adapted from the vector package++-- | Discard first 'n' elements from the stream and take the rest.+--+{-# INLINE_NORMAL drop #-}+drop :: Monad m => Int -> Stream m a -> Stream m a+drop n (Stream step state) = Stream step' (state, Just n)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, Just i)+      | i > 0 = do+          r <- step gst st+          return $+            case r of+              Yield _ s -> Skip (s, Just (i - 1))+              Skip s    -> Skip (s, Just i)+              Stop      -> Stop+      | otherwise = return $ Skip (st, Nothing)++    step' gst (st, Nothing) = do+      r <- step gst st+      return $+        case r of+          Yield x s -> Yield x (s, Nothing)+          Skip  s   -> Skip (s, Nothing)+          Stop      -> Stop++-- Adapted from the vector package+data DropWhileState s a+    = DropWhileDrop s+    | DropWhileYield a s+    | DropWhileNext s++-- | Same as 'dropWhile' but with a monadic predicate.+--+{-# INLINE_NORMAL dropWhileM #-}+dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+-- dropWhileM p = scanMaybe (FL.droppingWhileM p)+dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (DropWhileDrop st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                if b+                then return $ Skip (DropWhileDrop s)+                else return $ Skip (DropWhileYield x s)+            Skip s -> return $ Skip (DropWhileDrop s)+            Stop -> return Stop++    step' gst (DropWhileNext st) =  do+        r <- step gst st+        case r of+            Yield x s -> return $ Skip (DropWhileYield x s)+            Skip s    -> return $ Skip (DropWhileNext s)+            Stop      -> return Stop++    step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)++-- | Drop elements in the stream as long as the predicate succeeds and then+-- take the rest of the stream.+--+{-# INLINE dropWhile #-}+dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+-- dropWhile p = scanMaybe (FL.droppingWhile p)+dropWhile f = dropWhileM (return . f)++-- | Drop @n@ elements at the end of the stream.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropLast #-}+dropLast :: -- Monad m =>+    Int -> Stream m a -> Stream m a+dropLast = undefined -- fromStreamD $ D.dropLast n $ toStreamD m++-- | Drop all consecutive elements at the end of the stream for which the+-- predicate is true.+--+-- O(n) space, where n is the number elements dropped.+--+-- /Unimplemented/+{-# INLINE dropWhileLast #-}+dropWhileLast :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+dropWhileLast = undefined -- fromStreamD $ D.dropWhileLast n $ toStreamD m++-- | Like 'dropWhile' and 'dropWhileLast' combined.+--+-- O(n) space, where n is the number elements dropped from the end.+--+-- /Unimplemented/+{-# INLINE dropWhileAround #-}+dropWhileAround :: -- Monad m =>+    (a -> Bool) -> Stream m a -> Stream m a+dropWhileAround = undefined -- fromStreamD $ D.dropWhileAround n $ toStreamD m++------------------------------------------------------------------------------+-- Inserting Elements+------------------------------------------------------------------------------++-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in+-- @stream@ that is less than @elem@ when compared using @cmp@.+--+-- >>> insertBy cmp x = Stream.mergeBy cmp (Stream.fromPure x)+--+-- >>> input = Stream.fromList [1,3,5]+-- >>> Stream.fold Fold.toList $ Stream.insertBy compare 2 input+-- [1,2,3,5]+--+{-# INLINE_NORMAL insertBy #-}+insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a+insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, False, _) = do+        r <- step gst st+        case r of+            Yield x s -> case cmp a x of+                GT -> return $ Yield x (s, False, Nothing)+                _  -> return $ Yield a (s, True, Just x)+            Skip s -> return $ Skip (s, False, Nothing)+            Stop   -> return $ Yield a (st, True, Nothing)++    step' _ (_, True, Nothing) = return Stop++    step' gst (st, True, Just prev) = do+        r <- step gst st+        case r of+            Yield x s -> return $ Yield prev (s, True, Just x)+            Skip s    -> return $ Skip (s, True, Just prev)+            Stop      -> return $ Yield prev (st, True, Nothing)++data LoopState x s = FirstYield s+                   | InterspersingYield s+                   | YieldAndCarry x s++-- | 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.+--+-- Definition:+--+-- >>> intersperseM x = Stream.interleaveSepBy (Stream.repeatM x)+--+{-# INLINE_NORMAL intersperseM #-}+intersperseM :: Monad m => m a -> Stream m a -> Stream m a+intersperseM m (Stream step state) = Stream step' (FirstYield state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (FirstYield st) = do+        r <- step gst st+        return $+            case r of+                Yield x s -> Skip (YieldAndCarry x s)+                Skip s -> Skip (FirstYield s)+                Stop -> Stop++    step' gst (InterspersingYield st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                a <- m+                return $ Yield a (YieldAndCarry x s)+            Skip s -> return $ Skip $ InterspersingYield s+            Stop -> return Stop++    step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st)++-- | Insert a pure value between successive elements of a stream. It does+-- nothing if stream has less than two elements.+--+-- 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)++-- | Perform a side effect between two successive elements of a stream. It does+-- nothing if the stream has less than two elements.+--+-- >>> 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_ #-}+intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a+intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1))+  where+    {-# INLINE_LATE step #-}+    step gst (Left (eff, st)) = do+        r <- step1 gst st+        case r of+            Yield x s -> eff >> return (Yield x (Right s))+            Skip s -> return $ Skip (Left (eff, s))+            Stop -> return Stop++    step _ (Right st) = return $ Skip $ Left (void m, st)++-- | Intersperse a monadic action into the input stream after every @n@+-- elements.+--+-- 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.toList $ Stream.intersperseEveryM 2 (return ',') input+-- "he,ll,o"+--+-- /Unimplemented/+{-# INLINE intersperseEveryM #-}+intersperseEveryM :: -- Monad m =>+    Int -> m a -> Stream m a -> Stream m a+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 every element of a stream.+--+-- 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 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+        r <- step gst st+        return $ case r of+            Yield x s -> Skip (SuffixYield x (SuffixSuffix s))+            Skip s -> Skip (SuffixElem s)+            Stop -> Stop++    step' _ (SuffixSuffix st) = do+        action >>= \r -> return $ Skip (SuffixYield r (SuffixElem st))++    step' _ (SuffixYield x next) = return $ Yield x next++RENAME(intersperseMSuffix,intersperseEndByM)++-- | Insert an effect after every element of a stream.+--+-- 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 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+        r <- step1 gst st+        case r of+            Yield x s -> return $ Yield x (Right s)+            Skip s -> return $ Skip $ Left s+            Stop -> return Stop++    step _ (Right st) = m >> return (Skip (Left st))++RENAME(intersperseMSuffix_,intersperseEndByM_)++data SuffixSpanState s a+    = SuffixSpanElem s Int+    | SuffixSpanSuffix s+    | SuffixSpanYield a (SuffixSpanState s a)+    | SuffixSpanLast+    | SuffixSpanStop++-- | 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.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 intersperseEndByEveryM #-}+intersperseEndByEveryM, intersperseMSuffixWith :: forall m a. Monad m+    => Int -> m a -> Stream m a -> Stream m a+intersperseEndByEveryM n action (Stream step state) =+    Stream step' (SuffixSpanElem state n)+    where+    {-# INLINE_LATE step' #-}+    step' gst (SuffixSpanElem st i) | i > 0 = do+        r <- step gst st+        return $ case r of+            Yield x s -> Skip (SuffixSpanYield x (SuffixSpanElem s (i - 1)))+            Skip s -> Skip (SuffixSpanElem s i)+            Stop -> if i == n then Stop else Skip SuffixSpanLast+    step' _ (SuffixSpanElem st _) = return $ Skip (SuffixSpanSuffix st)++    step' _ (SuffixSpanSuffix st) = do+        action >>= \r -> return $ Skip (SuffixSpanYield r (SuffixSpanElem st n))++    step' _ SuffixSpanLast = do+        action >>= \r -> return $ Skip (SuffixSpanYield r SuffixSpanStop)++    step' _ (SuffixSpanYield x next) = return $ Yield x next++    step' _ SuffixSpanStop = return Stop++RENAME(intersperseMSuffixWith,intersperseEndByEveryM)++-- | Insert a side effect before every element of a stream.+--+-- Definition:+--+-- >>> intersperseBeginByM_ = Stream.trace_+-- >>> intersperseBeginByM_ m = Stream.mapM (\x -> void m >> return x)+--+-- 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 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+------------------------------------------------------------------------------++-- XXX This should be in Prelude, should we export this as a helper function?++-- | Block the current thread for specified number of seconds.+{-# INLINE sleep #-}+sleep :: MonadIO m => Double -> m ()+sleep n = liftIO $ threadDelay $ round $ n * 1000000++-- | Introduce a delay of specified seconds between elements of the stream.+--+-- Definition:+--+-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000+-- >>> delay = Stream.intersperseM_ . sleep+--+-- Example:+--+-- >>> input = Stream.enumerateFromTo 1 3+-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delay 1 input+-- 1+-- 2+-- 3+--+{-# INLINE delay #-}+delay :: MonadIO m => Double -> Stream m a -> Stream m a+delay = intersperseM_ . sleep++-- | Introduce a delay of specified seconds after consuming an element of a+-- stream.+--+-- Definition:+--+-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000+-- >>> delayPost = Stream.intersperseEndByM_ . sleep+--+-- Example:+--+-- >>> input = Stream.enumerateFromTo 1 3+-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPost 1 input+-- 1+-- 2+-- 3+--+-- /Pre-release/+--+{-# INLINE delayPost #-}+delayPost :: MonadIO m => Double -> Stream m a -> Stream m a+delayPost n = intersperseMSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000++-- | Introduce a delay of specified seconds before consuming an element of a+-- stream.+--+-- Definition:+--+-- >>> sleep n = liftIO $ threadDelay $ round $ n * 1000000+-- >>> delayPre = Stream.intersperseBeginByM_ . sleep+--+-- Example:+--+-- >>> input = Stream.enumerateFromTo 1 3+-- >>> Stream.fold (Fold.drainMapM print) $ Stream.delayPre 1 input+-- 1+-- 2+-- 3+--+-- /Pre-release/+--+{-# INLINE delayPre #-}+delayPre :: MonadIO m => Double -> Stream m a -> Stream m a+delayPre = intersperseMPrefix_. sleep++------------------------------------------------------------------------------+-- Reordering+------------------------------------------------------------------------------++-- | Returns the elements of the stream in reverse order.  The stream must be+-- finite. Note that this necessarily buffers the entire stream in memory.+--+-- Definition:+--+-- >>> reverse m = Stream.concatEffect $ Stream.fold Fold.toListRev m >>= return . Stream.fromList+--+{-# INLINE_NORMAL reverse #-}+reverse :: Monad m => Stream m a -> Stream m a+reverse m = concatEffect $ fold FL.toListRev m <&> fromList+{-+reverse m = Stream step Nothing+    where+    {-# INLINE_LATE step #-}+    step _ Nothing = do+        xs <- foldl' (flip (:)) [] m+        return $ Skip (Just xs)+    step _ (Just (x:xs)) = return $ Yield x (Just xs)+    step _ (Just []) = return Stop+-}++-- | Like 'reverse' but several times faster, requires an 'Unbox' instance.+--+-- /O(n) space/+--+-- /Pre-release/+{-# INLINE reverseUnbox #-}+reverseUnbox :: (MonadIO m, Unbox a) => Stream m a -> Stream m a+reverseUnbox =+    A.concatRev -- unfoldMany A.readerRev+        . fromStreamK+        . K.reverse+        . toStreamK+        . A.chunksOf defaultChunkSize++-- | Buffer until the next element in sequence arrives. The function argument+-- determines the difference in sequence numbers. This could be useful in+-- implementing sequenced streams, for example, TCP reassembly.+--+-- /Unimplemented/+--+{-# INLINE reassembleBy #-}+reassembleBy+    :: -- Monad m =>+       Fold m a b+    -> (a -> a -> Int)+    -> Stream m a+    -> Stream m b+reassembleBy = undefined++------------------------------------------------------------------------------+-- Position Indexing+------------------------------------------------------------------------------++-- Adapted from the vector package++-- |+-- >>> f = 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+--+-- Pair each element in a stream with its index, starting from index 0.+--+-- >>> Stream.fold Fold.toList $ Stream.indexed $ Stream.fromList "hello"+-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]+--+{-# INLINE_NORMAL indexed #-}+indexed :: Monad m => Stream m a -> Stream m (Int, a)+-- indexed = scanMaybe FL.indexing+indexed (Stream step state) = Stream step' (state, 0)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, i) = i `seq` do+         r <- step (adaptState gst) st+         case r of+             Yield x s -> return $ Yield (i, x) (s, i+1)+             Skip    s -> return $ Skip (s, i)+             Stop      -> return Stop++-- Adapted from the vector package++-- |+-- >>> f n = 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)+--+-- Pair each element in a stream with its index, starting from the+-- given index @n@ and counting down.+--+-- >>> Stream.fold Fold.toList $ Stream.indexedR 10 $ Stream.fromList "hello"+-- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]+--+{-# INLINE_NORMAL indexedR #-}+indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)+-- indexedR n = scanMaybe (FL.indexingRev n)+indexedR m (Stream step state) = Stream step' (state, m)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, i) = i `seq` do+         r <- step (adaptState gst) st+         case r of+             Yield x s -> let i' = i - 1+                          in return $ Yield (i, x) (s, i')+             Skip    s -> return $ Skip (s, i)+             Stop      -> return Stop++-------------------------------------------------------------------------------+-- Time Indexing+-------------------------------------------------------------------------------++-- Note: The timestamp stream must be the second stream in the zip so that the+-- timestamp is generated after generating the stream element and not before.+-- If we do not do that then the following example will generate the same+-- timestamp for first two elements:+--+-- Stream.fold Fold.toList $ Stream.timestamped $ Stream.delay $ Stream.enumerateFromTo 1 3++-- | Pair each element in a stream with an absolute timestamp, using a clock of+-- specified granularity.  The timestamp is generated just before the element+-- is consumed.+--+-- >>> Stream.fold Fold.toList $ Stream.timestampWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- [(AbsTime (TimeSpec {sec = ..., nsec = ...}),1),(AbsTime (TimeSpec {sec = ..., nsec = ...}),2),(AbsTime (TimeSpec {sec = ..., nsec = ...}),3)]+--+-- /Pre-release/+--+{-# INLINE timestampWith #-}+timestampWith :: (MonadIO m)+    => Double -> Stream m a -> Stream m (AbsTime, a)+timestampWith g stream = zipWith (flip (,)) stream (absTimesWith g)++-- TBD: check performance vs a custom implementation without using zipWith.+--+-- /Pre-release/+--+{-# INLINE timestamped #-}+timestamped :: (MonadIO m)+    => Stream m a -> Stream m (AbsTime, a)+timestamped = timestampWith 0.01++-- | Pair each element in a stream with relative times starting from 0, using a+-- clock with the specified granularity. The time is measured just before the+-- element is consumed.+--+-- >>> Stream.fold Fold.toList $ Stream.timeIndexWith 0.01 $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]+--+-- /Pre-release/+--+{-# INLINE timeIndexWith #-}+timeIndexWith :: (MonadIO m)+    => Double -> Stream m a -> Stream m (RelTime64, a)+timeIndexWith g stream = zipWith (flip (,)) stream (relTimesWith g)++-- | Pair each element in a stream with relative times starting from 0, using a+-- 10 ms granularity clock. The time is measured just before the element is+-- consumed.+--+-- >>> Stream.fold Fold.toList $ Stream.timeIndexed $ Stream.delay 1 $ Stream.enumerateFromTo 1 3+-- [(RelTime64 (NanoSecond64 ...),1),(RelTime64 (NanoSecond64 ...),2),(RelTime64 (NanoSecond64 ...),3)]+--+-- /Pre-release/+--+{-# INLINE timeIndexed #-}+timeIndexed :: (MonadIO m)+    => Stream m a -> Stream m (RelTime64, a)+timeIndexed = timeIndexWith 0.01++------------------------------------------------------------------------------+-- Searching+------------------------------------------------------------------------------++-- | Find all the indices where the element in the stream satisfies the given+-- predicate.+--+-- >>> findIndices p = Stream.postscanlMaybe (Scanl.findIndices p)+--+{-# INLINE_NORMAL findIndices #-}+findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int+findIndices p (Stream step state) = Stream step' (state, 0)+  where+    {-# INLINE_LATE step' #-}+    step' gst (st, i) = i `seq` do+      r <- step (adaptState gst) st+      return $ case r of+          Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)+          Skip s -> Skip (s, i)+          Stop   -> Stop++-- | Find all the indices where the value of the element in the stream is equal+-- to the given value.+--+-- >>> elemIndices a = Stream.findIndices (== a)+--+{-# INLINE elemIndices #-}+elemIndices :: (Monad m, Eq a) => a -> Stream m a -> Stream m Int+elemIndices a = findIndices (== a)++------------------------------------------------------------------------------+-- Rolling map+------------------------------------------------------------------------------++data RollingMapState s a = RollingMapGo s a++-- | Like 'rollingMap' but with an effectful map function.+--+-- /Pre-release/+--+{-# INLINE rollingMapM #-}+rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Stream m a -> Stream m b+-- rollingMapM f = scanMaybe (FL.slide2 $ Window.rollingMapM f)+rollingMapM f (Stream step1 state1) = Stream step (RollingMapGo state1 Nothing)++    where++    step gst (RollingMapGo s1 curr) = do+        r <- step1 (adaptState gst) s1+        case r of+            Yield x s -> do+                !res <- f curr x+                return $ Yield res $ RollingMapGo s (Just x)+            Skip s -> return $ Skip $ RollingMapGo s curr+            Stop   -> return Stop++-- rollingMap is a special case of an incremental sliding fold. It can be+-- written as:+--+-- > fld f = slidingWindow 1 (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+-- argument of the map function is the previous element and the second argument+-- is the current element. When the current element is the first element, the+-- previous element is 'Nothing'.+--+-- /Pre-release/+--+{-# INLINE rollingMap #-}+rollingMap :: Monad m => (Maybe a -> a -> b) -> Stream m a -> Stream m b+-- rollingMap f = scanMaybe (FL.slide2 $ Window.rollingMap f)+rollingMap f = rollingMapM (\x y -> return $ f x y)++-- | Like 'rollingMap' but requires at least two elements in the stream,+-- returns an empty stream otherwise.+--+-- This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.+--+-- /Pre-release/+--+{-# INLINE rollingMap2 #-}+rollingMap2 :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b+rollingMap2 f = catMaybes . rollingMap g++    where++    g Nothing _ = Nothing+    g (Just x) y = Just (f x y)++------------------------------------------------------------------------------+-- Maybe Streams+------------------------------------------------------------------------------++-- XXX Will this always fuse properly?++-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'+-- elements, and return a stream of values extracted from 'Just'.+--+-- Equivalent to:+--+-- >>> mapMaybe f = Stream.catMaybes . fmap f+--+{-# INLINE_NORMAL mapMaybe #-}+mapMaybe :: Monad m => (a -> Maybe b) -> Stream m a -> Stream m b+mapMaybe f = fmap fromJust . filter isJust . map f++-- | Like 'mapMaybe' but maps a monadic function.+--+-- Equivalent to:+--+-- >>> mapMaybeM f = Stream.catMaybes . Stream.mapM f+--+-- >>> mapM f = Stream.mapMaybeM (\x -> Just <$> f x)+--+{-# INLINE_NORMAL mapMaybeM #-}+mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b+mapMaybeM f = fmap fromJust . filter isJust . mapM f++-- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.+--+-- >>> catMaybes = Stream.mapMaybe id+-- >>> catMaybes = fmap fromJust . Stream.filter isJust+--+-- /Pre-release/+--+{-# INLINE catMaybes #-}+catMaybes :: Monad m => Stream m (Maybe a) -> Stream m a+-- catMaybes = fmap fromJust . filter isJust+catMaybes (Stream step state) = Stream step1 state++    where++    {-# INLINE_LATE step1 #-}+    step1 gst st = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                return+                    $ case x of+                        Just a -> Yield a s+                        Nothing -> Skip s+            Skip s -> return $ Skip s+            Stop -> return Stop++-- | Use a filtering scan on a stream.+--+-- >>> 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++------------------------------------------------------------------------------+-- Either streams+------------------------------------------------------------------------------++-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.+--+-- >>> catLefts = fmap (fromLeft undefined) . Stream.filter isLeft+--+-- /Pre-release/+--+{-# INLINE catLefts #-}+catLefts :: Monad m => Stream m (Either a b) -> Stream m a+catLefts = fmap (fromLeft undefined) . filter isLeft++-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.+--+-- >>> catRights = fmap (fromRight undefined) . Stream.filter isRight+--+-- /Pre-release/+--+{-# INLINE catRights #-}+catRights :: Monad m => Stream m (Either a b) -> Stream m b+catRights = fmap (fromRight undefined) . filter isRight++-- | Remove the either wrapper and flatten both lefts and as well as rights in+-- the output stream.+--+-- >>> catEithers = fmap (either id id)+--+-- /Pre-release/+--+{-# INLINE catEithers #-}+catEithers :: Monad m => Stream m (Either a a) -> Stream m a+catEithers = fmap (either id id)++------------------------------------------------------------------------------+-- Splitting+------------------------------------------------------------------------------++-- 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:+--+-- Definition:+--+--+-- Usage:+--+-- >>> splitOn p xs = Stream.fold Fold.toList $ Stream.splitSepBy_ p Fold.toList (Stream.fromList xs)+-- >>> splitOn (== '.') "a.b"+-- ["a","b"]+--+-- Splitting an empty stream results in an empty stream i.e. zero splits:+--+-- >>> 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 (== '.') ".a"+-- ["","a"]+--+-- >>> splitOn (== '.') "a."+-- ["a",""]+--+-- >>> splitOn (== '.') "a..b"+-- ["a","","b"]+--+-- 'splitSepBy_' is an inverse of 'unfoldEachSepBy':+--+-- > Stream.unfoldEachSepBy '.' Unfold.fromList . Stream.splitSepBy_ (== '.') Fold.toList === id+--+-- Assuming the input stream does not contain the separator:+--+-- > 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 =+    foldManyPost (FL.takeEndBy_ predicate f)
src/Streamly/Internal/Data/Stream/Transformer.hs view
@@ -1,44 +1,62 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Data.Stream.Transformer--- Copyright   : (c) 2019 Composewell Technologies+-- Copyright   : (c) 2018 Composewell Technologies -- License     : BSD-3-Clause -- Maintainer  : streamly@composewell.com -- Stability   : experimental -- Portability : GHC+--+-- Transform the underlying monad of a stream using a monad transfomer.  module Streamly.Internal.Data.Stream.Transformer     (+    -- * Fold to Transformer Monad       foldlT     , foldrT +    -- * Inner Monad Operations     , liftInner-    , usingReaderT+     , runReaderT+    , usingReaderT+    , withReaderT+    , localReaderT+     , evalStateT-    , usingStateT     , runStateT+    , usingStateT     ) where -import Control.Monad.Trans.Class (MonadTrans)+#include "inline.hs"++import Control.Monad.Trans.Class (MonadTrans(lift)) import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.State.Strict (StateT)-import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.SVar.Type (defState, adaptState) -import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as D+import qualified Control.Monad.Trans.Reader as Reader+import qualified Control.Monad.Trans.State.Strict as State --- $setup--- >>> :m--- >>> import Control.Monad.Trans.Class (lift)--- >>> import Control.Monad.Trans.Identity (runIdentityT)--- >>> import qualified Streamly.Internal.Data.Stream as Stream+import Streamly.Internal.Data.Stream.Type +#include "DocTestDataStream.hs"+ -- | Lazy left fold to a transformer monad. ---{-# INLINE foldlT #-}+{-# INLINE_NORMAL foldlT #-} foldlT :: (Monad m, Monad (s m), MonadTrans s)     => (s m b -> a -> s m b) -> s m b -> Stream m a -> s m b-foldlT f z s = D.foldlT f z (toStreamD s)+foldlT fstep begin (Stream step state) = go SPEC begin state+  where+    go !_ acc st = do+        r <- lift $ step defState st+        case r of+            Yield x s -> go SPEC (fstep acc x) s+            Skip s -> go SPEC acc s+            Stop   -> acc  -- | Right fold to a transformer monad.  This is the most general right fold -- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'@@ -53,22 +71,38 @@ -- monads e.g.  to a different streaming type. -- -- /Pre-release/-{-# INLINE foldrT #-}-foldrT :: (Monad m, Monad (s m), MonadTrans s)-    => (a -> s m b -> s m b) -> s m b -> Stream m a -> s m b-foldrT f z s = D.foldrT f z (toStreamD s)+{-# INLINE_NORMAL foldrT #-}+foldrT :: (Monad m, Monad (t m), MonadTrans t)+    => (a -> t m b -> t m b) -> t m b -> Stream m a -> t m b+foldrT f final (Stream step state) = go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = do+          r <- lift $ step defState st+          case r of+            Yield x s -> f x (go SPEC s)+            Skip s    -> go SPEC s+            Stop      -> final ---------------------------------------------------------------------------------- Add and remove a monad transformer-------------------------------------------------------------------------------+-------------------------------------------------------------------------------+-- Transform Inner Monad+-------------------------------------------------------------------------------  -- | Lift the inner monad @m@ of @Stream m a@ to @t m@ where @t@ is a monad -- transformer. ---{-# INLINE liftInner #-}+{-# INLINE_NORMAL liftInner #-} liftInner :: (Monad m, MonadTrans t, Monad (t m))     => Stream m a -> Stream (t m) a-liftInner xs = fromStreamD $ D.liftInner (toStreamD xs)+liftInner (Stream step state) = Stream step' state+    where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- lift $ step (adaptState gst) st+        return $ case r of+            Yield x s -> Yield x s+            Skip s    -> Skip s+            Stop      -> Stop  ------------------------------------------------------------------------------ -- Sharing read only state in a stream@@ -76,16 +110,21 @@  -- | Evaluate the inner monad of a stream as 'ReaderT'. ---{-# INLINE runReaderT #-}+{-# INLINE_NORMAL runReaderT #-} runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a-runReaderT s xs = fromStreamD $ D.runReaderT s (toStreamD xs)+runReaderT env (Stream step state) = Stream step' (state, env)+    where+    {-# INLINE_LATE step' #-}+    step' gst (st, action) = do+        sv <- action+        r <- Reader.runReaderT (step (adaptState gst) st) sv+        return $ case r of+            Yield x s -> Yield x (s, return sv)+            Skip  s   -> Skip (s, return sv)+            Stop      -> Stop  -- | Run a stream transformation using a given environment. ----- See also: 'Serial.map'------ / Internal/--- {-# INLINE usingReaderT #-} usingReaderT     :: Monad m@@ -95,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 ------------------------------------------------------------------------------@@ -103,12 +164,34 @@ -- -- >>> evalStateT s = fmap snd . Stream.runStateT s ----- / Internal/+{-# INLINE_NORMAL evalStateT #-}+evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a+evalStateT initial (Stream step state) = Stream step' (state, initial)+    where+    {-# INLINE_LATE step' #-}+    step' gst (st, action) = do+        sv <- action+        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv+        return $ case r of+            Yield x s -> Yield x (s, return sv')+            Skip  s   -> Skip (s, return sv')+            Stop      -> Stop++-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting+-- state and value pair after each step. ---{-# INLINE evalStateT #-}-evalStateT ::  Monad m => m s -> Stream (StateT s m) a -> Stream m a--- evalStateT s = fmap snd . runStateT s-evalStateT s xs = fromStreamD $ D.evalStateT s (toStreamD xs)+{-# INLINE_NORMAL runStateT #-}+runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)+runStateT initial (Stream step state) = Stream step' (state, initial)+    where+    {-# INLINE_LATE step' #-}+    step' gst (st, action) = do+        sv <- action+        (r, !sv') <- State.runStateT (step (adaptState gst) st) sv+        return $ case r of+            Yield x s -> Yield (sv', x) (s, return sv')+            Skip  s   -> Skip (s, return sv')+            Stop      -> Stop  -- | Run a stateful (StateT) stream transformation using a given state. --@@ -116,20 +199,11 @@ -- -- See also: 'scan' ----- / Internal/--- {-# INLINE usingStateT #-} 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---- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting--- state and value pair after each step.----{-# INLINE runStateT #-}-runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)-runStateT s xs = fromStreamD $ D.runStateT s (toStreamD xs)
src/Streamly/Internal/Data/Stream/Type.hs view
@@ -1,491 +1,2704 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.Type--- Copyright   : (c) 2017 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC----module Streamly.Internal.Data.Stream.Type-    (-    -- * Stream Type-      Stream -- XXX To be removed-    , StreamK--    -- * Type Conversion-    , fromStreamK-    , toStreamK-    , fromStreamD-    , toStreamD-    , fromStream-    , toStream-    , Streamly.Internal.Data.Stream.Type.fromList--    -- * Construction-    , cons-    , consM-    , nil-    , nilM-    , fromPure-    , fromEffect--    -- * Applicative-    , crossApply-    , crossApplySnd-    , crossApplyFst-    , crossWith-    , cross--    -- * Bind/Concat-    , bindWith-    , concatMapWith--    -- * Double folds-    , eqBy-    , cmpBy-    )-where--#include "inline.hs"--import Control.Applicative (liftA2)-import Data.Foldable (Foldable(foldl'), fold)-import Data.Functor.Identity (Identity(..), runIdentity)-import Data.Maybe (fromMaybe)-import Data.Semigroup (Endo(..))-import GHC.Exts (IsList(..), IsString(..), oneShot)-import Streamly.Internal.BaseCompat ((#.))-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import qualified Streamly.Internal.Data.Stream.Common as P-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K---- $setup--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold--- >>> import qualified Streamly.Internal.Data.Stream as Stream----------------------------------------------------------------------------------- Stream----------------------------------------------------------------------------------- | Semigroup instance appends two streams:------ >>> (<>) = Stream.append----newtype StreamK m a = StreamK (K.StreamK m a)-    -- XXX when deriving do we inherit an INLINE?-    deriving (Semigroup, Monoid)--type Stream = StreamK----------------------------------------------------------------------------------- Conversions---------------------------------------------------------------------------------{-# INLINE_EARLY fromStreamK #-}-fromStreamK :: K.StreamK m a -> Stream m a-fromStreamK = StreamK--{-# INLINE_EARLY toStreamK #-}-toStreamK :: Stream m a -> K.StreamK m a-toStreamK (StreamK k) = k--{-# INLINE_EARLY fromStreamD #-}-fromStreamD :: Monad m => D.Stream m a -> Stream m a-fromStreamD = fromStreamK . D.toStreamK--{-# INLINE_EARLY toStreamD #-}-toStreamD :: Applicative m => Stream m a -> D.Stream m a-toStreamD = D.fromStreamK . toStreamK--{-# INLINE fromStream #-}-fromStream :: Monad m => D.Stream m a -> Stream m a-fromStream = fromStreamD--{-# INLINE toStream #-}-toStream :: Applicative m => Stream m a -> D.Stream m a-toStream = toStreamD----------------------------------------------------------------------------------- Generation----------------------------------------------------------------------------------- |--- >>> fromList = Prelude.foldr Stream.cons Stream.nil------ Construct a stream from a list of pure values. This is more efficient than--- 'fromFoldable'.----{-# INLINE fromList #-}-fromList :: Monad m => [a] -> Stream m a-fromList = fromStreamK . P.fromList----------------------------------------------------------------------------------- Comparison----------------------------------------------------------------------------------- | Compare two streams for equality----{-# INLINE eqBy #-}-eqBy :: Monad m =>-    (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool-eqBy f m1 m2 = D.eqBy f (toStreamD m1) (toStreamD m2)---- | Compare two streams----{-# INLINE cmpBy #-}-cmpBy-    :: Monad m-    => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering-cmpBy f m1 m2 = D.cmpBy f (toStreamD m1) (toStreamD m2)----------------------------------------------------------------------------------- Functor---------------------------------------------------------------------------------instance Monad m => Functor (Stream m) where-    {-# INLINE fmap #-}-    -- IMPORTANT: do not use eta reduction.-    fmap f m = fromStreamD $ D.mapM (return . f) $ toStreamD m--    {-# INLINE (<$) #-}-    (<$) = fmap . const----------------------------------------------------------------------------------- Lists----------------------------------------------------------------------------------- Serial streams can act like regular lists using the Identity monad---- XXX Show instance is 10x slower compared to read, we can do much better.--- The list show instance itself is really slow.---- XXX The default definitions of "<" in the Ord instance etc. do not perform--- well, because they do not get inlined. Need to add INLINE in Ord class in--- base?--instance IsList (Stream Identity a) where-    type (Item (Stream Identity a)) = a--    {-# INLINE fromList #-}-    fromList xs = StreamK $ P.fromList xs--    {-# INLINE toList #-}-    toList (StreamK xs) = runIdentity $ P.toList xs--instance Eq a => Eq (Stream Identity a) where-    {-# INLINE (==) #-}-    (==) (StreamK xs) (StreamK ys) = runIdentity $ P.eqBy (==) xs ys--instance Ord a => Ord (Stream Identity a) where-    {-# INLINE compare #-}-    compare (StreamK xs) (StreamK ys) = runIdentity $ P.cmpBy compare xs ys--    {-# INLINE (<) #-}-    x < y =-        case compare x y of-            LT -> True-            _ -> False--    {-# INLINE (<=) #-}-    x <= y =-        case compare x y of-            GT -> False-            _ -> True--    {-# INLINE (>) #-}-    x > y =-        case compare x y of-            GT -> True-            _ -> False--    {-# INLINE (>=) #-}-    x >= y =-        case compare x y of-            LT -> False-            _ -> True--    {-# INLINE max #-}-    max x y = if x <= y then y else x--    {-# INLINE min #-}-    min x y = if x <= y then x else y--instance Show a => Show (Stream Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (toList dl)--instance Read a => Read (Stream Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        Streamly.Internal.Data.Stream.Type.fromList <$> readPrec--    readListPrec = readListPrecDefault--instance (a ~ Char) => IsString (Stream Identity a) where-    {-# INLINE fromString #-}-    fromString xs = StreamK $ P.fromList xs------------------------------------------------------------------------------------ Foldable------------------------------------------------------------------------------------ The default Foldable instance has several issues:--- 1) several definitions do not have INLINE on them, so we provide---    re-implementations with INLINE pragmas.--- 2) the definitions of sum/product/maximum/minimum are inefficient as they---    use right folds, they cannot run in constant memory. We provide---    implementations using strict left folds here.--instance (Foldable m, Monad m) => Foldable (Stream m) where--    {-# INLINE foldMap #-}-    foldMap f (StreamK xs) = fold $ P.foldr (mappend . f) mempty xs--    {-# INLINE foldr #-}-    foldr f z t = appEndo (foldMap (Endo #. f) t) z--    {-# INLINE foldl' #-}-    foldl' f z0 xs = foldr f' id xs z0-        where f' x k = oneShot $ \z -> k $! f z x--    {-# INLINE length #-}-    length = foldl' (\n _ -> n + 1) 0--    {-# INLINE elem #-}-    elem = any . (==)--    {-# INLINE maximum #-}-    maximum =-          fromMaybe (errorWithoutStackTrace "maximum: empty stream")-        . toMaybe-        . foldl' getMax Nothing'--        where--        getMax Nothing' x = Just' x-        getMax (Just' mx) x = Just' $! max mx x--    {-# INLINE minimum #-}-    minimum =-          fromMaybe (errorWithoutStackTrace "minimum: empty stream")-        . toMaybe-        . foldl' getMin Nothing'--        where--        getMin Nothing' x = Just' x-        getMin (Just' mn) x = Just' $! min mn x--    {-# INLINE sum #-}-    sum = foldl' (+) 0--    {-# INLINE product #-}-    product = foldl' (*) 1------------------------------------------------------------------------------------ Traversable----------------------------------------------------------------------------------instance Traversable (Stream Identity) where-    {-# INLINE traverse #-}-    traverse f (StreamK xs) =-        fmap StreamK $ runIdentity $ P.foldr consA (pure mempty) xs--        where--        consA x ys = liftA2 K.cons (f x) ys------------------------------------------------------------------------------------ Construction----------------------------------------------------------------------------------infixr 5 `cons`---- | A right associative prepend operation to add a pure value at the head of--- an existing stream::------ >>> s = 1 `Stream.cons` 2 `Stream.cons` 3 `Stream.cons` Stream.nil--- >>> Stream.fold Fold.toList s--- [1,2,3]------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldable = Prelude.foldr Stream.cons Stream.nil------ Same as the following but more efficient:------ >>> cons x xs = return x `Stream.consM` xs------ /CPS/----{-# INLINE_NORMAL cons #-}-cons ::  a -> Stream m a -> Stream m a-cons x = fromStreamK . K.cons x . toStreamK--infixr 5 `consM`---- | A right associative prepend operation to add an effectful value at the--- head of an existing stream::------ >>> s = putStrLn "hello" `consM` putStrLn "world" `consM` Stream.nil--- >>> Stream.fold Fold.drain s--- hello--- world------ It can be used efficiently with 'Prelude.foldr':------ >>> fromFoldableM = Prelude.foldr Stream.consM Stream.nil------ Same as the following but more efficient:------ >>> consM x xs = Stream.fromEffect x `Stream.append` xs------ /CPS/----{-# INLINE consM #-}-{-# SPECIALIZE consM :: IO a -> Stream IO a -> Stream IO a #-}-consM :: Monad m => m a -> Stream m a -> Stream m a-consM m = fromStreamK . K.consM m . toStreamK---- | A stream that terminates without producing any output or side effect.------ >>> Stream.fold Fold.toList Stream.nil--- []----{-# INLINE_NORMAL nil #-}-nil ::  Stream m a-nil = fromStreamK K.nil---- | A stream that terminates without producing any output, but produces a side--- effect.------ >>> Stream.fold Fold.toList (Stream.nilM (print "nil"))--- "nil"--- []------ /Pre-release/-{-# INLINE_NORMAL nilM #-}-nilM :: Monad m => m b -> Stream m a-nilM = fromStreamK . K.nilM---- | Create a singleton stream from a pure value.------ >>> fromPure a = a `cons` Stream.nil--- >>> fromPure = pure--- >>> fromPure = fromEffect . pure----{-# INLINE_NORMAL fromPure #-}-fromPure :: a -> Stream m a-fromPure = fromStreamK . K.fromPure---- | Create a singleton stream from a monadic action.------ >>> fromEffect m = m `consM` Stream.nil--- >>> fromEffect = Stream.sequence . Stream.fromPure------ >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello")--- hello----{-# INLINE_NORMAL fromEffect #-}-fromEffect :: Monad m => m a -> Stream m a-fromEffect = fromStreamK . K.fromEffect------------------------------------------------------------------------------------ Applicative------------------------------------------------------------------------------------ | Apply a stream of functions to a stream of values and flatten the results.------ Note that the second stream is evaluated multiple times.------ >>> crossApply = Stream.crossWith id----{-# INLINE crossApply #-}-crossApply :: Stream m (a -> b) -> Stream m a -> Stream m b-crossApply m1 m2 =-    fromStreamK $ K.crossApply (toStreamK m1) (toStreamK m2)--{-# INLINE crossApplySnd #-}-crossApplySnd :: Stream m a -> Stream m b -> Stream m b-crossApplySnd m1 m2 =-    fromStreamK $ K.crossApplySnd (toStreamK m1) (toStreamK m2)--{-# INLINE crossApplyFst #-}-crossApplyFst :: Stream m a -> Stream m b -> Stream m a-crossApplyFst m1 m2 =-    fromStreamK $ K.crossApplyFst (toStreamK m1) (toStreamK m2)---- |--- Definition:------ >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2------ Note that the second stream is evaluated multiple times.----{-# INLINE crossWith #-}-crossWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c-crossWith f m1 m2 = fmap f m1 `crossApply` m2---- | Given a @Stream m a@ and @Stream m b@ generate a stream with all possible--- combinations of the tuple @(a, b)@.------ Definition:------ >>> cross = Stream.crossWith (,)------ The second stream is evaluated multiple times. If that is not desired it can--- be cached in an 'Data.Array.Array' and then generated from the array before--- calling this function. Caching may also improve performance if the stream is--- expensive to evaluate.------ See 'Streamly.Internal.Data.Unfold.cross' for a much faster fused--- alternative.------ Time: O(m x n)------ /Pre-release/-{-# INLINE cross #-}-cross :: Monad m => Stream m a -> Stream m b -> Stream m (a, b)-cross = crossWith (,)------------------------------------------------------------------------------------ Bind/Concat------------------------------------------------------------------------------------ |------ /CPS/-{-# INLINE bindWith #-}-bindWith-    :: (Stream m b -> Stream m b -> Stream m b)-    -> Stream m a-    -> (a -> Stream m b)-    -> Stream m b-bindWith par m1 f =-    fromStreamK-        $ K.bindWith-            (\s1 s2 -> toStreamK $ par (fromStreamK s1) (fromStreamK s2))-            (toStreamK m1)-            (toStreamK . f)---- | @concatMapWith mixer generator stream@ is a two dimensional looping--- combinator.  The @generator@ function is used to generate streams from the--- elements in the input @stream@ and the @mixer@ function is used to merge--- those streams.------ /CPS/-{-# INLINE concatMapWith #-}-concatMapWith-    :: (Stream m b -> Stream m b -> Stream m b)-    -> (a -> Stream m b)-    -> Stream m a-    -> Stream m b-concatMapWith par f xs = bindWith par xs f+{-# LANGUAGE CPP #-}+{-# LANGUAGE 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+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Roman Leshchinskiy 2008-2010+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- The stream type is inspired by the vector package.  A few functions in this+-- module have been originally adapted from the vector package (c) Roman+-- Leshchinskiy. See the notes in specific functions.++module Streamly.Internal.Data.Stream.Type+    (+    -- * Type+      Step (..)+    -- XXX UnStream is exported to avoid a performance issue in some+    -- combinators if we use the pattern synonym "Stream".+    , Stream (Stream, UnStream)++    -- * Nested+    , Nested(..)++    -- * To StreamK+    , fromStreamK+    , toStreamK++    -- * From Unfold+    , unfold++    -- * Construction+    -- ** Primitives+    , nilM+    , consM++    -- ** From Values+    , fromPure+    , fromEffect++    -- ** From Containers+    , Streamly.Internal.Data.Stream.Type.fromList++    -- * Elimination+    -- ** Primitives+    , uncons++    -- ** Strict Left Folds+    , Streamly.Internal.Data.Stream.Type.fold+    , foldBreak+    , foldAddLazy+    , foldAdd+    , foldEither++    , Streamly.Internal.Data.Stream.Type.foldl'+    , foldlM'+    , foldlx'+    , foldlMx'++    -- ** Lazy Right Folds+    , foldrM+    , foldrMx+    , Streamly.Internal.Data.Stream.Type.foldr+    , foldrS++    -- ** Specific Folds+    , drain+    , head+    , headElse+    , Streamly.Internal.Data.Stream.Type.toList++    -- * Mapping+    , map+    , mapM++    -- * Stateful Filters+    , 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++    -- ** Cross Product+    , crossApply+    , crossApplyFst+    , crossApplySnd+    , crossWith+    , cross+    , FairUnfoldState (..)+    , fairCrossWithM+    , fairCrossWith+    , fairCross+    , loop -- forEach+    , loopBy++    -- * Unfold Many+    , ConcatMapUState (..)+    , unfoldEach++    -- * 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+    , unfoldIterate+    , bfsUnfoldIterate+    , altBfsUnfoldIterate++    -- * Concat Iterate+    , concatIterateScan+    , concatIterate+    , bfsConcatIterate+    , altBfsConcatIterate++    -- * Fold Many+    , FoldMany (..) -- for inspection testing+    , FoldManyPost (..)+    , foldMany+    , foldManyPost+    , foldManySepBy+    , groupsOf+    , refoldMany+    , refoldIterateM++    -- * Fold Iterate+    , bfsReduceIterate+    , bfsFoldIterate++    -- * Splitting+    , 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)+import Control.Applicative (liftA2)+#endif+import Control.Monad.Catch (MonadThrow, throwM)+import Control.Monad.Trans.Class (MonadTrans(lift))+import Control.Monad.IO.Class (MonadIO(..))+import Data.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+    (head, map, mapM, take, concatMap, takeWhile, zipWith, concat, splitAt)+import Text.Read+       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec+       , readListPrecDefault)++import Streamly.Internal.BaseCompat ((#.))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Refold.Type (Refold(..))+import Streamly.Internal.Data.Stream.Step (Step (..))+import Streamly.Internal.Data.SVar.Type (State, adaptState, defState)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Fold.Type as FL hiding (foldr)+import qualified Streamly.Internal.Data.StreamK.Type as K+import qualified Streamly.Internal.Data.Unfold.Type as Unfold++#include "DocTestDataStream.hs"++------------------------------------------------------------------------------+-- The direct style stream type+------------------------------------------------------------------------------++-- gst = global state++-- | A stream consists of a step function that generates the next step given a+-- current state, and the current state.+data Stream m a =+    forall s. UnStream (State K.StreamK m a -> s -> m (Step s a)) s++-- XXX This causes perf trouble when pattern matching with "Stream"  in a+-- recursive way, e.g. in uncons, foldBreak, concatMap. We need to get rid of+-- this.+unShare :: Stream m a -> Stream m a+unShare (UnStream step state) = UnStream step' state+    where step' gst = step (adaptState gst)++pattern Stream :: (State K.StreamK m a -> s -> m (Step s a)) -> s -> Stream m a+pattern Stream step state <- (unShare -> UnStream step state)+    where Stream = UnStream++{-# COMPLETE Stream #-}++------------------------------------------------------------------------------+-- Primitives+------------------------------------------------------------------------------++-- | A stream that terminates without producing any output, but produces a side+-- effect.+--+-- >>> nilM action = Stream.before action Stream.nil+-- >>> Stream.fold Fold.toList (Stream.nilM (print "nil"))+-- "nil"+-- []+--+-- /Pre-release/+{-# INLINE_NORMAL nilM #-}+nilM :: Applicative m => m b -> Stream m a+nilM m = Stream (\_ _ -> m $> Stop) ()++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+consM m (Stream step state) = Stream step1 Nothing++    where++    {-# INLINE_LATE step1 #-}+    step1 _ Nothing = (`Yield` Just state) <$> m+    step1 gst (Just st) = do+          (\case+            Yield a s -> Yield a (Just s)+            Skip  s   -> Skip (Just s)+            Stop      -> Stop) <$> step gst st++-- | Decompose a stream into its head and tail. If the stream is empty, returns+-- 'Nothing'. If the stream is non-empty, returns @Just (a, ma)@, where @a@ is+-- the head of the stream and @ma@ its tail.+--+-- Properties:+--+-- >>> Nothing <- Stream.uncons Stream.nil+-- >>> Just ("a", t) <- Stream.uncons (Stream.cons "a" Stream.nil)+--+-- This can be used to consume the stream in an imperative manner one element+-- at a time, as it just breaks down the stream into individual elements and we+-- can loop over them as we deem fit. For example, this can be used to convert+-- a streamly stream into other stream types.+--+-- All the folds in this module can be expressed in terms of 'uncons', however,+-- this is generally less efficient than specific folds because it takes apart+-- the stream one element at a time, therefore, does not take adavantage of+-- stream fusion.+--+-- 'foldBreak' is a more general way of consuming a stream piecemeal.+--+-- >>> :{+-- uncons xs = do+--     r <- Stream.foldBreak Fold.one xs+--     return $ case r of+--         (Nothing, _) -> Nothing+--         (Just h, t) -> Just (h, t)+-- :}+--+{-# INLINE_NORMAL uncons #-}+uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+uncons (UnStream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield x s -> return $ Just (x, Stream step s)+            Skip  s   -> go SPEC s+            Stop      -> return Nothing++------------------------------------------------------------------------------+-- From 'Unfold'+------------------------------------------------------------------------------++data UnfoldState s = UnfoldNothing | UnfoldJust s++-- | Convert an 'Unfold' into a stream by supplying it an input seed.+--+-- >>> s = Stream.unfold Unfold.replicateM (3, putStrLn "hello")+-- >>> Stream.fold Fold.drain s+-- hello+-- hello+-- hello+--+{-# INLINE_NORMAL unfold #-}+unfold :: Applicative m => Unfold m a b -> a -> Stream m b+unfold (Unfold ustep inject) seed = Stream step UnfoldNothing++    where++    {-# INLINE_LATE step #-}+    step _ UnfoldNothing = Skip . UnfoldJust <$> inject seed+    step _ (UnfoldJust st) = do+        (\case+            Yield x s -> Yield x (UnfoldJust s)+            Skip s    -> Skip (UnfoldJust s)+            Stop      -> Stop) <$> ustep st++------------------------------------------------------------------------------+-- From Values+------------------------------------------------------------------------------++-- | Create a singleton stream from a pure value.+--+-- >>> fromPure a = a `Stream.cons` Stream.nil+-- >>> fromPure = pure+-- >>> fromPure = Stream.fromEffect . pure+--+{-# INLINE_NORMAL fromPure #-}+fromPure :: Applicative m => a -> Stream m a+fromPure x = Stream (\_ s -> pure $ step undefined s) True+  where+    {-# INLINE_LATE step #-}+    step _ True  = Yield x False+    step _ False = Stop++-- | Create a singleton stream from a monadic action.+--+-- >>> fromEffect m = m `Stream.consM` Stream.nil+-- >>> fromEffect = Stream.sequence . Stream.fromPure+--+-- >>> Stream.fold Fold.drain $ Stream.fromEffect (putStrLn "hello")+-- hello+--+{-# INLINE_NORMAL fromEffect #-}+fromEffect :: Applicative m => m a -> Stream m a+fromEffect m = Stream step True++    where++    {-# INLINE_LATE step #-}+    step _ True  = (`Yield` False) <$> m+    step _ False = pure Stop++------------------------------------------------------------------------------+-- From Containers+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Construct a stream from a list of pure values.+{-# INLINE_LATE fromList #-}+fromList :: Applicative m => [a] -> Stream m a+#ifdef USE_UNFOLDS_EVERYWHERE+fromList = unfold Unfold.fromList+#else+fromList = Stream step+  where+    {-# INLINE_LATE step #-}+    step _ (x:xs) = pure $ Yield x xs+    step _ []     = pure Stop+#endif++------------------------------------------------------------------------------+-- Conversions From/To+------------------------------------------------------------------------------++-- | Convert a CPS encoded StreamK to direct style step encoded StreamD+{-# INLINE_LATE fromStreamK #-}+fromStreamK :: Applicative m => K.StreamK m a -> Stream m a+fromStreamK = Stream step+    where+    step gst m1 =+        let stop       = pure Stop+            single a   = pure $ Yield a K.nil+            yieldk a r = pure $ Yield a r+         in K.foldStreamShared gst yieldk single stop m1++-- | Convert a direct style step encoded StreamD to a CPS encoded StreamK+{-# INLINE_LATE toStreamK #-}+toStreamK :: Monad m => Stream m a -> K.StreamK m a+toStreamK (Stream step state) = go state+    where+    go st = K.MkStream $ \gst yld _ stp ->+      let go' ss = do+           r <- step gst ss+           case r of+               Yield x s -> yld x (go s)+               Skip  s   -> go' s+               Stop      -> stp+      in go' st++{-# RULES "fromStreamK/toStreamK fusion"+    forall s. toStreamK (fromStreamK s) = s #-}+{-# RULES "toStreamK/fromStreamK fusion"+    forall s. fromStreamK (toStreamK s) = s #-}++------------------------------------------------------------------------------+-- Running a 'Fold'+------------------------------------------------------------------------------++-- | Fold resulting in either breaking the stream or continuation of the fold.+-- Instead of supplying the input stream in one go we can run the fold multiple+-- times, each time supplying the next segment of the input stream. If the fold+-- has not yet finished it returns a fold that can be run again otherwise it+-- returns the fold result and the residual stream.+--+-- /Internal/+{-# INLINE_NORMAL foldEither #-}+foldEither :: Monad m =>+    Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))+foldEither (Fold fstep begin done final) (UnStream step state) = do+    res <- begin+    case res of+        FL.Partial fs -> go SPEC fs state+        FL.Done fb -> return $! Right (fb, Stream step state)++    where++    {-# INLINE go #-}+    go !_ !fs st = do+        r <- step defState st+        case r of+            Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Done b -> return $! Right (b, Stream step s)+                    FL.Partial fs1 -> go SPEC fs1 s+            Skip s -> go SPEC fs s+            Stop ->+                let f = Fold fstep (return $ FL.Partial fs) done final+                 in return $! Left f++-- | Like 'fold' but also returns the remaining stream. The resulting stream+-- would be 'Stream.nil' if the stream finished before the fold.+--+{-# INLINE_NORMAL foldBreak #-}+foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)+foldBreak fld strm = do+    r <- foldEither fld strm+    case r of+        Right res -> return res+        Left (Fold _ initial _ final) -> do+            res <- initial+            case res of+                FL.Done _ -> error "foldBreak: unreachable state"+                FL.Partial s -> do+                    b <- final s+                    return (b, nil)++    where++    nil = Stream (\_ _ -> return Stop) ()++-- >>> fold f = Fold.extractM . Stream.foldAddLazy f+-- >>> fold f = Stream.fold Fold.one . Stream.foldMany0 f+-- >>> fold f = Fold.extractM <=< Stream.foldAdd f++-- | Fold a stream using the supplied left 'Fold' and reducing the resulting+-- expression strictly at each step. The behavior is similar to 'foldl''. A+-- 'Fold' can terminate early without consuming the full stream. See the+-- documentation of individual 'Fold's for termination behavior.+--+-- Definitions:+--+-- >>> fold f = fmap fst . Stream.foldBreak f+-- >>> fold f = Stream.parse (Parser.fromFold f)+--+-- Example:+--+-- >>> Stream.fold Fold.sum (Stream.enumerateFromTo 1 100)+-- 5050+--+{-# INLINE_NORMAL fold #-}+fold :: Monad m => Fold m a b -> Stream m a -> m b+fold fld strm = do+    (b, _) <- foldBreak fld strm+    return b++-- | Append a stream to a fold lazily to build an accumulator incrementally.+--+-- Example, to continue folding a list of streams on the same sum fold:+--+-- >>> streams = [Stream.fromList [1..5], Stream.fromList [6..10]]+-- >>> f = Prelude.foldl Stream.foldAddLazy Fold.sum streams+-- >>> Stream.fold f Stream.nil+-- 55+--+{-# INLINE_NORMAL foldAddLazy #-}+foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b+foldAddLazy (Fold fstep finitial fextract ffinal) (Stream sstep state) =+    Fold fstep initial fextract ffinal++    where++    initial = do+        res <- finitial+        case res of+            FL.Partial fs -> go SPEC fs state+            FL.Done fb -> return $ FL.Done fb++    {-# INLINE go #-}+    go !_ !fs st = do+        r <- sstep defState st+        case r of+            Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Done b -> return $ FL.Done b+                    FL.Partial fs1 -> go SPEC fs1 s+            Skip s -> go SPEC fs s+            Stop -> return $ FL.Partial fs++-- >>> foldAdd f = Stream.foldAddLazy f >=> Fold.reduce++-- |+-- >>> foldAdd = flip Fold.addStream+--+foldAdd :: Monad m => Fold m a b -> Stream m a -> m (Fold m a b)+foldAdd f =+    Streamly.Internal.Data.Stream.Type.fold (FL.duplicate f)++------------------------------------------------------------------------------+-- Right Folds+------------------------------------------------------------------------------++-- Adapted from the vector package.+--+-- XXX Use of SPEC constructor in folds causes 2x performance degradation in+-- one shot operations, but helps immensely in operations composed of multiple+-- combinators or the same combinator many times. There seems to be an+-- opportunity to optimize here, can we get both, better perf for single ops+-- as well as composed ops? Without SPEC, all single operation benchmarks+-- become 2x faster.++-- The way we want a left fold to be strict, dually we want the right fold to+-- be lazy.  The correct signature of the fold function to keep it lazy must be+-- (a -> m b -> m b) instead of (a -> b -> m b). We were using the latter+-- earlier, which is incorrect. In the latter signature we have to feed the+-- value to the fold function after evaluating the monadic action, depending on+-- the bind behavior of the monad, the action may get evaluated immediately+-- introducing unnecessary strictness to the fold. If the implementation is+-- lazy the following example, must work:+--+-- S.foldrM (\x t -> if x then return t else return False) (return True)+--  (S.fromList [False,undefined] :: Stream IO Bool)++-- | Right associative/lazy pull fold. @foldrM build final stream@ constructs+-- an output structure using the step function @build@. @build@ is invoked with+-- the next input element and the remaining (lazy) tail of the output+-- structure. It builds a lazy output expression using the two. When the "tail+-- structure" in the output expression is evaluated it calls @build@ again thus+-- lazily consuming the input @stream@ until either the output expression built+-- by @build@ is free of the "tail" or the input is exhausted in which case+-- @final@ is used as the terminating case for the output structure. For more+-- details see the description in the previous section.+--+-- Example, determine if any element is 'odd' in a stream:+--+-- >>> s = Stream.fromList (2:4:5:undefined)+-- >>> step x xs = if odd x then return True else xs+-- >>> Stream.foldrM step (return False) s+-- True+--+-- >>> 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 #-}+    go !_ st = do+          r <- step defState st+          case r of+            Yield x s -> f x (go SPEC s)+            Skip s    -> go SPEC s+            Stop      -> z++{-# INLINE_NORMAL foldrMx #-}+foldrMx :: Monad m+    => (a -> m x -> m x) -> m x -> (m x -> m b) -> Stream m a -> m b+foldrMx fstep final convert (Stream step state) = convert $ go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = do+          r <- step defState st+          case r of+            Yield x s -> fstep x (go SPEC s)+            Skip s    -> go SPEC s+            Stop      -> final++-- XXX Should we make all argument strict wherever we use SPEC?++-- Note that foldr works on pure values, therefore it becomes necessarily+-- strict when the monad m is strict. In that case it cannot terminate early,+-- it would evaluate all of its input.  Though, this should work fine with lazy+-- monads. For example, if "any" is implemented using "foldr" instead of+-- "foldrM" it performs the same with Identity monad but performs 1000x slower+-- with IO monad.++-- | Right fold, lazy for lazy monads and pure streams, and strict for strict+-- monads.+--+-- Please avoid using this routine in strict monads like IO unless you need a+-- strict right fold. This is provided only for use in lazy monads (e.g.+-- Identity) or pure streams. Note that with this signature it is not possible+-- to implement a lazy foldr when the monad @m@ is strict. In that case it+-- would be strict in its accumulator and therefore would necessarily consume+-- all its input.+--+-- >>> foldr f z = Stream.foldrM (\a b -> f a <$> b) (return z)+--+-- Note: This is similar to Fold.foldr' (the right fold via left fold), but+-- could be more efficient.+--+{-# INLINE_NORMAL foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+foldr f z = foldrM (liftA2 f . return) (return z)++-- this performs horribly, should not be used+{-# INLINE_NORMAL foldrS #-}+foldrS+    :: Monad m+    => (a -> Stream m b -> Stream m b)+    -> Stream m b+    -> Stream m a+    -> Stream m b+foldrS f final (Stream step state) = go SPEC state+  where+    {-# INLINE_LATE go #-}+    go !_ st = concatEffect $ fmap g $ step defState st++    g r =+        case r of+          Yield x s -> f x (go SPEC s)+          Skip s    -> go SPEC s+          Stop      -> final++------------------------------------------------------------------------------+-- Left Folds+------------------------------------------------------------------------------++-- XXX run begin action only if the stream is not empty.+{-# INLINE_NORMAL foldlMx' #-}+foldlMx' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> m b+foldlMx' fstep begin done (Stream step state) =+    begin >>= \x -> go SPEC x state+  where+    -- XXX !acc?+    {-# INLINE_LATE go #-}+    go !_ acc st = acc `seq` do+        r <- step defState st+        case r of+            Yield x s -> do+                acc' <- fstep acc x+                go SPEC acc' s+            Skip s -> go SPEC acc s+            Stop   -> done acc++{-# INLINE foldlx' #-}+foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b+foldlx' fstep begin done =+    foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done)++-- Adapted from the vector package.+-- XXX implement in terms of foldlMx'?+{-# INLINE_NORMAL foldlM' #-}+foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b+foldlM' fstep mbegin (Stream step state) = do+    begin <- mbegin+    go SPEC begin state+  where+    {-# INLINE_LATE go #-}+    go !_ acc st = acc `seq` do+        r <- step defState st+        case r of+            Yield x s -> do+                acc' <- fstep acc x+                go SPEC acc' s+            Skip s -> go SPEC acc s+            Stop   -> return acc++{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b+foldl' fstep begin = foldlM' (\b a -> return (fstep b a)) (return begin)++------------------------------------------------------------------------------+-- Special folds+------------------------------------------------------------------------------++-- >>> drain = mapM_ (\_ -> return ())++-- |+-- Definitions:+--+-- >>> drain = Stream.fold Fold.drain+-- >>> drain = Stream.foldrM (\_ xs -> xs) (return ())+--+-- Run a stream, discarding the results.+--+{-# INLINE_LATE drain #-}+drain :: Monad m => Stream m a -> m ()+-- drain = foldrM (\_ xs -> xs) (return ())+drain (Stream step state) = go SPEC state+  where+    go !_ st = do+        r <- step defState st+        case r of+            Yield _ s -> go SPEC s+            Skip s    -> go SPEC s+            Stop      -> return ()++{-# 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+------------------------------------------------------------------------------++-- This toList impl is faster (30% on streaming-benchmarks) than the+-- corresponding left fold. The left fold retains an additional argument in the+-- recursive loop.+--+-- Core for the right fold loop:+--+-- main_$s$wgo1+--   = \ sc_s3e6 sc1_s3e5 ->+--       case ># sc1_s3e5 100000# of {+--         __DEFAULT ->+--           case main_$s$wgo1 sc_s3e6 (+# sc1_s3e5 1#) of+--+-- Core for the left fold loop:+--+--  main_$s$wgo1+--   = \ sc_s3oT sc1_s3oS sc2_s3oR ->+--       case sc2_s3oR of fs2_a2lw { __DEFAULT ->+--       case ># sc1_s3oS 100000# of {+--         __DEFAULT ->+--           let { wild_a2og = I# sc1_s3oS } in+--           main_$s$wgo1+--             sc_s3oT (+# sc1_s3oS 1#) (\ x_X9 -> fs2_a2lw (: wild_a2og x_X9));++-- |+-- Definitions:+--+-- >>> toList = Stream.foldr (:) []+-- >>> toList = Stream.fold Fold.toList+--+-- Convert a stream into a list in the underlying monad. The list can be+-- consumed lazily in a lazy monad (e.g. 'Identity'). In a strict monad (e.g.+-- IO) the whole list is generated and buffered before it can be consumed.+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Data.Array" instead.+--+-- Note that this could a bit more efficient compared to @Stream.fold+-- Fold.toList@, and it can fuse with pure list consumers.+--+{-# INLINE_NORMAL toList #-}+toList :: Monad m => Stream m a -> m [a]+toList = Streamly.Internal.Data.Stream.Type.foldr (:) []++-- Use foldr/build fusion to fuse with list consumers+-- This can be useful when using the IsList instance+{-# INLINE_LATE toListFB #-}+toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b+toListFB c n (Stream step state) = go state+  where+    go st = case runIdentity (step defState st) of+             Yield x s -> x `c` go s+             Skip s    -> go s+             Stop      -> n++{-# RULES "toList Identity" Streamly.Internal.Data.Stream.Type.toList = toListId #-}+{-# INLINE_EARLY toListId #-}+toListId :: Stream Identity a -> Identity [a]+toListId s = Identity $ build (\c n -> toListFB c n s)++------------------------------------------------------------------------------+-- Multi-stream folds+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Compare two streams for equality+{-# INLINE_NORMAL eqBy #-}+eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2+  where+    eq_loop0 !_ s1 s2 = do+      r <- step1 defState s1+      case r of+        Yield x s1' -> eq_loop1 SPEC x s1' s2+        Skip    s1' -> eq_loop0 SPEC   s1' s2+        Stop        -> eq_null s2++    eq_loop1 !_ x s1 s2 = do+      r <- step2 defState s2+      case r of+        Yield y s2'+          | eq x y    -> eq_loop0 SPEC   s1 s2'+          | otherwise -> return False+        Skip    s2'   -> eq_loop1 SPEC x s1 s2'+        Stop          -> return False++    eq_null s2 = do+      r <- step2 defState s2+      case r of+        Yield _ _ -> return False+        Skip s2'  -> eq_null s2'+        Stop      -> return True++-- Adapted from the vector package.++-- | Compare two streams lexicographically.+{-# INLINE_NORMAL cmpBy #-}+cmpBy+    :: Monad m+    => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering+cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2+  where+    cmp_loop0 !_ s1 s2 = do+      r <- step1 defState s1+      case r of+        Yield x s1' -> cmp_loop1 SPEC x s1' s2+        Skip    s1' -> cmp_loop0 SPEC   s1' s2+        Stop        -> cmp_null s2++    cmp_loop1 !_ x s1 s2 = do+      r <- step2 defState s2+      case r of+        Yield y s2' -> case x `cmp` y of+                         EQ -> cmp_loop0 SPEC s1 s2'+                         c  -> return c+        Skip    s2' -> cmp_loop1 SPEC x s1 s2'+        Stop        -> return GT++    cmp_null s2 = do+      r <- step2 defState s2+      case r of+        Yield _ _ -> return LT+        Skip s2'  -> cmp_null s2'+        Stop      -> return EQ++------------------------------------------------------------------------------+-- Transformations+------------------------------------------------------------------------------++-- Adapted from the vector package.++-- |+-- >>> mapM f = Stream.sequence . fmap f+--+-- Apply a monadic function to each element of the stream and replace it with+-- the output of the resulting action.+--+-- >>> s = Stream.fromList ["a", "b", "c"]+-- >>> Stream.fold Fold.drain $ Stream.mapM putStr s+-- abc+--+-- 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+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> f x >>= \a -> return $ Yield a s+            Skip s    -> return $ Skip s+            Stop      -> return Stop++{-# INLINE map #-}+map :: Monad m => (a -> b) -> Stream m a -> Stream m b+map f = mapM (return . f)++-- (Functor m) based implementation of fmap does not fuse well in+-- streaming-benchmarks. XXX need to investigate why.+instance Monad m => Functor (Stream m) where+    {-# INLINE fmap #-}+    fmap = map++    {-# INLINE (<$) #-}+    (<$) = fmap . const++------------------------------------------------------------------------------+-- Lists+------------------------------------------------------------------------------++-- XXX Show instance is 10x slower compared to read, we can do much better.+-- The list show instance itself is really slow.++-- XXX The default definitions of "<" in the Ord instance etc. do not perform+-- well, because they do not get inlined. Need to add INLINE in Ord class in+-- base?++instance IsList (Stream Identity a) where+    type (Item (Stream Identity a)) = a++    {-# INLINE fromList #-}+    fromList = Streamly.Internal.Data.Stream.Type.fromList++    {-# INLINE toList #-}+    toList = runIdentity . Streamly.Internal.Data.Stream.Type.toList++instance Eq a => Eq (Stream Identity a) where+    {-# INLINE (==) #-}+    (==) xs ys = runIdentity $ eqBy (==) xs ys++instance Ord a => Ord (Stream Identity a) where+    {-# INLINE compare #-}+    compare xs ys = runIdentity $ cmpBy compare xs ys++    {-# INLINE (<) #-}+    x < y =+        case compare x y of+            LT -> True+            _ -> False++    {-# INLINE (<=) #-}+    x <= y =+        case compare x y of+            GT -> False+            _ -> True++    {-# INLINE (>) #-}+    x > y =+        case compare x y of+            GT -> True+            _ -> False++    {-# INLINE (>=) #-}+    x >= y =+        case compare x y of+            LT -> False+            _ -> True++    {-# INLINE max #-}+    max x y = if x <= y then y else x++    {-# INLINE min #-}+    min x y = if x <= y then x else y++instance Show a => Show (Stream Identity a) where+    showsPrec p dl = showParen (p > 10) $+        showString "fromList " . shows (GHC.Exts.toList dl)++instance Read a => Read (Stream Identity a) where+    readPrec = parens $ prec 10 $ do+        Ident "fromList" <- lexP+        Streamly.Internal.Data.Stream.Type.fromList <$> readPrec++    readListPrec = readListPrecDefault++instance (a ~ Char) => IsString (Stream Identity a) where+    {-# INLINE fromString #-}+    fromString = Streamly.Internal.Data.Stream.Type.fromList++-------------------------------------------------------------------------------+-- Foldable+-------------------------------------------------------------------------------++-- The default Foldable instance has several issues:+-- 1) several definitions do not have INLINE on them, so we provide+--    re-implementations with INLINE pragmas.+-- 2) the definitions of sum/product/maximum/minimum are inefficient as they+--    use right folds, they cannot run in constant memory. We provide+--    implementations using strict left folds here.++-- There is no Traversable instance because, there is no scalable cons for+-- StreamD, use toList and fromList instead.++instance (Foldable m, Monad m) => Foldable (Stream m) where++    {-# INLINE foldMap #-}+    foldMap f =+        Data.Foldable.fold+            . Streamly.Internal.Data.Stream.Type.foldr (mappend . f) mempty++    {-# INLINE foldr #-}+    foldr f z t = appEndo (foldMap (Endo #. f) t) z++    {-# INLINE foldl' #-}+    foldl' f z0 xs = Data.Foldable.foldr f' id xs z0+        where f' x k = oneShot $ \z -> k $! f z x++    {-# INLINE length #-}+    length = Data.Foldable.foldl' (\n _ -> n + 1) 0++    {-# INLINE elem #-}+    elem = any . (==)++    {-# INLINE maximum #-}+    maximum =+          fromMaybe (errorWithoutStackTrace "maximum: empty stream")+        . toMaybe+        . Data.Foldable.foldl' getMax Nothing'++        where++        getMax Nothing' x = Just' x+        getMax (Just' mx) x = Just' $! max mx x++    {-# INLINE minimum #-}+    minimum =+          fromMaybe (errorWithoutStackTrace "minimum: empty stream")+        . toMaybe+        . Data.Foldable.foldl' getMin Nothing'++        where++        getMin Nothing' x = Just' x+        getMin (Just' mn) x = Just' $! min mn x++    {-# INLINE sum #-}+    sum = Data.Foldable.foldl' (+) 0++    {-# INLINE product #-}+    product = Data.Foldable.foldl' (*) 1++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++-- Adapted from the vector package.++-- | Take first 'n' elements from the stream and discard the rest.+--+{-# INLINE_NORMAL take #-}+take :: Applicative m => Int -> Stream m a -> Stream m a+take n (Stream step state) = n `seq` Stream step' (state, 0)++    where++    {-# INLINE_LATE step' #-}+    step' gst (st, i) | i < n = do+        (\case+            Yield x s -> Yield x (s, i + 1)+            Skip s    -> Skip (s, i)+            Stop      -> Stop) <$> step gst st+    step' _ (_, _) = pure Stop++-- Adapted from the vector package.++-- | Same as 'takeWhile' but with a monadic predicate.+--+{-# INLINE_NORMAL takeWhileM #-}+takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+-- takeWhileM p = scanMaybe (FL.takingEndByM_ (\x -> not <$> p x))+takeWhileM f (Stream step state) = Stream step' state+  where+    {-# INLINE_LATE step' #-}+    step' gst st = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                return $ if b then Yield x s else Stop+            Skip s -> return $ Skip s+            Stop   -> return Stop++-- | End the stream as soon as the predicate fails on an element.+--+{-# INLINE takeWhile #-}+takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeWhile f = takeWhileM (return . f)++-- Like takeWhile but with an inverted condition and also taking+-- the matching element.++{-# INLINE_NORMAL takeEndByM #-}+takeEndByM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+takeEndByM f (Stream step state) = Stream step' (Just state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (Just st) = do+        r <- step gst st+        case r of+            Yield x s -> do+                b <- f x+                return $+                    if not b+                    then Yield x (Just s)+                    else Yield x Nothing+            Skip s -> return $ Skip (Just s)+            Stop   -> return Stop++    step' _ Nothing = return Stop++{-# INLINE takeEndBy #-}+takeEndBy :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+takeEndBy f = takeEndByM (return . f)++-- |+-- >>> 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+------------------------------------------------------------------------------++-- | Like 'zipWith' but using a monadic zipping function.+--+{-# INLINE_NORMAL zipWithM #-}+zipWithM :: Monad m+    => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c+zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)+  where+    {-# INLINE_LATE step #-}+    step gst (sa, sb, Nothing) = do+        r <- stepa (adaptState gst) sa+        return $+          case r of+            Yield x sa' -> Skip (sa', sb, Just x)+            Skip sa'    -> Skip (sa', sb, Nothing)+            Stop        -> Stop++    step gst (sa, sb, Just x) = do+        r <- stepb (adaptState gst) sb+        case r of+            Yield y sb' -> do+                z <- f x y+                return $ Yield z (sa, sb', Nothing)+            Skip sb' -> return $ Skip (sa, sb', Just x)+            Stop     -> return Stop++{-# RULES "zipWithM xs xs"+    forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}++-- | WARNING! O(n^2) time complexity wrt number of streams. Suitable for+-- statically fusing a small number of streams. Use the O(n) complexity+-- StreamK.'Streamly.Data.StreamK.zipWith' otherwise.+--+-- Stream @a@ is evaluated first, followed by stream @b@, the resulting+-- elements @a@ and @b@ are then zipped using the supplied zip function and the+-- result @c@ is yielded to the consumer.+--+-- If stream @a@ or stream @b@ ends, the zipped stream ends. If stream @b@ ends+-- first, the element @a@ from previous evaluation of stream @a@ is discarded.+--+-- >>> s1 = Stream.fromList [1,2,3]+-- >>> s2 = Stream.fromList [4,5,6]+-- >>> Stream.fold Fold.toList $ Stream.zipWith (+) s1 s2+-- [5,7,9]+--+{-# INLINE zipWith #-}+zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c+zipWith f = zipWithM (\a b -> return (f a b))++------------------------------------------------------------------------------+-- Combine N Streams - concatAp+------------------------------------------------------------------------------++-- 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.+--+-- >>> crossApply = Stream.crossWith id+--+{-# INLINE_NORMAL crossApply #-}+crossApply :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b+crossApply (Stream stepa statea) (Stream stepb stateb) =+    Stream step' (Left statea)++    where++    {-# INLINE_LATE step' #-}+    step' gst (Left st) = fmap+        (\case+            Yield f s -> Skip (Right (f, s, stateb))+            Skip    s -> Skip (Left s)+            Stop      -> Stop)+        (stepa (adaptState gst) st)+    step' gst (Right (f, os, st)) = fmap+        (\case+            Yield a s -> Yield (f a) (Right (f, os, s))+            Skip s    -> Skip (Right (f,os, s))+            Stop      -> Skip (Left os))+        (stepb (adaptState gst) st)++-- 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) =+    Stream step (Left statea)++    where++    {-# INLINE_LATE step #-}+    step gst (Left st) =+        fmap+            (\case+                 Yield _ s -> Skip (Right (s, stateb))+                 Skip s -> Skip (Left s)+                 Stop -> Stop)+            (stepa (adaptState gst) st)+    step gst (Right (ostate, st)) =+        fmap+            (\case+                 Yield b s -> Yield b (Right (ostate, s))+                 Skip s -> Skip (Right (ostate, s))+                 Stop -> Skip (Left ostate))+            (stepb gst st)++{-# INLINE_NORMAL crossApplyFst #-}+crossApplyFst :: Functor f => Stream f a -> Stream f b -> Stream f a+crossApplyFst (Stream stepa statea) (Stream stepb stateb) =+    Stream step (Left statea)++    where++    {-# INLINE_LATE step #-}+    step gst (Left st) =+        fmap+            (\case+                 Yield b s -> Skip (Right (s, stateb, b))+                 Skip s -> Skip (Left s)+                 Stop -> Stop)+            (stepa gst st)+    step gst (Right (ostate, st, b)) =+        fmap+            (\case+                 Yield _ s -> Yield b (Right (ostate, s, b))+                 Skip s -> Skip (Right (ostate, s, b))+                 Stop -> Skip (Left ostate))+            (stepb (adaptState gst) st)++{-+instance Applicative f => Applicative (Stream f) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = crossApply++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++    {-# INLINE (*>) #-}+    (*>) = crossApplySnd++    {-# INLINE (<*) #-}+    (<*) = crossApplyFst+-}++-- 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:+--+-- >>> crossWith f m1 m2 = fmap f m1 `Stream.crossApply` m2+--+-- 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)@.+--+-- Definition:+--+-- >>> cross = Stream.crossWith (,)+--+-- The second stream is evaluated multiple times. If that is not desired it can+-- be cached in an 'Data.Array.Array' and then generated from the array before+-- calling this function. Caching may also improve performance if the stream is+-- expensive to evaluate.+--+-- Time: O(m x n)+--+-- /Pre-release/+{-# INLINE cross #-}+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 - unfoldEach+------------------------------------------------------------------------------++{-# ANN type ConcatMapUState Fuse #-}+data ConcatMapUState o i =+      ConcatMapUOuter o+    | ConcatMapUInner o i++-- | @unfoldEach unfold stream@ uses @unfold@ to map the input stream elements+-- to streams and then flattens the generated streams into a single output+-- stream.++-- This is like 'concatMap' but uses an unfold with an explicit state to+-- generate the stream instead of a 'Stream' type generator. This allows better+-- optimization via fusion.  This can be many times more efficient than+-- 'concatMap'.+--+-- '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.+--+-- >>> 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 #-}+    step gst (ConcatMapUOuter o) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a o' -> do+                i <- inject a+                i `seq` return (Skip (ConcatMapUInner o' i))+            Skip o' -> return $ Skip (ConcatMapUOuter o')+            Stop -> return Stop++    step _ (ConcatMapUInner o i) = do+        r <- istep i+        return $ case r of+            Yield x i' -> Yield x (ConcatMapUInner o i')+            Skip i'    -> Skip (ConcatMapUInner o i')+            Stop       -> Skip (ConcatMapUOuter o)++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 'unfoldEach' for a faster alternative.+--+{-# INLINE_NORMAL concatMapM #-}+concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b+concatMapM f (Stream step state) = Stream step' (Left state)+  where+    {-# INLINE_LATE step' #-}+    step' gst (Left st) = do+        r <- step (adaptState gst) st+        case r of+            Yield a s -> do+                b_stream <- f a+                return $ Skip (Right (b_stream, s))+            Skip s -> return $ Skip (Left s)+            Stop -> return Stop++    -- XXX using the pattern synonym "Stream" causes a major performance issue+    -- here even if the synonym does not include an adaptState call. Need to+    -- find out why. Is that something to be fixed in GHC?+    step' gst (Right (UnStream inner_step inner_st, st)) = do+        r <- inner_step (adaptState gst) inner_st+        case r of+            Yield b inner_s ->+                return $ Yield b (Right (Stream inner_step inner_s, st))+            Skip inner_s ->+                return $ Skip (Right (Stream inner_step inner_s, st))+            Stop -> return $ Skip (Left st)++-- | Map a stream producing function on each element of the stream and then+-- flatten the results into a single stream.+--+-- >>> concatMap f = Stream.concat . fmap f+-- >>> concatMap f = Stream.concatMapM (return . f)+-- >>> concatMap f = Stream.unfoldEach (Unfold.lmap f Unfold.fromStream)+--+-- 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+--+-- /Pre-release/+{-# INLINE concat #-}+concat :: Monad m => Stream m (Stream m a) -> Stream m a+concat = concatMap id++-- >>> concatEffect = Stream.concat . lift    -- requires (MonadTrans t)+-- >>> concatEffect = join . lift             -- requires (MonadTrans t, Monad (Stream m))++-- | 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 ())+--+-- See also: 'concat', 'sequence'+--+{-# INLINE concatEffect #-}+concatEffect :: Monad m => m (Stream m a) -> Stream m a+concatEffect generator = concatMapM (\() -> generator) (fromPure ())++{-+-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,+-- the monad instance does not seem to be significantly faster.+instance Monad m => Monad (Stream m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap++    {-# INLINE (>>) #-}+    (>>) = (*>)+-}++------------------------------------------------------------------------------+-- Traversing a tree top down+------------------------------------------------------------------------------++-- Next stream is to be generated by the return value of the previous stream. A+-- general intuitive way of doing that could be to use an appending monad+-- instance for streams where the result of the previous stream is used to+-- generate the next one. In the first pass we can just emit the values in the+-- stream and keep building a buffered list/stream, once done we can then+-- process the buffered stream.++-- | Generate a stream from an initial state, scan and concat the stream,+-- generate a stream again from the final state of the previous scan and repeat+-- the process.+{-# INLINE_NORMAL concatIterateScan #-}+concatIterateScan :: Monad m =>+       (b -> a -> m b)+    -> (b -> m (Maybe (b, Stream m a)))+    -> b+    -> Stream m a+concatIterateScan scanner generate initial = Stream step (Left initial)++    where++    {-# INLINE_LATE step #-}+    step _ (Left acc) = do+        r <- generate acc+        case r of+            Nothing -> return Stop+            Just v -> return $ Skip (Right v)++    step gst (Right (st, UnStream inner_step inner_st)) = do+        r <- inner_step (adaptState gst) inner_st+        case r of+            Yield b inner_s -> do+                acc <- scanner st b+                return $ Yield b (Right (acc, Stream inner_step inner_s))+            Skip inner_s ->+                return $ Skip (Right (st, Stream inner_step inner_s))+            Stop -> return $ Skip (Left st)++-- Note: The iterate function returns a Maybe Stream instead of returning a nil+-- stream for indicating a leaf node. This is to optimize so that we do not+-- have to store any state. This makes the stored state proportional to the+-- number of non-leaf nodes rather than total number of nodes.++-- | Same as 'concatIterateBfs' except that the traversal of the last+-- element on a level is emitted first and then going backwards up to the first+-- element (reversed ordering). This may be slightly faster than+-- 'concatIterateBfs'.+--+{-# INLINE_NORMAL altBfsConcatIterate #-}+altBfsConcatIterate, concatIterateBfsRev :: Monad m =>+       (a -> Maybe (Stream m a))+    -> Stream m a+    -> Stream m a+altBfsConcatIterate f stream = Stream step (stream, [])++    where++    {-# INLINE_LATE step #-}+    step gst (UnStream step1 st, xs) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield a s -> do+                let xs1 =+                        case f a of+                            Nothing -> xs+                            Just x -> x:xs+                return $ Yield a (Stream step1 s, xs1)+            Skip s -> return $ Skip (Stream step1 s, xs)+            Stop ->+                case xs of+                    (y:ys) -> return $ Skip (y, ys)+                    [] -> return Stop++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 id) (const Nothing)+-- >>> input = Stream.fromEffect (Left <$> Path.fromString ".")+-- >>> ls = Stream.bfsConcatIterate f input+--+-- /Pre-release/+{-# INLINE_NORMAL bfsConcatIterate #-}+bfsConcatIterate, concatIterateBfs :: Monad m =>+       (a -> Maybe (Stream m a))+    -> Stream m a+    -> Stream m a+bfsConcatIterate f stream = Stream step (stream, [], [])++    where++    {-# INLINE_LATE step #-}+    step gst (UnStream step1 st, xs, ys) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield a s -> do+                let ys1 =+                        case f a of+                            Nothing -> ys+                            Just y -> y:ys+                return $ Yield a (Stream step1 s, xs, ys1)+            Skip s -> return $ Skip (Stream step1 s, xs, ys)+            Stop ->+                case xs of+                    (x:xs1) -> return $ Skip (x, xs1, ys)+                    [] ->+                        case reverse ys of+                            (x:xs1) -> return $ Skip (x, xs1, [])+                            [] -> return Stop++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 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 concatIterate #-}+concatIterate, concatIterateDfs :: Monad m =>+       (a -> Maybe (Stream m a))+    -> Stream m a+    -> Stream m a+concatIterate f stream = Stream step (stream, [])++    where++    {-# INLINE_LATE step #-}+    step gst (UnStream step1 st, xs) = do+        r <- step1 (adaptState gst) st+        case r of+            Yield a s -> do+                let st1 =+                        case f a of+                            Nothing -> (Stream step1 s, xs)+                            Just x -> (x, Stream step1 s:xs)+                return $ Yield a st1+            Skip s -> return $ Skip (Stream step1 s, xs)+            Stop ->+                case xs of+                    (y:ys) -> return $ Skip (y, ys)+                    [] -> return Stop++RENAME(concatIterateDfs,concatIterate)++{-# ANN type IterateUnfoldState Fuse #-}+data IterateUnfoldState o i =+      IterateUnfoldOuter o+    | IterateUnfoldInner o i [i]++-- | Same as 'concatIterate' but more efficient due to stream fusion.+--+-- Example, list a directory tree using DFS:+--+-- >>> f = Unfold.either (Dir.eitherReaderPaths id) Unfold.nil+-- >>> input = Stream.fromEffect (Left <$> Path.fromString ".")+-- >>> ls = Stream.unfoldIterate f input+--+-- /Pre-release/+{-# INLINE_NORMAL unfoldIterate #-}+unfoldIterate, unfoldIterateDfs :: Monad m =>+       Unfold m a a+    -> Stream m a+    -> Stream m a+unfoldIterate (Unfold istep inject) (Stream ostep ost) =+    Stream step (IterateUnfoldOuter ost)++    where++    {-# INLINE_LATE step #-}+    step gst (IterateUnfoldOuter o) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a s -> do+                i <- inject a+                i `seq` return (Yield a (IterateUnfoldInner s i []))+            Skip s -> return $ Skip (IterateUnfoldOuter s)+            Stop -> return Stop++    step _ (IterateUnfoldInner o i ii) = do+        r <- istep i+        case r of+            Yield x s -> do+                i1 <- inject x+                i1 `seq` return $ Yield x (IterateUnfoldInner o i1 (s:ii))+            Skip s -> return $ Skip (IterateUnfoldInner o s ii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldInner o y ys)+                    [] -> return $ Skip (IterateUnfoldOuter o)++RENAME(unfoldIterateDfs,unfoldIterate)++{-# ANN type IterateUnfoldBFSRevState Fuse #-}+data IterateUnfoldBFSRevState o i =+      IterateUnfoldBFSRevOuter o [i]+    | IterateUnfoldBFSRevInner i [i]++-- | Like 'bfsUnfoldIterate' but processes the children in reverse order,+-- therefore, may be slightly faster.+--+-- /Pre-release/+{-# INLINE_NORMAL altBfsUnfoldIterate #-}+altBfsUnfoldIterate, unfoldIterateBfsRev :: Monad m =>+       Unfold m a a+    -> Stream m a+    -> Stream m a+altBfsUnfoldIterate (Unfold istep inject) (Stream ostep ost) =+    Stream step (IterateUnfoldBFSRevOuter ost [])++    where++    {-# INLINE_LATE step #-}+    step gst (IterateUnfoldBFSRevOuter o ii) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a s -> do+                i <- inject a+                i `seq` return (Yield a (IterateUnfoldBFSRevOuter s (i:ii)))+            Skip s -> return $ Skip (IterateUnfoldBFSRevOuter s ii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)+                    [] -> return Stop++    step _ (IterateUnfoldBFSRevInner i ii) = do+        r <- istep i+        case r of+            Yield x s -> do+                i1 <- inject x+                i1 `seq` return $ Yield x (IterateUnfoldBFSRevInner s (i1:ii))+            Skip s -> return $ Skip (IterateUnfoldBFSRevInner s ii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSRevInner y ys)+                    [] -> return Stop++RENAME(unfoldIterateBfsRev,altBfsUnfoldIterate)++{-# ANN type IterateUnfoldBFSState Fuse #-}+data IterateUnfoldBFSState o i =+      IterateUnfoldBFSOuter o [i]+    | IterateUnfoldBFSInner i [i] [i]++-- | Like 'unfoldIterate' but uses breadth first style traversal.+--+-- /Pre-release/+{-# INLINE_NORMAL bfsUnfoldIterate #-}+bfsUnfoldIterate, unfoldIterateBfs :: Monad m =>+       Unfold m a a+    -> Stream m a+    -> Stream m a+bfsUnfoldIterate (Unfold istep inject) (Stream ostep ost) =+    Stream step (IterateUnfoldBFSOuter ost [])++    where++    {-# INLINE_LATE step #-}+    step gst (IterateUnfoldBFSOuter o rii) = do+        r <- ostep (adaptState gst) o+        case r of+            Yield a s -> do+                i <- inject a+                i `seq` return (Yield a (IterateUnfoldBFSOuter s (i:rii)))+            Skip s -> return $ Skip (IterateUnfoldBFSOuter s rii)+            Stop ->+                case reverse rii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])+                    [] -> return Stop++    step _ (IterateUnfoldBFSInner i ii rii) = do+        r <- istep i+        case r of+            Yield x s -> do+                i1 <- inject x+                i1 `seq` return $ Yield x (IterateUnfoldBFSInner s ii (i1:rii))+            Skip s -> return $ Skip (IterateUnfoldBFSInner s ii rii)+            Stop ->+                case ii of+                    (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys rii)+                    [] ->+                        case reverse rii of+                            (y:ys) -> return $ Skip (IterateUnfoldBFSInner y ys [])+                            [] -> return Stop++RENAME(unfoldIterateBfs,bfsUnfoldIterate)++------------------------------------------------------------------------------+-- Folding a tree bottom up+------------------------------------------------------------------------------++-- | Binary BFS style reduce, folds a level entirely using the supplied fold+-- function, collecting the outputs as next level of the tree, then repeats the+-- same process on the next level. The last elements of a previously folded+-- level are folded first.+{-# INLINE_NORMAL bfsReduceIterate #-}+bfsReduceIterate, reduceIterateBfs :: Monad m =>+    (a -> a -> m a) -> Stream m a -> m (Maybe a)+bfsReduceIterate f (Stream step state) = go SPEC state [] Nothing++    where++    go _ st xs Nothing = do+        r <- step defState st+        case r of+            Yield x1 s -> go SPEC s xs (Just x1)+            Skip s -> go SPEC s xs Nothing+            Stop ->+                case xs of+                    [] -> return Nothing+                    _ -> goBuf SPEC xs []+    go _ st xs (Just x1) = do+        r2 <- step defState st+        case r2 of+            Yield x2 s -> do+                x <- f x1 x2+                go SPEC s (x:xs) Nothing+            Skip s -> go SPEC s xs (Just x1)+            Stop ->+                case xs of+                    [] -> return (Just x1)+                    _ -> goBuf SPEC (x1:xs) []++    goBuf _ [] ys = goBuf SPEC ys []+    goBuf _ [x1] ys = do+        case ys of+            [] -> return (Just x1)+            (x2:xs) -> do+                y <- f x1 x2+                goBuf SPEC xs [y]+    goBuf _ (x1:x2:xs) ys = do+        y <- f x1 x2+        goBuf SPEC xs (y:ys)++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/+bfsFoldIterate ::+    Fold m a (Either a a) -> Stream m a -> m (Maybe a)+bfsFoldIterate = undefined++------------------------------------------------------------------------------+-- Grouping/Splitting+------------------------------------------------------------------------------++-- 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++-- 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, compare with 'foldMany':+--+-- >>> f = Fold.take 2 Fold.toList+-- >>> fmany = Stream.fold Fold.toList . Stream.foldManyPost f+-- >>> fmany $ Stream.fromList []+-- [[]]+--+-- Example, last empty fold is included, compare with 'foldMany':+--+-- >>> fmany $ Stream.fromList [1..4]+-- [[1,2],[3,4],[]]+--+-- Example, last fold non-empty, same as 'foldMany':+--+-- >>> fmany $ Stream.fromList [1..5]+-- [[1,2],[3,4],[5]]+--+-- /Pre-release/+--+{-# INLINE_NORMAL foldManyPost #-}+foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b+foldManyPost (Fold fstep initial _ final) (Stream step state) =+    Stream step' (FoldManyPostStart state)++    where++    {-# INLINE consume #-}+    consume x s fs = do+        res <- fstep fs x+        return+            $ Skip+            $ case res of+                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart s)+                  FL.Partial ps -> FoldManyPostLoop s ps++    {-# INLINE_LATE step' #-}+    step' _ (FoldManyPostStart st) = do+        r <- initial+        return+            $ Skip+            $ case r of+                  FL.Done b -> FoldManyPostYield b (FoldManyPostStart st)+                  FL.Partial fs -> FoldManyPostLoop st fs+    step' gst (FoldManyPostLoop st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyPostLoop s fs)+            Stop -> do+                b <- final fs+                return $ Skip (FoldManyPostYield b FoldManyPostDone)+    step' _ (FoldManyPostYield b next) = return $ Yield b next+    step' _ FoldManyPostDone = return Stop++-- | 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+    | FoldManyLoop s fs+    | FoldManyYield b (FoldMany s fs b a)+    | FoldManyDone++-- XXX Nested foldMany does not fuse.++-- | 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, omits the empty fold value:+--+-- >>> f = Fold.take 2 Fold.toList+-- >>> fmany = Stream.fold Fold.toList . Stream.foldMany f+-- >>> fmany $ Stream.fromList []+-- []+--+-- Example, omits the last empty fold value:+--+-- >>> fmany $ Stream.fromList [1..4]+-- [[1,2],[3,4]]+--+-- Example, last fold non-empty:+--+-- >>> fmany $ Stream.fromList [1..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.+--+{-# INLINE_NORMAL foldMany #-}+foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+foldMany (Fold fstep initial _ final) (Stream step state) =+    Stream step' (FoldManyStart state)++    where++    {-# INLINE consume #-}+    consume x s fs = do+        res <- fstep fs x+        return+            $ Skip+            $ case res of+                  FL.Done b -> FoldManyYield b (FoldManyStart s)+                  FL.Partial ps -> FoldManyLoop s ps++    {-# INLINE_LATE step' #-}+    step' _ (FoldManyStart st) = do+        r <- initial+        return+            $ Skip+            $ case r of+                  FL.Done b -> FoldManyYield b (FoldManyStart st)+                  FL.Partial fs -> FoldManyFirst fs st+    step' gst (FoldManyFirst fs st) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyFirst fs s)+            Stop -> final fs >> return Stop+    step' gst (FoldManyLoop st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyLoop s fs)+            Stop -> do+                b <- final fs+                return $ Skip (FoldManyYield b FoldManyDone)+    step' _ (FoldManyYield b next) = return $ Yield b next+    step' _ FoldManyDone = return Stop++-- | Group the input stream into groups of @n@ elements each and then fold each+-- group using the provided fold function.+--+-- Definition:+--+-- >>> 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.+--+{-# INLINE groupsOf #-}+groupsOf :: Monad m => Int -> Fold m a b -> Stream m a -> Stream m b+groupsOf n f = foldMany (FL.take n f)++-- Keep the argument order consistent with refoldIterateM.++-- | Like 'foldMany' but for the 'Refold' type.  The supplied action is used as+-- the initial value for each refold.+--+-- /Internal/+{-# INLINE_NORMAL refoldMany #-}+refoldMany :: Monad m => Refold m x a b -> m x -> Stream m a -> Stream m b+refoldMany (Refold fstep inject extract) action (Stream step state) =+    Stream step' (FoldManyStart state)++    where++    {-# INLINE consume #-}+    consume x s fs = do+        res <- fstep fs x+        return+            $ Skip+            $ case res of+                  FL.Done b -> FoldManyYield b (FoldManyStart s)+                  FL.Partial ps -> FoldManyLoop s ps++    {-# INLINE_LATE step' #-}+    step' _ (FoldManyStart st) = do+        r <- action >>= inject+        return+            $ Skip+            $ case r of+                  FL.Done b -> FoldManyYield b (FoldManyStart st)+                  FL.Partial fs -> FoldManyFirst fs st+    step' gst (FoldManyFirst fs st) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyFirst fs s)+            Stop -> return Stop+    step' gst (FoldManyLoop st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyLoop s fs)+            Stop -> do+                b <- extract fs+                return $ Skip (FoldManyYield b FoldManyDone)+    step' _ (FoldManyYield b next) = return $ Yield b next+    step' _ FoldManyDone = return Stop++{-# ANN type CIterState Fuse #-}+data CIterState s f fs b+    = CIterInit s f+    | CIterConsume s fs+    | CIterYield b (CIterState s f fs b)+    | CIterStop++-- | Like 'foldIterateM' but using the 'Refold' type instead. This could be+-- much more efficient due to stream fusion.+--+-- /Internal/+{-# INLINE_NORMAL refoldIterateM #-}+refoldIterateM ::+       Monad m => Refold m b a b -> m b -> Stream m a -> Stream m b+refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =+    Stream stepOuter (CIterInit state initial)++    where++    {-# INLINE iterStep #-}+    iterStep st action = do+        res <- action+        return+            $ Skip+            $ case res of+                  FL.Partial fs -> CIterConsume st fs+                  FL.Done fb -> CIterYield fb $ CIterInit st (return fb)++    {-# INLINE_LATE stepOuter #-}+    stepOuter _ (CIterInit st action) = do+        iterStep st (action >>= finject)+    stepOuter gst (CIterConsume st fs) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> iterStep s (fstep fs x)+            Skip s -> return $ Skip $ CIterConsume s fs+            Stop -> do+                b <- fextract fs+                return $ Skip $ CIterYield b CIterStop+    stepOuter _ (CIterYield a next) = return $ Yield a next+    stepOuter _ CIterStop = return Stop++-- | The refold @indexerBy f n@ takes an (index, len) tuple as initial input,+-- and returns @(index + len + n, b)@ as output where @b@ is the output of the+-- fold.+{-# INLINE indexerBy #-}+indexerBy :: Monad m =>+    Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)+indexerBy (Fold step1 initial1 extract1 _final) n =+    Refold step inject extract++    where++    inject (i, len) = do+        r <- initial1+        return $ case r of+            FL.Partial s -> FL.Partial $ Tuple' (i + len + n) s+            FL.Done l -> FL.Done (i, l)++    step (Tuple' i s) x = do+        r <- step1 s x+        return $ case r of+            FL.Partial s1 -> FL.Partial $ Tuple' i s1+            FL.Done len -> FL.Done (i, len)++    extract (Tuple' i s) = (i,) <$> extract1 s++-- | 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 indexEndBy_ #-}+indexEndBy_, indexOnSuffix :: Monad m =>+    (a -> Bool) -> Stream m a -> Stream m (Int, Int)+indexEndBy_ predicate =+    refoldIterateM+        (indexerBy (FL.takeEndBy_ predicate FL.length) 1)+        (return (-1, 0))++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 = 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 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+-- instance.+--+-- A 'Monad' bind behaves like a @for@ loop:+--+-- >>> :{+-- 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+-- :}+-- [1,2]+--+-- Nested monad binds behave like nested @for@ loops:+--+-- >>> :{+-- 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 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 -> Nested m a+mkCross = Nested++{-# INLINE unCross #-}+unCross :: Nested m a -> Stream m a+unCross = unNested++-- Pure (Identity monad) stream instances+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 StreamD bind and pure:+    -- toList, filterAllout, *>, *<, >> (~2x)+    --++    -- Benchmarks better with CPS bind and pure:+    -- Prime sieve (25x)+    -- n binds, breakAfterSome, filterAllIn, state transformer (~2x)+    --+    {-# INLINE (>>=) #-}+    (>>=) (Nested m) f = Nested (concatMap (unNested . f) m)++    {-# INLINE (>>) #-}+    (>>) = (*>)++------------------------------------------------------------------------------+-- 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++------------------------------------------------------------------------------+-- 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/Stream/Zip.hs 
@@ -1,91 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}---- |--- Module      : Streamly.Internal.Data.Stream.Zip--- Copyright   : (c) 2017 Composewell Technologies------ License     : BSD3--- Maintainer  : streamly@composewell.com--- Stability   : experimental--- Portability : GHC------ To run examples in this module:------ >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.Zip as Stream----module Streamly.Internal.Data.Stream.Zip-    (-      ZipStream (..)-    , ZipSerialM-    , ZipSerial-    )-where--import Data.Functor.Identity (Identity(..))-import GHC.Exts (IsList(..), IsString(..))-import Streamly.Internal.Data.Stream.Type (Stream)-import Text.Read-       ( Lexeme(Ident), lexP, parens, prec, readPrec, readListPrec-       , readListPrecDefault)--import qualified Streamly.Internal.Data.Stream.Bottom as Stream-import qualified Streamly.Internal.Data.Stream.Generate as Stream---- $setup--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Stream.Zip as Stream----------------------------------------------------------------------------------- Serially Zipping Streams----------------------------------------------------------------------------------- | For 'ZipStream':------ @--- (<>) = 'Streamly.Data.Stream.append'--- (\<*>) = 'Streamly.Data.Stream.zipWith' id--- @------ Applicative evaluates the streams being zipped serially:------ >>> s1 = Stream.ZipStream $ Stream.fromFoldable [1, 2]--- >>> s2 = Stream.ZipStream $ Stream.fromFoldable [3, 4]--- >>> s3 = Stream.ZipStream $ Stream.fromFoldable [5, 6]--- >>> s = (,,) <$> s1 <*> s2 <*> s3--- >>> Stream.fold Fold.toList (Stream.unZipStream s)--- [(1,3,5),(2,4,6)]----newtype ZipStream m a = ZipStream {unZipStream :: Stream m a}-        deriving (Functor, Semigroup, Monoid)--deriving instance IsList (ZipStream Identity a)-deriving instance (a ~ Char) => IsString (ZipStream Identity a)-deriving instance Eq a => Eq (ZipStream Identity a)-deriving instance Ord a => Ord (ZipStream Identity a)-deriving instance (Foldable m, Monad m) => Foldable (ZipStream m)-deriving instance Traversable (ZipStream Identity)--instance Show a => Show (ZipStream Identity a) where-    showsPrec p dl = showParen (p > 10) $-        showString "fromList " . shows (toList dl)--instance Read a => Read (ZipStream Identity a) where-    readPrec = parens $ prec 10 $ do-        Ident "fromList" <- lexP-        fromList <$> readPrec-    readListPrec = readListPrecDefault--type ZipSerialM = ZipStream---- | An IO stream whose applicative instance zips streams serially.----type ZipSerial = ZipSerialM IO--instance Monad m => Applicative (ZipStream m) where-    pure = ZipStream . Stream.repeat--    {-# INLINE (<*>) #-}-    ZipStream m1 <*> ZipStream m2 = ZipStream $ Stream.zipWith id m1 m2
+ src/Streamly/Internal/Data/StreamK.hs view
@@ -0,0 +1,1397 @@+{-# LANGUAGE CPP #-}+{- HLINT ignore "Eta reduce" -}+-- |+-- Module      : Streamly.Internal.Data.StreamK+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.StreamK+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++      module Streamly.Internal.Data.StreamK.Type+    -- * Transformer+    , module Streamly.Internal.Data.StreamK.Transformer++    -- * From containers+    , fromStream++    -- * Specialized Generation+    , repeatM+    , replicate+    , replicateM+    , fromIndices+    , fromIndicesM+    , iterate+    , iterateM++    -- * Elimination+    -- ** General Folds+    , foldr1+    , fold+    , foldBreak+    , foldEither+    , foldConcat+    , ParserK.toParserK -- XXX move the code to this module+    , parseDBreak+    , parseD+    , parseBreak+    , parseBreakPos+    , parse+    , parsePos++    -- ** Specialized Folds+    , head+    , elem+    , notElem+    , all+    , any+    , last+    , minimum+    , minimumBy+    , maximum+    , maximumBy+    , findIndices+    , lookup+    , findM+    , find+    , (!!)++    -- ** To Containers+    , toList+    , toStream++    -- ** Map and Fold+    , mapM_++    -- * Transformation+    -- ** By folding (scans)+    , scanl'+    , scanlx'++    -- ** Filtering+    , filter+    , take+    , takeWhile+    , drop+    , dropWhile++    -- ** Mapping+    , mapM+    , sequence++    -- ** Inserting+    , intersperseM+    , intersperse+    , insertBy++    -- ** Deleting+    , deleteBy++    -- ** Reordering+    , sortBy+    , sortOn++    -- ** Map and Filter+    , mapMaybe++    -- ** Zipping+    , zipWith+    , zipWithM++    -- ** Merging+    , mergeBy+    , mergeByM++    -- ** 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.Ord (comparing)+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.IOFinalizer (newIOFinalizer, runIOFinalizer)+import Streamly.Internal.Data.ParserK.Type (ParserK)+import Streamly.Internal.Data.Producer.Type (Producer(..))+import Streamly.Internal.Data.SVar.Type (adaptState, defState)+import Streamly.Internal.Data.Unbox (Unbox)++import qualified Control.Monad.Catch as MC+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+import qualified Prelude++import Prelude+       hiding (Foldable(..), last, map, mapM, mapM_, repeat, sequence,+               take, filter, all, any, takeWhile, drop, dropWhile,+               notElem, head, tail, init, zipWith, lookup,+               (!!), replicate, reverse, concatMap, iterate, splitAt)+import Data.Foldable (length)+import Streamly.Internal.Data.StreamK.Type+import Streamly.Internal.Data.StreamK.Transformer+import Streamly.Internal.Data.Parser (ParseError(..), ParseErrorPos(..))++#include "DocTestDataStreamK.hs"++-- | Convert a fused 'Stream' to 'StreamK'.+--+-- For example:+--+-- >>> s1 = StreamK.fromStream $ Stream.fromList [1,2]+-- >>> s2 = StreamK.fromStream $ Stream.fromList [3,4]+-- >>> Stream.fold Fold.toList $ StreamK.toStream $ s1 `StreamK.append` s2+-- [1,2,3,4]+--+{-# INLINE fromStream #-}+fromStream :: Monad m => Stream.Stream m a -> StreamK m a+fromStream = Stream.toStreamK++-- | Convert a 'StreamK' to a fused 'Stream'.+--+{-# INLINE toStream #-}+toStream :: Applicative m => StreamK m a -> Stream.Stream m a+toStream = Stream.fromStreamK++-------------------------------------------------------------------------------+-- Generation+-------------------------------------------------------------------------------++{-+-- Generalization of concurrent streams/SVar via unfoldr.+--+-- Unfold a value into monadic actions and then run the resulting monadic+-- actions to generate a stream. Since the step of generating the monadic+-- action and running them are decoupled we can run the monadic actions+-- cooncurrently. For example, the seed could be a list of monadic actions or a+-- pure stream of monadic actions.+--+-- We can have different flavors of this depending on the stream type t. The+-- concurrent version could be async or ahead etc. Depending on how we queue+-- back the feedback portion b, it could be DFS or BFS style.+--+unfoldrA :: (b -> Maybe (m a, b)) -> b -> StreamK m a+unfoldrA = undefined+-}++-------------------------------------------------------------------------------+-- Special generation+-------------------------------------------------------------------------------++-- |+-- >>> repeatM = StreamK.sequence . StreamK.repeat+-- >>> repeatM = fix . StreamK.consM+-- >>> repeatM = cycle1 . StreamK.fromEffect+--+-- Generate a stream by repeatedly executing a monadic action forever.+--+-- >>> :{+-- repeatAction =+--        StreamK.repeatM (threadDelay 1000000 >> print 1)+--      & StreamK.take 10+--      & StreamK.fold Fold.drain+-- :}+--+repeatM :: Monad m => m a -> StreamK m a+repeatM = repeatMWith consM++{-# INLINE replicateM #-}+replicateM :: Monad m => Int -> m a -> StreamK m a+replicateM = replicateMWith consM+{-# INLINE replicate #-}+replicate :: Int -> a -> StreamK m a+replicate n a = go n+    where+    go cnt = if cnt <= 0 then nil else a `cons` go (cnt - 1)++{-# INLINE fromIndicesM #-}+fromIndicesM :: Monad m => (Int -> m a) -> StreamK m a+fromIndicesM = fromIndicesMWith consM+{-# INLINE fromIndices #-}+fromIndices :: (Int -> a) -> StreamK m a+fromIndices gen = go 0+  where+    go n = gen n `cons` go (n + 1)++-- |+-- >>> iterate f x = x `StreamK.cons` iterate f x+--+-- Generate an infinite stream with @x@ as the first element and each+-- successive element derived by applying the function @f@ on the previous+-- element.+--+-- >>> StreamK.toList $ StreamK.take 5 $ StreamK.iterate (+1) 1+-- [1,2,3,4,5]+--+{-# INLINE iterate #-}+iterate :: (a -> a) -> a -> StreamK m a+iterate step = go+    where+        go !s = cons s (go (step s))++-- |+-- >>> iterateM f m = m >>= \a -> return a `StreamK.consM` iterateM f (f a)+--+-- Generate an infinite stream with the first element generated by the action+-- @m@ and each successive element derived by applying the monadic function+-- @f@ on the previous element.+--+-- >>> :{+-- StreamK.iterateM (\x -> print x >> return (x + 1)) (return 0)+--     & StreamK.take 3+--     & StreamK.toList+-- :}+-- 0+-- 1+-- [0,1,2]+--+{-# INLINE iterateM #-}+iterateM :: Monad m => (a -> m a) -> m a -> StreamK m a+iterateM = iterateMWith consM++-------------------------------------------------------------------------------+-- Elimination by Folding+-------------------------------------------------------------------------------++{-# INLINE foldr1 #-}+foldr1 :: Monad m => (a -> a -> a) -> StreamK m a -> m (Maybe a)+foldr1 step m = do+    r <- uncons m+    case r of+        Nothing -> return Nothing+        Just (h, t) -> fmap Just (go h t)+    where+    go p m1 =+        let stp = return p+            single a = return $ step a p+            yieldk a r = fmap (step p) (go a r)+         in foldStream defState yieldk single stp m1++-- | Fold a stream using the supplied left 'Fold' and reducing the resulting+-- expression strictly at each step. The behavior is similar to 'foldl''. A+-- 'Fold' can terminate early without consuming the full stream. See the+-- documentation of individual 'Fold's for termination behavior.+--+-- Definitions:+--+-- >>> fold f = fmap fst . StreamK.foldBreak f+-- >>> fold f = StreamK.parseD (Parser.fromFold f)+--+-- Example:+--+-- >>> StreamK.fold Fold.sum $ StreamK.fromStream $ Stream.enumerateFromTo 1 100+-- 5050+--+{-# INLINABLE fold #-}+fold :: Monad m => FL.Fold m a b -> StreamK m a -> m b+fold (FL.Fold step begin _ final) m = do+    res <- begin+    case res of+        FL.Partial fs -> go fs m+        FL.Done fb -> return fb++    where+    go !acc m1 =+        let stop = final acc+            single a = step acc a+              >>= \case+                        FL.Partial s -> final s+                        FL.Done b1 -> return b1+            yieldk a r = step acc a+              >>= \case+                        FL.Partial s -> go s r+                        FL.Done b1 -> return b1+         in foldStream defState yieldk single stop m1++-- | Fold resulting in either breaking the stream or continuation of the fold.+-- Instead of supplying the input stream in one go we can run the fold multiple+-- times, each time supplying the next segment of the input stream. If the fold+-- has not yet finished it returns a fold that can be run again otherwise it+-- returns the fold result and the residual stream.+--+-- /Internal/+{-# INLINE foldEither #-}+foldEither :: Monad m =>+    Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))+foldEither (FL.Fold step begin done final) m = do+    res <- begin+    case res of+        FL.Partial fs -> go fs m+        FL.Done fb -> return $ Right (fb, m)++    where++    go !acc m1 =+        let stop =+                let f = Fold step (return $ FL.Partial acc) done final+                 in return $ Left f+            single a =+                step acc a+                  >>= \case+                    FL.Partial s ->+                        let f = Fold step (return $ FL.Partial s) done final+                         in return $ Left f+                    FL.Done b1 -> return $ Right (b1, nil)+            yieldk a r =+                step acc a+                  >>= \case+                    FL.Partial s -> go s r+                    FL.Done b1 -> return $ Right (b1, r)+         in foldStream defState yieldk single stop m1++-- | Like 'fold' but also returns the remaining stream. The resulting stream+-- would be 'StreamK.nil' if the stream finished before the fold.+--+{-# INLINE foldBreak #-}+foldBreak :: Monad m => Fold m a b -> StreamK m a -> m (b, StreamK m a)+foldBreak fld strm = do+    r <- foldEither fld strm+    case r of+        Right res -> return res+        Left (Fold _ initial _ final) -> do+            res <- initial+            case res of+                FL.Done _ -> error "foldBreak: unreachable state"+                FL.Partial s -> do+                    b <- final s+                    return (b, nil)++-- XXX Array folds can be implemented using this.+-- foldContainers? Specialized to foldArrays.++-- | Generate streams from individual elements of a stream and fold the+-- concatenation of those streams using the supplied fold. Return the result of+-- the fold and residual stream.+--+-- For example, this can be used to efficiently fold an Array Word8 stream+-- using Word8 folds.+--+-- /Internal/+{-# INLINE foldConcat #-}+foldConcat :: Monad m =>+    Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)+foldConcat+    (Producer pstep pinject pextract)+    (Fold fstep begin _ final)+    stream = do++    res <- begin+    case res of+        FL.Partial fs -> go fs stream+        FL.Done fb -> return (fb, stream)++    where++    go !acc m1 = do+        let stop = do+                r <- final acc+                return (r, nil)+            single a = do+                st <- pinject a+                res <- go1 SPEC acc st+                case res of+                    Left fs -> do+                        r <- final fs+                        return (r, nil)+                    Right (b, s) -> do+                        x <- pextract s+                        return (b, fromPure x)+            yieldk a r = do+                st <- pinject a+                res <- go1 SPEC acc st+                case res of+                    Left fs -> go fs r+                    Right (b, s) -> do+                        x <- pextract s+                        return (b, x `cons` r)+         in foldStream defState yieldk single stop m1++    {-# INLINE go1 #-}+    go1 !_ !fs st = do+        r <- pstep st+        case r of+            Stream.Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Done b -> return $ Right (b, s)+                    FL.Partial fs1 -> go1 SPEC fs1 s+            Stream.Skip s -> go1 SPEC fs s+            Stream.Stop -> return $ Left fs++------------------------------------------------------------------------------+-- Specialized folds+------------------------------------------------------------------------------++{-# INLINE head #-}+head :: Monad m => StreamK m a -> m (Maybe a)+-- head = foldrM (\x _ -> return $ Just x) (return Nothing)+head m =+    let stop      = return Nothing+        single a  = return (Just a)+        yieldk a _ = return (Just a)+    in foldStream defState yieldk single stop m++{-# INLINE elem #-}+elem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+elem e = go+    where+    go m1 =+        let stop      = return False+            single a  = return (a == e)+            yieldk a r = if a == e then return True else go r+        in foldStream defState yieldk single stop m1++{-# INLINE notElem #-}+notElem :: (Monad m, Eq a) => a -> StreamK m a -> m Bool+notElem e = go+    where+    go m1 =+        let stop      = return True+            single a  = return (a /= e)+            yieldk a r = if a == e then return False else go r+        in foldStream defState yieldk single stop m1++{-# INLINABLE all #-}+all :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+all p = go+    where+    go m1 =+        let single a   | p a       = return True+                       | otherwise = return False+            yieldk a r | p a       = go r+                       | otherwise = return False+         in foldStream defState yieldk single (return True) m1++{-# INLINABLE any #-}+any :: Monad m => (a -> Bool) -> StreamK m a -> m Bool+any p = go+    where+    go m1 =+        let single a   | p a       = return True+                       | otherwise = return False+            yieldk a r | p a       = return True+                       | otherwise = go r+         in foldStream defState yieldk single (return False) m1++-- | Extract the last element of the stream, if any.+{-# INLINE last #-}+last :: Monad m => StreamK m a -> m (Maybe a)+last = foldlx' (\_ y -> Just y) Nothing id++{-# INLINE minimum #-}+minimum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+minimum = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  =+                if res <= a+                then return (Just res)+                else return (Just a)+            yieldk a r =+                if res <= a+                then go (Just res) r+                else go (Just a) r+        in foldStream defState yieldk single stop m1++{-# INLINE minimumBy #-}+minimumBy+    :: (Monad m)+    => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+minimumBy cmp = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  = case cmp res a of+                GT -> return (Just a)+                _  -> return (Just res)+            yieldk a r = case cmp res a of+                GT -> go (Just a) r+                _  -> go (Just res) r+        in foldStream defState yieldk single stop m1++{-# INLINE maximum #-}+maximum :: (Monad m, Ord a) => StreamK m a -> m (Maybe a)+maximum = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  =+                if res <= a+                then return (Just a)+                else return (Just res)+            yieldk a r =+                if res <= a+                then go (Just a) r+                else go (Just res) r+        in foldStream defState yieldk single stop m1++{-# INLINE maximumBy #-}+maximumBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> m (Maybe a)+maximumBy cmp = go Nothing+    where+    go Nothing m1 =+        let stop      = return Nothing+            single a  = return (Just a)+            yieldk a r = go (Just a) r+        in foldStream defState yieldk single stop m1++    go (Just res) m1 =+        let stop      = return (Just res)+            single a  = case cmp res a of+                GT -> return (Just res)+                _  -> return (Just a)+            yieldk a r = case cmp res a of+                GT -> go (Just res) r+                _  -> go (Just a) r+        in foldStream defState yieldk single stop m1++{-# INLINE (!!) #-}+(!!) :: Monad m => StreamK m a -> Int -> m (Maybe a)+m !! i = go i m+    where+    go n m1 =+      let single a | n == 0 = return $ Just a+                   | otherwise = return Nothing+          yieldk a x | n < 0 = return Nothing+                     | n == 0 = return $ Just a+                     | otherwise = go (n - 1) x+      in foldStream defState yieldk single (return Nothing) m1++{-# INLINE lookup #-}+lookup :: (Monad m, Eq a) => a -> StreamK m (a, b) -> m (Maybe b)+lookup e = go+    where+    go m1 =+        let single (a, b) | a == e = return $ Just b+                          | otherwise = return Nothing+            yieldk (a, b) x | a == e = return $ Just b+                            | otherwise = go x+        in foldStream defState yieldk single (return Nothing) m1++{-# INLINE findM #-}+findM :: Monad m => (a -> m Bool) -> StreamK m a -> m (Maybe a)+findM p = go+    where+    go m1 =+        let single a = do+                b <- p a+                if b then return $ Just a else return Nothing+            yieldk a x = do+                b <- p a+                if b then return $ Just a else go x+        in foldStream defState yieldk single (return Nothing) m1++{-# INLINE find #-}+find :: Monad m => (a -> Bool) -> StreamK m a -> m (Maybe a)+find p = findM (return . p)++{-# INLINE findIndices #-}+findIndices :: (a -> Bool) -> StreamK m a -> StreamK m Int+findIndices p = go 0+    where+    go offset m1 = mkStream $ \st yld sng stp ->+        let single a | p a = sng offset+                     | otherwise = stp+            yieldk a x | p a = yld offset $ go (offset + 1) x+                       | otherwise = foldStream (adaptState st) yld sng stp $+                            go (offset + 1) x+        in foldStream (adaptState st) yieldk single stp m1++------------------------------------------------------------------------------+-- Map and Fold+------------------------------------------------------------------------------++-- | Apply a monadic action to each element of the stream and discard the+-- output of the action.+{-# INLINE mapM_ #-}+mapM_ :: Monad m => (a -> m b) -> StreamK m a -> m ()+mapM_ f = go+    where+    go m1 =+        let stop = return ()+            single a = void (f a)+            yieldk a r = f a >> go r+         in foldStream defState yieldk single stop m1++{-# INLINE mapM #-}+mapM :: Monad m => (a -> m b) -> StreamK m a -> StreamK m b+mapM = mapMWith consM++------------------------------------------------------------------------------+-- Converting folds+------------------------------------------------------------------------------++{-# INLINABLE toList #-}+toList :: Monad m => StreamK m a -> m [a]+toList = foldr (:) []++-- Based on suggestions by David Feuer and Pranay Sashank+{-# INLINE morphInner #-}+morphInner, hoist :: (Monad m, Monad n)+    => (forall x. m x -> n x) -> StreamK m a -> StreamK n a+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)+-------------------------------------------------------------------------------++{-# INLINE scanlx' #-}+scanlx' :: (x -> a -> x) -> x -> (x -> b) -> StreamK m a -> StreamK m b+scanlx' step begin done m =+    cons (done begin) $ go m begin+    where+    go m1 !acc = mkStream $ \st yld sng stp ->+        let single a = sng (done $ step acc a)+            yieldk a r =+                let s = step acc a+                in yld (done s) (go r s)+        in foldStream (adaptState st) yieldk single stp m1++{-# INLINE scanl' #-}+scanl' :: (b -> a -> b) -> b -> StreamK m a -> StreamK m b+scanl' step begin = scanlx' step begin id++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++{-# INLINE filter #-}+filter :: (a -> Bool) -> StreamK m a -> StreamK m a+filter p = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a   | p a       = sng a+                       | otherwise = stp+            yieldk a r | p a       = yld a (go r)+                       | otherwise = foldStream st yieldk single stp r+         in foldStream st yieldk single stp m1++{-# INLINE take #-}+take :: Int -> StreamK m a -> StreamK m a+take = go+    where+    go n1 m1 = mkStream $ \st yld sng stp ->+        let yieldk a r = yld a (go (n1 - 1) r)+        in if n1 <= 0+           then stp+           else foldStream st yieldk sng stp m1++{-# INLINE takeWhile #-}+takeWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+takeWhile p = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a   | p a       = sng a+                       | otherwise = stp+            yieldk a r | p a       = yld a (go r)+                       | otherwise = stp+         in foldStream st yieldk single stp m1++{-# INLINE drop #-}+drop :: Int -> StreamK m a -> StreamK m a+drop n m = unShare (go n m)+    where+    go n1 m1 = mkStream $ \st yld sng stp ->+        let single _ = stp+            yieldk _ r = foldStreamShared st yld sng stp $ go (n1 - 1) r+        -- Somehow "<=" check performs better than a ">"+        in if n1 <= 0+           then foldStreamShared st yld sng stp m1+           else foldStreamShared st yieldk single stp m1++{-# INLINE dropWhile #-}+dropWhile :: (a -> Bool) -> StreamK m a -> StreamK m a+dropWhile p = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single a   | p a       = stp+                       | otherwise = sng a+            yieldk a r | p a = foldStream st yieldk single stp r+                       | otherwise = yld a r+         in foldStream st yieldk single stp m1++-------------------------------------------------------------------------------+-- Mapping+-------------------------------------------------------------------------------++-- Be careful when modifying this, this uses a consM (|:) deliberately to allow+-- other stream types to overload it.+{-# INLINE sequence #-}+sequence :: Monad m => StreamK m (m a) -> StreamK m a+sequence = go+    where+    go m1 = mkStream $ \st yld sng stp ->+        let single ma = ma >>= sng+            yieldk ma r = foldStreamShared st yld sng stp $ ma `consM` go r+         in foldStream (adaptState st) yieldk single stp m1++-------------------------------------------------------------------------------+-- Inserting+-------------------------------------------------------------------------------++{-# INLINE intersperseM #-}+intersperseM :: Monad m => m a -> StreamK m a -> StreamK m a+intersperseM a = prependingStart+    where+    prependingStart m1 = mkStream $ \st yld sng stp ->+        let yieldk i x =+                foldStreamShared st yld sng stp $ return i `consM` go x+         in foldStream st yieldk sng stp m1+    go m2 = mkStream $ \st yld sng stp ->+        let single i = foldStreamShared st yld sng stp $ a `consM` fromPure i+            yieldk i x =+                foldStreamShared+                    st yld sng stp $ a `consM` return i `consM` go x+         in foldStream st yieldk single stp m2++{-# INLINE intersperse #-}+intersperse :: Monad m => a -> StreamK m a -> StreamK m a+intersperse a = intersperseM (return a)++{-# INLINE insertBy #-}+insertBy :: (a -> a -> Ordering) -> a -> StreamK m a -> StreamK m a+insertBy cmp x = go+  where+    go m1 = mkStream $ \st yld _ _ ->+        let single a = case cmp x a of+                GT -> yld a (fromPure x)+                _  -> yld x (fromPure a)+            stop = yld x nil+            yieldk a r = case cmp x a of+                GT -> yld a (go r)+                _  -> yld x (a `cons` r)+         in foldStream st yieldk single stop m1++------------------------------------------------------------------------------+-- Deleting+------------------------------------------------------------------------------++{-# INLINE deleteBy #-}+deleteBy :: (a -> a -> Bool) -> a -> StreamK m a -> StreamK m a+deleteBy eq x = go+  where+    go m1 = mkStream $ \st yld sng stp ->+        let single a = if eq x a then stp else sng a+            yieldk a r = if eq x a+              then foldStream st yld sng stp r+              else yld a (go r)+         in foldStream st yieldk single stp m1++-------------------------------------------------------------------------------+-- Map and Filter+-------------------------------------------------------------------------------++{-# INLINE mapMaybe #-}+mapMaybe :: (a -> Maybe b) -> StreamK m a -> StreamK m b+mapMaybe f = go+  where+    go m1 = mkStream $ \st yld sng stp ->+        let single a = maybe stp sng (f a)+            yieldk a r = case f a of+                Just b  -> yld b $ go r+                Nothing -> foldStream (adaptState st) yieldk single stp r+        in foldStream (adaptState st) yieldk single stp m1++-------------------------------------------------------------------------------+-- Exception Handling+-------------------------------------------------------------------------------++-- | Like Streamly.Data.Stream.'Streamly.Data.Stream.handle' but with one+-- significant difference, this function observes exceptions from the consumer+-- of the stream as well.+--+-- You can also convert 'StreamK' to 'Stream' and use exception handling from+-- 'Stream' module:+--+-- >>> handle f s = StreamK.fromStream $ Stream.handle (\e -> StreamK.toStream (f e)) (StreamK.toStream s)+--+{-# INLINABLE handle #-}+handle :: (MonadCatch m, Exception e)+    => (e -> m (StreamK m a)) -> StreamK m a -> StreamK m a+handle f stream = go stream++    where++    go m1 = mkStream $ \st yld sng stp ->+        let yieldk a r = yld a $ go r+        in do+            res <- MC.try (foldStream (adaptState st) yieldk sng stp m1)+            case res of+                Right r -> return r+                Left e -> do+                    r <- f e+                    foldStream (adaptState st) yld sng stp r++-------------------------------------------------------------------------------+-- Resource Management+-------------------------------------------------------------------------------++-- If we are folding the stream and we do not drain the entire stream (e.g. if+-- the fold terminates before the stream) then the finalizer will run on GC.+--+-- XXX To implement a prompt cleanup, we will have to yield a cleanup function+-- via the yield continuation. A chain of cleanup functions can be built and+-- the entire chain can be invoked when the stream ends voluntarily or if+-- someone decides to abandon the stream.++-- | Like Streamly.Data.Stream.'Streamly.Data.Stream.bracketIO' but with one+-- significant difference, this function observes exceptions from the consumer+-- of the stream as well. Therefore, it cleans up the resource promptly when+-- the consumer encounters an exception.+--+-- You can also convert 'StreamK' to 'Stream' and use resource handling from+-- 'Stream' module:+--+-- >>> bracketIO bef aft bet = StreamK.fromStream $ Stream.bracketIO bef aft (StreamK.toStream . bet)+--+{-# INLINABLE bracketIO #-}+bracketIO :: (MonadIO m, MonadCatch m)+    => IO b -> (b -> IO c) -> (b -> StreamK m a) -> StreamK m a+bracketIO bef aft bet =+    concatEffect $ do+        (r, ref) <- liftIO $ mask_ $ do+            r <- bef+            ref <- newIOFinalizer (aft r)+            return (r, ref)+        return $ go ref (bet r)++    where++    go ref m1 = mkStream $ \st yld sng stp ->+        let+            -- We can discard exceptions on continuations to make it equivalent+            -- to StreamD, but it seems like a desirable behavior.+            stop = liftIO (runIOFinalizer ref) >> stp+            single a = liftIO (runIOFinalizer ref) >> sng a+            yieldk a r = yld a $ go ref r+        in do+            -- Do not call the finalizer twice if it has already been+            -- called via stop continuation and stop continuation itself+            -- generated an exception. runIOFinalizer takes care of that.+            res <- MC.try (foldStream (adaptState st) yieldk single stop m1)+            case res of+                Right r -> return r+                Left (e :: MC.SomeException) ->+                    liftIO (runIOFinalizer ref) >> MC.throwM e++------------------------------------------------------------------------------+-- Serial Zipping+------------------------------------------------------------------------------++-- | Zipping of @n@ streams can be performed by combining the streams pair+-- wise using 'mergeMapWith' with O(n * log n) time complexity. If used+-- with 'concatMapWith' it will have O(n^2) performance.+{-# INLINE zipWith #-}+zipWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+zipWith f = zipWithM (\a b -> return (f a b))++{-# INLINE zipWithM #-}+zipWithM :: Monad m =>+    (a -> b -> m c) -> StreamK m a -> StreamK m b -> StreamK m c+zipWithM f = go++    where++    go mx my = mkStream $ \st yld sng stp -> do+        let merge a ra =+                let single2 b   = f a b >>= sng+                    yield2 b rb = f a b >>= \x -> yld x (go ra rb)+                 in foldStream (adaptState st) yield2 single2 stp my+        let single1 a = merge a nil+            yield1 = merge+        foldStream (adaptState st) yield1 single1 stp mx++------------------------------------------------------------------------------+-- Merging+------------------------------------------------------------------------------++{-# INLINE mergeByM #-}+mergeByM :: Monad m =>+    (a -> a -> m Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+mergeByM cmp = go++    where++    go mx my = mkStream $ \st yld sng stp -> do+        let stop = foldStream st yld sng stp my+            single x = foldStream st yld sng stp (goX0 x my)+            yield x rx = foldStream st yld sng stp (goX x rx my)+        foldStream st yield single stop mx++    goX0 x my = mkStream $ \st yld sng _ -> do+        let stop = sng x+            single y = do+                r <- cmp x y+                case r of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield y ry = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX0 x ry)+                    _  -> yld x (y `cons` ry)+         in foldStream st yield single stop my++    goX x mx my = mkStream $ \st yld _ _ -> do+        let stop = yld x mx+            single y = do+                r <- cmp x y+                case r of+                    GT -> yld y (x `cons` mx)+                    _  -> yld x (goY0 mx y)+            yield y ry = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX x mx ry)+                    _  -> yld x (goY mx y ry)+         in foldStream st yield single stop my++    goY0 mx y = mkStream $ \st yld sng _ -> do+        let stop = sng y+            single x = do+                r <- cmp x y+                case r of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield x rx = do+                r <- cmp x y+                case r of+                    GT -> yld y (x `cons` rx)+                    _  -> yld x (goY0 rx y)+         in foldStream st yield single stop mx++    goY mx y my = mkStream $ \st yld _ _ -> do+        let stop = yld y my+            single x = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX0 x my)+                    _  -> yld x (y `cons` my)+            yield x rx = do+                r <- cmp x y+                case r of+                    GT -> yld y (goX x rx my)+                    _  -> yld x (goY rx y my)+         in foldStream st yield single stop mx++-- | Merging of @n@ streams can be performed by combining the streams pair+-- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used+-- with 'concatMapWith' it will have O(n^2) performance.+--+{-# INLINE mergeBy #-}+mergeBy :: (a -> a -> Ordering) -> StreamK m a -> StreamK m a -> StreamK m a+-- XXX GHC: This has slightly worse performance than replacing "r <- cmp x y"+-- with "let r = cmp x y" in the monadic version. The definition below is+-- exactly the same as mergeByM except this change.+-- mergeBy cmp = mergeByM (\a b -> return $ cmp a b)+mergeBy cmp = go++    where++    go mx my = mkStream $ \st yld sng stp -> do+        let stop = foldStream st yld sng stp my+            single x = foldStream st yld sng stp (goX0 x my)+            yield x rx = foldStream st yld sng stp (goX x rx my)+        foldStream st yield single stop mx++    goX0 x my = mkStream $ \st yld sng _ -> do+        let stop = sng x+            single y = do+                case cmp x y of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield y ry = do+                case cmp x y of+                    GT -> yld y (goX0 x ry)+                    _  -> yld x (y `cons` ry)+         in foldStream st yield single stop my++    goX x mx my = mkStream $ \st yld _ _ -> do+        let stop = yld x mx+            single y = do+                case cmp x y of+                    GT -> yld y (x `cons` mx)+                    _  -> yld x (goY0 mx y)+            yield y ry = do+                case cmp x y of+                    GT -> yld y (goX x mx ry)+                    _  -> yld x (goY mx y ry)+         in foldStream st yield single stop my++    goY0 mx y = mkStream $ \st yld sng _ -> do+        let stop = sng y+            single x = do+                case cmp x y of+                    GT -> yld y (fromPure x)+                    _  -> yld x (fromPure y)+            yield x rx = do+                case cmp x y of+                    GT -> yld y (x `cons` rx)+                    _  -> yld x (goY0 rx y)+         in foldStream st yield single stop mx++    goY mx y my = mkStream $ \st yld _ _ -> do+        let stop = yld y my+            single x = do+                case cmp x y of+                    GT -> yld y (goX0 x my)+                    _  -> yld x (y `cons` my)+            yield x rx = do+                case cmp x y of+                    GT -> yld y (goX x rx my)+                    _  -> yld x (goY rx y my)+         in foldStream st yield single stop mx++------------------------------------------------------------------------------+-- Transformation comprehensions+------------------------------------------------------------------------------++{-# INLINE the #-}+the :: (Eq a, Monad m) => StreamK m a -> m (Maybe a)+the m = do+    r <- uncons m+    case r of+        Nothing -> return Nothing+        Just (h, t) -> go h t+    where+    go h m1 =+        let single a   | h == a    = return $ Just h+                       | otherwise = return Nothing+            yieldk a r | h == a    = go h r+                       | otherwise = return Nothing+         in foldStream defState yieldk single (return $ Just h) m1++------------------------------------------------------------------------------+-- Alternative & MonadPlus+------------------------------------------------------------------------------++_alt :: StreamK m a -> StreamK m a -> StreamK m a+_alt m1 m2 = mkStream $ \st yld sng stp ->+    let stop  = foldStream st yld sng stp m2+    in foldStream st yld sng stop m1++------------------------------------------------------------------------------+-- MonadError+------------------------------------------------------------------------------++{-+-- XXX handle and test cross thread state transfer+withCatchError+    :: MonadError e m+    => StreamK m a -> (e -> StreamK m a) -> StreamK m a+withCatchError m h =+    mkStream $ \_ stp sng yld ->+        let run x = unStream x Nothing stp sng yieldk+            handle r = r `catchError` \e -> run $ h e+            yieldk a r = yld a (withCatchError r h)+        in handle $ run m+-}++-------------------------------------------------------------------------------+-- Parsing+-------------------------------------------------------------------------------++-- | 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 ParseErrorPos b, StreamK m a)+parseDBreak (PR.Parser pstep initial extract) stream = do+    res <- initial+    case res of+        PR.IPartial s -> goStream stream [] s 0+        PR.IDone b -> return (Right b, 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 i =+        let stop = do+                r <- extract pst+                case r of+                    PR.FError err -> do+                        let src = Prelude.reverse buf+                        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.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 (i + m)+            single x = yieldk x nil+            yieldk x r = do+                res <- pstep pst x+                case res of+                    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 (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 (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.SError err -> do+                        let src = Prelude.reverse (x:buf)+                        return (Left (ParseErrorPos (i + 1) err), append (fromList src) r)+         in foldStream defState yieldk single stop st++    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.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 (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 (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 ++ xs+                return (Right b, append (fromList src) st)+            PR.SError err -> do+                let src = Prelude.reverse buf ++ x:xs+                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+-- to chunks before parsing. Or just have a ParserK element parser for StreamK+-- and convert ParserD to ParserK for element parsing using StreamK.+{-# INLINE parseD #-}+parseD :: Monad m =>+    Parser.Parser a m b -> StreamK m a -> m (Either ParseErrorPos b)+parseD f = fmap fst . parseDBreak f++-------------------------------------------------------------------------------+-- ParserK Chunked+-------------------------------------------------------------------------------++-- 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 = 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 = Array.parse++-------------------------------------------------------------------------------+-- ParserK Singular+-------------------------------------------------------------------------------++-- | Similar to 'parseBreak' but works on singular elements.+--+{-# 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 = Drivers.parseBreakStreamK++-- | 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.+{-# INLINE parse #-}+parse :: Monad m =>+    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+-------------------------------------------------------------------------------++-- | 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 = 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 = GenArr.parse++-------------------------------------------------------------------------------+-- Sorting+-------------------------------------------------------------------------------++-- | Sort the input stream using a supplied comparison function.+--+-- Sorting can be achieved by simply:+--+-- >>> sortBy cmp = StreamK.mergeMapWith (StreamK.mergeBy cmp) StreamK.fromPure+--+-- However, this combinator uses a parser to first split the input stream into+-- down and up sorted segments and then merges them to optimize sorting when+-- pre-sorted sequences exist in the input stream.+--+-- /O(n) space/+--+{-# INLINE sortBy #-}+sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a+-- sortBy f = Stream.concatPairsWith (Stream.mergeBy f) Stream.fromPure+sortBy cmp =+    let p =+            Parser.groupByRollingEither+                (\x -> (< GT) . cmp x)+                FL.toStreamKRev+                FL.toStreamK+     in   mergeMapWith (mergeBy cmp) id+        . Stream.toStreamK+        . Stream.catRights -- its a non-failing backtracking parser+        . Stream.parseMany (fmap (either id id) p)+        . Stream.fromStreamK++{-# 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/Alt.hs view
@@ -0,0 +1,244 @@+-- |+-- Module      : Streamly.StreamDK.Type+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A CPS style stream using a constructor based representation instead of a+-- function based representation.+--+-- Streamly internally uses two fundamental stream representations, (1) streams+-- with an open or arbitrary control flow (we call it StreamK), (2) streams+-- with a structured or closed loop control flow (we call it StreamD). The+-- higher level stream types can use any of these representations under the+-- hood and can interconvert between the two.+--+-- StreamD:+--+-- StreamD is a non-recursive data type in which the state of the stream and+-- the step function are separate. When the step function is called, a stream+-- element and the new stream state is yielded. The generated element and the+-- state are passed to the next consumer in the loop. The state is threaded+-- around in the loop until control returns back to the original step function+-- to run the next step. This creates a structured closed loop representation+-- (like "for" loops in C) with state of each step being hidden/abstracted or+-- existential within that step. This creates a loop representation identical+-- to the "for" or "while" loop constructs in imperative languages, the states+-- of the steps combined together constitute the state of the loop iteration.+--+-- Internally most combinators use a closed loop representation because it+-- provides very high efficiency due to stream fusion. The performance of this+-- representation is competitive to the C language implementations.+--+-- Pros and Cons of StreamD:+--+-- 1) stream-fusion: This representation can be optimized very efficiently by+-- the compiler because the state is explicitly separated from step functions,+-- represented using pure data constructors and visible to the compiler, the+-- stream steps can be fused using case-of-case transformations and the state+-- can be specialized using spec-constructor optimization, yielding a C like+-- tight loop/state machine with no constructors, the state is used unboxed and+-- therefore no unnecessary allocation.+--+-- 2) Because of a closed representation consing too many elements in this type+-- of stream does not scale, it will have quadratic performance slowdown. Each+-- cons creates a layer that needs to return the control back to the caller.+-- Another implementation of cons is possible but that will have to box/unbox+-- the state and will not fuse. So effectively cons breaks fusion.+--+-- 3) unconsing an item from the stream breaks fusion, we have to "pause" the+-- loop, rebox and save the state.+--+-- 3) Exception handling is easy to implement in this model because control+-- flow is structured in the loop and cannot be arbitrary. Therefore,+-- implementing "bracket" is natural.+--+-- 4) Round-robin scheduling for co-operative multitasking is easy to implement.+--+-- 5) It fuses well with the direct style Fold implementation.+--+-- StreamK/StreamDK:+--+-- StreamDK i.e. the stream defined in this module, like StreamK, is a+-- recursive data type which has no explicit state defined using constructors,+-- each step yields an element and a computation representing the rest of the+-- stream.  Stream state is part of the function representing the rest of the+-- stream.  This creates an open computation representation, or essentially a+-- continuation passing style computation.  After the stream step is executed,+-- the caller is free to consume the produced element and then send the control+-- wherever it wants, there is no restriction on the control to return back+-- somewhere, the control is free to go anywhere. The caller may decide not to+-- consume the rest of the stream. This representation is more like a "goto"+-- based implementation in imperative languages.+--+-- Pros and Cons of StreamK:+--+-- 1) The way StreamD can be optimized using stream-fusion, this type can be+-- optimized using foldr/build fusion. However, foldr/build has not yet been+-- fully implemented for StreamK/StreamDK.+--+-- 2) Using cons is natural in this representation, unlike in StreamD it does+-- not have a quadratic slowdown. Currently, we in fact wrap StreamD in StreamK+-- to support a better cons operation.+--+-- 3) Similarly, uncons is natural in this representation.+--+-- 4) Exception handling is not easy to implement because of the "goto" nature+-- of CPS.+--+-- 5) Composable folds are not implemented/proven, however, intuition says that+-- a push style CPS representation should be able to be used along with StreamK+-- to efficiently implement composable folds.++module Streamly.Internal.Data.StreamK.Alt+    (+    -- * Stream Type++      Stream+    , Step (..)++    -- * Construction+    , nil+    , cons+    , consM+    , unfoldr+    , unfoldrM+    , replicateM++    -- * Folding+    , uncons+    , foldrS++    -- * Specific Folds+    , drain+    )+where++#include "inline.hs"++-- XXX Use Cons and Nil instead of Yield and Stop?+data Step m a = Yield a (Stream m a) | Stop++newtype Stream m a = Stream (m (Step m a))++-------------------------------------------------------------------------------+-- Construction+-------------------------------------------------------------------------------++nil :: Monad m => Stream m a+nil = Stream $ return Stop++{-# INLINE_NORMAL cons #-}+cons :: Monad m => a -> Stream m a -> Stream m a+cons x xs = Stream $ return $ Yield x xs++consM :: Monad m => m a -> Stream m a -> Stream m a+consM eff xs = Stream $ eff >>= \x -> return $ Yield x xs++unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a+unfoldrM next state = Stream (step' state)+  where+    step' st = do+        r <- next st+        return $ case r of+            Just (x, s) -> Yield x (Stream (step' s))+            Nothing     -> Stop+{-+unfoldrM next s0 = buildM $ \yld stp ->+    let go s = do+            r <- next s+            case r of+                Just (a, b) -> yld a (go b)+                Nothing -> stp+    in go s0+-}++{-# INLINE unfoldr #-}+unfoldr :: Monad m => (b -> Maybe (a, b)) -> b -> Stream m a+unfoldr next s0 = build $ \yld stp ->+    let go s =+            case next s of+                Just (a, b) -> yld a (go b)+                Nothing -> stp+    in go s0++replicateM :: Monad m => Int -> a -> Stream m a+replicateM n x = Stream (step n)+    where+    step i = return $+        if i <= 0+        then Stop+        else Yield x (Stream (step (i - 1)))++-------------------------------------------------------------------------------+-- Folding+-------------------------------------------------------------------------------++uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))+uncons (Stream step) = do+    r <- step+    return $ case r of+        Yield x xs -> Just (x, xs)+        Stop -> Nothing++-- | Lazy right associative fold to a stream.+{-# INLINE_NORMAL foldrS #-}+foldrS :: Monad m+       => (a -> Stream m b -> Stream m b)+       -> Stream m b+       -> Stream m a+       -> Stream m b+foldrS f streamb = go+    where+    go (Stream stepa) = Stream $ do+        r <- stepa+        case r of+            Yield x xs -> let Stream step = f x (go xs) in step+            Stop -> let Stream step = streamb in step++{-# INLINE_LATE foldrM #-}+foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+foldrM fstep acc = go+    where+    go (Stream step) = do+        r <- step+        case r of+            Yield x xs -> fstep x (go xs)+            Stop -> acc++{-# INLINE_NORMAL build #-}+build :: Monad m+    => forall a. (forall b. (a -> b -> b) -> b -> b) -> Stream m a+build g = g cons nil++{-# RULES+"foldrM/build"  forall k z (g :: forall b. (a -> b -> b) -> b -> b).+                foldrM k z (build g) = g k z #-}++{-+-- To fuse foldrM with unfoldrM we need the type m1 to be polymorphic such that+-- it is either Monad m or Stream m.  So that we can use cons/nil as well as+-- monadic construction function as its arguments.+--+{-# INLINE_NORMAL buildM #-}+buildM :: Monad m+    => forall a. (forall b. (a -> m1 b -> m1 b) -> m1 b -> m1 b) -> Stream m a+buildM g = g cons nil+-}++-------------------------------------------------------------------------------+-- Specific folds+-------------------------------------------------------------------------------++{-# INLINE drain #-}+drain :: Monad m => Stream m a -> m ()+drain = foldrM (\_ xs -> xs) (return ())+{-+drain (Stream step) = do+    r <- step+    case r of+        Yield _ next -> drain next+        Stop      -> return ()+        -}
+ src/Streamly/Internal/Data/StreamK/Transformer.hs view
@@ -0,0 +1,91 @@+-- |+-- Module      : Streamly.Internal.Data.StreamK.Transformer+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.StreamK.Transformer+    (+      foldlT+    , foldrT++    , liftInner+    , evalStateT++    , 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, foldStream, mkStream)+import Control.Monad.Trans.Reader (ReaderT, local)++import qualified Control.Monad.Trans.State.Strict as State++-- | Lazy left fold to an arbitrary transformer monad.+{-# INLINE foldlT #-}+foldlT :: (Monad m, Monad (s m), MonadTrans s)+    => (s m b -> a -> s m b) -> s m b -> StreamK m a -> s m b+foldlT step = go+  where+    go acc m1 = do+        res <- lift $ uncons m1+        case res of+            Just (h, t) -> go (step acc h) t+            Nothing -> acc++-- | Right associative fold to an arbitrary transformer monad.+{-# INLINE foldrT #-}+foldrT :: (Monad m, Monad (s m), MonadTrans s)+    => (a -> s m b -> s m b) -> s m b -> StreamK m a -> s m b+foldrT step final = go+  where+    go m1 = do+        res <- lift $ uncons m1+        case res of+            Just (h, t) -> step h (go t)+            Nothing -> final++------------------------------------------------------------------------------+-- Lifting inner monad+------------------------------------------------------------------------------++{-# INLINE evalStateT #-}+evalStateT :: Monad m => m s -> StreamK (StateT s m) a -> StreamK m a+evalStateT = go++    where++    go st m1 = concatEffect $ fmap f (st >>= State.runStateT (uncons m1))++    f (res, s1) =+        case res of+            Just (h, t) -> cons h (go (return s1) t)+            Nothing -> nil++{-# INLINE liftInner #-}+liftInner :: (Monad m, MonadTrans t, Monad (t m)) =>+    StreamK m a -> StreamK (t m) a+liftInner = go++    where++    go m1 = concatEffect $ fmap f $ lift $ uncons m1++    f res =+        case res of+            Just (h, t) -> cons h (go t)+            Nothing -> nil++-- | 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
@@ -0,0 +1,3126 @@+{-# LANGUAGE CPP #-}+{-# 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
@@ -9,8 +9,7 @@ module Streamly.Internal.Data.Time.Clock     (     -- * System clock-      Clock(..)-    , getTime+      module Streamly.Internal.Data.Time.Clock.Type      -- * Async clock     , asyncClock@@ -30,12 +29,13 @@ import Control.Concurrent (threadDelay, ThreadId) import Control.Concurrent.MVar (MVar, newEmptyMVar, takeMVar, tryPutMVar) import Control.Monad (forever, when, void)-import Streamly.Internal.Data.Time.Clock.Type (Clock(..), getTime) import Streamly.Internal.Data.Time.Units     (MicroSecond64(..), fromAbsTime, addToAbsTime, toRelTime) import Streamly.Internal.Control.ForkIO (forkIOManaged) -import qualified Streamly.Internal.Data.IORef.Unboxed as Unboxed+import qualified Streamly.Internal.Data.IORef as Unboxed++import Streamly.Internal.Data.Time.Clock.Type  ------------------------------------------------------------------------------ -- Async clock
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,6 +1,3 @@-{-# LANGUAGE TypeInType #-}-{-# LANGUAGE UnboxedTuples #-}- -- | -- Module      : Streamly.Internal.Data.Time.Units -- Copyright   : (c) 2019 Composewell Technologies@@ -52,7 +49,7 @@  import Data.Int import Foreign.Storable (Storable)-import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Internal.Data.Unbox (Unbox) import Streamly.Internal.Data.Time.TimeSpec  -------------------------------------------------------------------------------
+ src/Streamly/Internal/Data/Unbox.hs view
@@ -0,0 +1,923 @@+{-# LANGUAGE DataKinds #-}+{-# 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+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unbox+    (+    -- ** Unbox type class+      Unbox(..)++    -- ** Peek and poke utilities+    , BoundedPtr (..)+    -- Peek+    , Peeker (..)+    , read+    , readUnsafe+    , skipByte+    , runPeeker+    -- Poke+    , pokeBoundedPtrUnsafe+    , pokeBoundedPtr++    -- ** Generic Deriving+    , PeekRep(..)+    , PokeRep(..)+    , SizeOfRep(..)+    , genericSizeOf+    , genericPeekByteIndex+    , genericPokeByteIndex+    ) where++#include "MachDeps.h"+#include "HsBaseConfig.h"+#include "ArrayMacros.h"++import Control.Monad (void, when)+import Data.Complex (Complex((:+)))+import Data.Functor ((<&>))+import Data.Functor.Const (Const(..))+import Data.Functor.Identity (Identity(..))+import Data.Kind (Type)+import Data.Proxy (Proxy (..))+import Foreign.C.Types (CChar(..), CWchar(..))+import Foreign.Ptr (IntPtr(..), WordPtr(..))+import GHC.Base (IO(..))+import GHC.Fingerprint.Type (Fingerprint(..))+import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))+import GHC.Real (Ratio(..))+import GHC.Stable (StablePtr(..))+import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))+#if MIN_VERSION_base(4,21,0)+import GHC.IO.SubSystem (IoSubSystem (..))+#elif MIN_VERSION_base(4,15,0)+import GHC.RTS.Flags (IoSubSystem(..))+#endif+import Streamly.Internal.Data.Builder (Builder (..))++import GHC.Generics+import GHC.Exts+import GHC.TypeLits+import Prelude hiding (read)++import Streamly.Internal.Data.MutByteArray.Type (MutByteArray(..))+#ifdef DEBUG+import qualified Streamly.Internal.Data.MutByteArray.Type as MutByteArray+#endif++--------------------------------------------------------------------------------+-- The Unbox type class+--------------------------------------------------------------------------------++-- XXX generate error if the size is < 1++-- = Design notes =+--+-- == Fixed length data types ==+--+-- The main goal of the Unbox type class is to be used in arrays. Invariants+-- for the sizeOf value required for use in arrays:+--+-- * size is independent of the value, it is determined by the type only. So+-- that we can store values of the same type in fixed length array cells.+-- * recursive data types cannot be fixed length, therefore, cannot be+-- serialized using this type class.+-- * size cannot be zero. So that the length of an array storing the element+-- and the number of elements can be related.+--+-- Note, for general serializable types the size cannot be fixed e.g. we may+-- want to serialize a list. This type class can be considered a special case+-- of a more general serialization type class.+--+-- == Stream vs Array ==+--+-- In theory we could convert a type to and from a byte stream and use that+-- to implement boxing, unboxing. But composing a stream from parts of the+-- structure is much more inefficient than writing them to a memory location.+-- However, it should be possible to efficiently parse a Haskell type from an+-- array using chunk folds.+--+-- Also, this type class allows each primitive type to have its own specific+-- efficient implementation to read and write the type to the mutable byte+-- array using special GHC byte array operations. For example, see the Unbox+-- instances of Char, Int, Word types.+--+-- == MutableByteArray vs ForeignPtr ==+--+-- The Unbox typeclass uses MutableByteArray but could use ForeignPtr or+-- any other representation of memory. We could make this a multiparameter type+-- class if necessary.+--+-- If the type class would have to support reading and writing to a Ptr as well,+-- basically what Storable does. We will also need to touch the anchoring ptr at+-- the right points which is prone to errors. However, it should be simple to+-- implement unmanaged/read-only memory arrays by allowing a Ptr type in+-- ArrayContents, though it would require all instances to support reading from+-- a Ptr.+--+-- == Byte Offset vs Element Index ==+--+-- There is a reason for using byte offset instead of element index in read and+-- write operations in the type class. If we use element index, slicing of the+-- array becomes rigid. We can only slice the array at addresses that are+-- aligned with the type, therefore, we cannot slice at misaligned location and+-- then cast the slice into another type which does not necessarily align with+-- the original type.+--+-- == Alignment ==+--+-- As a side note, there seem to be no performance advantage of alignment+-- anymore, see+-- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/+--+-- = Unboxed Records =+--+-- Unboxed types can be treated as unboxed records. We can provide a more+-- convenient API to access different parts from the Unboxed representation+-- without having to unbox the entire type. The type can have nested parts+-- therefore, we will need a general way (some sort of lenses) to address the+-- parts.+--+-- = Lazy Boxing =+--+-- When converting an unboxed representation to a boxed representation we can+-- use lazy construction. Each constructor of the constructed computation may+-- just hold a lazy computation to actually construct it on demand. This could+-- be useful for larger structures where we may need only small parts of it.+--+-- Same thing can be done for serialize type class as well but it will require+-- size fields at each nesting level, aggregating the size upwards.++-- | The 'Unbox' type class provides operations for serialization (unboxing)+-- and deserialization (boxing) of fixed-length, non-recursive Haskell data+-- types to and from their byte stream representation.+--+-- Unbox uses fixed size encoding, therefore, size is independent of the value,+-- it must be determined solely by the type. This restriction makes types with+-- 'Unbox' instances suitable for storing in arrays. Note that sum types may+-- have multiple constructors of different sizes, the size of a sum type is+-- computed as the maximum required by any constructor.+--+-- The 'peekAt' operation reads as many bytes from the mutable byte+-- array as the @size@ of the data type and builds a Haskell data type from+-- these bytes. 'pokeAt' operation converts a Haskell data type to its+-- binary representation which consists of @size@ bytes and then stores+-- these bytes into the mutable byte array. These operations do not check the+-- bounds of the array, the user of the type class is expected to check the+-- bounds before peeking or poking.+--+-- IMPORTANT: The serialized data's byte ordering remains the same as the host+-- machine's byte order. Therefore, it can not be deserialized from host+-- machines with a different byte ordering.+--+-- Instances can be derived via Generics, Template Haskell, or written+-- manually. Note that the data type must be non-recursive. WARNING! Generic+-- and Template Haskell deriving, both hang for recursive data types. Deriving+-- via Generics is more convenient but Template Haskell should be preferred+-- over Generics for the following reasons:+--+-- 1. Instances derived via Template Haskell provide better and more reliable+-- performance.+-- 2. Generic deriving allows only 256 fields or constructor tags whereas+-- template Haskell has no limit.+--+-- Here is an example, for deriving an instance of this type class using+-- generics:+--+-- >>> import GHC.Generics (Generic)+-- >>> :{+-- data Object = Object+--     { _int0 :: Int+--     , _int1 :: Int+--     } deriving Generic+-- :}+--+-- >>> import Streamly.Data.MutByteArray (Unbox(..))+-- >>> instance Unbox Object+--+-- To derive the instance via Template Haskell:+--+-- @+-- import Streamly.Data.MutByteArray (deriveUnbox)+-- \$(deriveUnbox [d|instance Unbox Object|])+-- @+--+-- See 'Streamly.Data.MutByteArray.deriveUnbox' for more information on deriving+-- using Template Haskell.+--+-- If you want to write the instance manually:+--+-- >>> :{+-- instance Unbox Object where+--     sizeOf _ = 16+--     peekAt i arr = do+--        -- Check the array bounds+--         x0 <- peekAt i arr+--         x1 <- peekAt (i + 8) arr+--         return $ Object x0 x1+--     pokeAt i arr (Object x0 x1) = do+--        -- Check the array bounds+--         pokeAt i arr x0+--         pokeAt (i + 8) arr x1+-- :}+--+class Unbox a where+    -- | Get the size. Size cannot be zero, should be at least 1 byte.+    sizeOf :: Proxy a -> Int++    {-# INLINE sizeOf #-}+    default sizeOf :: (SizeOfRep (Rep a)) => Proxy a -> Int+    sizeOf = genericSizeOf++    -- | @peekAt byte-offset array@ reads an element of type @a@ from the+    -- 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.+    peekAt :: Int -> MutByteArray -> IO a++    {-# INLINE peekAt #-}+    default peekAt :: (Generic a, PeekRep (Rep a)) =>+         Int -> MutByteArray -> IO a+    peekAt i arr = genericPeekByteIndex arr i++    peekByteIndex :: Int -> MutByteArray -> IO a+    peekByteIndex = peekAt++    -- | @pokeAt byte-offset array@ writes an element of type @a@ to the+    -- 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.+    pokeAt :: Int -> MutByteArray -> a -> IO ()++    pokeByteIndex :: Int -> MutByteArray -> a -> IO ()+    pokeByteIndex = pokeAt++    {-# INLINE pokeAt #-}+    default pokeAt :: (Generic a, PokeRep (Rep a)) =>+        Int -> MutByteArray -> a -> IO ()+    pokeAt i arr = genericPokeByteIndex arr i++{-# DEPRECATED peekByteIndex "Use peekAt." #-}+{-# DEPRECATED pokeByteIndex "Use pokeAt." #-}++-- _size is the length from array start to the last accessed byte.+{-# INLINE checkBounds #-}+checkBounds :: String -> Int -> MutByteArray -> IO ()+checkBounds _label _size _arr = do+#ifdef DEBUG+    sz <- MutByteArray.length _arr+    if (_size > sz)+    then error+        $ _label+            ++ ": accessing array at offset = "+            ++ show (_size - 1)+            ++ " max valid offset = " ++ show (sz - 1)+    else return ()+#else+    return ()+#endif++#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \+instance Unbox _type where {                                                  \+; {-# INLINE peekAt #-}                                                       \+; peekAt off@(I# n) arr@(MutByteArray mbarr) =                                \+    checkBounds "peek" (off + sizeOf (Proxy :: Proxy _type)) arr              \+    >> (IO $ \s ->                                                            \+      case _readArray mbarr n s of                                            \+          { (# s1, i #) -> (# s1, _constructor i #) })                        \+; {-# INLINE pokeAt #-}                                                       \+; pokeAt off@(I# n) arr@(MutByteArray mbarr) (_constructor val) =             \+    checkBounds "poke" (off + sizeOf (Proxy :: Proxy _type)) arr              \+    >> (IO $ \s -> (# _writeArray mbarr n val s, () #))                       \+; {-# INLINE sizeOf #-}                                                       \+; sizeOf _ = _sizeOf                                                          \+}++#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType)    \+instance _constraint Unbox _type where                                        \+; {-# INLINE peekAt #-}                                                       \+; peekAt i arr =                                                              \+    checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr                \+    >> _constructor <$> peekAt i arr                                          \+; {-# INLINE pokeAt #-}                                                       \+; pokeAt i arr (_constructor a) =                                             \+    checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr                \+    >> pokeAt i arr a                                                         \+; {-# INLINE sizeOf #-}                                                       \+; sizeOf _ = SIZE_OF(_innerType)++#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType)     \+instance _constraint Unbox _type where {                                      \+; {-# INLINE peekAt #-}                                                       \+; peekAt i arr =                                                              \+      checkBounds "peek" (i + sizeOf (Proxy :: Proxy _type)) arr >>           \+      peekAt i arr >>=                                                        \+        (\p1 -> peekAt (i + SIZE_OF(_innerType)) arr <&> _constructor p1)     \+; {-# INLINE pokeAt #-}                                                       \+; pokeAt i arr (_constructor p1 p2) =                                         \+      checkBounds "poke" (i + sizeOf (Proxy :: Proxy _type)) arr >>           \+      pokeAt i arr p1 >>                                                      \+        pokeAt (i + SIZE_OF(_innerType)) arr p2                               \+; {-# INLINE sizeOf #-}                                                       \+; sizeOf _ = 2 * SIZE_OF(_innerType)                                          \+}++-------------------------------------------------------------------------------+-- Unbox instances for primitive types+-------------------------------------------------------------------------------++DERIVE_UNBOXED( Char+              , C#+              , readWord8ArrayAsWideChar#+              , writeWord8ArrayAsWideChar#+              , SIZEOF_HSCHAR)++DERIVE_UNBOXED( Int8+              , I8#+              , readInt8Array#+              , writeInt8Array#+              , 1)++DERIVE_UNBOXED( Int16+              , I16#+              , readWord8ArrayAsInt16#+              , writeWord8ArrayAsInt16#+              , 2)++DERIVE_UNBOXED( Int32+              , I32#+              , readWord8ArrayAsInt32#+              , writeWord8ArrayAsInt32#+              , 4)++DERIVE_UNBOXED( Int+              , I#+              , readWord8ArrayAsInt#+              , writeWord8ArrayAsInt#+              , SIZEOF_HSINT)++DERIVE_UNBOXED( Int64+              , I64#+              , readWord8ArrayAsInt64#+              , writeWord8ArrayAsInt64#+              , 8)++DERIVE_UNBOXED( Word+              , W#+              , readWord8ArrayAsWord#+              , writeWord8ArrayAsWord#+              , SIZEOF_HSWORD)++DERIVE_UNBOXED( Word8+              , W8#+              , readWord8Array#+              , writeWord8Array#+              , 1)++DERIVE_UNBOXED( Word16+              , W16#+              , readWord8ArrayAsWord16#+              , writeWord8ArrayAsWord16#+              , 2)++DERIVE_UNBOXED( Word32+              , W32#+              , readWord8ArrayAsWord32#+              , writeWord8ArrayAsWord32#+              , 4)++DERIVE_UNBOXED( Word64+              , W64#+              , readWord8ArrayAsWord64#+              , writeWord8ArrayAsWord64#+              , 8)++DERIVE_UNBOXED( Double+              , D#+              , readWord8ArrayAsDouble#+              , writeWord8ArrayAsDouble#+              , SIZEOF_HSDOUBLE)++DERIVE_UNBOXED( Float+              , F#+              , readWord8ArrayAsFloat#+              , writeWord8ArrayAsFloat#+              , SIZEOF_HSFLOAT)++-------------------------------------------------------------------------------+-- Unbox instances for derived types+-------------------------------------------------------------------------------++DERIVE_UNBOXED( (StablePtr a)+              , StablePtr+              , readWord8ArrayAsStablePtr#+              , writeWord8ArrayAsStablePtr#+              , SIZEOF_HSSTABLEPTR)++DERIVE_UNBOXED( (Ptr a)+              , Ptr+              , readWord8ArrayAsAddr#+              , writeWord8ArrayAsAddr#+              , SIZEOF_HSPTR)++DERIVE_UNBOXED( (FunPtr a)+              , FunPtr+              , readWord8ArrayAsAddr#+              , writeWord8ArrayAsAddr#+              , SIZEOF_HSFUNPTR)++DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)+DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)+#if MIN_VERSION_base(4,14,0)+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)+#endif+DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)++-- 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)++instance Unbox () where++    {-# INLINE peekAt #-}+    peekAt i arr =+      checkBounds "peek ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()++    {-# INLINE pokeAt #-}+    pokeAt i arr _ =+      checkBounds "poke ()" (i + sizeOf (Proxy :: Proxy ())) arr >> return ()++    {-# INLINE sizeOf #-}+    sizeOf _ = 1++#if MIN_VERSION_base(4,15,0)++instance Unbox IoSubSystem where++    {-# INLINE peekAt #-}+    peekAt i arr =+        checkBounds+            "peek IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr+        >> toEnum <$> peekAt i arr++    {-# INLINE pokeAt #-}+    pokeAt i arr a =+        checkBounds+            "poke IoSubSystem" (i + sizeOf (Proxy :: Proxy IoSubSystem)) arr+        >> pokeAt i arr (fromEnum a)++    {-# INLINE sizeOf #-}+    sizeOf _ = sizeOf (Proxy :: Proxy Int)+#endif++instance Unbox Bool where++    {-# INLINE peekAt #-}+    peekAt i arr = do+        checkBounds "peek Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr+        res <- peekAt i arr+        return $ res /= (0 :: Int8)++    {-# INLINE pokeAt #-}+    pokeAt i arr a =+        checkBounds "poke Bool" (i + sizeOf (Proxy :: Proxy Bool)) arr+        >> if a+           then pokeAt i arr (1 :: Int8)+           else pokeAt i arr (0 :: Int8)++    {-# INLINE sizeOf #-}+    sizeOf _ = 1++--------------------------------------------------------------------------------+-- Generic deriving+--------------------------------------------------------------------------------++-- Utilities to build or parse a type safely and easily.++-- 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 =+    BoundedPtr+        MutByteArray          -- byte array+        Int                       -- current pos+        Int                       -- position after end++--------------------------------------------------------------------------------+-- Peeker monad+--------------------------------------------------------------------------------++-- | Chains peek functions that pass the current position to the next function+newtype Peeker a = Peeker (Builder BoundedPtr IO a)+    deriving (Functor, Applicative, Monad)++{-# INLINE readUnsafe #-}+readUnsafe :: Unbox a => Peeker a+readUnsafe = Peeker (Builder step)++    where++    {-# INLINE step #-}+    step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)+    step (BoundedPtr arr pos end) = do+        let next = pos + sizeOf (Proxy :: Proxy a)+#ifdef DEBUG+        when (next > end)+            $ error $ "readUnsafe: reading beyond limit. next = "+                ++ show next+                ++ " end = " ++ show end+#endif+        r <- peekAt pos arr+        return (r, BoundedPtr arr next end)++{-# INLINE read #-}+read :: Unbox a => Peeker a+read = Peeker (Builder step)++    where++    {-# INLINE step #-}+    step :: forall a. Unbox a => BoundedPtr -> IO (a, BoundedPtr)+    step (BoundedPtr arr pos end) = do+        let next = pos + sizeOf (Proxy :: Proxy a)+        when (next > end)+            $ error $ "read: reading beyond limit. next = "+                ++ show next+                ++ " end = " ++ show end+        r <- peekAt pos arr+        return (r, BoundedPtr arr next end)++{-# INLINE skipByte #-}+skipByte :: Peeker ()+skipByte = Peeker (Builder step)++    where++    {-# INLINE step #-}+    step :: BoundedPtr -> IO ((), BoundedPtr)+    step (BoundedPtr arr pos end) = do+        let next = pos + 1+#ifdef DEBUG+        when (next > end)+            $ error $ "skipByte: reading beyond limit. next = "+                ++ show next+                ++ " end = " ++ show end+#endif+        return ((), BoundedPtr arr next end)++{-# INLINE runPeeker #-}+runPeeker :: Peeker a -> BoundedPtr -> IO a+runPeeker (Peeker (Builder f)) ptr = fmap fst (f ptr)++--------------------------------------------------------------------------------+-- Poke utilities+--------------------------------------------------------------------------------++-- XXX 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+-- return the newly allocated array in the output.++-- Does not check writing beyond bound.+{-# INLINE pokeBoundedPtrUnsafe #-}+pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+pokeBoundedPtrUnsafe a (BoundedPtr arr pos end) = do+    let next = pos + sizeOf (Proxy :: Proxy a)+#ifdef DEBUG+    when (next > end)+        $ error $ "pokeBoundedPtrUnsafe: reading beyond limit. next = "+            ++ show next+            ++ " end = " ++ show end+#endif+    pokeAt pos arr a+    return (BoundedPtr arr next end)++{-# INLINE pokeBoundedPtr #-}+pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr+pokeBoundedPtr a (BoundedPtr arr pos end) = do+    let next = pos + sizeOf (Proxy :: Proxy a)+    when (next > end) $ error "pokeBoundedPtr writing beyond limit"+    pokeAt pos arr a+    return (BoundedPtr arr next end)++--------------------------------------------------------------------------------+-- Check the number of constructors in a sum type+--------------------------------------------------------------------------------++-- Count the constructors of a sum type.+type family SumArity (a :: Type -> Type) :: Nat where+    SumArity (C1 _ _) = 1+    -- Requires UndecidableInstances+    SumArity (f :+: g) = SumArity f + SumArity g++type family TypeErrorMessage (a :: Symbol) :: Constraint where+    TypeErrorMessage a = TypeError ('Text a)++type family ArityCheck (b :: Bool) :: Constraint where+    ArityCheck 'True = ()+    ArityCheck 'False = TypeErrorMessage+        "Generic Unbox deriving does not support > 256 constructors."++-- Type constraint to restrict the sum type arity so that the constructor tag+-- can fit in a single byte.+-- Note that Arity starts from 1 and constructor tags start from 0. So if max+-- arity is 256 then max constructor tag would be 255.+-- XXX Use variable length encoding to support more than 256 constructors.+type MaxArity256 n = ArityCheck (n <=? 256)++--------------------------------------------------------------------------------+-- Generic Deriving of Unbox instance+--------------------------------------------------------------------------------++-- Unbox uses fixed size encoding, therefore, when a (sum) type has multiple+-- constructors, the size of the type is computed as the maximum required by+-- any constructor. Therefore, size is independent of the value, it can be+-- determined solely by the type.++-- | Implementation of sizeOf that works on the generic representation of an+-- ADT.+class SizeOfRep (f :: Type -> Type) where+    sizeOfRep :: f x -> Int++-- Meta information wrapper, go inside+instance SizeOfRep f => SizeOfRep (M1 i c f) where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = sizeOfRep (undefined :: f x)++-- Primitive type "a".+instance Unbox a => SizeOfRep (K1 i a) where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = sizeOf (Proxy :: Proxy a)++-- Void: data type without constructors. Values of this type cannot exist,+-- therefore the size is undefined. We should never be serializing structures+-- with elements of this type.+instance SizeOfRep V1 where+    {-# INLINE sizeOfRep #-}+    sizeOfRep = error "sizeOfRep: a value of a Void type must not exist"++-- Note that when a sum type has many unit constructors only a single byte is+-- required to encode the type as only the constructor tag is stored.+instance SizeOfRep U1 where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = 0++-- Product type+instance (SizeOfRep f, SizeOfRep g) => SizeOfRep (f :*: g) where+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ = sizeOfRep (undefined :: f x) + sizeOfRep (undefined :: g x)++-------------------------------------------------------------------------------++class SizeOfRepSum (f :: Type -> Type) where+    sizeOfRepSum :: f x -> Int++-- Constructor+instance SizeOfRep a => SizeOfRepSum (C1 c a) where+    {-# INLINE sizeOfRepSum #-}+    sizeOfRepSum = sizeOfRep++instance (SizeOfRepSum f, SizeOfRepSum g) => SizeOfRepSum (f :+: g) where+    {-# INLINE sizeOfRepSum #-}+    sizeOfRepSum _ =+        max (sizeOfRepSum (undefined :: f x)) (sizeOfRepSum (undefined :: g x))++-------------------------------------------------------------------------------++instance (MaxArity256 (SumArity (f :+: g)), SizeOfRepSum f, SizeOfRepSum g) =>+    SizeOfRep (f :+: g) where++    -- The size of a sum type is the max of any of the constructor size.+    -- sizeOfRepSum type class operation is used here instead of sizeOfRep so+    -- that we account the constructor index byte only for the first time and+    -- avoid including it for the subsequent sum constructors.+    {-# INLINE sizeOfRep #-}+    sizeOfRep _ =+        -- One byte for the constructor id and then the constructor value.+        sizeOf (Proxy :: Proxy Word8) ++            max (sizeOfRepSum (undefined :: f x))+                (sizeOfRepSum (undefined :: g x))++-- Unit: constructors without arguments.+-- Theoretically the size can be 0, but we use 1 to simplify the implementation+-- of an array of unit type elements. With a non-zero size we can count the number+-- of elements in the array based on the size of the array. Otherwise we will+-- have to store a virtual length in the array, but keep the physical size of+-- the array as 0. Or we will have to make a special handling for zero sized+-- elements to make the size as 1. Or we can disallow arrays with elements+-- having size 0.+--+-- Some examples:+--+-- data B = B -- one byte+-- data A = A B -- one byte+-- data X = X1 | X2 -- one byte (constructor tag only)+--+{-# INLINE genericSizeOf #-}+genericSizeOf :: forall a. (SizeOfRep (Rep a)) => Proxy a -> Int+genericSizeOf _ =+    let s = sizeOfRep (undefined :: Rep a x)+      in if s == 0 then 1 else s++--------------------------------------------------------------------------------+-- Generic poke+--------------------------------------------------------------------------------++class PokeRep (f :: Type -> Type) where+    pokeRep :: f a -> BoundedPtr -> IO BoundedPtr++instance PokeRep f => PokeRep (M1 i c f) where+    {-# INLINE pokeRep #-}+    pokeRep f = pokeRep (unM1 f)++instance Unbox a => PokeRep (K1 i a) where+    {-# INLINE pokeRep #-}+    pokeRep a = pokeBoundedPtrUnsafe (unK1 a)++instance PokeRep V1 where+    {-# INLINE pokeRep #-}+    pokeRep = error "pokeRep: a value of a Void type should not exist"++instance PokeRep U1 where+    {-# INLINE pokeRep #-}+    pokeRep _ x = pure x++instance (PokeRep f, PokeRep g) => PokeRep (f :*: g) where+    {-# INLINE pokeRep #-}+    pokeRep (f :*: g) ptr = pokeRep f ptr >>= pokeRep g++-------------------------------------------------------------------------------++class KnownNat n => PokeRepSum (n :: Nat) (f :: Type -> Type) where+    -- "n" is the constructor tag to be poked.+    pokeRepSum :: Proxy n -> f a -> BoundedPtr -> IO BoundedPtr++instance (KnownNat n, PokeRep a) => PokeRepSum n (C1 c a) where+    {-# INLINE pokeRepSum #-}+    pokeRepSum _ x ptr = do+        let tag = fromInteger (natVal (Proxy :: Proxy n)) :: Word8+        pokeBoundedPtrUnsafe tag ptr >>= pokeRep x++instance (PokeRepSum n f, PokeRepSum (n + SumArity f) g)+         => PokeRepSum n (f :+: g) where+    {-# INLINE pokeRepSum #-}+    pokeRepSum _ (L1 x) ptr =+        pokeRepSum (Proxy :: Proxy n) x ptr+    pokeRepSum _ (R1 x) ptr =+        pokeRepSum (Proxy :: Proxy (n + SumArity f)) x ptr++-------------------------------------------------------------------------------++instance (MaxArity256 (SumArity (f :+: g)), PokeRepSum 0 (f :+: g)) =>+    PokeRep (f :+: g) where++    {-# INLINE pokeRep #-}+    pokeRep = pokeRepSum (Proxy :: Proxy 0)++{-# INLINE genericPokeObject #-}+genericPokeObject :: (Generic a, PokeRep (Rep a)) =>+    a -> BoundedPtr -> IO BoundedPtr+genericPokeObject a = pokeRep (from a)++genericPokeObj :: (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()+genericPokeObj a ptr = void $ genericPokeObject a ptr++{-# INLINE genericPokeByteIndex #-}+genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) =>+    MutByteArray -> Int -> a -> IO ()+genericPokeByteIndex arr index x = do+    -- XXX Should we use unsafe poke?+#ifdef DEBUG+    end <- MutByteArray.length arr+    genericPokeObj x (BoundedPtr arr index end)+#else+    genericPokeObj x (BoundedPtr arr index undefined)+#endif++--------------------------------------------------------------------------------+-- Generic peek+--------------------------------------------------------------------------------++class PeekRep (f :: Type -> Type) where+    -- Like pokeRep, we can use the following signature instead of using Peeker+    -- peekRep :: BoundedPtr -> IO (BoundedPtr, f a)+    peekRep :: Peeker (f x)++instance PeekRep f => PeekRep (M1 i c f) where+    {-# INLINE peekRep #-}+    peekRep = fmap M1 peekRep++instance Unbox a => PeekRep (K1 i a) where+    {-# INLINE peekRep #-}+    peekRep = fmap K1 readUnsafe++instance PeekRep V1 where+    {-# INLINE peekRep #-}+    peekRep = error "peekRep: a value of a Void type should not exist"++instance PeekRep U1 where+    {-# INLINE peekRep #-}+    peekRep = pure U1++instance (PeekRep f, PeekRep g) => PeekRep (f :*: g) where+    {-# INLINE peekRep #-}+    peekRep = (:*:) <$> peekRep <*> peekRep++-------------------------------------------------------------------------------++class KnownNat n => PeekRepSum (n :: Nat) (f :: Type -> Type) where+    -- "n" is the constructor tag to be matched.+    peekRepSum :: Proxy n -> Word8 -> Peeker (f a)++instance (KnownNat n, PeekRep a) => PeekRepSum n (C1 c a) where+    {-# INLINE peekRepSum #-}+    peekRepSum _ _ = peekRep+    {-+    -- These error checks are expensive, to avoid these+    -- we validate the max value of the tag in peekRep.+    -- XXX Add tests to cover all cases+    peekRepSum _ tag+        | tag == curTag = peekRep+        | tag > curTag =+            error $ "Unbox instance peek: Constructor tag index "+                ++ show tag ++ " out of range, max tag index is "+                ++ show curTag+        | otherwise = error "peekRepSum: bug"++        where++        curTag = fromInteger (natVal (Proxy :: Proxy n))+    -}++instance (PeekRepSum n f, PeekRepSum (n + SumArity f) g)+         => PeekRepSum n (f :+: g) where+    {-# INLINE peekRepSum #-}+    peekRepSum curProxy tag+        | tag < firstRightTag =+            L1 <$> peekRepSum curProxy tag+        | otherwise =+            R1 <$> peekRepSum (Proxy :: Proxy (n + SumArity f)) tag++        where++        firstRightTag = fromInteger (natVal (Proxy :: Proxy (n + SumArity f)))++-------------------------------------------------------------------------------++instance ( MaxArity256 (SumArity (f :+: g))+         , KnownNat (SumArity (f :+: g))+         , PeekRepSum 0 (f :+: g))+         => PeekRep (f :+: g) where+    {-# INLINE peekRep #-}+    peekRep = do+        tag :: Word8 <- readUnsafe+        -- XXX test with 256 and more constructors+        let arity :: Int =+                fromInteger (natVal (Proxy :: Proxy (SumArity (f :+: g))))+        when (fromIntegral tag >= arity)+            $ error $ "peek: Tag " ++ show tag+                ++ " is greater than the max tag " ++ show (arity - 1)+                ++ " for the data type"+        peekRepSum (Proxy :: Proxy 0) tag -- DataKinds++{-# INLINE genericPeeker #-}+genericPeeker :: (Generic a, PeekRep (Rep a)) => Peeker a+genericPeeker = to <$> peekRep++{-# INLINE genericPeekBoundedPtr #-}+genericPeekBoundedPtr :: (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a+genericPeekBoundedPtr = runPeeker genericPeeker++{-# INLINE genericPeekByteIndex #-}+genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) =>+    MutByteArray -> Int -> IO a+genericPeekByteIndex arr index = do+    -- XXX Should we use unsafe peek?+#ifdef DEBUG+    end <- MutByteArray.length arr+    genericPeekBoundedPtr (BoundedPtr arr index end)+#else+    genericPeekBoundedPtr (BoundedPtr arr index undefined)+#endif
+ src/Streamly/Internal/Data/Unbox/TH.hs view
@@ -0,0 +1,499 @@+{-# LANGUAGE TemplateHaskell #-}++-- |+-- Module      : Streamly.Internal.Data.Unbox.TH+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unbox.TH+    ( deriveUnbox++    -- th-helpers+    , DataCon(..)+    , DataType(..)+    , reifyDataType+    ) where++--------------------------------------------------------------------------------+-- Imports+--------------------------------------------------------------------------------++import Data.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+import Streamly.Internal.Data.Unbox++--------------------------------------------------------------------------------+-- th-utilities+--------------------------------------------------------------------------------++-- Note: We don't support template-haskell < 2.14 (GHC < 8.6)++-- The following are copied to remove the dependency on th-utilities.+-- The code has been copied from th-abstraction and th-utilities.++-- Some CPP macros in the following code are not required but are kept+-- anyway. They can be removed if deemed as a maintainance burden.++#if MIN_VERSION_template_haskell(2,17,0)+type TyVarBndr_ flag = TyVarBndr flag+#else+type TyVarBndr_ flag = TyVarBndr+#endif++-- | Case analysis for a 'TyVarBndr'. If the value is a @'PlainTV' n _@, apply+-- the first function to @n@; if it is @'KindedTV' n _ k@, apply the second+-- function to @n@ and @k@.+elimTV :: (Name -> r) -> (Name -> Kind -> r) -> TyVarBndr_ flag -> r+#if MIN_VERSION_template_haskell(2,17,0)+elimTV ptv _ktv (PlainTV n _)    = ptv n+elimTV _ptv ktv (KindedTV n _ k) = ktv n k+#else+elimTV ptv _ktv (PlainTV n)    = ptv n+elimTV _ptv ktv (KindedTV n k) = ktv n k+#endif++-- | Extract the type variable name from a 'TyVarBndr', ignoring the+-- kind signature if one exists.+tvName :: TyVarBndr_ flag -> Name+tvName = elimTV id const++-- | Get the 'Name' of a 'TyVarBndr'+tyVarBndrName :: TyVarBndr_ flag -> Name+tyVarBndrName = tvName++-- | Simplified info about a 'DataD'. Omits deriving, strictness,+-- kind info, and whether it's @data@ or @newtype@.+data DataType = DataType+    { dtName :: Name+    , dtTvs :: [Name]+    , dtCxt :: Cxt+    , dtCons :: [DataCon]+    } deriving (Eq, Show, Ord) --, Data, Typeable, Generic)++-- | Simplified info about a 'Con'. Omits deriving, strictness, and kind+-- info. This is much nicer than consuming 'Con' directly, because it+-- unifies all the constructors into one.+data DataCon = DataCon+    { dcName :: Name+    , dcTvs :: [Name]+    , dcCxt :: Cxt+    , dcFields :: [(Maybe Name, Type)]+    } deriving (Eq, Show, Ord) --, Data, Typeable, Generic)+++-- | Convert a 'Con' to a list of 'DataCon'. The result is a list+-- because 'GadtC' and 'RecGadtC' can define multiple constructors.+conToDataCons :: Con -> [DataCon]+conToDataCons = \case+    NormalC name slots ->+        [DataCon name [] [] (map (\(_, ty) -> (Nothing, ty)) slots)]+    RecC name fields ->+        [DataCon name [] [] (map (\(n, _, ty) -> (Just n, ty)) fields)]+    InfixC (_, ty1) name (_, ty2) ->+        [DataCon name [] [] [(Nothing, ty1), (Nothing, ty2)]]+    ForallC tvs preds con ->+        map (\(DataCon name tvs0 preds0 fields) ->+            DataCon name (tvs0 ++ map tyVarBndrName tvs) (preds0 ++ preds) fields) (conToDataCons con)+#if MIN_VERSION_template_haskell(2,11,0)+    GadtC ns slots _ ->+        map (\dn -> DataCon dn [] [] (map (\(_, ty) -> (Nothing, ty)) slots)) ns+    RecGadtC ns fields _ ->+        map (\dn -> DataCon dn [] [] (map (\(fn, _, ty) -> (Just fn, ty)) fields)) ns+#endif++-- | Reify the given data or newtype declaration, and yields its+-- 'DataType' representation.+reifyDataType :: Name -> Q DataType+reifyDataType name = do+    info <- reify name+    case infoToDataType info of+        Nothing -> fail $ "Expected to reify a datatype. Instead got:\n" ++ pprint info+        Just x -> return x++infoToDataType :: Info -> Maybe DataType+infoToDataType info = case info of+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (DataD preds name tvs _kind cons _deriving) ->+#else+    TyConI (DataD preds name tvs cons _deriving) ->+#endif+        Just $ DataType name (map tyVarBndrName tvs) preds (concatMap conToDataCons cons)+#if MIN_VERSION_template_haskell(2,11,0)+    TyConI (NewtypeD preds name tvs _kind con _deriving) ->+#else+    TyConI (NewtypeD preds name tvs con _deriving) ->+#endif+        Just $ DataType name (map tyVarBndrName tvs) preds (conToDataCons con)+    _ -> Nothing++--------------------------------------------------------------------------------+-- Helpers+--------------------------------------------------------------------------------++type Field = (Maybe Name, Type)++_arr :: Name+_arr = mkName "arr"++_tag :: Name+_tag = mkName "tag"++_initialOffset :: Name+_initialOffset = mkName "initialOffset"++_val :: Name+_val = mkName "val"++mkOffsetName :: Int -> Name+mkOffsetName i = mkName ("offset" ++ show i)++mkFieldName :: Int -> Name+mkFieldName i = mkName ("field" ++ show i)++--------------------------------------------------------------------------------+-- Domain specific helpers+--------------------------------------------------------------------------------++exprGetSize :: Type -> Q Exp+exprGetSize ty = appE (varE 'sizeOf) [|Proxy :: Proxy $(pure ty)|]++getTagSize :: Int -> Int+getTagSize numConstructors+    | numConstructors == 1 = 0+    | fromIntegral (maxBound :: Word8) >= numConstructors = 1+    | fromIntegral (maxBound :: Word16) >= numConstructors = 2+    | fromIntegral (maxBound :: Word32) >= numConstructors = 4+    | fromIntegral (maxBound :: Word64) >= numConstructors = 8+    | otherwise = error "Too many constructors"++getTagType :: Int -> Name+getTagType numConstructors+    | numConstructors == 1 = error "No tag for 1 constructor"+    | fromIntegral (maxBound :: Word8) >= numConstructors = ''Word8+    | fromIntegral (maxBound :: Word16) >= numConstructors = ''Word16+    | fromIntegral (maxBound :: Word32) >= numConstructors = ''Word32+    | fromIntegral (maxBound :: Word64) >= numConstructors = ''Word64+    | otherwise = error "Too many constructors"++mkOffsetDecls :: Int -> [Field] -> [Q Dec]+mkOffsetDecls tagSize fields =+    init+        ((:) (valD+                  (varP (mkOffsetName 0))+                  (normalB+                       [|$(litE (IntegerL (fromIntegral tagSize))) ++                         $(varE _initialOffset)|])+                  [])+             (fmap mkOffsetExpr (zip [1 ..] fields)))++    where++    mkOffsetExpr (i, (_, ty)) =+        valD+            (varP (mkOffsetName i))+            (normalB [|$(varE (mkOffsetName (i - 1))) + $(exprGetSize ty)|])+            []++--------------------------------------------------------------------------------+-- Size+--------------------------------------------------------------------------------++isUnitType :: [DataCon] -> Bool+isUnitType [DataCon _ _ _ []] = True+isUnitType _ = False++mkSizeOfExpr :: Type -> [DataCon] -> Q Exp+mkSizeOfExpr headTy constructors =+    case constructors of+        [] ->+            [|error+                  ("Attempting to get size with no constructors (" +++                   $(lift (pprint headTy)) ++ ")")|]+        -- One constructor with no fields is a unit type. Size of a unit type is+        -- 1.+        [con@(DataCon _ _ _ fields)] ->+            case fields of+                [] -> litE (IntegerL 1)+                _ -> [|$(sizeOfConstructor con)|]+        _ -> [|$(litE (IntegerL (fromIntegral tagSize))) + $(sizeOfHeadDt)|]++    where++    tagSize = getTagSize (length constructors)+    sizeOfField (_, ty) = exprGetSize ty+    sizeOfConstructor (DataCon _ _ _ fields) =+        appE (varE 'sum) (listE (map sizeOfField fields))+    -- The size of any Unbox type is atleast 1+    sizeOfHeadDt =+        appE (varE 'maximum) (listE (map sizeOfConstructor constructors))++--------------------------------------------------------------------------------+-- Peek+--------------------------------------------------------------------------------++mkPeekExprOne :: Int -> DataCon -> Q Exp+mkPeekExprOne tagSize (DataCon cname _ _ fields) =+    case fields of+        -- XXX Should we peek and check if the byte value is 0?+        [] -> [|pure $(conE cname)|]+        _ ->+            letE+                (mkOffsetDecls tagSize fields)+                (foldl+                     (\acc i -> [|$(acc) <*> $(peekField i)|])+                     [|$(conE cname) <$> $(peekField 0)|]+                     [1 .. (length fields - 1)])++    where++    peekField i = [|peekAt $(varE (mkOffsetName i)) $(varE _arr)|]++mkPeekExpr :: Type -> [DataCon] -> Q Exp+mkPeekExpr headTy cons =+    case cons of+        [] ->+            [|error+                  ("Attempting to peek type with no constructors (" +++                   $(lift (pprint headTy)) ++ ")")|]+        [con] -> mkPeekExprOne 0 con+        _ ->+            doE+                [ bindS+                      (varP _tag)+                      [|peekAt $(varE _initialOffset) $(varE _arr)|]+                , noBindS+                      (caseE+                           (sigE (varE _tag) (conT tagType))+                           (fmap peekMatch (zip [0 ..] cons) ++ [peekErr]))+                ]++    where++    lenCons = length cons+    tagType = getTagType lenCons+    tagSize = getTagSize lenCons+    peekMatch (i, con) =+        match (litP (IntegerL i)) (normalB (mkPeekExprOne tagSize con)) []+    peekErr =+        match+            wildP+            (normalB+                 [|error+                       ("Found invalid tag while peeking (" +++                        $(lift (pprint headTy)) ++ ")")|])+            []++--------------------------------------------------------------------------------+-- Poke+--------------------------------------------------------------------------------++mkPokeExprTag :: Name -> Int -> Q Exp+mkPokeExprTag tagType tagVal = pokeTag++    where++    pokeTag =+        [|pokeAt+              $(varE _initialOffset)+              $(varE _arr)+              $(sigE (litE (IntegerL (fromIntegral tagVal))) (conT tagType))|]++mkPokeExprFields :: Int -> [Field] -> Q Exp+mkPokeExprFields tagSize fields = do+    case fields of+        [] -> [|pure ()|]+        _ ->+            letE+                (mkOffsetDecls tagSize fields)+                (doE $ map (noBindS . pokeField) [0 .. (numFields - 1)])++    where++    numFields = length fields+    pokeField i =+        [|pokeAt+              $(varE (mkOffsetName i))+              $(varE _arr)+              $(varE (mkFieldName i))|]++mkPokeMatch :: Name -> Int -> Q Exp -> Q Match+mkPokeMatch cname numFields exp0 =+    match+        (conP cname (map (varP . mkFieldName) [0 .. (numFields - 1)]))+        (normalB exp0)+        []++mkPokeExpr :: Type -> [DataCon] -> Q Exp+mkPokeExpr headTy cons =+    case cons of+        [] ->+            [|error+                  ("Attempting to poke type with no constructors (" +++                   $(lift (pprint headTy)) ++ ")")|]+        -- 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] ->+            caseE+                (varE _val)+                [mkPokeMatch cname (length fields) (mkPokeExprFields 0 fields)]+        _ ->+            caseE+                (varE _val)+                (fmap (\(tagVal, DataCon cname _ _ fields) ->+                          mkPokeMatch+                              cname+                              (length fields)+                              (doE [ noBindS $ mkPokeExprTag tagType tagVal+                                   , noBindS $ mkPokeExprFields tagSize fields+                                   ]))+                     (zip [0 ..] cons))++    where++    lenCons = length cons+    tagType = getTagType lenCons+    tagSize = getTagSize lenCons++--------------------------------------------------------------------------------+-- Main+--------------------------------------------------------------------------------++-- | A general function to derive Unbox instances where you can control which+-- Constructors of the datatype to consider and what the Context for the 'Unbox'+-- instance would be.+--+-- Consider the datatype:+-- @+-- data CustomDataType a b+--     = CDTConstructor1+--     | CDTConstructor2 Bool+--     | CDTConstructor3 Bool b+--     deriving (Show, Eq)+-- @+--+-- Usage:+-- @+-- $(deriveUnboxInternal+--       [AppT (ConT ''Unbox) (VarT (mkName "b"))]+--       (AppT+--            (AppT (ConT ''CustomDataType) (VarT (mkName "a")))+--            (VarT (mkName "b")))+--       [ DataCon 'CDTConstructor1 [] [] []+--       , DataCon 'CDTConstructor2 [] [] [(Nothing, (ConT ''Bool))]+--       , DataCon+--             'CDTConstructor3+--             []+--             []+--             [(Nothing, (ConT ''Bool)), (Nothing, (VarT (mkName "b")))]+--       ])+-- @+deriveUnboxInternal :: Type -> [DataCon] -> ([Dec] -> Q [Dec]) -> Q [Dec]+deriveUnboxInternal headTy cons mkDec = do+    sizeOfMethod <- mkSizeOfExpr headTy cons+    peekMethod <- mkPeekExpr headTy cons+    pokeMethod <- mkPokeExpr headTy cons+    let methods =+            -- INLINE on sizeOf actually worsens some benchmarks, and improves+            -- none+            [ -- PragmaD (InlineP 'sizeOf Inline FunLike AllPhases)+              FunD 'sizeOf [Clause [WildP] (NormalB sizeOfMethod) []]+            , PragmaD (InlineP 'peekAt Inline FunLike AllPhases)+            , FunD+                  'peekAt+                  [ Clause+                        (if isUnitType cons+                             then [WildP, WildP]+                             else [VarP _initialOffset, VarP _arr])+                        (NormalB peekMethod)+                        []+                  ]+            , PragmaD (InlineP 'pokeAt Inline FunLike AllPhases)+            , FunD+                  'pokeAt+                  [ Clause+                        (if isUnitType cons+                             then [WildP, WildP, WildP]+                             else [VarP _initialOffset, VarP _arr, VarP _val])+                        (NormalB pokeMethod)+                        []+                  ]+            ]+    mkDec methods++-- | Given an 'Unbox' instance declaration splice without the methods (e.g.+-- @[d|instance Unbox a => Unbox (Maybe a)|]@), generate an instance+-- declaration including all the type class method implementations.+--+-- Usage:+--+-- @+-- \$(deriveUnbox [d|instance Unbox a => Unbox (Maybe a)|])+-- @+deriveUnbox :: Q [Dec] -> Q [Dec]+deriveUnbox mDecs = do+    dec <- mDecs+    case dec of+        [InstanceD mo preds headTyWC []] -> do+            let headTy = unwrap dec headTyWC+                (mainTyName, subs) = getMainTypeName dec headTy+            dt <- reifyDataType mainTyName+            let tyVars = dtTvs dt+                mapper = mapperWith (VarT <$> tyVars) subs+                cons = map (modifyConVariables mapper) (dtCons dt)+            deriveUnboxInternal headTy cons (mkInst mo preds headTyWC)+        _ -> errorMessage dec++    where++    mapperWith l1 l2 a =+        case elemIndex a l1 of+            Nothing -> a+            -- XXX Capture this case and give a relavant error.+            Just i -> l2 !! i++    mapType f (AppT t1 t2) = AppT (mapType f t1) (mapType f t2)+    mapType f (InfixT t1 n t2) = InfixT (mapType f t1) n (mapType f t2)+    mapType f (UInfixT t1 n t2) = UInfixT (mapType f t1) n (mapType f t2)+    mapType f (ParensT t) = ParensT (mapType f t)+    mapType f v = f v++    modifyConVariables f con =+        con { dcFields = map (second (mapType f)) (dcFields con) }++    mkInst mo preds headTyWC methods =+        pure [InstanceD mo preds headTyWC methods]++    errorMessage dec =+        error $ unlines+            [ "Error: deriveUnbox:"+            , ""+            , ">> " ++ pprint dec+            , ""+            , "The supplied declaration not a valid instance declaration."+            , "Provide a valid Haskell instance declaration without a body."+            , ""+            , "Examples:"+            , "instance Unbox (Proxy a)"+            , "instance Unbox a => Unbox (Identity a)"+            , "instance Unbox (TableT Identity)"+            ]++    unwrap _ (AppT (ConT _) r) = r+    unwrap dec _ = errorMessage dec++    getMainTypeName dec = go []++        where++        go xs (ConT nm) = (nm, xs)+        go xs (AppT l r) = go (r:xs) l+        go _ _ = errorMessage dec
− src/Streamly/Internal/Data/Unboxed.hs 
@@ -1,855 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE UndecidableInstances #-}---- | TODO: Implement TH based instance derivation for better performance.--module Streamly.Internal.Data.Unboxed-    ( Unbox(..)-    , peekWith-    , pokeWith-    , MutableByteArray(..)-    , touch-    , getMutableByteArray#-    , pin-    , unpin-    , newUnpinnedBytes-    , newPinnedBytes-    , newAlignedPinnedBytes-    , nil--    -- * Type Parser and Builder-    , BoundedPtr (..)--    , Peeker (..)-    , read-    , readUnsafe-    , skipByte-    , runPeeker--    , pokeBoundedPtrUnsafe-    , pokeBoundedPtr--    -- * Generic Unbox instances-    , genericSizeOf-    , genericPeekByteIndex-    , genericPokeByteIndex--    -- Classess used for generic deriving.-    , PeekRep(..)-    , PokeRep(..)-    , SizeOfRep(..)-    ) where--#include "MachDeps.h"-#include "ArrayMacros.h"--import Control.Monad (void, when)-import Data.Complex (Complex((:+)))-import Data.Functor ((<&>))-import Data.Functor.Const (Const(..))-import Data.Functor.Identity (Identity(..))-import Data.Kind (Type)-import Data.Proxy (Proxy (..))-import Foreign.Ptr (IntPtr(..), WordPtr(..))-import GHC.Base (IO(..))-import GHC.Fingerprint.Type (Fingerprint(..))-import GHC.Int (Int16(..), Int32(..), Int64(..), Int8(..))-import GHC.Real (Ratio(..))-import GHC.Stable (StablePtr(..))-import GHC.Word (Word16(..), Word32(..), Word64(..), Word8(..))-#if MIN_VERSION_base(4,15,0)-import GHC.RTS.Flags (IoSubSystem(..))-#endif-import Streamly.Internal.Data.Builder (Builder (..))-import System.IO.Unsafe (unsafePerformIO)--import GHC.Generics-import GHC.Exts-import GHC.TypeLits-import Prelude hiding (read)------------------------------------------------------------------------------------- The ArrayContents type------------------------------------------------------------------------------------- XXX can use UnliftedNewtypes-data MutableByteArray = MutableByteArray (MutableByteArray# RealWorld)--{-# INLINE getMutableByteArray# #-}-getMutableByteArray# :: MutableByteArray -> MutableByteArray# RealWorld-getMutableByteArray# (MutableByteArray mbarr) = mbarr--{-# INLINE touch #-}-touch :: MutableByteArray -> IO ()-touch (MutableByteArray contents) =-    IO $ \s -> case touch# contents s of s' -> (# s', () #)---- | Return the size of the array in bytes.-{-# INLINE sizeOfMutableByteArray #-}-sizeOfMutableByteArray :: MutableByteArray -> IO Int-sizeOfMutableByteArray (MutableByteArray arr) =-    IO $ \s ->-        case getSizeofMutableByteArray# arr s of-            (# s1, i #) -> (# s1, I# i #)------------------------------------------------------------------------------------- Creation-----------------------------------------------------------------------------------{-# NOINLINE nil #-}-nil :: MutableByteArray-nil = unsafePerformIO $ newUnpinnedBytes 0--{-# INLINE newUnpinnedBytes #-}-newUnpinnedBytes :: Int -> IO MutableByteArray-newUnpinnedBytes nbytes | nbytes < 0 =-  errorWithoutStackTrace "newUnpinnedBytes: size must be >= 0"-newUnpinnedBytes (I# nbytes) = IO $ \s ->-    case newByteArray# nbytes s of-        (# s', mbarr# #) ->-           let c = MutableByteArray mbarr#-            in (# s', c #)--{-# INLINE newPinnedBytes #-}-newPinnedBytes :: Int -> IO MutableByteArray-newPinnedBytes nbytes | nbytes < 0 =-  errorWithoutStackTrace "newPinnedBytes: size must be >= 0"-newPinnedBytes (I# nbytes) = IO $ \s ->-    case newPinnedByteArray# nbytes s of-        (# s', mbarr# #) ->-           let c = MutableByteArray mbarr#-            in (# s', c #)--{-# INLINE newAlignedPinnedBytes #-}-newAlignedPinnedBytes :: Int -> Int -> IO MutableByteArray-newAlignedPinnedBytes nbytes _align | nbytes < 0 =-  errorWithoutStackTrace "newAlignedPinnedBytes: size must be >= 0"-newAlignedPinnedBytes (I# nbytes) (I# align) = IO $ \s ->-    case newAlignedPinnedByteArray# nbytes align s of-        (# s', mbarr# #) ->-           let c = MutableByteArray mbarr#-            in (# s', c #)------------------------------------------------------------------------------------ Pinning & Unpinning----------------------------------------------------------------------------------{-# INLINE isPinned #-}-isPinned :: MutableByteArray -> Bool-isPinned (MutableByteArray arr#) =-    let pinnedInt = I# (isMutableByteArrayPinned# arr#)-     in pinnedInt == 1---{-# INLINE cloneMutableArrayWith# #-}-cloneMutableArrayWith#-    :: (Int# -> State# RealWorld -> (# State# RealWorld-                                     , MutableByteArray# RealWorld #))-    -> MutableByteArray# RealWorld-    -> State# RealWorld-    -> (# State# RealWorld, MutableByteArray# RealWorld #)-cloneMutableArrayWith# alloc# arr# s# =-    case getSizeofMutableByteArray# arr# s# of-        (# s1#, i# #) ->-            case alloc# i# s1# of-                (# s2#, arr1# #) ->-                    case copyMutableByteArray# arr# 0# arr1# 0# i# s2# of-                        s3# -> (# s3#, arr1# #)--{-# INLINE pin #-}-pin :: MutableByteArray -> IO MutableByteArray-pin arr@(MutableByteArray marr#) =-    if isPinned arr-    then return arr-    else IO-             $ \s# ->-                   case cloneMutableArrayWith# newPinnedByteArray# marr# s# of-                       (# s1#, marr1# #) -> (# s1#, MutableByteArray marr1# #)--{-# INLINE unpin #-}-unpin :: MutableByteArray -> IO MutableByteArray-unpin arr@(MutableByteArray marr#) =-    if not (isPinned arr)-    then return arr-    else IO-             $ \s# ->-                   case cloneMutableArrayWith# newByteArray# marr# s# of-                       (# s1#, marr1# #) -> (# s1#, MutableByteArray marr1# #)------------------------------------------------------------------------------------- The Unbox type class------------------------------------------------------------------------------------- XXX generate error if the size is < 1---- In theory we could convert a type to and from a byte stream and use that--- to implement boxing, unboxing. But that would be inefficient. This type--- class allows each primitive type to have its own specific efficient--- implementation to read and write the type to memory.------ This is a typeclass that uses MutableByteArray but could use ForeignPtr or--- any other representation of memory. We could make this a multiparameter type--- class if necessary.------ If the type class would have to support reading and writing to a Ptr as well,--- basically what Storable does. We will also need to touch the anchoring ptr at--- the right points which is prone to errors. However, it should be simple to--- implement unmanaged/read-only memory arrays by allowing a Ptr type in--- ArrayContents, though it would require all instances to support reading from--- a Ptr.------ There is a reason for using byte offset instead of element index in read and--- write operations in the type class. If we use element index slicing of the--- array becomes rigid. We can only slice the array at addresses that are--- aligned with the type, therefore, we cannot slice at misaligned location and--- then cast the slice into another type which does not ncessarily align with--- the original type.------ As a side note, there seem to be no performance advantage of alignment--- anymore, see--- https://lemire.me/blog/2012/05/31/data-alignment-for-speed-myth-or-reality/------- The main goal of the Unbox type class is to be used in arrays. Invariants--- for the sizeOf value required for use in arrays:------ * size is independent of the value, it is determined by the type only. So--- that we can store values of the same type in fixed length array cells.--- * size cannot be zero. So that the length of an array storing the element--- and the number of elements can be related.------ Note, for general serializable types the size cannot be fixed e.g. we may--- want to serialize a list. This type class can be considered a special case--- of a more general serialization type class.---- | A type implementing the 'Unbox' interface supplies operations for reading--- and writing the type from and to a mutable byte array (an unboxed--- representation of the type) in memory. The read operation 'peekByteIndex'--- deserializes the boxed type from the mutable byte array. The write operation--- 'pokeByteIndex' serializes the boxed type to the mutable byte array.------ Instances can be derived via 'Generic'. Note that the data type must be--- non-recursive. Here is an example, for deriving an instance of this type--- class.------ >>> import GHC.Generics (Generic)--- >>> :{--- data Object = Object---     { _int0 :: Int---     , _int1 :: Int---     } deriving Generic--- :}------ WARNING! Generic deriving hangs for recursive data types.------ >>> import Streamly.Data.Array (Unbox(..))--- >>> instance Unbox Object------ If you want to write the instance manually:------ >>> :{--- instance Unbox Object where---     sizeOf _ = 16---     peekByteIndex i arr = do---         x0 <- peekByteIndex i arr---         x1 <- peekByteIndex (i + 8) arr---         return $ Object x0 x1---     pokeByteIndex i arr (Object x0 x1) = do---         pokeByteIndex i arr x0---         pokeByteIndex (i + 8) arr x1--- :}----class Unbox a where-    -- | Get the size. Size cannot be zero.-    sizeOf :: Proxy a -> Int--    default sizeOf :: (SizeOfRep (Rep a)) => Proxy a -> Int-    sizeOf = genericSizeOf--    -- | Read an element of type "a" from a MutableByteArray given the byte-    -- index.-    ---    -- IMPORTANT: The implementation of this interface may not check the bounds-    -- of the array, the caller must not assume that.-    peekByteIndex :: Int -> MutableByteArray -> IO a--    default peekByteIndex :: (Generic a, PeekRep (Rep a)) =>-         Int -> MutableByteArray -> IO a-    peekByteIndex i arr = genericPeekByteIndex arr i--    -- | Write an element of type "a" to a MutableByteArray given the byte-    -- index.-    ---    -- IMPORTANT: The implementation of this interface may not check the bounds-    -- of the array, the caller must not assume that.-    pokeByteIndex :: Int -> MutableByteArray -> a -> IO ()--    default pokeByteIndex :: (Generic a, PokeRep (Rep a)) =>-        Int -> MutableByteArray -> a -> IO ()-    pokeByteIndex i arr = genericPokeByteIndex arr i--#define DERIVE_UNBOXED(_type, _constructor, _readArray, _writeArray, _sizeOf) \-instance Unbox _type where {                                         \-; {-# INLINE peekByteIndex #-}                                       \-; peekByteIndex (I# n) (MutableByteArray mbarr) = IO $ \s ->         \-      case _readArray mbarr n s of                                   \-          { (# s1, i #) -> (# s1, _constructor i #) }                \-; {-# INLINE pokeByteIndex #-}                                       \-; pokeByteIndex (I# n) (MutableByteArray mbarr) (_constructor val) = \-        IO $ \s -> (# _writeArray mbarr n val s, () #)               \-; {-# INLINE sizeOf #-}                                              \-; sizeOf _ = _sizeOf                                                 \-}--#define DERIVE_WRAPPED_UNBOX(_constraint, _type, _constructor, _innerType)    \-instance _constraint Unbox _type where                                        \-; {-# INLINE peekByteIndex #-}                                                \-; peekByteIndex i arr = _constructor <$> peekByteIndex i arr                  \-; {-# INLINE pokeByteIndex #-}                                                \-; pokeByteIndex i arr (_constructor a) = pokeByteIndex i arr a                \-; {-# INLINE sizeOf #-}                                                       \-; sizeOf _ = SIZE_OF(_innerType)--#define DERIVE_BINARY_UNBOX(_constraint, _type, _constructor, _innerType) \-instance _constraint Unbox _type where {                                  \-; {-# INLINE peekByteIndex #-}                                            \-; peekByteIndex i arr =                                                   \-      peekByteIndex i arr >>=                                             \-        (\p1 -> peekByteIndex (i + SIZE_OF(_innerType)) arr               \-            <&> _constructor p1)                                          \-; {-# INLINE pokeByteIndex #-}                                            \-; pokeByteIndex i arr (_constructor p1 p2) =                              \-      pokeByteIndex i arr p1 >>                                           \-        pokeByteIndex (i + SIZE_OF(_innerType)) arr p2                    \-; {-# INLINE sizeOf #-}                                                   \-; sizeOf _ = 2 * SIZE_OF(_innerType)                                      \-}------------------------------------------------------------------------------------ Unbox instances for primitive types----------------------------------------------------------------------------------DERIVE_UNBOXED( Char-              , C#-              , readWord8ArrayAsWideChar#-              , writeWord8ArrayAsWideChar#-              , SIZEOF_HSCHAR)--DERIVE_UNBOXED( Int8-              , I8#-              , readInt8Array#-              , writeInt8Array#-              , 1)--DERIVE_UNBOXED( Int16-              , I16#-              , readWord8ArrayAsInt16#-              , writeWord8ArrayAsInt16#-              , 2)--DERIVE_UNBOXED( Int32-              , I32#-              , readWord8ArrayAsInt32#-              , writeWord8ArrayAsInt32#-              , 4)--DERIVE_UNBOXED( Int-              , I#-              , readWord8ArrayAsInt#-              , writeWord8ArrayAsInt#-              , SIZEOF_HSINT)--DERIVE_UNBOXED( Int64-              , I64#-              , readWord8ArrayAsInt64#-              , writeWord8ArrayAsInt64#-              , 8)--DERIVE_UNBOXED( Word-              , W#-              , readWord8ArrayAsWord#-              , writeWord8ArrayAsWord#-              , SIZEOF_HSWORD)--DERIVE_UNBOXED( Word8-              , W8#-              , readWord8Array#-              , writeWord8Array#-              , 1)--DERIVE_UNBOXED( Word16-              , W16#-              , readWord8ArrayAsWord16#-              , writeWord8ArrayAsWord16#-              , 2)--DERIVE_UNBOXED( Word32-              , W32#-              , readWord8ArrayAsWord32#-              , writeWord8ArrayAsWord32#-              , 4)--DERIVE_UNBOXED( Word64-              , W64#-              , readWord8ArrayAsWord64#-              , writeWord8ArrayAsWord64#-              , 8)--DERIVE_UNBOXED( Double-              , D#-              , readWord8ArrayAsDouble#-              , writeWord8ArrayAsDouble#-              , SIZEOF_HSDOUBLE)--DERIVE_UNBOXED( Float-              , F#-              , readWord8ArrayAsFloat#-              , writeWord8ArrayAsFloat#-              , SIZEOF_HSFLOAT)------------------------------------------------------------------------------------ Unbox instances for derived types----------------------------------------------------------------------------------DERIVE_UNBOXED( (StablePtr a)-              , StablePtr-              , readWord8ArrayAsStablePtr#-              , writeWord8ArrayAsStablePtr#-              , SIZEOF_HSSTABLEPTR)--DERIVE_UNBOXED( (Ptr a)-              , Ptr-              , readWord8ArrayAsAddr#-              , writeWord8ArrayAsAddr#-              , SIZEOF_HSPTR)--DERIVE_UNBOXED( (FunPtr a)-              , FunPtr-              , readWord8ArrayAsAddr#-              , writeWord8ArrayAsAddr#-              , SIZEOF_HSFUNPTR)--DERIVE_WRAPPED_UNBOX(,IntPtr,IntPtr,Int)-DERIVE_WRAPPED_UNBOX(,WordPtr,WordPtr,Word)-DERIVE_WRAPPED_UNBOX(Unbox a =>,(Identity a),Identity,a)-#if MIN_VERSION_base(4,14,0)-DERIVE_WRAPPED_UNBOX(Unbox a =>,(Down a),Down,a)-#endif-DERIVE_WRAPPED_UNBOX(Unbox a =>,(Const a b),Const,a)-DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Complex a),(:+),a)-DERIVE_BINARY_UNBOX(forall a. Unbox a =>,(Ratio a),(:%),a)-DERIVE_BINARY_UNBOX(,Fingerprint,Fingerprint,Word64)--instance Unbox () where--    {-# INLINE peekByteIndex #-}-    peekByteIndex _ _ = return ()--    {-# INLINE pokeByteIndex #-}-    pokeByteIndex _ _ _ = return ()--    {-# INLINE sizeOf #-}-    sizeOf _ = 1--#if MIN_VERSION_base(4,15,0)-instance Unbox IoSubSystem where--    {-# INLINE peekByteIndex #-}-    peekByteIndex i arr = toEnum <$> peekByteIndex i arr--    {-# INLINE pokeByteIndex #-}-    pokeByteIndex i arr a = pokeByteIndex i arr (fromEnum a)--    {-# INLINE sizeOf #-}-    sizeOf _ = sizeOf (Proxy :: Proxy Int)-#endif--instance Unbox Bool where--    {-# INLINE peekByteIndex #-}-    peekByteIndex i arr = do-        res <- peekByteIndex i arr-        return $ res /= (0 :: Int8)--    {-# INLINE pokeByteIndex #-}-    pokeByteIndex i arr a =-        if a-        then pokeByteIndex i arr (1 :: Int8)-        else pokeByteIndex i arr (0 :: Int8)--    {-# INLINE sizeOf #-}-    sizeOf _ = 1------------------------------------------------------------------------------------- Functions-----------------------------------------------------------------------------------{-# INLINE peekWith #-}-peekWith :: Unbox a => MutableByteArray -> Int -> IO a-peekWith arr i = peekByteIndex i arr--{-# INLINE pokeWith #-}-pokeWith :: Unbox a => MutableByteArray -> Int -> a -> IO ()-pokeWith arr i = pokeByteIndex i arr------------------------------------------------------------------------------------- Generic deriving------------------------------------------------------------------------------------- Utilities to build or parse a type safely and easily.---- | A location inside a mutable byte array with the bound of the array. Is it--- cheaper to just get the bound using the size of the array whenever needed?-data BoundedPtr =-    BoundedPtr-        MutableByteArray          -- byte array-        Int                       -- current pos-        Int                       -- position after end------------------------------------------------------------------------------------- Peeker monad------------------------------------------------------------------------------------- | Chains peek functions that pass the current position to the next function-newtype Peeker a = Peeker (Builder BoundedPtr IO a)-    deriving (Functor, Applicative, Monad)--{-# INLINE readUnsafe #-}-readUnsafe :: Unbox a => Peeker a-readUnsafe = Peeker (Builder step)--    where--    {-# INLINE step #-}-    step :: forall a. Unbox a => BoundedPtr -> IO (BoundedPtr, a)-    step (BoundedPtr arr pos end) = do-        let next = pos + sizeOf (Proxy :: Proxy a)-        r <- peekByteIndex pos arr-        return (BoundedPtr arr next end, r)--{-# INLINE read #-}-read :: Unbox a => Peeker a-read = Peeker (Builder step)--    where--    {-# INLINE step #-}-    step :: forall a. Unbox a => BoundedPtr -> IO (BoundedPtr, a)-    step (BoundedPtr arr pos end) = do-        let next = pos + sizeOf (Proxy :: Proxy a)-        when (next > end) $ error "peekObject reading beyond limit"-        r <- peekByteIndex pos arr-        return (BoundedPtr arr next end, r)--{-# INLINE skipByte #-}-skipByte :: Peeker ()-skipByte = Peeker (Builder step)--    where--    {-# INLINE step #-}-    step :: BoundedPtr -> IO (BoundedPtr, ())-    step (BoundedPtr arr pos end) = do-        let next = pos + 1-        when (next > end)-            $ error $ "skipByte: reading beyond limit. next = "-                ++ show next-                ++ " end = " ++ show end-        return (BoundedPtr arr next end, ())--{-# INLINE runPeeker #-}-runPeeker :: Peeker a -> BoundedPtr -> IO a-runPeeker (Peeker (Builder f)) ptr = fmap snd (f ptr)------------------------------------------------------------------------------------- Poke utilities------------------------------------------------------------------------------------- XXX Using a Poker monad may be useful when we have to compute the size to be--- poked as we go and then poke the size at a previous location. For variable--- sized object serialization we may also want to reallocate the array and--- return the newly allocated array in the output.---- Does not check writing beyond bound.-{-# INLINE pokeBoundedPtrUnsafe #-}-pokeBoundedPtrUnsafe :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr-pokeBoundedPtrUnsafe a (BoundedPtr arr pos end) = do-    let next = pos + sizeOf (Proxy :: Proxy a)-    pokeByteIndex pos arr a-    return (BoundedPtr arr next end)--{-# INLINE pokeBoundedPtr #-}-pokeBoundedPtr :: forall a. Unbox a => a -> BoundedPtr -> IO BoundedPtr-pokeBoundedPtr a (BoundedPtr arr pos end) = do-    let next = pos + sizeOf (Proxy :: Proxy a)-    when (next > end) $ error "pokeBoundedPtr writing beyond limit"-    pokeByteIndex pos arr a-    return (BoundedPtr arr next end)------------------------------------------------------------------------------------- Check the number of constructors in a sum type------------------------------------------------------------------------------------- Count the constructors of a sum type.-type family SumArity (a :: Type -> Type) :: Nat where-    SumArity (C1 _ _) = 1-    -- Requires UndecidableInstances-    SumArity (f :+: g) = SumArity f + SumArity g--type family TypeErrorMessage (a :: Symbol) :: Constraint where-    TypeErrorMessage a = TypeError ('Text a)--type family ArityCheck (b :: Bool) :: Constraint where-    ArityCheck 'True = ()-    ArityCheck 'False = TypeErrorMessage-        "Generic Unbox deriving does not support > 256 constructors."---- Type constraint to restrict the sum type arity so that the constructor tag--- can fit in a single byte.-type MaxArity256 n = ArityCheck (n <=? 255)------------------------------------------------------------------------------------- Generic Deriving of Unbox instance------------------------------------------------------------------------------------- Unbox uses fixed size encoding, therefore, when a (sum) type has multiple--- constructors, the size of the type is computed as the maximum required by--- any constructor. Therefore, size is independent of the value, it can be--- determined solely by the type.---- | Implementation of sizeOf that works on the generic representation of an--- ADT.-class SizeOfRep (f :: Type -> Type) where-    sizeOfRep :: f x -> Int---- Meta information wrapper, go inside-instance SizeOfRep f => SizeOfRep (M1 i c f) where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = sizeOfRep (undefined :: f x)---- Primitive type "a".-instance Unbox a => SizeOfRep (K1 i a) where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = sizeOf (Proxy :: Proxy a)---- Void: data type without constructors. Values of this type cannot exist,--- therefore the size is undefined. We should never be serializing structures--- with elements of this type.-instance SizeOfRep V1 where-    {-# INLINE sizeOfRep #-}-    sizeOfRep = error "sizeOfRep: a value of a Void type must not exist"---- Note that when a sum type has many unit constructors only a single byte is--- required to encode the type as only the constructor tag is stored.-instance SizeOfRep U1 where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = 0---- Product type-instance (SizeOfRep f, SizeOfRep g) => SizeOfRep (f :*: g) where-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ = sizeOfRep (undefined :: f x) + sizeOfRep (undefined :: g x)-----------------------------------------------------------------------------------class SizeOfRepSum (f :: Type -> Type) where-    sizeOfRepSum :: f x -> Int---- Constructor-instance SizeOfRep a => SizeOfRepSum (C1 c a) where-    {-# INLINE sizeOfRepSum #-}-    sizeOfRepSum = sizeOfRep--instance (SizeOfRepSum f, SizeOfRepSum g) => SizeOfRepSum (f :+: g) where-    {-# INLINE sizeOfRepSum #-}-    sizeOfRepSum _ =-        max (sizeOfRepSum (undefined :: f x)) (sizeOfRepSum (undefined :: g x))-----------------------------------------------------------------------------------instance (MaxArity256 (SumArity (f :+: g)), SizeOfRepSum f, SizeOfRepSum g) =>-    SizeOfRep (f :+: g) where--    -- The size of a sum type is the max of any of the constructor size.-    -- sizeOfRepSum type class operation is used here instead of sizeOfRep so-    -- that we add the constructor index byte only for the first time and avoid-    -- including it for the subsequent sum constructors.-    {-# INLINE sizeOfRep #-}-    sizeOfRep _ =-        -- One byte for the constructor id and then the constructor value.-        sizeOf (Proxy :: Proxy Word8) +-            max (sizeOfRepSum (undefined :: f x))-                (sizeOfRepSum (undefined :: g x))---- Unit: constructors without arguments.--- Theoretically the size can be 0, but we use 1 to simplify the implementation--- of an array of unit type elements. With a non-zero size we can count the number--- of elements in the array based on the size of the array. Otherwise we will--- have to store a virtual length in the array, but keep the physical size of--- the array as 0. Or we will have to make a special handling for zero sized--- elements to make the size as 1. Or we can disallow arrays with elements--- having size 0.----{-# INLINE genericSizeOf #-}-genericSizeOf :: forall a. (SizeOfRep (Rep a)) => Proxy a -> Int-genericSizeOf _ =-    let s = sizeOfRep (undefined :: Rep a x)-      in if s == 0 then 1 else s------------------------------------------------------------------------------------- Generic poke-----------------------------------------------------------------------------------class PokeRep (f :: Type -> Type) where-    pokeRep :: f a -> BoundedPtr -> IO BoundedPtr--instance PokeRep f => PokeRep (M1 i c f) where-    {-# INLINE pokeRep #-}-    pokeRep f = pokeRep (unM1 f)--instance Unbox a => PokeRep (K1 i a) where-    {-# INLINE pokeRep #-}-    pokeRep a = pokeBoundedPtr (unK1 a)--instance PokeRep V1 where-    {-# INLINE pokeRep #-}-    pokeRep = error "pokeRep: a value of a Void type should not exist"--instance PokeRep U1 where-    {-# INLINE pokeRep #-}-    pokeRep _ x = pure x--instance (PokeRep f, PokeRep g) => PokeRep (f :*: g) where-    {-# INLINE pokeRep #-}-    pokeRep (f :*: g) ptr = pokeRep f ptr >>= pokeRep g-----------------------------------------------------------------------------------class KnownNat n => PokeRepSum (n :: Nat) (f :: Type -> Type) where-    -- "n" is the constructor tag to be poked.-    pokeRepSum :: Proxy n -> f a -> BoundedPtr -> IO BoundedPtr--instance (KnownNat n, PokeRep a) => PokeRepSum n (C1 c a) where-    {-# INLINE pokeRepSum #-}-    pokeRepSum _ x ptr = do-        pokeBoundedPtr (fromInteger (natVal (Proxy :: Proxy n)) :: Word8) ptr-            >>= pokeRep x--instance (KnownNat n, PokeRepSum n f, PokeRepSum (n + SumArity f) g)-         => PokeRepSum n (f :+: g) where-    {-# INLINE pokeRepSum #-}-    pokeRepSum _ (L1 x) ptr =-        pokeRepSum (Proxy :: Proxy n) x ptr-    pokeRepSum _ (R1 x) ptr =-        pokeRepSum (Proxy :: Proxy (n + SumArity f)) x ptr-----------------------------------------------------------------------------------instance (MaxArity256 (SumArity (f :+: g)), PokeRepSum 0 (f :+: g)) =>-    PokeRep (f :+: g) where--    {-# INLINE pokeRep #-}-    pokeRep = pokeRepSum (Proxy :: Proxy 0)--{-# INLINE genericPokeObject #-}-genericPokeObject :: (Generic a, PokeRep (Rep a)) =>-    a -> BoundedPtr -> IO BoundedPtr-genericPokeObject a = pokeRep (from a)--genericPokeObj :: (Generic a, PokeRep (Rep a)) => a -> BoundedPtr -> IO ()-genericPokeObj a ptr = void $ genericPokeObject a ptr--{-# INLINE genericPokeByteIndex #-}-genericPokeByteIndex :: (Generic a, PokeRep (Rep a)) =>-    MutableByteArray -> Int -> a -> IO ()-genericPokeByteIndex arr index x = do-    -- XXX Should we use unsafe poke?-    end <- sizeOfMutableByteArray arr-    genericPokeObj x (BoundedPtr arr index end)------------------------------------------------------------------------------------- Generic peek-----------------------------------------------------------------------------------class PeekRep (f :: Type -> Type) where-    peekRep :: Peeker (f x)--instance PeekRep f => PeekRep (M1 i c f) where-    {-# INLINE peekRep #-}-    peekRep = fmap M1 peekRep--instance Unbox a => PeekRep (K1 i a) where-    {-# INLINE peekRep #-}-    peekRep = fmap K1 read--instance PeekRep V1 where-    {-# INLINE peekRep #-}-    peekRep = error "peekRep: a value of a Void type should not exist"--instance PeekRep U1 where-    {-# INLINE peekRep #-}-    peekRep = pure U1--instance (PeekRep f, PeekRep g) => PeekRep (f :*: g) where-    {-# INLINE peekRep #-}-    peekRep = (:*:) <$> peekRep <*> peekRep-----------------------------------------------------------------------------------class KnownNat n => PeekRepSum (n :: Nat) (f :: Type -> Type) where-    -- "n" is the constructor tag to be matched.-    peekRepSum :: Proxy n -> Word8 -> Peeker (f a)--instance (KnownNat n, PeekRep a) => PeekRepSum n (C1 c a) where-    {-# INLINE peekRepSum #-}-    peekRepSum _ tag-        | tag == curTag = peekRep-        | tag > curTag =-            error $ "Unbox instance peek: Constructor tag index "-                ++ show tag ++ " out of range, max tag index is "-                ++ show curTag-        | otherwise = error "peekRepSum: bug"--        where--        curTag = fromInteger (natVal (Proxy :: Proxy n))--instance (KnownNat n, PeekRepSum n f, PeekRepSum (n + SumArity f) g)-         => PeekRepSum n (f :+: g) where-    {-# INLINE peekRepSum #-}-    peekRepSum curProxy tag-        | tag < firstRightTag =-            L1 <$> peekRepSum curProxy tag-        | otherwise =-            R1 <$> peekRepSum (Proxy :: Proxy (n + SumArity f)) tag--        where--        firstRightTag = fromInteger (natVal (Proxy :: Proxy (n + SumArity f)))-----------------------------------------------------------------------------------instance (MaxArity256 (SumArity (f :+: g)), PeekRepSum 0 (f :+: g))-         => PeekRep (f :+: g) where-    {-# INLINE peekRep #-}-    peekRep = do-        tag <- read-        peekRepSum (Proxy :: Proxy 0) tag--{-# INLINE genericPeeker #-}-genericPeeker :: (Generic a, PeekRep (Rep a)) => Peeker a-genericPeeker = to <$> peekRep--{-# INLINE genericPeekBoundedPtr #-}-genericPeekBoundedPtr :: (Generic a, PeekRep (Rep a)) => BoundedPtr -> IO a-genericPeekBoundedPtr = runPeeker genericPeeker--{-# INLINE genericPeekByteIndex #-}-genericPeekByteIndex :: (Generic a, PeekRep (Rep a)) =>-    MutableByteArray -> Int -> IO a-genericPeekByteIndex arr index = do-    -- XXX Should we use unsafe peek?-    end <- sizeOfMutableByteArray arr-    genericPeekBoundedPtr (BoundedPtr arr index end)
src/Streamly/Internal/Data/Unfold.hs view
@@ -16,69 +16,28 @@     -- $setup      -- * Unfold Type-      Step(..)-    , Unfold+      module Streamly.Internal.Data.Unfold.Type      -- * Unfolds     -- One to one correspondence with     -- "Streamly.Internal.Data.Stream.Generate"     -- ** Basic Constructors-    , mkUnfoldM-    , mkUnfoldrM-    , unfoldrM-    , unfoldr-    , functionM-    , function-    , identity     , nilM     , nil     , consM -    -- ** From Values-    , fromEffect-    , fromPure-     -- ** Generators     -- | Generate a monadic stream from a seed.     , repeatM+    , repeat     , replicateM     , fromIndicesM     , iterateM      -- ** Enumerations-    , Enumerable (..)--    -- ** Enumerate Num-    , enumerateFromNum-    , enumerateFromThenNum-    , enumerateFromStepNum--    -- ** Enumerating 'Bounded 'Integral' Types-    , enumerateFromIntegralBounded-    , enumerateFromThenIntegralBounded-    , enumerateFromToIntegralBounded-    , enumerateFromThenToIntegralBounded--    -- ** Enumerating 'Unounded Integral' Types-    , enumerateFromIntegral-    , enumerateFromThenIntegral-    , enumerateFromToIntegral-    , enumerateFromThenToIntegral--    -- ** Enumerating 'Small Integral' Types-    , enumerateFromSmallBounded-    , enumerateFromThenSmallBounded-    , enumerateFromToSmall-    , enumerateFromThenToSmall--    -- ** Enumerating 'Fractional' Types-    , enumerateFromFractional-    , enumerateFromThenFractional-    , enumerateFromToFractional-    , enumerateFromThenToFractional+    , module Streamly.Internal.Data.Unfold.Enumeration      -- ** From Containers-    , fromList     , fromListM      -- ** From Memory@@ -91,11 +50,6 @@      -- * Combinators     -- ** Mapping on Input-    , lmap-    , lmapM-    , both-    , first-    , second     , discardFirst     , discardSecond     , swap@@ -105,20 +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-    , map-    , map2-    , mapM-    , mapM2-     , postscanlM'     , postscan-    , scan-    , scanMany+    , scanl+    , scanlMany     , foldMany     -- pipe @@ -126,8 +71,6 @@     , either      -- ** Filtering-    , takeWhileM-    , takeWhile     , take     , filter     , filterM@@ -135,23 +78,11 @@     , dropWhile     , dropWhileM -    -- ** Zipping-    , zipWithM-    , zipWith-     -- ** Cross product-    , crossWithM-    , crossWith-    , cross-    , joinInnerGeneric-    , crossApply+    , innerJoin -    -- ** Nesting-    , ConcatState (..)-    , many-    , many2-    , concatMapM-    , bind+    -- ** Zip+    , zipRepeat      -- ** Resource Management     -- | 'bracket' is the most general resource management operation, all other@@ -176,6 +107,10 @@     -- stream of arrays before flattening it to a stream of chars.     , onException     , handle++    -- ** Deprecated+    , scan+    , scanMany     ) where @@ -187,29 +122,34 @@ 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.StreamD.Type (Stream(..), Step(..))+import Streamly.Internal.Data.Stream.Type (Stream(..)) import Streamly.Internal.Data.SVar.Type (defState)  import qualified Control.Monad.Catch as MC import qualified Data.Tuple as Tuple import qualified Streamly.Internal.Data.Fold.Type as FL-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K+import qualified Streamly.Internal.Data.Stream.Type as D+import qualified Streamly.Internal.Data.StreamK.Type as K import qualified Prelude  import Streamly.Internal.Data.Unfold.Enumeration 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  #include "DocTestDataUnfold.hs" +-------------------------------------------------------------------------------+-- Input operations+-------------------------------------------------------------------------------+ -- | Convert an 'Unfold' into an unfold accepting a tuple as an argument, -- using the argument of the original fold as the second element of tuple and -- discarding the first element of the tuple.@@ -270,7 +210,7 @@ -- {-# INLINE_NORMAL fold #-} fold :: Monad m => Fold m b c -> Unfold m a b -> a -> m c-fold (Fold fstep initial extract) (Unfold ustep inject) a = do+fold (Fold fstep initial _ final) (Unfold ustep inject) a = do     res <- initial     case res of         FL.Partial x -> inject a >>= go SPEC x@@ -288,7 +228,7 @@                     FL.Partial fs1 -> go SPEC fs1 s                     FL.Done c -> return c             Skip s -> go SPEC fs s-            Stop -> extract fs+            Stop -> final fs  -- {-# ANN type FoldMany Fuse #-} data FoldMany s fs b a@@ -303,7 +243,7 @@ -- /Pre-release/ {-# INLINE_NORMAL foldMany #-} foldMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-foldMany (Fold fstep initial extract) (Unfold ustep inject1) =+foldMany (Fold fstep initial _ final) (Unfold ustep inject1) =     Unfold step inject      where@@ -334,14 +274,14 @@         case r of             Yield x s -> consume x s fs             Skip s -> return $ Skip (FoldManyFirst fs s)-            Stop -> return Stop+            Stop -> final fs >> return Stop     step (FoldManyLoop st fs) = do         r <- ustep st         case r of             Yield x s -> consume x s fs             Skip s -> return $ Skip (FoldManyLoop s fs)             Stop -> do-                b <- extract fs+                b <- final fs                 return $ Skip (FoldManyYield b FoldManyDone)     step (FoldManyYield b next) = return $ Yield b next     step FoldManyDone = return Stop@@ -382,7 +322,7 @@ -- /Pre-release/ {-# INLINE_NORMAL postscan #-} postscan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c-postscan (Fold stepF initial extract) (Unfold stepU injectU) =+postscan (Fold stepF initial extract final) (Unfold stepU injectU) =     Unfold step inject      where@@ -405,15 +345,15 @@                         v <- extract fs1                         return $ Yield v (Just (fs1, s))             Skip s -> return $ Skip (Just (fs, s))-            Stop -> return Stop+            Stop -> final fs >> return Stop      step Nothing = return Stop  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) (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@@ -438,34 +378,46 @@         case res of             Yield x s -> runStep s (fstep fs x)             Skip s -> return $ Skip $ ScanDo s fs-            Stop -> return Stop+            Stop -> final fs >> return Stop     step ScanDone = return Stop  -- | Scan the output of an 'Unfold' to change it in a stateful manner. -- 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. --@@ -584,7 +536,7 @@      where -    inject seed = pure seed+    inject = pure      {-# INLINE_LATE step #-}     step (i, action) =@@ -603,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. --@@ -742,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/Enumeration.hs view
@@ -65,7 +65,6 @@ import Data.Word import Numeric.Natural import Data.Functor.Identity (Identity(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..)) import Streamly.Internal.Data.Unfold.Type import Prelude        hiding (map, mapM, takeWhile, take, filter, const, zipWith@@ -88,7 +87,7 @@ -- the value overflows it keeps enumerating in a cycle: -- -- @--- >>> Stream.fold Fold.toList $ Stream.take 10 $ Stream.unfold Unfold.enumerateFromStepNum (255::Word8,1)+-- >>> Stream.toList $ Stream.take 10 $ Stream.unfold Unfold.enumerateFromStepNum (255::Word8,1) -- [255,0,1,2,3,4,5,6,7,8] -- -- @@@ -125,7 +124,7 @@ -- -- Example: -- @--- >>> Stream.fold Fold.toList $ Stream.take 10 $ Stream.unfold enumerateFromThenNum (255::Word8,0)+-- >>> Stream.toList $ Stream.take 10 $ Stream.unfold enumerateFromThenNum (255::Word8,0) -- [255,0,1,2,3,4,5,6,7,8] -- -- @@@ -152,7 +151,7 @@ -- -- @ -- >>> enumerateFromNum = lmap (\from -> (from, 1)) Unfold.enumerateFromStepNum--- >>> Stream.fold Fold.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9)+-- >>> Stream.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9) -- [0.9,1.9,2.9,3.9,4.9,5.9] -- -- @@@ -162,7 +161,7 @@ -- -- @ -- >>> enumerateFromNum = lmap (\from -> (from, from + 1)) Unfold.enumerateFromThenNum--- >>> Stream.fold Fold.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9)+-- >>> Stream.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9) -- [0.9,1.9,2.9,3.8999999999999995,4.8999999999999995,5.8999999999999995] -- -- @@@ -284,7 +283,7 @@ -- specified upper limit rounded to the nearest integral value: -- -- @--- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromToFractional (0.1, 6.3)+-- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromToFractional (0.1, 6.3) -- [0.1,1.1,2.1,3.1,4.1,5.1,6.1] -- -- @@@ -389,24 +388,15 @@     -- @from@, enumerating up to 'maxBound' when the type is 'Bounded' or     -- generating an infinite stream when the type is not 'Bounded'.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom (0 :: Int)+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom (0 :: Int)     -- [0,1,2,3]     ---    -- @-    --     -- For 'Fractional' types, enumeration is numerically stable. However, no     -- overflow or underflow checks are performed.     ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom 1.1+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFrom 1.1     -- [1.1,2.1,3.1,4.1]     ---    -- @-    --     -- /Pre-release/     --     enumerateFrom :: Monad m => Unfold m a a@@ -415,27 +405,18 @@     -- @from@, enumerating the type up to the value @to@. If @to@ is smaller than     -- @from@ then an empty stream is returned.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromTo (0, 4)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (0, 4)     -- [0,1,2,3,4]     ---    -- @-    --     -- For 'Fractional' types, the last element is equal to the specified @to@     -- value after rounding to the nearest integral value.     ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4)     -- [1.1,2.1,3.1,4.1]     ---    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4.6)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromTo (1.1, 4.6)     -- [1.1,2.1,3.1,4.1,5.1]     ---    -- @-    --     -- /Pre-release/     enumerateFromTo :: Monad m => Unfold m (a, a) a @@ -445,18 +426,12 @@     -- after @from@. For 'Bounded' types the stream ends when 'maxBound' is     -- reached, for unbounded types it keeps enumerating infinitely.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0, 2)+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0, 2)     -- [0,2,4,6]     ---    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0,(-2))+    -- >>> Stream.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0,(-2))     -- [0,-2,-4,-6]     ---    -- @-    --     -- /Pre-release/     enumerateFromThen :: Monad m => Unfold m (a, a) a @@ -465,17 +440,11 @@     -- @to@. Enumeration can occur downwards or upwards depending on whether @then@     -- comes before or after @from@.     ---    -- >>> import qualified Streamly.Data.Stream as Stream-    -- >>> import qualified Streamly.Internal.Data.Unfold as Unfold-    ---    -- @-    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, 2, 6)+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, 2, 6)     -- [0,2,4,6]     ---    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, (-2), (-6))+    -- >>> Stream.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, (-2), (-6))     -- [0,-2,-4,-6]-    ---    -- @     --     -- /Pre-release/     enumerateFromThenTo :: Monad m => Unfold m (a, a, a) a
src/Streamly/Internal/Data/Unfold/Type.hs view
@@ -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'.@@ -39,17 +39,13 @@  module Streamly.Internal.Data.Unfold.Type     (-    -- * Setup-    -- | To execute the code examples provided in this module in ghci, please-    -- run the following commands first.-    ---    -- $setup-     -- * General Notes     -- $notes      -- * Type-      Unfold (..)+    -- StreamD Step type re-exported+      Step(..)+    , Unfold (..)      -- * Basic Constructors     , mkUnfoldM@@ -66,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@@ -103,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(..))@@ -115,8 +124,7 @@ import Control.Monad ((>=>)) import Data.Void (Void) import Fusion.Plugin.Types (Fuse(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Streamly.Internal.Data.Stream.Step (Step(..))  import Prelude hiding (map, mapM, concatMap, zipWith, takeWhile) @@ -150,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@@ -221,6 +229,8 @@ -- Basic constructors ------------------------------------------------------------------------------ +-- XXX unfoldWith?+ -- | Make an unfold from @step@ and @inject@ functions. -- -- /Pre-release/@@ -279,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)@@ -341,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@@ -361,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. --@@ -393,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@@ -408,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)@@ -427,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@@ -503,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. @@ -539,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 @@ -568,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 =>@@ -607,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)@@ -622,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:@@ -641,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) @@ -796,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 @@ -826,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.@@ -844,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@@ -879,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. --@@ -895,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 -------------------------------------------------------------------------------@@ -935,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@@ -1001,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
@@ -6,10 +6,10 @@ -- -- License     : BSD3 -- Maintainer  : streamly@composewell.com--- Stability   : pre-release -- Portability : GHC  module Streamly.Internal.FileSystem.Dir+{-# DEPRECATED "Please use \"Streamly.Internal.FileSystem.DirIO\" instead." #-}     (     -- * Streams       read@@ -83,153 +83,51 @@     ) 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 System.FilePath ((</>))--import qualified Streamly.Data.Unfold as UF-import qualified Streamly.Internal.Data.Unfold as UF (mapM2) 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)+import Streamly.Internal.FileSystem.Path (Path) --- 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+import qualified Streamly.Internal.FileSystem.Path as Path+import qualified Streamly.Internal.FileSystem.DirIO as DirIO+import qualified Streamly.Internal.Data.Unfold as Unfold --- | 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+import Prelude hiding (read) ----------------------------------------------------------------------------------- Read a Directory to Stream--------------------------------------------------------------------------------+--------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------- --- 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.+{-# INLINE ePathMap #-}+ePathMap :: Either Path Path -> Either FilePath FilePath+ePathMap (Left a) = Left (Path.toString a)+ePathMap (Right a) = Right (Path.toString a) --- | 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+{-# INLINE pMapUnfold #-}+pMapUnfold :: MonadCatch m => Unfold m Path Path -> Unfold m FilePath FilePath+pMapUnfold = fmap Path.toString . Unfold.lmapM Path.fromString --- | @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--}+{-# INLINE pMapUnfoldE #-}+pMapUnfoldE+    :: MonadCatch m+    => Unfold m Path (Either Path Path)+    -> Unfold m FilePath (Either FilePath FilePath)+pMapUnfoldE = fmap ePathMap . Unfold.lmapM Path.fromString --- 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.+--------------------------------------------------------------------------------+-- Functions+-------------------------------------------------------------------------------- --- XXX exception handling+#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 --  "." and ".." entries.@@ -237,16 +135,8 @@ --  /Internal/ -- {-# INLINE reader #-}-reader :: MonadIO m => Unfold m FilePath FilePath-reader =-    -- XXX use proper streaming read of the dir-      UF.filter (\x -> x /= "." && x /= "..")-    $ UF.lmapM (liftIO . Dir.getDirectoryContents) UF.fromList---- XXX 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 :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+reader = fmap Path.toString $ Unfold.lmapM Path.fromString DirIO.reader  -- | Read directories as Left and files as Right. Filter out "." and ".." -- entries.@@ -254,19 +144,13 @@ --  /Internal/ -- {-# INLINE eitherReader #-}-eitherReader :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)-eitherReader = UF.mapM2 classify reader+eitherReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)+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 => Unfold m FilePath (Either FilePath FilePath)-eitherReaderPaths =-    UF.mapM2 (\dir -> return . bimap (dir </>) (dir </>)) eitherReader+eitherReaderPaths ::(MonadIO m, MonadCatch m) => Unfold m FilePath (Either FilePath FilePath)+eitherReaderPaths = pMapUnfoldE (DirIO.eitherReaderPaths CONF)  -- -- | Read files only.@@ -274,27 +158,27 @@ --  /Internal/ -- {-# INLINE fileReader #-}-fileReader :: MonadIO m => Unfold m FilePath FilePath-fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader+fileReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+fileReader = pMapUnfold (DirIO.fileReader CONF)  -- | Read directories only. Filter out "." and ".." entries. -- --  /Internal/ -- {-# INLINE dirReader #-}-dirReader :: MonadIO m => Unfold m FilePath FilePath-dirReader = fmap (fromLeft undefined) $ UF.filter isLeft eitherReader+dirReader :: (MonadIO m, MonadCatch m) => Unfold m FilePath FilePath+dirReader = pMapUnfold (DirIO.dirReader CONF)  -- | Raw read of a directory. -- -- /Pre-release/ {-# INLINE read #-}-read :: MonadIO m => FilePath -> Stream m FilePath+read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath read = S.unfold reader  {-# DEPRECATED toStream "Please use 'read' instead" #-} {-# INLINE toStream #-}-toStream :: MonadIO m => String -> Stream m String+toStream :: (MonadIO m, MonadCatch m) => String -> Stream m String toStream = read  -- | Read directories as Left and files as Right. Filter out "." and ".."@@ -302,18 +186,18 @@ -- -- /Pre-release/ {-# INLINE readEither #-}-readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+readEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath) readEither = S.unfold eitherReader  -- | Like 'readEither' but prefix the names of the files and directories with -- the supplied directory path. {-# INLINE readEitherPaths #-}-readEitherPaths :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+readEitherPaths :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath) readEitherPaths dir = fmap (bimap (dir </>) (dir </>)) $ readEither dir  {-# DEPRECATED toEither "Please use 'readEither' instead" #-} {-# INLINE toEither #-}-toEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+toEither :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Either FilePath FilePath) toEither = readEither  -- | Read files only.@@ -321,12 +205,12 @@ --  /Internal/ -- {-# INLINE readFiles #-}-readFiles :: MonadIO m => FilePath -> Stream m FilePath+readFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath readFiles = S.unfold fileReader  {-# DEPRECATED toFiles "Please use 'readFiles' instead" #-} {-# INLINE toFiles #-}-toFiles :: MonadIO m => FilePath -> Stream m FilePath+toFiles :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath toFiles = readFiles  -- | Read directories only.@@ -334,130 +218,10 @@ --  /Internal/ -- {-# INLINE readDirs #-}-readDirs :: MonadIO m => FilePath -> Stream m FilePath+readDirs :: (MonadIO m, MonadCatch m) => FilePath -> Stream m FilePath readDirs = S.unfold dirReader  {-# DEPRECATED toDirs "Please use 'readDirs' instead" #-} {-# INLINE toDirs #-}-toDirs :: MonadIO m => String -> Stream m String+toDirs :: (MonadIO m, MonadCatch m) => String -> Stream m String toDirs = readDirs--{------------------------------------------------------------------------------------ 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.chunksOf 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 (writeNUnsafe 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
@@ -6,7 +6,6 @@ -- -- License     : BSD3 -- Maintainer  : streamly@composewell.com--- Stability   : pre-release -- Portability : GHC -- -- Read and write streams and arrays to and from files specified by their paths@@ -21,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,@@ -76,11 +76,11 @@     , fromChunks      -- ** Append To File-    , append-    , appendWith+    , writeAppend+    , writeAppendWith     -- , appendShared-    , appendArray-    , appendChunks+    , writeAppendArray+    , writeAppendChunks      -- * Deprecated     , readWithBufferOf@@ -96,25 +96,27 @@  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 import qualified System.IO as SIO  import Streamly.Data.Fold (groupsOf, drain)-import Streamly.Internal.Data.Array.Type (Array(..), writeNUnsafe)+import Streamly.Internal.Data.Array.Type (Array(..)) import Streamly.Internal.Data.Fold.Type (Fold(..)) import Streamly.Data.Stream (Stream)-import Streamly.Internal.Data.Unboxed (Unbox) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize) -import qualified Streamly.Data.Array as A+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 (chunksOf') import qualified Streamly.Internal.Data.Unfold as UF (bracketIO) import qualified Streamly.Internal.Data.Fold.Type as FL     (Step(..), snoc, reduce)@@ -149,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@@ -162,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@@ -173,6 +190,7 @@      before (x, file) =  do         h <- openFile file ReadMode+        hSetBuffering h NoBuffering         return (x, h)      after (_, h) = hClose h@@ -186,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@@ -205,16 +224,16 @@ -- /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. -- -- /Pre-release/ ---{-# INLINABLE appendArray #-}-appendArray :: FilePath -> Array a -> IO ()-appendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)+{-# INLINABLE writeAppendArray #-}+writeAppendArray :: forall (a :: Type). FilePath -> Array a -> IO ()+writeAppendArray file arr = SIO.withFile file AppendMode (`FH.putChunk` arr)  ------------------------------------------------------------------------------- -- Stream of Arrays IO@@ -337,11 +356,7 @@ -- /Pre-release/ {-# INLINE reader #-} reader :: (MonadIO m, MonadCatch m) => Unfold m FilePath Word8-reader = UF.many A.reader (usingFile FH.chunkReader)--{-# INLINE concatChunks #-}-concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a-concatChunks = S.unfoldMany A.reader+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@@ -351,7 +366,7 @@ -- {-# INLINE read #-} read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8-read file = concatChunks $ withFile file ReadMode FH.readChunks+read file = A.concat $ withFile file ReadMode FH.readChunks  {-# DEPRECATED toBytes "Please use 'read' instead"  #-} {-# INLINE toBytes #-}@@ -374,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)@@ -384,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 @@ -405,7 +420,7 @@ {-# INLINE fromBytesWith #-} fromBytesWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Stream m Word8 -> m ()-fromBytesWith n file xs = fromChunks file $ S.chunksOf n xs+fromBytesWith n file xs = fromChunks file $ IA.chunksOf' n xs  {-# DEPRECATED fromBytesWithBufferOf "Please use 'fromBytesWith' instead"  #-} {-# INLINE fromBytesWithBufferOf #-}@@ -436,24 +451,28 @@ -- -- /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+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)     step (fld, h) x = do         r <- FL.snoc fld x `MC.onException` liftIO (hClose h)         return $ FL.Partial (r, h)-    extract (Fold _ initial1 extract1, h) = do++    extract _ = return ()++    final (Fold _ initial1 _ final1, h) = do         liftIO $ hClose h         res <- initial1         case res of-            FL.Partial fs -> extract1 fs-            FL.Done fb -> return fb+            FL.Partial fs -> final1 fs+            FL.Done () -> return ()  -- | @writeWith chunkSize handle@ writes the input stream to @handle@. -- Bytes in the input stream are collected into a buffer until we have a chunk@@ -464,7 +483,7 @@ writeWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Fold m Word8 () writeWith n path =-    groupsOf n (writeNUnsafe n) (writeChunks path)+    groupsOf n (A.unsafeCreateOf' n) (writeChunks path)  {-# DEPRECATED writeWithBufferOf "Please use 'writeWith' instead"  #-} {-# INLINE writeWithBufferOf #-}@@ -488,10 +507,10 @@ -- -- /Pre-release/ ---{-# INLINE appendChunks #-}-appendChunks :: (MonadIO m, MonadCatch m)+{-# INLINE writeAppendChunks #-}+writeAppendChunks :: forall m (a :: Type). (MonadIO m, MonadCatch m)     => FilePath -> Stream m (Array a) -> m ()-appendChunks = fromChunksMode AppendMode+writeAppendChunks = fromChunksMode AppendMode  -- | Like 'append' but provides control over the write buffer. Output will -- be written to the IO device as soon as we collect the specified number of@@ -499,10 +518,11 @@ -- -- /Pre-release/ ---{-# INLINE appendWith #-}-appendWith :: (MonadIO m, MonadCatch m)+{-# INLINE writeAppendWith #-}+writeAppendWith :: (MonadIO m, MonadCatch m)     => Int -> FilePath -> Stream m Word8 -> m ()-appendWith n file xs = appendChunks file $ S.chunksOf n xs+writeAppendWith n file xs =+    writeAppendChunks file $ IA.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@@ -511,9 +531,9 @@ -- -- /Pre-release/ ---{-# INLINE append #-}-append :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()-append = appendWith defaultChunkSize+{-# INLINE writeAppend #-}+writeAppend :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+writeAppend = writeAppendWith defaultChunkSize  {- -- | Like 'append' but the file is not locked for exclusive writes.
+ src/Streamly/Internal/FileSystem/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
@@ -1,3 +1,5 @@+{-# LANGUAGE CPP #-}+ #include "inline.hs"  -- |@@ -25,6 +27,12 @@ -- module Streamly.Internal.FileSystem.Handle     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Singleton APIs       getChunk     , getChunkOf@@ -32,8 +40,8 @@      -- * Streams     , read-    , readWith-    , readChunksWith+    , readWith       -- readConcatChunksOf+    , readChunksWith -- readChunksOf     , readChunks      -- * Unfolds@@ -51,10 +59,10 @@     -- , writeUtf8ByLines     -- , writeByFrames     -- , writeLines-    , writeWith+    , writeWith -- writeChunksOf     , writeChunks-    , writeChunksWith-    , writeMaybesWith+    , writeChunksWith -- writeCompactChunksOf+    , writeMaybesWith -- writeCompactJustsOf      -- * Refolds     , writer@@ -113,9 +121,10 @@ 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.Unboxed (Unbox)+import Streamly.Internal.Data.Unbox (Unbox) import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek) import Prelude hiding (read) @@ -123,36 +132,23 @@ import Streamly.Internal.Data.Refold.Type (Refold(..)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.Data.Array.Type-       (Array(..), writeNUnsafe, unsafeFreezeWithShrink, byteLength)-import Streamly.Internal.Data.Stream.StreamD.Type (Stream)-import Streamly.Internal.Data.Stream.Chunked (lpackArraysChunksOf)+       (Array(..), unsafeFreezeWithShrink, byteLength)+import Streamly.Internal.Data.Stream.Type (Stream) -- import Streamly.String (encodeUtf8, decodeUtf8, foldLines) import Streamly.Internal.System.IO (defaultChunkSize)  import qualified Streamly.Data.Fold as FL-import qualified Streamly.Data.Array as A-import qualified Streamly.Internal.Data.Array.Type as A-import qualified Streamly.Internal.Data.Stream.Chunked as AS-import qualified Streamly.Internal.Data.Array.Mut.Type as MArray+import qualified Streamly.Internal.Data.Array as A+import qualified Streamly.Internal.Data.MutArray.Type as MArray import qualified Streamly.Internal.Data.Refold.Type as Refold import qualified Streamly.Internal.Data.Fold.Type as FL(refoldMany)-import qualified Streamly.Internal.Data.Stream.StreamD as S-import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream as S+import qualified Streamly.Internal.Data.Stream as D     (Stream(..), Step(..)) import qualified Streamly.Internal.Data.Unfold as UF-import qualified Streamly.Internal.Data.Stream.StreamK.Type as K (mkStream)+import qualified Streamly.Internal.Data.StreamK.Type as K (mkStream) --- $setup--- >>> import qualified Streamly.Data.Array as Array--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Data.Unfold as Unfold--- >>> import qualified Streamly.Data.Stream as Stream------ >>> import qualified Streamly.Internal.Data.Array.Type as Array (writeNUnsafe)--- >>> import qualified Streamly.Internal.Data.Stream as Stream--- >>> import qualified Streamly.Internal.Data.Unfold as Unfold (first)--- >>> import qualified Streamly.Internal.FileSystem.Handle as Handle--- >>> import qualified Streamly.Internal.System.IO as IO (defaultChunkSize)+#include "DocTestFileSystemHandle.hs"  ------------------------------------------------------------------------------- -- References@@ -171,6 +167,8 @@ -- Array IO (Input) ------------------------------------------------------------------------------- +-- XXX add an API that compacts the arrays to an exact size.+ -- | Read a 'ByteArray' consisting of one or more bytes from a file handle. If -- no data is available on the handle it blocks until at least one byte becomes -- available. If any data is available then it immediately returns that data@@ -180,14 +178,10 @@ {-# INLINABLE getChunk #-} getChunk :: MonadIO m => Int -> Handle -> m (Array Word8) getChunk size h = liftIO $ do-    arr <- MArray.newPinnedBytes size     -- ptr <- mallocPlainForeignPtrAlignedBytes size (alignment (undefined :: Word8))-    MArray.asPtrUnsafe 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@@ -327,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' --@@ -340,38 +334,34 @@ readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8 readWithBufferOf = readerWith -{-# INLINE concatChunks #-}-concatChunks :: (Monad m, Unbox a) => Stream m (Array a) -> Stream m a-concatChunks = S.unfoldMany A.reader- -- | @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 #-} readWith :: MonadIO m => Int -> Handle -> Stream m Word8-readWith size h = concatChunks $ readChunksWith size h+readWith size h = A.concat $ readChunksWith size h  -- | Unfolds a file handle into a byte stream. IO requests to the device are -- performed in sizes of -- 'Streamly.Internal.Data.Array.Type.defaultChunkSize'. ----- >>> reader = Unfold.many Array.reader 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 #-} read :: MonadIO m => Handle -> Stream m Word8-read = concatChunks . readChunks+read = A.concat . readChunks  ------------------------------------------------------------------------------- -- Writing@@ -384,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.asPtrUnsafe arr $ \ptr ->-    liftIO $ hPutBuf h ptr aLen--    where--    -- XXX We should have the length passed by asPtrUnsafe itself.-    aLen = A.byteLength arr+putChunk h arr = A.unsafePinnedAsPtr arr $ \ptr byteLen ->+    liftIO $ hPutBuf h ptr byteLen  ------------------------------------------------------------------------------- -- Stream of Arrays IO@@ -408,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@@ -423,17 +409,17 @@ {-# INLINE putChunksWith #-} putChunksWith :: (MonadIO m, Unbox a)     => Int -> Handle -> Stream m (Array a) -> m ()-putChunksWith n h xs = putChunks h $ AS.compact n xs+putChunksWith n h xs = putChunks h $ A.compactMax n xs +-- > putBytesWith n h m = Handle.putChunks h $ A.pinnedChunksOf n m+ -- | @putBytesWith bufsize handle stream@ writes @stream@ to @handle@ -- in chunks of @bufsize@.  A write is performed to the IO device as soon as we -- collect the required input size. ----- >>> putBytesWith n h m = Handle.putChunks h $ Stream.chunksOf n m--- {-# INLINE putBytesWith #-} putBytesWith :: MonadIO m => Int -> Handle -> Stream m Word8 -> m ()-putBytesWith n h m = putChunks h $ A.chunksOf n m+putBytesWith n h m = putChunks h $ A.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.@@ -453,18 +439,16 @@ -- 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 --- XXX lpackArraysChunksOf should be written idiomatically- -- | @writeChunksWith 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@@ -474,7 +458,10 @@ {-# INLINE writeChunksWith #-} writeChunksWith :: (MonadIO m, Unbox a)     => Int -> Handle -> Fold m (Array a) ()-writeChunksWith n h = lpackArraysChunksOf 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' --@@ -492,17 +479,17 @@ -- 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 -- of @reqSize@ and then written to the IO device. ----- >>> writeWith n h = Fold.groupsOf n (Array.writeNUnsafe n) (Handle.writeChunks h)+-- >>> writeWith n h = Fold.groupsOf n (Array.unsafeCreateOf n) (Handle.writeChunks h) -- {-# INLINE writeWith #-} writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()-writeWith n h = FL.groupsOf n (writeNUnsafe n) (writeChunks h)+writeWith n h = FL.groupsOf n (A.unsafeCreateOf' n) (writeChunks h)  -- | Same as 'writeWith' --@@ -520,7 +507,7 @@ writeMaybesWith :: (MonadIO m )     => Int -> Handle -> Fold m (Maybe Word8) () writeMaybesWith n h =-    let writeNJusts = FL.lmap fromJust $ A.writeN n+    let writeNJusts = FL.lmap fromJust $ A.createOf' n         writeOnNothing = FL.takeEndBy_ isNothing writeNJusts     in FL.many writeOnNothing (writeChunks h) @@ -530,7 +517,7 @@ {-# INLINE writerWith #-} writerWith :: MonadIO m => Int -> Refold m Handle Word8 () writerWith n =-    FL.refoldMany (FL.take n $ writeNUnsafe n) chunkWriter+    FL.refoldMany (FL.take n $ 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
@@ -0,0 +1,129 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.FileSystem.Path+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Portability : GHC+--+-- == References+--+--  * 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+--+-- == Windows and Posix 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.+--+-- == File System as Tree vs Graph+--+-- 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.+--+-- == Rooted and Branch paths+--+-- 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.+--+-- 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.+--+-- 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.+--+-- Rooted paths can never be appended to any other path whereas a branch can be+-- appended.+--+-- == Comparing Paths+--+-- 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.+--+-- == Implicit Roots (.)+--+-- 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.+--+-- @./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.+--+-- The same arguments apply to paths with implicit drive on Windows.+--+-- 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.+--+-- 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.+--+-- 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.+--+-- Note that a trailing . or a . in the middle of a path is different as it+-- refers to a known name.+--+-- == Ambiguous References (..)+--+-- ".." 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.+--+-- 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.+--++#define IS_PORTABLE++#if defined(mingw32_HOST_OS) || defined(__MINGW32__)+#define IS_WINDOWS+#include "Streamly/Internal/FileSystem/WindowsPath.hs"+#else+#include "Streamly/Internal/FileSystem/PosixPath.hs"+#endif
+ src/Streamly/Internal/FileSystem/Path/Common.hs view
@@ -0,0 +1,1564 @@+{-# 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 =+    -- The encoded array may be longer than the char count. We are encoding it+    -- twice, but it may still be cheaper than reallocating the array or+    -- oversizing the array.+    let n = runIdentity $ Stream.fold Fold.length (encode 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 capi unsafe "sys/stat.h lstat"+    c_lstat :: CString -> Ptr CStat -> IO CInt++foreign import capi unsafe "sys/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/Serialize/FromBytes.hs 
@@ -1,394 +0,0 @@--- |--- Module      : Streamly.Internal.Serialize.FromBytes--- Copyright   : (c) 2020 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Decode Haskell data types from byte streams.--module Streamly.Internal.Serialize.FromBytes-    (-    -- * Type class-      FromBytes (..)--    -- * Decoders-    , unit-    , bool-    , ordering-    , eqWord8 -- XXX rename to word8Eq-    , word8-    , word16be-    , word16le-    , word32be-    , word32le-    , word64be-    , word64le-    , word64host-    , int8-    , int16be-    , int16le-    , int32be-    , int32le-    , int64be-    , int64le-    , float32be-    , float32le-    , double64be-    , double64le-    , charLatin1-    )-where--import Control.Monad.IO.Class (MonadIO)-import Data.Bits ((.|.), unsafeShiftL)-import Data.Char (chr)-import Data.Int (Int8, Int16, Int32, Int64)-import GHC.Float (castWord32ToFloat, castWord64ToDouble)-import Data.Word (Word8, Word16, Word32, Word64)-import Streamly.Internal.Data.Parser (Parser)-import Streamly.Internal.Data.Maybe.Strict (Maybe'(..))-import Streamly.Internal.Data.Tuple.Strict (Tuple' (..))-import qualified Streamly.Data.Array as A-import qualified Streamly.Internal.Data.Array as A-    (unsafeIndex, castUnsafe)-import qualified Streamly.Internal.Data.Parser as PR-    (fromPure, either, satisfy, takeEQ)-import qualified Streamly.Internal.Data.Parser.ParserD as PRD-    (Parser(..), Initial(..), Step(..))---- Note: The () type does not need to have an on-disk representation in theory.--- But we use a concrete representation for it so that we count how many ()--- types we have. Or when we have an array of units the array a concrete--- length.---- | A value of type '()' is encoded as @0@ in binary encoding.------ @--- 0 ==> ()--- @------ /Pre-release/----{-# INLINE unit #-}-unit :: Monad m => Parser Word8 m ()-unit = eqWord8 0 *> PR.fromPure ()--{-# INLINE word8ToBool #-}-word8ToBool :: Word8 -> Either String Bool-word8ToBool 0 = Right False-word8ToBool 1 = Right True-word8ToBool w = Left ("Invalid Bool encoding " ++ Prelude.show w)---- | A value of type 'Bool' is encoded as follows in binary encoding.------ @--- 0 ==> False--- 1 ==> True--- @------ /Pre-release/----{-# INLINE bool #-}-bool :: Monad m => Parser Word8 m Bool-bool = PR.either word8ToBool--{-# INLINE word8ToOrdering #-}-word8ToOrdering :: Word8 -> Either String Ordering-word8ToOrdering 0 = Right LT-word8ToOrdering 1 = Right EQ-word8ToOrdering 2 = Right GT-word8ToOrdering w = Left ("Invalid Ordering encoding " ++ Prelude.show w)---- | A value of type 'Ordering' is encoded as follows in binary encoding.------ @--- 0 ==> LT--- 1 ==> EQ--- 2 ==> GT--- @------ /Pre-release/----{-# INLINE ordering #-}-ordering :: Monad m => Parser Word8 m Ordering-ordering = PR.either word8ToOrdering---- XXX should go in a Word8 parser module?--- | Accept the input byte only if it is equal to the specified value.------ /Pre-release/----{-# INLINE eqWord8 #-}-eqWord8 :: Monad m => Word8 -> Parser Word8 m Word8-eqWord8 b = PR.satisfy (== b)---- | Accept any byte.------ /Pre-release/----{-# INLINE word8 #-}-word8 :: Monad m => Parser Word8 m Word8-word8 = PR.satisfy (const True)---- | Big endian (MSB first) Word16-{-# INLINE word16beD #-}-word16beD :: Monad m => PRD.Parser Word8 m Word16-word16beD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial Nothing'--    step Nothing' a =-        -- XXX We can use a non-failing parser or a fold so that we do not-        -- have to buffer for backtracking which is inefficient.-        return $ PRD.Continue 0 (Just' (fromIntegral a `unsafeShiftL` 8))-    step (Just' w) a =-        return $ PRD.Done 0 (w .|. fromIntegral a)--    extract _ = return $ PRD.Error "word16be: end of input"---- | Parse two bytes as a 'Word16', the first byte is the MSB of the Word16 and--- second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word16be #-}-word16be :: Monad m => Parser Word8 m Word16-word16be = word16beD---- | Little endian (LSB first) Word16-{-# INLINE word16leD #-}-word16leD :: Monad m => PRD.Parser Word8 m Word16-word16leD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial Nothing'--    step Nothing' a =-        return $ PRD.Continue 0 (Just' (fromIntegral a))-    step (Just' w) a =-        return $ PRD.Done 0 (w .|. fromIntegral a `unsafeShiftL` 8)--    extract _ = return $ PRD.Error "word16le: end of input"---- | Parse two bytes as a 'Word16', the first byte is the LSB of the Word16 and--- second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE word16le #-}-word16le :: Monad m => Parser Word8 m Word16-word16le = word16leD---- | Big endian (MSB first) Word32-{-# INLINE word32beD #-}-word32beD :: Monad m => PRD.Parser Word8 m Word32-word32beD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 24--    step (Tuple' w sh) a = return $-        if sh /= 0-        then-            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-             in PRD.Continue 0 (Tuple' w1 (sh - 8))-        else PRD.Done 0 (w .|. fromIntegral a)--    extract _ = return $ PRD.Error "word32beD: end of input"---- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32be #-}-word32be :: Monad m => Parser Word8 m Word32-word32be = word32beD---- | Little endian (LSB first) Word32-{-# INLINE word32leD #-}-word32leD :: Monad m => PRD.Parser Word8 m Word32-word32leD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 0--    step (Tuple' w sh) a = return $-        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-         in if sh /= 24-            then PRD.Continue 0 (Tuple' w1 (sh + 8))-            else PRD.Done 0 w1--    extract _ = return $ PRD.Error "word32leD: end of input"---- | Parse four bytes as a 'Word32', the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32le #-}-word32le :: Monad m => Parser Word8 m Word32-word32le = word32leD---- | Big endian (MSB first) Word64-{-# INLINE word64beD #-}-word64beD :: Monad m => PRD.Parser Word8 m Word64-word64beD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 56--    step (Tuple' w sh) a = return $-        if sh /= 0-        then-            let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-             in PRD.Continue 0 (Tuple' w1 (sh - 8))-        else PRD.Done 0 (w .|. fromIntegral a)--    extract _ = return $ PRD.Error "word64beD: end of input"---- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64be #-}-word64be :: Monad m => Parser Word8 m Word64-word64be = word64beD---- | Little endian (LSB first) Word64-{-# INLINE word64leD #-}-word64leD :: Monad m => PRD.Parser Word8 m Word64-word64leD = PRD.Parser step initial extract--    where--    initial = return $ PRD.IPartial $ Tuple' 0 0--    step (Tuple' w sh) a = return $-        let w1 = w .|. (fromIntegral a `unsafeShiftL` sh)-         in if sh /= 56-            then PRD.Continue 0 (Tuple' w1 (sh + 8))-            else PRD.Done 0 w1--    extract _ = return $ PRD.Error "word64leD: end of input"---- | Parse eight bytes as a 'Word64', the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64le #-}-word64le :: Monad m => Parser Word8 m Word64-word64le = word64leD--{-# INLINE int8 #-}-int8 :: Monad m => Parser Word8 m Int8-int8 = fromIntegral <$> word8---- | Parse two bytes as a 'Int16', the first byte is the MSB of the Int16 and--- second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int16be #-}-int16be :: Monad m => Parser Word8 m Int16-int16be = fromIntegral <$> word16be---- | Parse two bytes as a 'Int16', the first byte is the LSB of the Int16 and--- second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE int16le #-}-int16le :: Monad m => Parser Word8 m Int16-int16le = fromIntegral <$> word16le---- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int32be #-}-int32be :: Monad m => Parser Word8 m Int32-int32be = fromIntegral <$> word32be---- | Parse four bytes as a 'Int32', the first byte is the MSB of the Int32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int32le #-}-int32le :: Monad m => Parser Word8 m Int32-int32le = fromIntegral <$> word32le---- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int64be #-}-int64be :: Monad m => Parser Word8 m Int64-int64be = fromIntegral <$> word64be---- | Parse eight bytes as a 'Int64', the first byte is the MSB of the Int64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int64le #-}-int64le :: Monad m => Parser Word8 m Int64-int64le = fromIntegral <$> word64le--{-# INLINE float32be #-}-float32be :: MonadIO m => Parser Word8 m Float-float32be = castWord32ToFloat <$> word32be--{-# INLINE float32le #-}-float32le :: MonadIO m => Parser Word8 m Float-float32le = castWord32ToFloat <$> word32le--{-# INLINE double64be #-}-double64be :: MonadIO m => Parser Word8 m Double-double64be =  castWord64ToDouble <$> word64be--{-# INLINE double64le #-}-double64le :: MonadIO m => Parser Word8 m Double-double64le = castWord64ToDouble <$> word64le---- | Accept any byte.------ /Pre-release/----{-# INLINE charLatin1 #-}-charLatin1 :: Monad m => Parser Word8 m Char-charLatin1 = fmap (chr . fromIntegral) word8------------------------------------------------------------------------------------ Host byte order------------------------------------------------------------------------------------ | Parse eight bytes as a 'Word64' in the host byte order.------ /Pre-release/----{-# INLINE word64host #-}-word64host :: MonadIO m => Parser Word8 m Word64-word64host =-    fmap (A.unsafeIndex 0 . A.castUnsafe) $ PR.takeEQ 8 (A.writeN 8)------------------------------------------------------------------------------------ Type class----------------------------------------------------------------------------------class FromBytes a where-    -- | Decode a byte stream to a Haskell type.-    fromBytes :: Parser Word8 m a
− src/Streamly/Internal/Serialize/ToBytes.hs 
@@ -1,374 +0,0 @@--- |--- Module      : Streamly.Internal.Serialize.ToBytes--- Copyright   : (c) 2022 Composewell Technologies--- License     : BSD-3-Clause--- Maintainer  : streamly@composewell.com--- Stability   : pre-release--- Portability : GHC------ Encode Haskell data types to byte streams.--module Streamly.Internal.Serialize.ToBytes-    (-    -- * Type class-      ToBytes (..)--    -- * Encoders-    , unit-    , bool-    , ordering-    , word8-    , word16be-    , word16le-    , word32be-    , word32le-    , word64be-    , word64le-    , word64host-    , int8-    , int16be-    , int16le-    , int32be-    , int32le-    , int64be-    , int64le-    , float32be-    , float32le-    , double64be-    , double64le-    , charLatin1-    , charUtf8-    )-where--#include "MachDeps.h"--import Data.Bits (shiftR)-import Data.Char (ord)-import Data.Int (Int8, Int16, Int32, Int64)-import Data.Word (Word8, Word16, Word32, Word64)-import GHC.Float (castDoubleToWord64, castFloatToWord32)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamD (Step(..))-import Streamly.Internal.Unicode.Stream (readCharUtf8)--import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD as D---- XXX Use StreamD directly?---- | A value of type '()' is encoded as @0@ in binary encoding.------ @--- 0 ==> ()--- @------ /Pre-release/----{-# INLINE unit #-}-unit :: Applicative m => Stream m Word8-unit = Stream.fromPure 0--{-# INLINE boolToWord8 #-}-boolToWord8 :: Bool -> Word8-boolToWord8 False = 0-boolToWord8 True = 1---- | A value of type 'Bool' is encoded as follows in binary encoding.------ @--- 0 ==> False--- 1 ==> True--- @------ /Pre-release/----{-# INLINE bool #-}-bool :: Applicative m => Bool -> Stream m Word8-bool = Stream.fromPure . boolToWord8--{-# INLINE orderingToWord8 #-}-orderingToWord8 :: Ordering -> Word8-orderingToWord8 LT = 0-orderingToWord8 EQ = 1-orderingToWord8 GT = 2---- | A value of type 'Ordering' is encoded as follows in binary encoding.------ @--- 0 ==> LT--- 1 ==> EQ--- 2 ==> GT--- @------ /Pre-release/----{-# INLINE ordering #-}-ordering :: Applicative m => Ordering -> Stream m Word8-ordering = Stream.fromPure . orderingToWord8---- | Stream a 'Word8'.------ /Pre-release/----{-# INLINE word8 #-}-word8 :: Applicative m => Word8 -> Stream m Word8-word8 = Stream.fromPure--data W16State = W16B1 | W16B2 | W16Done--{-# INLINE word16beD #-}-word16beD :: Applicative m => Word16 -> D.Stream m Word8-word16beD w = D.Stream step W16B1--    where--    step _ W16B1 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16B2-    step _ W16B2 = pure $ Yield (fromIntegral w :: Word8) W16Done-    step _ W16Done = pure Stop---- | Stream a 'Word16' as two bytes, the first byte is the MSB of the Word16--- and second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word16be #-}-word16be :: Monad m => Word16 -> Stream m Word8-word16be = word16beD---- | Little endian (LSB first) Word16-{-# INLINE word16leD #-}-word16leD :: Applicative m => Word16 -> D.Stream m Word8-word16leD w = D.Stream step W16B1--    where--    step _ W16B1 = pure $ Yield (fromIntegral w :: Word8) W16B2-    step _ W16B2 = pure $ Yield (fromIntegral (shiftR w 8) :: Word8) W16Done-    step _ W16Done = pure Stop---- | Stream a 'Word16' as two bytes, the first byte is the LSB of the Word16--- and second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE word16le #-}-word16le :: Monad m => Word16 -> Stream m Word8-word16le = word16leD--data W32State = W32B1 | W32B2 | W32B3 | W32B4 | W32Done---- | Big endian (MSB first) Word32-{-# INLINE word32beD #-}-word32beD :: Applicative m => Word32 -> D.Stream m Word8-word32beD w = D.Stream step W32B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W32B1 = yield 24 W32B2-    step _ W32B2 = yield 16 W32B3-    step _ W32B3 = yield 8 W32B4-    step _ W32B4 = pure $ Yield (fromIntegral w :: Word8) W32Done-    step _ W32Done = pure Stop---- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32be #-}-word32be :: Monad m => Word32 -> Stream m Word8-word32be = word32beD---- | Little endian (LSB first) Word32-{-# INLINE word32leD #-}-word32leD :: Applicative m => Word32 -> D.Stream m Word8-word32leD w = D.Stream step W32B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W32B1 = pure $ Yield (fromIntegral w :: Word8) W32B2-    step _ W32B2 = yield 8 W32B3-    step _ W32B3 = yield 16 W32B4-    step _ W32B4 = yield 24 W32Done-    step _ W32Done = pure Stop---- | Stream a 'Word32' as four bytes, the first byte is the MSB of the Word32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word32le #-}-word32le :: Monad m => Word32 -> Stream m Word8-word32le = word32leD--data W64State =-    W64B1 | W64B2 | W64B3 | W64B4 | W64B5 | W64B6 | W64B7 | W64B8 | W64Done---- | Big endian (MSB first) Word64-{-# INLINE word64beD #-}-word64beD :: Applicative m => Word64 -> D.Stream m Word8-word64beD w = D.Stream step W64B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W64B1 = yield 56 W64B2-    step _ W64B2 = yield 48 W64B3-    step _ W64B3 = yield 40 W64B4-    step _ W64B4 = yield 32 W64B5-    step _ W64B5 = yield 24 W64B6-    step _ W64B6 = yield 16 W64B7-    step _ W64B7 = yield  8 W64B8-    step _ W64B8 = pure $ Yield (fromIntegral w :: Word8) W64Done-    step _ W64Done = pure Stop---- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64be #-}-word64be :: Monad m => Word64 -> Stream m Word8-word64be = word64beD---- | Little endian (LSB first) Word64-{-# INLINE word64leD #-}-word64leD :: Applicative m => Word64 -> D.Stream m Word8-word64leD w = D.Stream step W64B1--    where--    yield n s = pure $ Yield (fromIntegral (shiftR w n) :: Word8) s--    step _ W64B1 = pure $ Yield (fromIntegral w :: Word8) W64B2-    step _ W64B2 = yield  8 W64B3-    step _ W64B3 = yield 16 W64B4-    step _ W64B4 = yield 24 W64B5-    step _ W64B5 = yield 32 W64B6-    step _ W64B6 = yield 40 W64B7-    step _ W64B7 = yield 48 W64B8-    step _ W64B8 = yield 56 W64Done-    step _ W64Done = pure Stop---- | Stream a 'Word64' as eight bytes, the first byte is the MSB of the Word64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE word64le #-}-word64le :: Monad m => Word64 -> Stream m Word8-word64le = word64leD--{-# INLINE int8 #-}-int8 :: Applicative m => Int8 -> Stream m Word8-int8 i = word8 (fromIntegral i :: Word8)---- | Stream a 'Int16' as two bytes, the first byte is the MSB of the Int16--- and second byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int16be #-}-int16be :: Monad m => Int16 -> Stream m Word8-int16be i = word16be (fromIntegral i :: Word16)---- | Stream a 'Int16' as two bytes, the first byte is the LSB of the Int16--- and second byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE int16le #-}-int16le :: Monad m => Int16 -> Stream m Word8-int16le i = word16le (fromIntegral i :: Word16)---- | Stream a 'Int32' as four bytes, the first byte is the MSB of the Int32--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int32be #-}-int32be :: Monad m => Int32 -> Stream m Word8-int32be i = word32be (fromIntegral i :: Word32)--{-# INLINE int32le #-}-int32le :: Monad m => Int32 -> Stream m Word8-int32le i = word32le (fromIntegral i :: Word32)---- | Stream a 'Int64' as eight bytes, the first byte is the MSB of the Int64--- and last byte is the LSB (big endian representation).------ /Pre-release/----{-# INLINE int64be #-}-int64be :: Monad m => Int64 -> Stream m Word8-int64be i = word64be (fromIntegral i :: Word64)---- | Stream a 'Int64' as eight bytes, the first byte is the LSB of the Int64--- and last byte is the MSB (little endian representation).------ /Pre-release/----{-# INLINE int64le #-}-int64le :: Monad m => Int64 -> Stream m Word8-int64le i = word64le (fromIntegral i :: Word64)---- | Big endian (MSB first) Float-{-# INLINE float32be #-}-float32be :: Monad m => Float -> Stream m Word8-float32be = word32beD . castFloatToWord32---- | Little endian (LSB first) Float-{-# INLINE float32le #-}-float32le :: Monad m => Float -> Stream m Word8-float32le = word32leD . castFloatToWord32---- | Big endian (MSB first) Double-{-# INLINE double64be #-}-double64be :: Monad m => Double -> Stream m Word8-double64be = word64beD . castDoubleToWord64---- | Little endian (LSB first) Double-{-# INLINE double64le #-}-double64le :: Monad m => Double -> Stream m Word8-double64le = word64leD . castDoubleToWord64---- | Encode a Unicode character to stream of bytes in 0-255 range.----{-# INLINE charLatin1 #-}-charLatin1 :: Applicative m => Char -> Stream m Word8-charLatin1 = Stream.fromPure . fromIntegral . ord--{-# INLINE charUtf8 #-}-charUtf8 :: Monad m => Char -> Stream m Word8-charUtf8 = Stream.unfold readCharUtf8------------------------------------------------------------------------------------ Host byte order------------------------------------------------------------------------------------ | Stream a 'Word64' as eight bytes in the host byte order.------ /Pre-release/----{-# INLINE word64host #-}-word64host :: Monad m => Word64 -> Stream m Word8-word64host =-#ifdef WORDS_BIGENDIAN-    word64be-#else-    word64le-#endif------------------------------------------------------------------------------------ Type class----------------------------------------------------------------------------------class ToBytes a where-    -- | Convert a Haskell type to a byte stream.-    toBytes :: a -> Stream m Word8
src/Streamly/Internal/Unicode/Array.hs view
@@ -14,6 +14,12 @@ -- module Streamly.Internal.Unicode.Array     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Streams of Strings       lines     , words@@ -49,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.@@ -61,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
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.Parser -- Copyright   : (c) 2021 Composewell Technologies@@ -12,6 +13,12 @@  module Streamly.Internal.Unicode.Parser     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Generic       char     , charIgnoreCase@@ -47,16 +54,23 @@      -- * Numeric     , signed+    , number+    , doubleParser     , double     , decimal     , hexadecimal++    -- * Utilities+    , mkDouble     ) where  import Control.Applicative (Alternative(..))-import Data.Bits (Bits, (.|.), shiftL)+import Data.Bits (Bits, (.|.), shiftL, (.&.)) import Data.Char (ord)-import Streamly.Internal.Data.Parser (Parser)+import Data.Ratio ((%))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Parser (Parser(..), Initial(..), Step(..), Final(..))  import qualified Data.Char as Char import qualified Streamly.Data.Fold as Fold@@ -69,6 +83,8 @@     , dropWhile     ) +#include "DocTestUnicodeParser.hs"+ -------------------------------------------------------------------------------- -- Character classification --------------------------------------------------------------------------------@@ -263,36 +279,349 @@ signed :: (Num a, Monad m) => Parser Char m a -> Parser Char m a signed p = (negate <$> (char '-' *> p)) <|> (char '+' *> p) <|> p --- | Parse a 'Double'.+-- XXX Change Multiplier to Sign+type Multiplier = Int++-- XXX We can use Int instead of Integer to make it twice as fast. But then we+-- will have to truncate the significant digits before overflow occurs.+type Number = Integer+type DecimalPlaces = Int+type PowerMultiplier = Int+type Power = Int++{-# ANN type ScientificParseState Fuse #-}+data ScientificParseState+  = SPInitial+  | SPSign !Multiplier+  | SPAfterSign !Multiplier !Number+  | SPDot !Multiplier !Number+  | SPAfterDot !Multiplier !Number !DecimalPlaces+  | SPExponent !Multiplier !Number !DecimalPlaces+  | SPExponentWithSign !Multiplier !Number !DecimalPlaces !PowerMultiplier+  | SPAfterExponent !Multiplier !Number !DecimalPlaces !PowerMultiplier !Power++-- XXX See https://hackage.haskell.org/package/integer-conversion for large+-- integers.++-- | A generic parser for scientific notation of numbers. Returns (mantissa,+-- exponent) tuple. The result can be mapped to 'Double' or any other number+-- representation e.g. @Scientific@. ----- This parser accepts an optional leading sign character, followed by--- at most one decimal digit.  The syntax is similar to that accepted by--- the 'read' function, with the exception that a trailing @\'.\'@ is--- consumed.+-- For example, using the @scientific@ package:+-- >> parserScientific = uncurry Data.Scientific.scientific <$> 'number'+{-# INLINE number #-}+number :: Monad m => Parser Char m (Integer, Int)+number =  Parser (\s a -> return $ step s a) initial (return . extract)++    where++    intToInteger :: Int -> Integer+    intToInteger = fromIntegral++    combineNum buf num = buf * 10 + num++    {-# INLINE initial #-}+    initial = pure $ IPartial SPInitial++    exitSPInitial msg =+        "number: expecting sign or decimal digit, got " ++ msg+    exitSPSign msg =+        "number: expecting decimal digit, got " ++ msg+    exitSPAfterSign multiplier num = (intToInteger multiplier * num, 0)+    exitSPAfterDot multiplier num decimalPlaces =+        ( intToInteger multiplier * num+        , -decimalPlaces+        )+    exitSPAfterExponent mult num decimalPlaces powerMult powerNum =+        let e = powerMult * powerNum - decimalPlaces+         in (intToInteger mult * num, e)++    {-# INLINE step #-}+    step SPInitial val =+        case val of+          '+' -> SContinue 1 (SPSign 1)+          '-' -> SContinue 1 (SPSign (-1))+          _ -> do+              let num = ord val - 48+              if num >= 0 && num <= 9+              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 SPartial 1 $ SPAfterSign multiplier (intToInteger num)+            else SError $ exitSPSign $ show val+    step (SPAfterSign multiplier buf) val =+        case val of+            '.' -> 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+                        SPartial 1+                            $ SPAfterSign multiplier (combineNum buf (intToInteger num))+                    else SDone 0 $ exitSPAfterSign multiplier buf+    step (SPDot multiplier buf) val =+        let num = ord val - 48+         in if num >= 0 && num <= 9+            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' -> 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+                        SPartial 1+                            $ SPAfterDot+                                  multiplier+                                  (combineNum buf (intToInteger num))+                                  (decimalPlaces + 1)+                    else SDone 0 $ exitSPAfterDot multiplier buf decimalPlaces+    step (SPExponent multiplier buf decimalPlaces) val =+        case val of+          '+' -> 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 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 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+                SPartial 1+                    $ SPAfterExponent+                          mult num decimalPlaces powerMult (combineNum buf n)+            else+                SDone 0+                    $ exitSPAfterExponent mult num decimalPlaces powerMult buf++    {-# INLINE extract #-}+    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) =+        FDone 0 $ exitSPAfterDot mult num decimalPlaces+    extract (SPExponent mult num decimalPlaces) =+        FDone (-1) $ exitSPAfterDot mult num decimalPlaces+    extract (SPExponentWithSign mult num decimalPlaces _) =+        FDone (-2) $ exitSPAfterDot mult num decimalPlaces+    extract (SPAfterExponent mult num decimalPlaces powerMult powerNum) =+        FDone 0 $ exitSPAfterExponent mult num decimalPlaces powerMult powerNum++type MantissaInt = Int+type OverflowPower = Int++{-# ANN type DoubleParseState Fuse #-}+data DoubleParseState+  = DPInitial+  | DPSign !Multiplier+  | DPAfterSign !Multiplier !MantissaInt !OverflowPower+  | DPDot !Multiplier !MantissaInt !OverflowPower+  | DPAfterDot !Multiplier !MantissaInt !OverflowPower+  | DPExponent !Multiplier !MantissaInt !OverflowPower+  | DPExponentWithSign !Multiplier !MantissaInt !OverflowPower !PowerMultiplier+  | DPAfterExponent !Multiplier !MantissaInt !OverflowPower !PowerMultiplier !Power++-- | A fast, custom parser for double precision flaoting point numbers. Returns+-- (mantissa, exponent) tuple. This is much faster than 'number' because it+-- assumes the number will fit in a 'Double' type and uses 'Int' representation+-- to store mantissa. ----- === Examples+-- Number larger than 'Double' may overflow. Int overflow is not checked in the+-- exponent. ----- Examples with behaviour identical to 'read', if you feed an empty--- continuation to the first result:+{-# INLINE doubleParser #-}+doubleParser :: Monad m => Parser Char m (Int, Int)+doubleParser =  Parser (\s a -> return $ step s a) initial (return . extract)++    where++    -- XXX Assuming Int = Int64++    -- Up to 58 bits Int won't overflow+    -- ghci> (2^59-1)*10+9 :: Int+    -- 5764607523034234879+    mask :: Word+    mask = 0x7c00000000000000 -- 58 bits, ignore the sign bit++    {-# INLINE combineNum #-}+    combineNum :: Int -> Int -> Int -> (Int, Int)+    combineNum mantissa power num =+         if fromIntegral mantissa .&. mask == 0+         then (mantissa * 10 + num, power)+         else (mantissa, power + 1)++    {-# INLINE initial #-}+    initial = pure $ IPartial DPInitial++    exitDPInitial msg =+        "number: expecting sign or decimal digit, got " ++ msg+    exitDPSign msg =+        "number: expecting decimal digit, got " ++ msg+    exitDPAfterSign multiplier num opower = (fromIntegral multiplier * num, opower)+    exitDPAfterDot multiplier num opow =+        (fromIntegral multiplier * num , opow)+    exitDPAfterExponent mult num opow powerMult powerNum =+        (fromIntegral mult * num, opow + powerMult * powerNum)++    {-# INLINE step #-}+    step DPInitial val =+        case val of+          '+' -> SContinue 1 (DPSign 1)+          '-' -> SContinue 1 (DPSign (-1))+          _ -> do+              let num = ord val - 48+              if num >= 0 && num <= 9+              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 SPartial 1 $ DPAfterSign multiplier num 0+            else SError $ exitDPSign $ show val+    step (DPAfterSign multiplier buf opower) val =+        case val of+            '.' -> 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 SPartial 1+                            $ DPAfterSign multiplier buf1 power1+                    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 SPartial 1 $ DPAfterDot multiplier buf1 (power1 - 1)+            else SDone (-1) $ exitDPAfterSign multiplier buf opower+    step (DPAfterDot multiplier buf opower) val =+        case val of+            '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 SPartial 1 $ DPAfterDot multiplier buf1 (power1 - 1)+                    else SDone 0 $ exitDPAfterDot multiplier buf opower+    step (DPExponent multiplier buf opower) val =+        case val of+          '+' -> 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 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 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+                SPartial 1+                    $ DPAfterExponent mult num opower powerMult (buf * 10 + n)+            else SDone 0 $ exitDPAfterExponent mult num opower powerMult buf++    {-# INLINE extract #-}+    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) =+        FDone 0 $ exitDPAfterDot mult num opow+    extract (DPExponent mult num opow) =+        FDone (-1) $ exitDPAfterDot mult num opow+    extract (DPExponentWithSign mult num opow _) =+        FDone (-2) $ exitDPAfterDot mult num opow+    extract (DPAfterExponent 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.++-- XXX This is very expensive, takes much more time than the rest of the+-- parsing. Need to look into fromRational.++-- | @mkDouble mantissa exponent@ converts a mantissa and exponent to a+-- 'Double' value equivalent to @mantissa * 10^exponent@. It does not check for+-- overflow, powers more than 308 will overflow.+{-# INLINE mkDouble #-}+mkDouble :: Integer -> Int -> Double+mkDouble mantissa power =+    if power > 0+    then fromRational ((mantissa * 10 ^ power) % 1)+    else fromRational (mantissa % 10 ^ (-power))++-- | Parse a decimal 'Double' value. This parser accepts an optional sign (+ or+-- -) followed by at least one decimal digit. Decimal digits are optionally+-- followed by a decimal point and at least one decimal digit after the point.+-- This parser accepts the maximal valid input as long as it gives a valid+-- number. Specifcally a trailing decimal point is allowed but not consumed.+-- This function does not accept \"NaN\" or \"Infinity\" string representations+-- of double values. ----- > IS.parse double (IS.fromList "3")     == 3.0--- > IS.parse double (IS.fromList "3.1")   == 3.1--- > IS.parse double (IS.fromList "3e4")   == 30000.0--- > IS.parse double (IS.fromList "3.1e4") == 31000.0--- > IS.parse double (IS.fromList "3e")    == 30+-- Definition: ----- Examples with behaviour identical to 'read':+-- >>> double = uncurry Unicode.mkDouble <$> Unicode.number ----- > IS.parse (IS.fromList ".3")    == error "Parse failed"--- > IS.parse (IS.fromList "e3")    == error "Parse failed"+-- Examples: ----- Example of difference from 'read':+-- >>> p = Stream.parsePos Unicode.double . Stream.fromList ----- > IS.parse double (IS.fromList "3.foo") == 3.0+-- >>> p "-1.23e-123"+-- Right (-1.23e-123) ----- This function does not accept string representations of \"NaN\" or--- \"Infinity\".+-- Trailing input examples: ----- /Unimplemented/-double :: Parser Char m Double-double = undefined+-- >>> p "1."+-- Right 1.0+--+-- >>> p "1.2.3"+-- Right 1.2+--+-- >>> p "1e"+-- Right 1.0+--+-- >>> p "1e2.3"+-- Right 100.0+--+-- >>> p "1+2"+-- Right 1.0+--+-- Error cases:+--+-- >>> p ""+-- Left (ParseErrorPos 0 "number: expecting sign or decimal digit, got end of input")+--+-- >>> p ".1"+-- Left (ParseErrorPos 1 "number: expecting sign or decimal digit, got '.'")+--+-- >>> p "+"+-- Left (ParseErrorPos 1 "number: expecting decimal digit, got end of input")+--+{-# INLINE double #-}+double :: Monad m => Parser Char m Double+double = fmap (\(m,e) -> mkDouble (fromIntegral m) e) doubleParser
src/Streamly/Internal/Unicode/Stream.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.Stream -- Copyright   : (c) 2018 Composewell Technologies@@ -11,10 +12,18 @@  module Streamly.Internal.Unicode.Stream     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $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@@ -22,7 +31,11 @@     , decodeUtf8'     , decodeUtf8_ -    -- ** Resumable UTF-8 Decoding+    -- ** UTF-16 Byte Stream Decoding+    , decodeUtf16le'+    , decodeUtf16le++    -- ** Resumable UTF-8 Byte Stream Decoding     , DecodeError(..)     , DecodeState     , CodePoint@@ -33,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_@@ -48,6 +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)@@ -56,10 +85,10 @@      -- * Transformation     , stripHead-    , lines-    , words-    , unlines-    , unwords+    , lines -- foldLines+    , words -- foldWords+    , unlines -- unfoldLines+    , unwords -- unfoldWords      -- * StreamD UTF8 Encoding / Decoding transformations.     , decodeUtf8D@@ -74,6 +103,10 @@     -- * Decoding String Literals     , fromStr# +    -- * Word16 Utilities+    , mkEvenW8Chunks+    , swapByteOrder+     -- * Deprecations     , decodeUtf8Lax     , encodeLatin1Lax@@ -83,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, (.|.), (.&.))@@ -90,7 +127,7 @@ #if MIN_VERSION_base(4,17,0) import Data.Char (generalCategory, GeneralCategory(Space)) #endif-import Data.Word (Word8)+import Data.Word (Word8, Word16) import Foreign.Marshal.Alloc (mallocBytes) import Foreign.Storable (Storable(..)) #ifndef __GHCJS__@@ -102,34 +139,28 @@ import GHC.Ptr (Ptr (..), plusPtr) import System.IO.Unsafe (unsafePerformIO) import Streamly.Internal.Data.Array.Type (Array(..))-import Streamly.Internal.Data.Array.Mut.Type (MutableByteArray)+import Streamly.Internal.Data.MutByteArray.Type (MutByteArray) import Streamly.Internal.Data.Fold (Fold)-import Streamly.Internal.Data.Stream.StreamD (Stream)-import Streamly.Internal.Data.Stream.StreamD (Step (..))+import Streamly.Internal.Data.Parser (Parser)+import Streamly.Internal.Data.Stream (Stream)+import Streamly.Internal.Data.Stream (Step (..)) import Streamly.Internal.Data.SVar.Type (adaptState) import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))-import Streamly.Internal.Data.Unboxed (peekWith)+import Streamly.Internal.Data.Unbox (Unbox(peekAt)) import Streamly.Internal.Data.Unfold.Type (Unfold(..)) import Streamly.Internal.System.IO (unsafeInlineIO)  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.ParserD as ParserD-import qualified Streamly.Internal.Data.Stream.StreamD as Stream-import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Parser as ParserD+import qualified Streamly.Internal.Data.Stream as Stream+import qualified Streamly.Internal.Data.Stream as D  import Prelude hiding (lines, words, unlines, unwords) --- $setup--- >>> :m--- >>> :set -XMagicHash--- >>> import Prelude hiding (lines, words, unlines, unwords)--- >>> import qualified Streamly.Data.Stream as Stream--- >>> import qualified Streamly.Data.Fold as Fold--- >>> import qualified Streamly.Internal.Unicode.Stream as Unicode--- >>> import Streamly.Internal.Unicode.Stream+#include "DocTestUnicodeStream.hs"  ------------------------------------------------------------------------------- -- Latin1 decoding@@ -462,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 =@@ -480,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@@ -489,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"@@ -504,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"@@ -523,8 +554,8 @@ -- workflow requires backtracking 1 element. This can be revisited once "Fold" -- supports backtracking. {-# INLINE writeCharUtf8' #-}-writeCharUtf8' :: Monad m => Fold m Word8 Char-writeCharUtf8' =  ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)+writeCharUtf8' :: Monad m => Parser Word8 m Char+writeCharUtf8' =  parseCharUtf8WithD ErrorOnCodingFailure  -- XXX The initial idea was to have "parseCharUtf8" and offload the error -- handling to another parser. So, say we had "parseCharUtf8'",@@ -556,7 +587,7 @@      where -    prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "+    prefix = "Streamly.Internal.Data.Stream.decodeUtf8With: "      {-# INLINE handleError #-}     handleError e s =@@ -676,6 +707,188 @@ decodeUtf8Lax = decodeUtf8  -------------------------------------------------------------------------------+-- Decoding Utf16+-------------------------------------------------------------------------------++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.+--+{-# INLINE decodeUtf16le' #-}+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 ------------------------------------------------------------------------------- @@ -684,9 +897,9 @@ #endif data FlattenState s     = OuterLoop s !(Maybe (DecodeState, CodePoint))-    | InnerLoopDecodeInit s MutableByteArray !Int !Int-    | InnerLoopDecodeFirst s MutableByteArray !Int !Int Word8-    | InnerLoopDecoding s MutableByteArray !Int !Int+    | InnerLoopDecodeInit s MutByteArray !Int !Int+    | InnerLoopDecodeFirst s MutByteArray !Int !Int Word8+    | InnerLoopDecoding s MutByteArray !Int !Int         !DecodeState !CodePoint     | YAndC !Char (FlattenState s)   -- These constructors can be                                      -- encoded in the UTF8DecodeState@@ -720,7 +933,7 @@         case cfm of             ErrorOnCodingFailure ->                 error $-                show "Streamly.Internal.Data.Stream.StreamD."+                show "Streamly.Internal.Data.Stream."                 ++ "decodeUtf8ArraysWith: Input Underflow"             TransliterateCodingFailure -> YAndC replacementChar D             DropOnCodingFailure -> D@@ -745,7 +958,7 @@         | p == end = do             return $ Skip $ OuterLoop st Nothing     step' _ _ (InnerLoopDecodeInit st contents p end) = do-        x <- liftIO $ peekWith contents p+        x <- liftIO $ peekAt p contents         -- Note: It is important to use a ">" instead of a "<=" test here for         -- GHC to generate code layout for default branch prediction for the         -- common case. This is fragile and might change with the compiler@@ -769,7 +982,7 @@                     Skip $                     transliterateOrError                         (-                           "Streamly.Internal.Data.Stream.StreamD."+                           "Streamly.Internal.Data.Stream."                         ++ "decodeUtf8ArraysWith: Invalid UTF8"                         ++ " codepoint encountered"                         )@@ -779,7 +992,7 @@     step' _ _ (InnerLoopDecoding st _ p end sv cp)         | p == end = return $ Skip $ OuterLoop st (Just (sv, cp))     step' table _ (InnerLoopDecoding st contents p end statePtr codepointPtr) = do-        x <- liftIO $ peekWith contents p+        x <- liftIO $ peekAt p contents         let (Tuple' sv cp) = decode1 table statePtr codepointPtr x         return $             case sv of@@ -792,7 +1005,7 @@                     Skip $                     transliterateOrError                         (-                           "Streamly.Internal.Data.Stream.StreamD."+                           "Streamly.Internal.Data.Stream."                         ++ "decodeUtf8ArraysWith: Invalid UTF8"                         ++ " codepoint encountered"                         )@@ -834,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@@ -847,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@@ -856,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@@ -866,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@@ -894,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@@ -913,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@@ -929,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.@@ -946,9 +1159,84 @@ encodeUtf8Lax = encodeUtf8  -------------------------------------------------------------------------------+-- Encoding to Utf16+-------------------------------------------------------------------------------++{-# 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.+--+{-# INLINE encodeUtf16le' #-}+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. --@@ -962,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@@ -978,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@.@@ -1016,7 +1304,7 @@  -- | Remove leading whitespace from a string. ----- > stripHead = Stream.dropWhile isSpace+-- >>> stripHead = Stream.dropWhile Char.isSpace -- -- /Pre-release/ {-# INLINE stripHead #-}@@ -1026,11 +1314,15 @@ -- | Fold each line of the stream using the supplied 'Fold' -- and stream the result. ----- >>> Stream.fold Fold.toList $ lines Fold.toList (Stream.fromList "lines\nthis\nstring\n\n\n")--- ["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@@ -1054,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 $ 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@@ -1070,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,5 @@-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TemplateHaskellQuotes #-}+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Internal.Unicode.String -- Copyright   : (c) 2022 Composewell Technologies@@ -31,14 +32,21 @@ -- using Haskell functions.  module Streamly.Internal.Unicode.String-    ( str+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++      str     ) where   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@@ -49,11 +57,8 @@ import qualified Streamly.Data.Stream as Stream  (fromList, parse) import qualified Streamly.Internal.Unicode.Parser as Parser --- $setup--- >>> :m--- >>> :set -XQuasiQuotes--- >>> import Streamly.Internal.Unicode.String---+#include "DocTestUnicodeString.hs"+ -------------------------------------------------------------------------------- -- Parsing --------------------------------------------------------------------------------@@ -101,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 ->@@ -135,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/Parser.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Unicode.Parser -- Copyright   : (c) 2021 Composewell Technologies@@ -12,9 +13,15 @@  module Streamly.Unicode.Parser     (-     -- * Single Chars+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup -     -- Any char+    -- * Single Chars++    -- Any char       char     , charIgnoreCase @@ -50,6 +57,7 @@     -- * Digit Sequences (Numbers)     , decimal     , hexadecimal+    , double      -- * Modifiers     , signed@@ -57,3 +65,5 @@ where  import Streamly.Internal.Unicode.Parser++#include "DocTestUnicodeParser.hs"
src/Streamly/Unicode/Stream.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Unicode.Stream -- Copyright   : (c) 2020 Composewell Technologies@@ -24,14 +25,11 @@ -- routines in this module and then written to IO devices or to arrays in -- memory. ----- If you have to store a 'Char' stream in memory you can convert it into a--- 'String' using 'Streamly.Data.Fold.toList' fold. The 'String' type can be--- more efficient than pinned arrays for short and short lived strings.------ For longer or long lived streams you can 'Streamly.Data.Stream.fold' the+-- If you have to store a 'Char' stream in memory you can+-- 'Streamly.Data.Stream.fold' the -- 'Char' stream as @Array Char@ using the array 'Streamly.Data.Array.write'--- fold.  The 'Array' type provides a more compact representation and pinned--- memory reducing GC overhead. If space efficiency is a concern you can use+-- fold.  The 'Array' type provides a more compact representation+-- reducing GC overhead. If space efficiency is a concern you can use -- 'encodeUtf8'' on the 'Char' stream before writing it to an 'Array' providing -- an even more compact representation. --@@ -69,16 +67,21 @@ -- Some experimental APIs to conveniently process text using the -- @Array Char@ represenation directly can be found in -- "Streamly.Internal.Unicode.Array".---- XXX an unpinned array representation can be useful to store short and short--- lived strings in memory. -- module Streamly.Unicode.Stream     (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup+     -- * Construction (Decoding)       decodeLatin1     , decodeUtf8     , decodeUtf8'+    , decodeUtf16le+    , decodeUtf16le'     , decodeUtf8Chunks      -- * Elimination (Encoding)@@ -86,6 +89,8 @@     , encodeLatin1'     , encodeUtf8     , encodeUtf8'+    , encodeUtf16le+    , encodeUtf16le'     , encodeStrings     {-     -- * Operations on character strings@@ -105,3 +110,5 @@  import Streamly.Internal.Unicode.Stream import Prelude hiding (lines, words, unlines, unwords)++#include "DocTestUnicodeStream.hs"
src/Streamly/Unicode/String.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} -- | -- Module      : Streamly.Unicode.String -- Copyright   : (c) 2022 Composewell Technologies@@ -7,10 +8,23 @@ -- Portability : GHC -- -- Convenient template Haskell quasiquoters to format strings.+--+-- The 'str' quasiquoter retains newlines in the string when the line is split+-- across multiple lines. The @unwords . lines@ idiom can be used on the+-- resulting string to collapse it into a single line.  module Streamly.Unicode.String-    ( str+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    str     ) where  import Streamly.Internal.Unicode.String++#include "DocTestUnicodeString.hs"
src/config.h.in view
@@ -1,6 +1,6 @@ /* src/config.h.in.  Generated from configure.ac by autoheader.  */ -/* Define to 1 if you have the `clock_gettime' function. */+/* Define to 1 if you have the 'clock_gettime' function. */ #undef HAVE_CLOCK_GETTIME  /* Define to 1 if you have the <inttypes.h> header file. */@@ -51,7 +51,7 @@ /* Define to the version of this package. */ #undef PACKAGE_VERSION -/* Define to 1 if all of the C90 standard headers exist (not just the ones+/* Define to 1 if all of the C89 standard headers exist (not just the ones    required in a freestanding environment). This macro is provided for    backward compatibility; new code need not use it. */ #undef STDC_HEADERS
+ 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,23 +1,52 @@-cabal-version:      2.2+cabal-version:      2.4 name:               streamly-core-version:            0.1.0-synopsis:           Streaming, parsers, arrays and more+version:            0.3.1+synopsis:           Streaming, parsers, arrays, serialization and more description:-  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>.+  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>.   .-  This package provides streams, arrays, parsers, unicode text, file-  IO, and console IO functionality.+  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.   .-  Note: The dependencies "heaps" and "monad-control" are included in-  the package solely for backward compatibility, and will be removed in-  future versions.+  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.+  .+  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.+  .+  @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.+  .+  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@@ -27,8 +56,12 @@                    , GHC==8.8.4                    , GHC==8.10.7                    , GHC==9.0.2-                   , GHC==9.2.7-                   , GHC==9.4.4+                   , GHC==9.2.8+                   , GHC==9.4.7+                   , GHC==9.6.3+                   , GHC==9.8.1+                   , GHC==9.10.1+                   , GHC==9.12.1 author:              Composewell Technologies maintainer:          streamly@composewell.com copyright:           2017 Composewell Technologies@@ -43,19 +76,14 @@     configure.ac     -- doctest include files-    src/DocTestDataArray.hs-    src/DocTestDataFold.hs-    src/DocTestDataMutArray.hs-    src/DocTestDataMutArrayGeneric.hs-    src/DocTestDataParser.hs-    src/DocTestDataStream.hs-    src/DocTestDataStreamK.hs-    src/DocTestDataUnfold.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@@ -69,7 +97,7 @@ extra-doc-files:     Changelog.md     docs/*.md-    docs/ApiChangelogs/0.1.0.txt+    docs/ApiChangelogs/*.txt  source-repository head     type: git@@ -80,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 @@ -90,16 +118,6 @@   manual: True   default: False -flag no-fusion-  description: Disable rewrite rules for stream fusion-  manual: True-  default: False--flag use-c-malloc-  description: Use C malloc instead of GHC malloc-  manual: True-  default: False- flag opt   description: off=GHC default, on=-O2   manual: True@@ -110,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 @@ -125,17 +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(no-fusion)-      cpp-options:    -DDISABLE_FUSION+    if flag(force-lstat-readdir)+      cpp-options:    -DFORCE_LSTAT_READDIR -    if flag(dev)+    if flag(internal-dev)       cpp-options:    -DDEVBUILD      if flag(use-unfolds)@@ -144,9 +165,6 @@     if flag(use-folds)       cpp-options:    -DUSE_FOLDS_EVERYWHERE -    if flag(use-c-malloc)-      cpp-options:    -DUSE_C_MALLOC-     ghc-options:    -Weverything                     -Wno-implicit-prelude                     -Wno-missing-deriving-strategies@@ -167,24 +185,48 @@         -Wno-redundant-bang-patterns         -Wno-operator-whitespace +    if impl(ghc >= 9.8)+      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@@ -196,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@@ -225,7 +282,8 @@                  -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  common threading-options@@ -248,16 +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 @@ -289,81 +350,49 @@                      -- streamly-time                      , Streamly.Internal.Data.Time.TimeSpec                      , Streamly.Internal.Data.Time.Units-                     , Streamly.Internal.Data.Time.Clock.Type                      , Streamly.Internal.Data.Time.Clock+                     , Streamly.Internal.Data.Path                       -- streamly-core-stream-types                      , Streamly.Internal.Data.SVar.Type-                     , Streamly.Internal.Data.Stream.StreamK.Type-                     , Streamly.Internal.Data.Fold.Step                      , Streamly.Internal.Data.Refold.Type-                     , Streamly.Internal.Data.Fold.Type-                     , Streamly.Internal.Data.Stream.StreamD.Step-                     , Streamly.Internal.Data.Stream.StreamD.Type-                     , Streamly.Internal.Data.Unfold.Type-                     , Streamly.Internal.Data.Producer.Type                      , Streamly.Internal.Data.Producer-                     , Streamly.Internal.Data.Producer.Source-                     , Streamly.Internal.Data.Parser.ParserK.Type-                     , Streamly.Internal.Data.Parser.ParserD.Type-                     , Streamly.Internal.Data.Pipe.Type                       -- streamly-core-array-types-                     , Streamly.Internal.Data.Unboxed-                    -- Unboxed IORef-                     , Streamly.Internal.Data.IORef.Unboxed+                     , Streamly.Internal.Data.MutByteArray+                     , Streamly.Internal.Data.CString++                     -- streaming and parsing Haskell types to/from bytes+                     , Streamly.Internal.Data.Binary.Parser+                     , Streamly.Internal.Data.Binary.Stream+                      -- May depend on streamly-core-stream-                     , Streamly.Internal.Data.Array.Mut.Type-                     , Streamly.Internal.Data.Array.Mut-                     , Streamly.Internal.Data.Array.Type-                     , Streamly.Internal.Data.Array.Generic.Mut.Type+                     , Streamly.Internal.Data.MutArray+                     , Streamly.Internal.Data.MutArray.Generic                       -- streamly-core-streams-                     , Streamly.Internal.Data.Stream.StreamK+                     , Streamly.Internal.Data.StreamK                      -- StreamD depends on streamly-array-types-                     , Streamly.Internal.Data.Stream.StreamD.Generate-                     , Streamly.Internal.Data.Stream.StreamD.Eliminate-                     , Streamly.Internal.Data.Stream.StreamD.Nesting-                     , Streamly.Internal.Data.Stream.StreamD.Transform-                     , Streamly.Internal.Data.Stream.StreamD.Exception-                     , Streamly.Internal.Data.Stream.StreamD.Lift-                     , Streamly.Internal.Data.Stream.StreamD.Top-                     , Streamly.Internal.Data.Stream.StreamD-                     , Streamly.Internal.Data.Stream.Common                      , Streamly.Internal.Data.Stream -                     , Streamly.Internal.Data.Parser.ParserD.Tee-                     , Streamly.Internal.Data.Parser.ParserD-                      -- streamly-core-data                      , Streamly.Internal.Data.Builder                      , Streamly.Internal.Data.Unfold-                     , Streamly.Internal.Data.Unfold.Enumeration-                     , Streamly.Internal.Data.Fold.Tee-                     , Streamly.Internal.Data.Fold-                     , Streamly.Internal.Data.Fold.Chunked-                     , Streamly.Internal.Data.Fold.Window                      , Streamly.Internal.Data.Parser+                     , Streamly.Internal.Data.ParserK                      , Streamly.Internal.Data.Pipe--                     -- streamly-transformers (non-base)-                     , Streamly.Internal.Data.Stream.StreamD.Transformer-                     , Streamly.Internal.Data.Stream.StreamK.Transformer+                     , Streamly.Internal.Data.Scanr                       -- streamly-containers (non-base)-                     , Streamly.Internal.Data.Stream.StreamD.Container-                     , Streamly.Internal.Data.Fold.Container--                     , Streamly.Internal.Data.Stream.Chunked+                     , Streamly.Internal.Data.Fold+                     , Streamly.Internal.Data.Scanl                       -- streamly-core-data-arrays                      , Streamly.Internal.Data.Array.Generic                      , Streamly.Internal.Data.Array-                     , Streamly.Internal.Data.Array.Mut.Stream -                     -- streamly-serde-                     , Streamly.Internal.Serialize.FromBytes-                     , Streamly.Internal.Serialize.ToBytes+                     -- Unboxed IORef+                     , Streamly.Internal.Data.IORef                      -- streamly-unicode-core                      , Streamly.Internal.Unicode.Stream@@ -372,34 +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.Unboxed-                     , Streamly.Internal.Data.Ring+                    -- 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@@ -407,45 +449,112 @@                      -- , 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.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 -    if flag(dev)+                    -- 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.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+                    , Streamly.Internal.Data.Stream.Exception+                    , Streamly.Internal.Data.Stream.Generate+                    , Streamly.Internal.Data.Stream.Lift+                    , Streamly.Internal.Data.Stream.Nesting+                    , Streamly.Internal.Data.Stream.Step+                    , Streamly.Internal.Data.Stream.Top+                    , Streamly.Internal.Data.Stream.Transform+                    , Streamly.Internal.Data.Stream.Transformer+                    , Streamly.Internal.Data.Stream.Type++                    , Streamly.Internal.Data.StreamK.Type+                    , Streamly.Internal.Data.StreamK.Transformer++                    , Streamly.Internal.Data.Pipe.Type++                    , Streamly.Internal.Data.Unfold.Type+                    , Streamly.Internal.Data.Unfold.Enumeration++                    , Streamly.Internal.Data.MutArray.Type++                    , Streamly.Internal.Data.Array.Type+                    , Streamly.Internal.Data.Array.Generic.Type++                    , Streamly.Internal.Data.MutByteArray.Type+                    , Streamly.Internal.Data.Unbox+                    , Streamly.Internal.Data.Unbox.TH+                    , Streamly.Internal.Data.Serialize.Type+                    , Streamly.Internal.Data.Serialize.TH+                    , Streamly.Internal.Data.Serialize.TH.RecHeader+                    , Streamly.Internal.Data.Serialize.TH.Common+                    , Streamly.Internal.Data.Serialize.TH.Bottom++                    , Streamly.Internal.Data.Producer.Type+                    , Streamly.Internal.Data.Producer.Source++                    , Streamly.Internal.Data.Time.Clock.Type+                    , Streamly.Internal.FileSystem.Path.Common+                    , Streamly.Internal.FileSystem.DirOptions++    if flag(internal-dev)       exposed-modules:-                        Streamly.Internal.Data.Stream.StreamK.Alt-                      , Streamly.Internal.Data.Stream.Type-                      , Streamly.Internal.Data.Stream.Eliminate-                      , Streamly.Internal.Data.Stream.Enumerate-                      , Streamly.Internal.Data.Stream.Generate-                      , Streamly.Internal.Data.Stream.Transform-                      , Streamly.Internal.Data.Stream.Bottom-                      , Streamly.Internal.Data.Stream.Exception-                      , Streamly.Internal.Data.Stream.Expand-                      , Streamly.Internal.Data.Stream.Lift-                      , Streamly.Internal.Data.Stream.Reduce-                      , Streamly.Internal.Data.Stream.Transformer-                      , Streamly.Internal.Data.Stream.StreamDK-                      , Streamly.Internal.Data.Stream.Zip-                      , Streamly.Internal.Data.Stream.Cross-                      , Streamly.Internal.Data.List-                      , Streamly.Data.Stream.Zip-                      --, Streamly.Internal.Data.Parser.ParserDK+                        Streamly.Internal.Data.StreamK.Alt+                        -- XXX Compilation needs to be fixed+                      -- , Streamly.Internal.Data.List      build-depends:                     -- streamly-base@@ -459,21 +568,27 @@                     -- packages depending on the "ghc" package (packages                     -- depending on doctest is a common example) can                     -- depend on streamly.-                       ghc-prim          >= 0.5.3 && < 0.10+                       ghc-prim          >= 0.5.3 && < 0.14                      , fusion-plugin-types >= 0.1 && < 0.2-                     , base              >= 4.12  && < 4.19+                     , base              >= 4.12  && < 4.23                      , exceptions        >= 0.8.0 && < 0.11                      , transformers      >= 0.5.5 && < 0.7-                     , filepath          >= 1.4.2 && < 1.5                      -- streamly-unicode-core-                     , template-haskell  >= 2.14  && < 2.20--                     -- streamly-filesystem-core-                     , directory         >= 1.3.3 && < 1.4+                     , template-haskell  >= 2.14  && < 2.25                       -- XXX to be removed-                     , containers        >= 0.6.0 && < 0.7+                     , filepath          >= 1.4.2 && < 1.6+                     , containers        >= 0.6.0 && < 0.9                      , heaps             >= 0.3   && < 0.5-    if !flag(use-unliftio)++    if impl(ghc >= 9.0)+      build-depends:  ghc-bignum >= 1.0  && < 2+    else+      build-depends:  integer-gmp >= 1.0 && < 1.2++    if !flag(internal-use-unliftio)       build-depends:   monad-control     >= 1.0 && < 1.1++    if os(windows)+      build-depends: Win32            >= 2.6 && < 2.15