packages feed

streamly-core (empty) → 0.1.0

raw patch · 135 files changed

+60099/−0 lines, 135 filesdep +basedep +containersdep +directorysetup-changed

Dependencies added: base, containers, directory, exceptions, filepath, fusion-plugin-types, ghc-prim, heaps, monad-control, template-haskell, transformers

Files

+ Changelog.md view
@@ -0,0 +1,32 @@+# Changelog++## 0.1.0 (March 2023)++Also see [streamly-core-0.1.0 API Changelog](/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+has only GHC boot library depdendecies, and (2) `streamly` that contains+higher level operations (including concurrent ones) with additional+dependencies.++* Moved the following modules from `streamly` package to the+  `streamly-core` package:+  * Streamly.Console.Stdio+  * Streamly.Data.Fold+  * Streamly.Data.Unfold+  * Streamly.FileSystem.Handle+  * Streamly.Unicode.Stream+* Added the following new modules:+  * Streamly.Data.Array+  * Streamly.Data.Array.Generic+  * Streamly.Data.MutArray+  * Streamly.Data.MutArray.Generic+  * Streamly.Data.Parser+  * Streamly.Data.ParserK+  * Streamly.Data.Stream+  * Streamly.Data.StreamK+  * Streamly.FileSystem.Dir+  * Streamly.FileSystem.File+  * Streamly.Unicode.Parser+  * Streamly.Unicode.String
+ LICENSE view
@@ -0,0 +1,281 @@+Copyright (c) 2017, Composewell Technologies+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+may be used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 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.++-------------------------------------------------------------------------------+base-4.12.0.0 (http://hackage.haskell.org/package/base-4.12.0.0)+-------------------------------------------------------------------------------+This library (libraries/base) is derived from code from several+sources:++  * Code from the GHC project which is largely (c) The University of+    Glasgow, and distributable under a BSD-style license (see below),++  * Code from the Haskell 98 Report which is (c) Simon Peyton Jones+    and freely redistributable (but see the full license for+    restrictions).++  * Code from the Haskell Foreign Function Interface specification,+    which is (c) Manuel M. T. Chakravarty and freely redistributable+    (but see the full license for restrictions).++The full text of these licenses is reproduced below.  All of the+licenses are BSD-style or compatible.++The Glasgow Haskell Compiler License++Copyright 2004, The University Court of the University of Glasgow.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+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.++Code derived from the document "Report on the Programming Language+Haskell 98", is distributed under the following license:++  Copyright (c) 2002 Simon Peyton Jones++  The authors intend this Report to belong to the entire Haskell+  community, and so we grant permission to copy and distribute it for+  any purpose, provided that it is reproduced in its entirety,+  including this Notice.  Modified versions of this Report may also be+  copied and distributed for any purpose, provided that the modified+  version is clearly presented as such, and that it does not claim to+  be a definition of the Haskell 98 Language.++Code derived from the document "The Haskell 98 Foreign Function+Interface, An Addendum to the Haskell 98 Report" is distributed under+the following license:++  Copyright (c) 2002 Manuel M. T. Chakravarty++  The authors intend this Report to belong to the entire Haskell+  community, and so we grant permission to copy and distribute it for+  any purpose, provided that it is reproduced in its entirety,+  including this Notice.  Modified versions of this Report may also be+  copied and distributed for any purpose, provided that the modified+  version is clearly presented as such, and that it does not claim to+  be a definition of the Haskell 98 Foreign Function Interface.++-------------------------------------------------------------------------------+bjoern-2008-2009 (http://bjoern.hoehrmann.de/utf-8/decoder/dfa/)+-------------------------------------------------------------------------------+Copyright (c) 2008-2009 Bjoern Hoehrmann <bjoern@hoehrmann.de>++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.++-------------------------------------------------------------------------------+clock-0.7.2 (http://hackage.haskell.org/package/clock-0.7.2)+-------------------------------------------------------------------------------+Copyright (c) 2009-2012, Cetin Sert+Copyright (c) 2010, Eugene Kirpichov++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 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.++-------------------------------------------------------------------------------+foldl-1.4.5 (http://hackage.haskell.org/package/foldl-1.4.5)+-------------------------------------------------------------------------------+Copyright (c) 2013 Gabriel Gonzalez+All rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:+    * Redistributions of source code must retain the above copyright notice,+      this list of conditions and the following disclaimer.+    * Redistributions in binary form must reproduce the above copyright notice,+      this list of conditions and the following disclaimer in the documentation+      and/or other materials provided with the distribution.+    * Neither the name of Gabriel Gonzalez nor the names of other contributors+      may be used to endorse or promote products derived from this software+      without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 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.++-------------------------------------------------------------------------------+primitive-0.7.0.0 (https://hackage.haskell.org/package/primitive-0.7.0.0)+-------------------------------------------------------------------------------+Copyright (c) 2008-2009, Roman Leshchinskiy+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+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.++-------------------------------------------------------------------------------+transient-0.5.5 (http://hackage.haskell.org/package/transient-0.5.5)+-------------------------------------------------------------------------------+Copyright © 2014-2016 Alberto G. Corona       <https://github.com/agocorona>++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.++-------------------------------------------------------------------------------+vector-0.12.0.2 (http://hackage.haskell.org/package/vector-0.12.0.2)+-------------------------------------------------------------------------------+Copyright (c) 2008-2012, Roman Leshchinskiy+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++- Redistributions of source code must retain the above copyright notice,+this list of conditions and the following disclaimer.++- Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation+and/or other materials provided with the distribution.++- Neither name of the University nor the names of its contributors may be+used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE UNIVERSITY COURT OF THE UNIVERSITY OF+GLASGOW AND THE CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE+UNIVERSITY COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+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.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMainWithHooks autoconfUserHooks
+ configure view
@@ -0,0 +1,4349 @@+#! /bin/sh+# Guess values for system-dependent variables and create Makefiles.+# Generated by GNU Autoconf 2.71 for streamly-core 0.1.0.+#+# Report bugs to <streamly@composewell.com>.+#+#+# Copyright (C) 1992-1996, 1998-2017, 2020-2021 Free Software Foundation,+# Inc.+#+#+# This configure script is free software; the Free Software Foundation+# gives unlimited permission to copy, distribute and modify it.+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# 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+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # 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 #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi++++# Reset variables that may have inherited troublesome values from+# the environment.++# IFS needs to be set, to space, tab, and newline, in precisely that order.+# (If _AS_PATH_WALK were called with IFS unset, it would have the+# side effect of setting IFS to empty, thus disabling word splitting.)+# Quoting is to prevent editors from complaining about space-tab.+as_nl='+'+export as_nl+IFS=" ""	$as_nl"++PS1='$ '+PS2='> '+PS4='+ '++# Ensure predictable behavior from utilities with locale-dependent output.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# We cannot yet rely on "unset" to work, but we need these variables+# to be unset--not just set to an empty or harmless value--now, to+# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh).  This construct+# also avoids known problems related to "unset" and subshell syntax+# in other old shells (e.g. bash 2.01 and pdksh 5.2.14).+for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH+do eval test \${$as_var+y} \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done++# Ensure that fds 0, 1, and 2 are open.+if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi+if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi+if (exec 3>&2)            ; then :; else exec 2>/dev/null; fi++# The user is always right.+if ${PATH_SEPARATOR+false} :; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    test -r "$as_dir$0" && as_myself=$as_dir$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# 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+fi+if test ! -f "$as_myself"; then+  printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi+++# Use a proper internal environment variable to ensure we don't fall+  # into an infinite loop, continuously re-executing ourselves.+  if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then+    _as_can_reexec=no; export _as_can_reexec;+    # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+  *v*x* | *x*v* ) as_opts=-vx ;;+  *v* ) as_opts=-v ;;+  *x* ) as_opts=-x ;;+  * ) as_opts= ;;+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'.+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+then :+  emulate sh+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which+  # 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 #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi+"+  as_required="as_fn_return () { (exit \$1); }+as_fn_success () { as_fn_return 0; }+as_fn_failure () { as_fn_return 1; }+as_fn_ret_success () { return 0; }+as_fn_ret_failure () { return 1; }++exitcode=0+as_fn_success || { exitcode=1; echo as_fn_success failed.; }+as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }+as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }+as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }+if ( set x; as_fn_ret_success y && test x = \"\$1\" )+then :++else \$as_nop+  exitcode=1; echo positional parameters were not saved.+fi+test x\$exitcode = x0 || exit 1+blah=\$(echo \$(echo blah))+test x\"\$blah\" = xblah || exit 1+test -x / || exit 1"+  as_suggested="  as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO+  as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO+  eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&+  test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"+  if (eval "$as_required") 2>/dev/null+then :+  as_have_required=yes+else $as_nop+  as_have_required=no+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+as_found=false+for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+  as_found=:+  case $as_dir in #(+	 /*)+	   for as_base in sh bash ksh sh5; do+	     # Try only shells that exist, to save several forks.+	     as_shell=$as_dir$as_base+	     if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&+		    as_run=a "$as_shell" -c "$as_bourne_compatible""$as_required" 2>/dev/null+then :+  CONFIG_SHELL=$as_shell as_have_required=yes+		   if as_run=a "$as_shell" -c "$as_bourne_compatible""$as_suggested" 2>/dev/null+then :+  break 2+fi+fi+	   done;;+       esac+  as_found=false+done+IFS=$as_save_IFS+if $as_found+then :++else $as_nop+  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+++      if test "x$CONFIG_SHELL" != x+then :+  export CONFIG_SHELL+             # We cannot yet assume a decent shell, so we have to provide a+# neutralization value for shells without unset; and this also+# works around shells that cannot unset nonexistent variables.+# Preserve -v and -x to the replacement shell.+BASH_ENV=/dev/null+ENV=/dev/null+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV+case $- in # ((((+  *v*x* | *x*v* ) as_opts=-vx ;;+  *v* ) as_opts=-v ;;+  *x* ) as_opts=-x ;;+  * ) as_opts= ;;+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'.+printf "%s\n" "$0: could not re-execute with $CONFIG_SHELL" >&2+exit 255+fi++    if test x$as_have_required = xno+then :+  printf "%s\n" "$0: This script requires a shell more modern than all"+  printf "%s\n" "$0: the shells that I found on your system."+  if test ${ZSH_VERSION+y} ; then+    printf "%s\n" "$0: In particular, zsh $ZSH_VERSION has bugs and should"+    printf "%s\n" "$0: be upgraded to zsh 4.3.4 or later."+  else+    printf "%s\n" "$0: Please tell bug-autoconf@gnu.org and+$0: streamly@composewell.com about your system, including+$0: any error possibly output before this message. Then+$0: install a modern shell, or manually run the script+$0: under such a shell if you do have one."+  fi+  exit 1+fi+fi+fi+SHELL=${CONFIG_SHELL-/bin/sh}+export SHELL+# Unset more variables known to interfere with behavior of common tools.+CLICOLOR_FORCE= GREP_OPTIONS=+unset CLICOLOR_FORCE GREP_OPTIONS++## --------------------- ##+## M4sh Shell Functions. ##+## --------------------- ##+# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset+++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  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+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+  test -f "$1" && test -x "$1"+} # as_fn_executable_p+# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null+then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else $as_nop+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null+then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else $as_nop+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+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]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  printf "%s\n" "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++  as_lineno_1=$LINENO as_lineno_1a=$LINENO+  as_lineno_2=$LINENO as_lineno_2a=$LINENO+  eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&+  test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {+  # Blame Lee E. McMahon (1931-1989) for sed's syntax.  :-)+  sed -n '+    p+    /[$]LINENO/=+  ' <$as_myself |+    sed '+      s/[$]LINENO.*/&-/+      t lineno+      b+      :lineno+      N+      :loop+      s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/+      t loop+      s/-\n.*//+    ' >$as_me.lineno &&+  chmod +x "$as_me.lineno" ||+    { printf "%s\n" "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }++  # If we had to re-execute with $CONFIG_SHELL, we're ensured to have+  # already done that, so ensure we don't try to do so again and fall+  # in an infinite loop.  This has already happened in practice.+  _as_can_reexec=no; export _as_can_reexec+  # Don't try to exec as it changes $[0], causing all sort of problems+  # (the dirname of $[0] is not the place where we might find the+  # original and so on.  Autoconf is especially sensitive to this).+  . "./$as_me.lineno"+  # Exit status is that of the last command.+  exit+}+++# Determine whether it's possible to make 'echo' print without a newline.+# These variables are no longer used directly by Autoconf, but are AC_SUBSTed+# for compatibility with existing Makefiles.+ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++# For backward compatibility with old third-party macros, we provide+# the shell variables $as_echo and $as_echo_n.  New code should use+# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively.+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+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  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'.+    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+    as_ln_s=ln+  else+    as_ln_s='cp -pR'+  fi+else+  as_ln_s='cp -pR'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null++if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi++as_test_x='test -x'+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'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++test -n "$DJDIR" || exec 7<&0 </dev/null+exec 6>&1++# Name of the host.+# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,+# so uname gets run too.+ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`++#+# Initializations.+#+ac_default_prefix=/usr/local+ac_clean_files=+ac_config_libobj_dir=.+LIBOBJS=+cross_compiling=no+subdirs=+MFLAGS=+MAKEFLAGS=++# 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_BUGREPORT='streamly@composewell.com'+PACKAGE_URL='https://streamly.composewell.com'++# Factoring default headers for most tests.+ac_includes_default="\+#include <stddef.h>+#ifdef HAVE_STDIO_H+# include <stdio.h>+#endif+#ifdef HAVE_STDLIB_H+# include <stdlib.h>+#endif+#ifdef HAVE_STRING_H+# include <string.h>+#endif+#ifdef HAVE_INTTYPES_H+# include <inttypes.h>+#endif+#ifdef HAVE_STDINT_H+# include <stdint.h>+#endif+#ifdef HAVE_STRINGS_H+# include <strings.h>+#endif+#ifdef HAVE_SYS_TYPES_H+# include <sys/types.h>+#endif+#ifdef HAVE_SYS_STAT_H+# include <sys/stat.h>+#endif+#ifdef HAVE_UNISTD_H+# include <unistd.h>+#endif"++ac_header_c_list=+ac_subst_vars='LTLIBOBJS+LIBOBJS+OBJEXT+EXEEXT+ac_ct_CC+CPPFLAGS+LDFLAGS+CFLAGS+CC+target_alias+host_alias+build_alias+LIBS+ECHO_T+ECHO_N+ECHO_C+DEFS+mandir+localedir+libdir+psdir+pdfdir+dvidir+htmldir+infodir+docdir+oldincludedir+includedir+runstatedir+localstatedir+sharedstatedir+sysconfdir+datadir+datarootdir+libexecdir+sbindir+bindir+program_transform_name+prefix+exec_prefix+PACKAGE_URL+PACKAGE_BUGREPORT+PACKAGE_STRING+PACKAGE_VERSION+PACKAGE_TARNAME+PACKAGE_NAME+PATH_SEPARATOR+SHELL'+ac_subst_files=''+ac_user_opts='+enable_option_checking+with_compiler+'+      ac_precious_vars='build_alias+host_alias+target_alias+CC+CFLAGS+LDFLAGS+LIBS+CPPFLAGS'+++# Initialize some variables set by options.+ac_init_help=+ac_init_version=false+ac_unrecognized_opts=+ac_unrecognized_sep=+# The variables have the same names as the options, with+# dashes changed to underlines.+cache_file=/dev/null+exec_prefix=NONE+no_create=+no_recursion=+prefix=NONE+program_prefix=NONE+program_suffix=NONE+program_transform_name=s,x,x,+silent=+site=+srcdir=+verbose=+x_includes=NONE+x_libraries=NONE++# Installation directory options.+# These are left unexpanded so users can "make install exec_prefix=/foo"+# and all the variables that are supposed to be based on exec_prefix+# by default will actually change.+# Use braces instead of parens because sh, perl, etc. also accept them.+# (The list follows the same order as the GNU Coding Standards.)+bindir='${exec_prefix}/bin'+sbindir='${exec_prefix}/sbin'+libexecdir='${exec_prefix}/libexec'+datarootdir='${prefix}/share'+datadir='${datarootdir}'+sysconfdir='${prefix}/etc'+sharedstatedir='${prefix}/com'+localstatedir='${prefix}/var'+runstatedir='${localstatedir}/run'+includedir='${prefix}/include'+oldincludedir='/usr/include'+docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'+infodir='${datarootdir}/info'+htmldir='${docdir}'+dvidir='${docdir}'+pdfdir='${docdir}'+psdir='${docdir}'+libdir='${exec_prefix}/lib'+localedir='${datarootdir}/locale'+mandir='${datarootdir}/man'++ac_prev=+ac_dashdash=+for ac_option+do+  # If the previous option needs an argument, assign it.+  if test -n "$ac_prev"; then+    eval $ac_prev=\$ac_option+    ac_prev=+    continue+  fi++  case $ac_option in+  *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;+  *=)   ac_optarg= ;;+  *)    ac_optarg=yes ;;+  esac++  case $ac_dashdash$ac_option in+  --)+    ac_dashdash=yes ;;++  -bindir | --bindir | --bindi | --bind | --bin | --bi)+    ac_prev=bindir ;;+  -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)+    bindir=$ac_optarg ;;++  -build | --build | --buil | --bui | --bu)+    ac_prev=build_alias ;;+  -build=* | --build=* | --buil=* | --bui=* | --bu=*)+    build_alias=$ac_optarg ;;++  -cache-file | --cache-file | --cache-fil | --cache-fi \+  | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)+    ac_prev=cache_file ;;+  -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \+  | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)+    cache_file=$ac_optarg ;;++  --config-cache | -C)+    cache_file=config.cache ;;++  -datadir | --datadir | --datadi | --datad)+    ac_prev=datadir ;;+  -datadir=* | --datadir=* | --datadi=* | --datad=*)+    datadir=$ac_optarg ;;++  -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \+  | --dataroo | --dataro | --datar)+    ac_prev=datarootdir ;;+  -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \+  | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)+    datarootdir=$ac_optarg ;;++  -disable-* | --disable-*)+    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'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=no ;;++  -docdir | --docdir | --docdi | --doc | --do)+    ac_prev=docdir ;;+  -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)+    docdir=$ac_optarg ;;++  -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)+    ac_prev=dvidir ;;+  -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)+    dvidir=$ac_optarg ;;++  -enable-* | --enable-*)+    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'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"enable_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval enable_$ac_useropt=\$ac_optarg ;;++  -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \+  | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \+  | --exec | --exe | --ex)+    ac_prev=exec_prefix ;;+  -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \+  | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \+  | --exec=* | --exe=* | --ex=*)+    exec_prefix=$ac_optarg ;;++  -gas | --gas | --ga | --g)+    # Obsolete; use --with-gas.+    with_gas=yes ;;++  -help | --help | --hel | --he | -h)+    ac_init_help=long ;;+  -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)+    ac_init_help=recursive ;;+  -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)+    ac_init_help=short ;;++  -host | --host | --hos | --ho)+    ac_prev=host_alias ;;+  -host=* | --host=* | --hos=* | --ho=*)+    host_alias=$ac_optarg ;;++  -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)+    ac_prev=htmldir ;;+  -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \+  | --ht=*)+    htmldir=$ac_optarg ;;++  -includedir | --includedir | --includedi | --included | --include \+  | --includ | --inclu | --incl | --inc)+    ac_prev=includedir ;;+  -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \+  | --includ=* | --inclu=* | --incl=* | --inc=*)+    includedir=$ac_optarg ;;++  -infodir | --infodir | --infodi | --infod | --info | --inf)+    ac_prev=infodir ;;+  -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)+    infodir=$ac_optarg ;;++  -libdir | --libdir | --libdi | --libd)+    ac_prev=libdir ;;+  -libdir=* | --libdir=* | --libdi=* | --libd=*)+    libdir=$ac_optarg ;;++  -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \+  | --libexe | --libex | --libe)+    ac_prev=libexecdir ;;+  -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \+  | --libexe=* | --libex=* | --libe=*)+    libexecdir=$ac_optarg ;;++  -localedir | --localedir | --localedi | --localed | --locale)+    ac_prev=localedir ;;+  -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)+    localedir=$ac_optarg ;;++  -localstatedir | --localstatedir | --localstatedi | --localstated \+  | --localstate | --localstat | --localsta | --localst | --locals)+    ac_prev=localstatedir ;;+  -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \+  | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)+    localstatedir=$ac_optarg ;;++  -mandir | --mandir | --mandi | --mand | --man | --ma | --m)+    ac_prev=mandir ;;+  -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)+    mandir=$ac_optarg ;;++  -nfp | --nfp | --nf)+    # Obsolete; use --without-fp.+    with_fp=no ;;++  -no-create | --no-create | --no-creat | --no-crea | --no-cre \+  | --no-cr | --no-c | -n)+    no_create=yes ;;++  -no-recursion | --no-recursion | --no-recursio | --no-recursi \+  | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)+    no_recursion=yes ;;++  -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \+  | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \+  | --oldin | --oldi | --old | --ol | --o)+    ac_prev=oldincludedir ;;+  -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \+  | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \+  | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)+    oldincludedir=$ac_optarg ;;++  -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)+    ac_prev=prefix ;;+  -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)+    prefix=$ac_optarg ;;++  -program-prefix | --program-prefix | --program-prefi | --program-pref \+  | --program-pre | --program-pr | --program-p)+    ac_prev=program_prefix ;;+  -program-prefix=* | --program-prefix=* | --program-prefi=* \+  | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)+    program_prefix=$ac_optarg ;;++  -program-suffix | --program-suffix | --program-suffi | --program-suff \+  | --program-suf | --program-su | --program-s)+    ac_prev=program_suffix ;;+  -program-suffix=* | --program-suffix=* | --program-suffi=* \+  | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)+    program_suffix=$ac_optarg ;;++  -program-transform-name | --program-transform-name \+  | --program-transform-nam | --program-transform-na \+  | --program-transform-n | --program-transform- \+  | --program-transform | --program-transfor \+  | --program-transfo | --program-transf \+  | --program-trans | --program-tran \+  | --progr-tra | --program-tr | --program-t)+    ac_prev=program_transform_name ;;+  -program-transform-name=* | --program-transform-name=* \+  | --program-transform-nam=* | --program-transform-na=* \+  | --program-transform-n=* | --program-transform-=* \+  | --program-transform=* | --program-transfor=* \+  | --program-transfo=* | --program-transf=* \+  | --program-trans=* | --program-tran=* \+  | --progr-tra=* | --program-tr=* | --program-t=*)+    program_transform_name=$ac_optarg ;;++  -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)+    ac_prev=pdfdir ;;+  -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)+    pdfdir=$ac_optarg ;;++  -psdir | --psdir | --psdi | --psd | --ps)+    ac_prev=psdir ;;+  -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)+    psdir=$ac_optarg ;;++  -q | -quiet | --quiet | --quie | --qui | --qu | --q \+  | -silent | --silent | --silen | --sile | --sil)+    silent=yes ;;++  -runstatedir | --runstatedir | --runstatedi | --runstated \+  | --runstate | --runstat | --runsta | --runst | --runs \+  | --run | --ru | --r)+    ac_prev=runstatedir ;;+  -runstatedir=* | --runstatedir=* | --runstatedi=* | --runstated=* \+  | --runstate=* | --runstat=* | --runsta=* | --runst=* | --runs=* \+  | --run=* | --ru=* | --r=*)+    runstatedir=$ac_optarg ;;++  -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)+    ac_prev=sbindir ;;+  -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \+  | --sbi=* | --sb=*)+    sbindir=$ac_optarg ;;++  -sharedstatedir | --sharedstatedir | --sharedstatedi \+  | --sharedstated | --sharedstate | --sharedstat | --sharedsta \+  | --sharedst | --shareds | --shared | --share | --shar \+  | --sha | --sh)+    ac_prev=sharedstatedir ;;+  -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \+  | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \+  | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \+  | --sha=* | --sh=*)+    sharedstatedir=$ac_optarg ;;++  -site | --site | --sit)+    ac_prev=site ;;+  -site=* | --site=* | --sit=*)+    site=$ac_optarg ;;++  -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)+    ac_prev=srcdir ;;+  -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)+    srcdir=$ac_optarg ;;++  -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \+  | --syscon | --sysco | --sysc | --sys | --sy)+    ac_prev=sysconfdir ;;+  -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \+  | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)+    sysconfdir=$ac_optarg ;;++  -target | --target | --targe | --targ | --tar | --ta | --t)+    ac_prev=target_alias ;;+  -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)+    target_alias=$ac_optarg ;;++  -v | -verbose | --verbose | --verbos | --verbo | --verb)+    verbose=yes ;;++  -version | --version | --versio | --versi | --vers | -V)+    ac_init_version=: ;;++  -with-* | --with-*)+    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'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=\$ac_optarg ;;++  -without-* | --without-*)+    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'"+    ac_useropt_orig=$ac_useropt+    ac_useropt=`printf "%s\n" "$ac_useropt" | sed 's/[-+.]/_/g'`+    case $ac_user_opts in+      *"+"with_$ac_useropt"+"*) ;;+      *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"+	 ac_unrecognized_sep=', ';;+    esac+    eval with_$ac_useropt=no ;;++  --x)+    # Obsolete; use --with-x.+    with_x=yes ;;++  -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \+  | --x-incl | --x-inc | --x-in | --x-i)+    ac_prev=x_includes ;;+  -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \+  | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)+    x_includes=$ac_optarg ;;++  -x-libraries | --x-libraries | --x-librarie | --x-librari \+  | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)+    ac_prev=x_libraries ;;+  -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \+  | --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"+    ;;++  *=*)+    ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`+    # 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'" ;;+    esac+    eval $ac_envvar=\$ac_optarg+    export $ac_envvar ;;++  *)+    # FIXME: should be removed in autoconf 3.0.+    printf "%s\n" "$as_me: WARNING: you should use --build, --host, --target" >&2+    expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&+      printf "%s\n" "$as_me: WARNING: invalid host type: $ac_option" >&2+    : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"+    ;;++  esac+done++if test -n "$ac_prev"; then+  ac_option=--`echo $ac_prev | sed 's/_/-/g'`+  as_fn_error $? "missing argument to $ac_option"+fi++if test -n "$ac_unrecognized_opts"; then+  case $enable_option_checking in+    no) ;;+    fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;+    *)     printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;+  esac+fi++# Check all directory arguments for consistency.+for ac_var in	exec_prefix prefix bindir sbindir libexecdir datarootdir \+		datadir sysconfdir sharedstatedir localstatedir includedir \+		oldincludedir docdir infodir htmldir dvidir pdfdir psdir \+		libdir localedir mandir runstatedir+do+  eval ac_val=\$$ac_var+  # Remove trailing slashes.+  case $ac_val in+    */ )+      ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`+      eval $ac_var=\$ac_val;;+  esac+  # Be sure to have absolute directory names.+  case $ac_val in+    [\\/$]* | ?:[\\/]* )  continue;;+    NONE | '' ) case $ac_var in *prefix ) continue;; esac;;+  esac+  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'+# used to hold the argument of --host etc.+# FIXME: To remove some day.+build=$build_alias+host=$host_alias+target=$target_alias++# FIXME: To remove some day.+if test "x$host_alias" != x; then+  if test "x$build_alias" = x; then+    cross_compiling=maybe+  elif test "x$build_alias" != "x$host_alias"; then+    cross_compiling=yes+  fi+fi++ac_tool_prefix=+test -n "$host_alias" && ac_tool_prefix=$host_alias-++test "$silent" = yes && exec 6>/dev/null+++ac_pwd=`pwd` && test -n "$ac_pwd" &&+ac_ls_di=`ls -di .` &&+ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||+  as_fn_error $? "working directory cannot be determined"+test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||+  as_fn_error $? "pwd does not report name of working directory"+++# Find the source files, if location was not specified.+if test -z "$srcdir"; then+  ac_srcdir_defaulted=yes+  # Try the directory containing this script, then the parent directory.+  ac_confdir=`$as_dirname -- "$as_myself" ||+$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_myself" : 'X\(//\)[^/]' \| \+	 X"$as_myself" : 'X\(//\)$' \| \+	 X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$as_myself" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  srcdir=$ac_confdir+  if test ! -r "$srcdir/$ac_unique_file"; then+    srcdir=..+  fi+else+  ac_srcdir_defaulted=no+fi+if test ! -r "$srcdir/$ac_unique_file"; then+  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_abs_confdir=`(+	cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"+	pwd)`+# When building in place, set srcdir=.+if test "$ac_abs_confdir" = "$ac_pwd"; then+  srcdir=.+fi+# Remove unnecessary trailing slashes from srcdir.+# Double slashes in file names in object file debugging info+# mess up M-x gdb in Emacs.+case $srcdir in+*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;+esac+for ac_var in $ac_precious_vars; do+  eval ac_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_env_${ac_var}_value=\$${ac_var}+  eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}+  eval ac_cv_env_${ac_var}_value=\$${ac_var}+done++#+# Report the --help message.+#+if test "$ac_init_help" = "long"; then+  # 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.++Usage: $0 [OPTION]... [VAR=VALUE]...++To assign environment variables (e.g., CC, CFLAGS...), specify them as+VAR=VALUE.  See below for descriptions of some of the useful variables.++Defaults for the options are specified in brackets.++Configuration:+  -h, --help              display this help and exit+      --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+      --cache-file=FILE   cache test results in FILE [disabled]+  -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 \`..']++Installation directories:+  --prefix=PREFIX         install architecture-independent files in PREFIX+                          [$ac_default_prefix]+  --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'.++For better control, use the options below.++Fine tuning of the installation directories:+  --bindir=DIR            user executables [EPREFIX/bin]+  --sbindir=DIR           system admin executables [EPREFIX/sbin]+  --libexecdir=DIR        program executables [EPREFIX/libexec]+  --sysconfdir=DIR        read-only single-machine data [PREFIX/etc]+  --sharedstatedir=DIR    modifiable architecture-independent data [PREFIX/com]+  --localstatedir=DIR     modifiable single-machine data [PREFIX/var]+  --runstatedir=DIR       modifiable per-process data [LOCALSTATEDIR/run]+  --libdir=DIR            object code libraries [EPREFIX/lib]+  --includedir=DIR        C header files [PREFIX/include]+  --oldincludedir=DIR     C header files for non-gcc [/usr/include]+  --datarootdir=DIR       read-only arch.-independent data root [PREFIX/share]+  --datadir=DIR           read-only architecture-independent data [DATAROOTDIR]+  --infodir=DIR           info documentation [DATAROOTDIR/info]+  --localedir=DIR         locale-dependent data [DATAROOTDIR/locale]+  --mandir=DIR            man documentation [DATAROOTDIR/man]+  --docdir=DIR            documentation root [DATAROOTDIR/doc/streamly-core]+  --htmldir=DIR           html documentation [DOCDIR]+  --dvidir=DIR            dvi documentation [DOCDIR]+  --pdfdir=DIR            pdf documentation [DOCDIR]+  --psdir=DIR             ps documentation [DOCDIR]+_ACEOF++  cat <<\_ACEOF+_ACEOF+fi++if test -n "$ac_init_help"; then+  case $ac_init_help in+     short | recursive ) echo "Configuration of streamly-core 0.1.0:";;+   esac+  cat <<\_ACEOF++Optional Packages:+  --with-PACKAGE[=ARG]    use PACKAGE [ARG=yes]+  --without-PACKAGE       do not use PACKAGE (same as --with-PACKAGE=no)+GHC++Some influential environment variables:+  CC          C compiler command+  CFLAGS      C compiler flags+  LDFLAGS     linker flags, e.g. -L<lib dir> if you have libraries in a+              nonstandard directory <lib dir>+  LIBS        libraries to pass to the linker, e.g. -l<library>+  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+it to find libraries and programs with nonstandard names/locations.++Report bugs to <streamly@composewell.com>.+streamly-core home page: <https://streamly.composewell.com>.+_ACEOF+ac_status=$?+fi++if test "$ac_init_help" = "recursive"; then+  # If there are subdirs, report their specific --help.+  for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue+    test -d "$ac_dir" ||+      { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||+      continue+    ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix++    cd "$ac_dir" || { ac_status=$?; continue; }+    # Check for configure.gnu first; this name is used for a wrapper for+    # Metaconfig's "Configure" on case-insensitive file systems.+    if test -f "$ac_srcdir/configure.gnu"; then+      echo &&+      $SHELL "$ac_srcdir/configure.gnu" --help=recursive+    elif test -f "$ac_srcdir/configure"; then+      echo &&+      $SHELL "$ac_srcdir/configure" --help=recursive+    else+      printf "%s\n" "$as_me: WARNING: no configuration information is in $ac_dir" >&2+    fi || ac_status=$?+    cd "$ac_pwd" || { ac_status=$?; break; }+  done+fi++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++Copyright (C) 2021 Free Software Foundation, Inc.+This configure script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it.+_ACEOF+  exit+fi++## ------------------------ ##+## Autoconf initialization. ##+## ------------------------ ##++# ac_fn_c_try_compile LINENO+# --------------------------+# Try to compile conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_compile ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext conftest.beam+  if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest.$ac_objext+then :+  ac_retval=0+else $as_nop+  printf "%s\n" "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1+fi+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_compile++# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES+# -------------------------------------------------------+# Tests whether HEADER exists and can be compiled using the include files in+# INCLUDES, setting the cache variable VAR accordingly.+ac_fn_c_check_header_compile ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+printf %s "checking for $2... " >&6; }+if eval test \${$3+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$4+#include <$2>+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  eval "$3=yes"+else $as_nop+  eval "$3=no"+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+fi+eval ac_res=\$$3+	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+printf "%s\n" "$ac_res" >&6; }+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_header_compile++# ac_fn_c_try_link LINENO+# -----------------------+# Try to link conftest.$ac_ext, and return whether this succeeded.+ac_fn_c_try_link ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  rm -f conftest.$ac_objext conftest.beam conftest$ac_exeext+  if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    grep -v '^ *+' conftest.err >conftest.er1+    cat conftest.er1 >&5+    mv -f conftest.er1 conftest.err+  fi+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; } && {+	 test -z "$ac_c_werror_flag" ||+	 test ! -s conftest.err+       } && test -s conftest$ac_exeext && {+	 test "$cross_compiling" = yes ||+	 test -x conftest$ac_exeext+       }+then :+  ac_retval=0+else $as_nop+  printf "%s\n" "$as_me: failed program was:" >&5+sed 's/^/| /' conftest.$ac_ext >&5++	ac_retval=1+fi+  # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information+  # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would+  # interfere with the next link command; also delete a directory that is+  # left behind by Apple's compiler.  We do this before executing the actions.+  rm -rf conftest.dSYM conftest_ipa8_conftest.oo+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno+  as_fn_set_status $ac_retval++} # ac_fn_c_try_link++# ac_fn_c_check_func LINENO FUNC VAR+# ----------------------------------+# Tests whether FUNC exists, setting the cache variable VAR accordingly+ac_fn_c_check_func ()+{+  as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $2" >&5+printf %s "checking for $2... " >&6; }+if eval test \${$3+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  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.  */++#include <limits.h>+#undef $2++/* Override any GCC internal prototype to avoid an error.+   Use char because int might match the return type of a GCC+   builtin and then its argument prototype would still apply.  */+#ifdef __cplusplus+extern "C"+#endif+char $2 ();+/* 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.  */+#if defined __stub_$2 || defined __stub___$2+choke me+#endif++int+main (void)+{+return $2 ();+  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_link "$LINENO"+then :+  eval "$3=yes"+else $as_nop+  eval "$3=no"+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam \+    conftest$ac_exeext conftest.$ac_ext+fi+eval ac_res=\$$3+	       { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5+printf "%s\n" "$ac_res" >&6; }+  eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno++} # ac_fn_c_check_func+ac_configure_args_raw=+for ac_arg+do+  case $ac_arg in+  *\'*)+    ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+  esac+  as_fn_append ac_configure_args_raw " '$ac_arg'"+done++case $ac_configure_args_raw in+  *$as_nl*)+    ac_safe_unquote= ;;+  *)+    ac_unsafe_z='|&;<>()$`\\"*?[ ''	' # This string ends in space, tab.+    ac_unsafe_a="$ac_unsafe_z#~"+    ac_safe_unquote="s/ '\\([^$ac_unsafe_a][^$ac_unsafe_z]*\\)'/ \\1/g"+    ac_configure_args_raw=`      printf "%s\n" "$ac_configure_args_raw" | sed "$ac_safe_unquote"`;;+esac++cat >config.log <<_ACEOF+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++  $ $0$ac_configure_args_raw++_ACEOF+exec 5>>config.log+{+cat <<_ASUNAME+## --------- ##+## Platform. ##+## --------- ##++hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`+uname -m = `(uname -m) 2>/dev/null || echo unknown`+uname -r = `(uname -r) 2>/dev/null || echo unknown`+uname -s = `(uname -s) 2>/dev/null || echo unknown`+uname -v = `(uname -v) 2>/dev/null || echo unknown`++/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`+/bin/uname -X     = `(/bin/uname -X) 2>/dev/null     || echo unknown`++/bin/arch              = `(/bin/arch) 2>/dev/null              || echo unknown`+/usr/bin/arch -k       = `(/usr/bin/arch -k) 2>/dev/null       || echo unknown`+/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`+/usr/bin/hostinfo      = `(/usr/bin/hostinfo) 2>/dev/null      || echo unknown`+/bin/machine           = `(/bin/machine) 2>/dev/null           || echo unknown`+/usr/bin/oslevel       = `(/usr/bin/oslevel) 2>/dev/null       || echo unknown`+/bin/universe          = `(/bin/universe) 2>/dev/null          || echo unknown`++_ASUNAME++as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    printf "%s\n" "PATH: $as_dir"+  done+IFS=$as_save_IFS++} >&5++cat >&5 <<_ACEOF+++## ----------- ##+## Core tests. ##+## ----------- ##++_ACEOF+++# Keep a trace of the command line.+# Strip out --no-create and --no-recursion so they do not pile up.+# Strip out --silent because we don't want to record it for future runs.+# Also quote any args containing shell meta-characters.+# Make two passes to allow for proper duplicate-argument suppression.+ac_configure_args=+ac_configure_args0=+ac_configure_args1=+ac_must_keep_next=false+for ac_pass in 1 2+do+  for ac_arg+  do+    case $ac_arg in+    -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;+    -q | -quiet | --quiet | --quie | --qui | --qu | --q \+    | -silent | --silent | --silen | --sile | --sil)+      continue ;;+    *\'*)+      ac_arg=`printf "%s\n" "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    case $ac_pass in+    1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;+    2)+      as_fn_append ac_configure_args1 " '$ac_arg'"+      if test $ac_must_keep_next = true; then+	ac_must_keep_next=false # Got value, back to normal.+      else+	case $ac_arg in+	  *=* | --config-cache | -C | -disable-* | --disable-* \+	  | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \+	  | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \+	  | -with-* | --with-* | -without-* | --without-* | --x)+	    case "$ac_configure_args0 " in+	      "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;+	    esac+	    ;;+	  -* ) ac_must_keep_next=true ;;+	esac+      fi+      as_fn_append ac_configure_args " '$ac_arg'"+      ;;+    esac+  done+done+{ ac_configure_args0=; unset ac_configure_args0;}+{ ac_configure_args1=; unset ac_configure_args1;}++# When interrupted or exit'd, cleanup temporary files, and complete+# config.log.  We remove comments because anyway the quotes in there+# would cause problems or look ugly.+# WARNING: Use '\'' to represent an apostrophe within the trap.+# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.+trap 'exit_status=$?+  # Sanitize IFS.+  IFS=" ""	$as_nl"+  # Save into config.log some information that might help in debugging.+  {+    echo++    printf "%s\n" "## ---------------- ##+## Cache variables. ##+## ---------------- ##"+    echo+    # The following way of writing the cache mishandles newlines in values,+(+  for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done+  (set) 2>&1 |+    case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(+    *${as_nl}ac_space=\ *)+      sed -n \+	"s/'\''/'\''\\\\'\'''\''/g;+	  s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"+      ;; #(+    *)+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+)+    echo++    printf "%s\n" "## ----------------- ##+## Output variables. ##+## ----------------- ##"+    echo+    for ac_var in $ac_subst_vars+    do+      eval ac_val=\$$ac_var+      case $ac_val in+      *\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+      esac+      printf "%s\n" "$ac_var='\''$ac_val'\''"+    done | sort+    echo++    if test -n "$ac_subst_files"; then+      printf "%s\n" "## ------------------- ##+## File substitutions. ##+## ------------------- ##"+      echo+      for ac_var in $ac_subst_files+      do+	eval ac_val=\$$ac_var+	case $ac_val in+	*\'\''*) ac_val=`printf "%s\n" "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;+	esac+	printf "%s\n" "$ac_var='\''$ac_val'\''"+      done | sort+      echo+    fi++    if test -s confdefs.h; then+      printf "%s\n" "## ----------- ##+## confdefs.h. ##+## ----------- ##"+      echo+      cat confdefs.h+      echo+    fi+    test "$ac_signal" != 0 &&+      printf "%s\n" "$as_me: caught signal $ac_signal"+    printf "%s\n" "$as_me: exit $exit_status"+  } >&5+  rm -f core *.core core.conftest.* &&+    rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&+    exit $exit_status+' 0+for ac_signal in 1 2 13 15; do+  trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal+done+ac_signal=0++# confdefs.h avoids OS command line length limits that DEFS can exceed.+rm -f -r conftest* confdefs.h++printf "%s\n" "/* confdefs.h */" > confdefs.h++# Predefined preprocessor variables.++printf "%s\n" "#define PACKAGE_NAME \"$PACKAGE_NAME\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_TARNAME \"$PACKAGE_TARNAME\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_VERSION \"$PACKAGE_VERSION\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_STRING \"$PACKAGE_STRING\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_BUGREPORT \"$PACKAGE_BUGREPORT\"" >>confdefs.h++printf "%s\n" "#define PACKAGE_URL \"$PACKAGE_URL\"" >>confdefs.h+++# Let the site file select an alternate cache file if it wants to.+# Prefer an explicitly selected file to automatically selected ones.+if test -n "$CONFIG_SITE"; then+  ac_site_files="$CONFIG_SITE"+elif test "x$prefix" != xNONE; then+  ac_site_files="$prefix/share/config.site $prefix/etc/config.site"+else+  ac_site_files="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"+fi++for ac_site_file in $ac_site_files+do+  case $ac_site_file in #(+  */*) :+     ;; #(+  *) :+    ac_site_file=./$ac_site_file ;;+esac+  if test -f "$ac_site_file" && test -r "$ac_site_file"; then+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5+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;}+as_fn_error $? "failed to load site script $ac_site_file+See \`config.log' for more details" "$LINENO" 5; }+  fi+done++if test -r "$cache_file"; then+  # Some versions of bash will fail to source /dev/null (special files+  # actually), so we avoid doing that.  DJGPP emulates it as a regular file.+  if test /dev/null != "$cache_file" && test -f "$cache_file"; then+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5+printf "%s\n" "$as_me: loading cache $cache_file" >&6;}+    case $cache_file in+      [\\/]* | ?:[\\/]* ) . "$cache_file";;+      *)                      . "./$cache_file";;+    esac+  fi+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5+printf "%s\n" "$as_me: creating cache $cache_file" >&6;}+  >$cache_file+fi++# Test code for whether the C compiler supports C89 (global declarations)+ac_c_conftest_c89_globals='+/* Does the compiler advertise C89 conformance?+   Do not test the value of __STDC__, because some compilers set it to 0+   while being otherwise adequately conformant. */+#if !defined __STDC__+# error "Compiler does not advertise C89 conformance"+#endif++#include <stddef.h>+#include <stdarg.h>+struct stat;+/* 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;+{+  return p[i];+}+static char *f (char * (*g) (char **, int), char **p, ...)+{+  char *s;+  va_list v;+  va_start (v,p);+  s = g (p, va_arg (v,int));+  va_end (v);+  return s;+}++/* 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+   as an "x".  The following induces an error, until -std is added to get+   proper ANSI mode.  Curiously \x00 != x always comes out true, for an+   array size at least.  It is necessary to write \x00 == 0 to get something+   that is true only with -std.  */+int osf4_cc_array ['\''\x00'\'' == 0 ? 1 : -1];++/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters+   inside strings and character constants.  */+#define FOO(x) '\''x'\''+int xlc6_cc_array[FOO(a) == '\''x'\'' ? 1 : -1];++int test (int i, double x);+struct s1 {int (*f) (int a);};+struct s2 {int (*f) (double a);};+int pairnames (int, char **, int *(*)(struct buf *, struct stat *, int),+               int, int);'++# Test code for whether the C compiler supports C89 (body of main).+ac_c_conftest_c89_main='+ok |= (argc == 0 || f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]);+'++# Test code for whether the C compiler supports C99 (global declarations)+ac_c_conftest_c99_globals='+// Does the compiler advertise C99 conformance?+#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 199901L+# error "Compiler does not advertise C99 conformance"+#endif++#include <stdbool.h>+extern int puts (const char *);+extern int printf (const char *, ...);+extern int dprintf (int, const char *, ...);+extern void *malloc (size_t);++// Check varargs macros.  These examples are taken from C99 6.10.3.5.+// dprintf is used instead of fprintf to avoid needing to declare+// FILE and stderr.+#define debug(...) dprintf (2, __VA_ARGS__)+#define showlist(...) puts (#__VA_ARGS__)+#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__))+static void+test_varargs_macros (void)+{+  int x = 1234;+  int y = 5678;+  debug ("Flag");+  debug ("X = %d\n", x);+  showlist (The first, second, and third items.);+  report (x>y, "x is %d but y is %d", x, y);+}++// Check long long types.+#define BIG64 18446744073709551615ull+#define BIG32 4294967295ul+#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0)+#if !BIG_OK+  #error "your preprocessor is broken"+#endif+#if BIG_OK+#else+  #error "your preprocessor is broken"+#endif+static long long int bignum = -9223372036854775807LL;+static unsigned long long int ubignum = BIG64;++struct incomplete_array+{+  int datasize;+  double data[];+};++struct named_init {+  int number;+  const wchar_t *name;+  double average;+};++typedef const char *ccp;++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)+    continue;+  return 0;+}++// Check varargs and va_copy.+static bool+test_varargs (const char *format, ...)+{+  va_list args;+  va_start (args, format);+  va_list args_copy;+  va_copy (args_copy, args);++  const char *str = "";+  int number = 0;+  float fnumber = 0;++  while (*format)+    {+      switch (*format++)+	{+	case '\''s'\'': // string+	  str = va_arg (args_copy, const char *);+	  break;+	case '\''d'\'': // int+	  number = va_arg (args_copy, int);+	  break;+	case '\''f'\'': // float+	  fnumber = va_arg (args_copy, double);+	  break;+	default:+	  break;+	}+    }+  va_end (args_copy);+  va_end (args);++  return *str && number && fnumber;+}+'++# Test code for whether the C compiler supports C99 (body of main).+ac_c_conftest_c99_main='+  // Check bool.+  _Bool success = false;+  success |= (argc != 0);++  // Check restrict.+  if (test_restrict ("String literal") == 0)+    success = true;+  char *restrict newvar = "Another string";++  // Check varargs.+  success &= test_varargs ("s, d'\'' f .", "string", 65, 34.234);+  test_varargs_macros ();++  // Check flexible array members.+  struct incomplete_array *ia =+    malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10));+  ia->datasize = 10;+  for (int i = 0; i < ia->datasize; ++i)+    ia->data[i] = i * 1.234;++  // Check named initializers.+  struct named_init ni = {+    .number = 34,+    .name = L"Test wide string",+    .average = 543.34343,+  };++  ni.number = 58;++  int dynamic_array[ni.number];+  dynamic_array[0] = argv[0][0];+  dynamic_array[ni.number - 1] = 543;++  // work around unused variable warnings+  ok |= (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == '\''x'\''+	 || dynamic_array[ni.number - 1] != 543);+'++# Test code for whether the C compiler supports C11 (global declarations)+ac_c_conftest_c11_globals='+// Does the compiler advertise C11 conformance?+#if !defined __STDC_VERSION__ || __STDC_VERSION__ < 201112L+# error "Compiler does not advertise C11 conformance"+#endif++// Check _Alignas.+char _Alignas (double) aligned_as_double;+char _Alignas (0) no_special_alignment;+extern char aligned_as_int;+char _Alignas (0) _Alignas (int) aligned_as_int;++// Check _Alignof.+enum+{+  int_alignment = _Alignof (int),+  int_array_alignment = _Alignof (int[100]),+  char_alignment = _Alignof (char)+};+_Static_assert (0 < -_Alignof (int), "_Alignof is signed");++// Check _Noreturn.+int _Noreturn does_not_return (void) { for (;;) continue; }++// Check _Static_assert.+struct test_static_assert+{+  int x;+  _Static_assert (sizeof (int) <= sizeof (long int),+                  "_Static_assert does not work in struct");+  long int y;+};++// Check UTF-8 literals.+#define u8 syntax error!+char const utf8_literal[] = u8"happens to be ASCII" "another string";++// Check duplicate typedefs.+typedef long *long_ptr;+typedef long int *long_ptr;+typedef long_ptr long_ptr;++// Anonymous structures and unions -- taken from C11 6.7.2.1 Example 1.+struct anonymous+{+  union {+    struct { int i; int j; };+    struct { int k; long int l; } w;+  };+  int m;+} v1;+'++# Test code for whether the C compiler supports C11 (body of main).+ac_c_conftest_c11_main='+  _Static_assert ((offsetof (struct anonymous, i)+		   == offsetof (struct anonymous, w.k)),+		  "Anonymous union alignment botch");+  v1.i = 2;+  v1.w.k = 5;+  ok |= v1.i != 5;+'++# Test code for whether the C compiler supports C11 (complete).+ac_c_conftest_c11_program="${ac_c_conftest_c89_globals}+${ac_c_conftest_c99_globals}+${ac_c_conftest_c11_globals}++int+main (int argc, char **argv)+{+  int ok = 0;+  ${ac_c_conftest_c89_main}+  ${ac_c_conftest_c99_main}+  ${ac_c_conftest_c11_main}+  return ok;+}+"++# Test code for whether the C compiler supports C99 (complete).+ac_c_conftest_c99_program="${ac_c_conftest_c89_globals}+${ac_c_conftest_c99_globals}++int+main (int argc, char **argv)+{+  int ok = 0;+  ${ac_c_conftest_c89_main}+  ${ac_c_conftest_c99_main}+  return ok;+}+"++# Test code for whether the C compiler supports C89 (complete).+ac_c_conftest_c89_program="${ac_c_conftest_c89_globals}++int+main (int argc, char **argv)+{+  int ok = 0;+  ${ac_c_conftest_c89_main}+  return ok;+}+"++as_fn_append ac_header_c_list " stdio.h stdio_h HAVE_STDIO_H"+as_fn_append ac_header_c_list " stdlib.h stdlib_h HAVE_STDLIB_H"+as_fn_append ac_header_c_list " string.h string_h HAVE_STRING_H"+as_fn_append ac_header_c_list " inttypes.h inttypes_h HAVE_INTTYPES_H"+as_fn_append ac_header_c_list " stdint.h stdint_h HAVE_STDINT_H"+as_fn_append ac_header_c_list " strings.h strings_h HAVE_STRINGS_H"+as_fn_append ac_header_c_list " sys/stat.h sys_stat_h HAVE_SYS_STAT_H"+as_fn_append ac_header_c_list " sys/types.h sys_types_h HAVE_SYS_TYPES_H"+as_fn_append ac_header_c_list " unistd.h unistd_h HAVE_UNISTD_H"+# Check that the precious variables saved in the cache have kept the same+# value.+ac_cache_corrupted=false+for ac_var in $ac_precious_vars; do+  eval ac_old_set=\$ac_cv_env_${ac_var}_set+  eval ac_new_set=\$ac_env_${ac_var}_set+  eval ac_old_val=\$ac_cv_env_${ac_var}_value+  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;}+      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;}+      ac_cache_corrupted=: ;;+    ,);;+    *)+      if test "x$ac_old_val" != "x$ac_new_val"; then+	# differences in whitespace do not lead to failure.+	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;}+	  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;}+	  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;}+      fi;;+  esac+  # Pass precious variables to config.status.+  if test "$ac_new_set" = set; then+    case $ac_new_val in+    *\'*) ac_arg=$ac_var=`printf "%s\n" "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;+    *) ac_arg=$ac_var=$ac_new_val ;;+    esac+    case " $ac_configure_args " in+      *" '$ac_arg' "*) ;; # Avoid dups.  Use of quotes ensures accuracy.+      *) as_fn_append ac_configure_args " '$ac_arg'" ;;+    esac+  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: 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'+	    and start over" "$LINENO" 5+fi+## -------------------- ##+## Main body of script. ##+## -------------------- ##++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu++++# To suppress "WARNING: unrecognized options: --with-compiler"++# Check whether --with-compiler was given.+if test ${with_compiler+y}+then :+  withval=$with_compiler;+fi+++# Check headers and functions required++++++++++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args.+set dummy ${ac_tool_prefix}gcc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}gcc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "gcc", so it can be a program name with args.+set dummy gcc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_ac_ct_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="gcc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+printf "%s\n" "$ac_ct_CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+else+  CC="$ac_cv_prog_CC"+fi++if test -z "$CC"; then+          if test -n "$ac_tool_prefix"; then+    # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args.+set dummy ${ac_tool_prefix}cc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}cc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++  fi+fi+if test -z "$CC"; then+  # Extract the first word of "cc", so it can be a program name with args.+set dummy cc; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+  ac_prog_rejected=no+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    if test "$as_dir$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then+       ac_prog_rejected=yes+       continue+     fi+    ac_cv_prog_CC="cc"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++if test $ac_prog_rejected = yes; then+  # We found a bogon in the path, so make sure we never use it.+  set dummy $ac_cv_prog_CC+  shift+  if test $# != 0; then+    # We chose a different compiler from the bogus one.+    # However, it has the same basename, so the bogon will be chosen+    # first if we set CC to just the basename; use the full file name.+    shift+    ac_cv_prog_CC="$as_dir$ac_word${1+' '}$@"+  fi+fi+fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  for ac_prog in cl.exe+  do+    # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args.+set dummy $ac_tool_prefix$ac_prog; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="$ac_tool_prefix$ac_prog"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++    test -n "$CC" && break+  done+fi+if test -z "$CC"; then+  ac_ct_CC=$CC+  for ac_prog in cl.exe+do+  # Extract the first word of "$ac_prog", so it can be a program name with args.+set dummy $ac_prog; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_ac_ct_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="$ac_prog"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+printf "%s\n" "$ac_ct_CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++  test -n "$ac_ct_CC" && break+done++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+fi++fi+if test -z "$CC"; then+  if test -n "$ac_tool_prefix"; then+  # Extract the first word of "${ac_tool_prefix}clang", so it can be a program name with args.+set dummy ${ac_tool_prefix}clang; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  if test -n "$CC"; then+  ac_cv_prog_CC="$CC" # Let the user override the test.+else+as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_CC="${ac_tool_prefix}clang"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+CC=$ac_cv_prog_CC+if test -n "$CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $CC" >&5+printf "%s\n" "$CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi+++fi+if test -z "$ac_cv_prog_CC"; then+  ac_ct_CC=$CC+  # Extract the first word of "clang", so it can be a program name with args.+set dummy clang; ac_word=$2+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5+printf %s "checking for $ac_word... " >&6; }+if test ${ac_cv_prog_ac_ct_CC+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  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+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    for ac_exec_ext in '' $ac_executable_extensions; do+  if as_fn_executable_p "$as_dir$ac_word$ac_exec_ext"; then+    ac_cv_prog_ac_ct_CC="clang"+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: found $as_dir$ac_word$ac_exec_ext" >&5+    break 2+  fi+done+  done+IFS=$as_save_IFS++fi+fi+ac_ct_CC=$ac_cv_prog_ac_ct_CC+if test -n "$ac_ct_CC"; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5+printf "%s\n" "$ac_ct_CC" >&6; }+else+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+fi++  if test "x$ac_ct_CC" = x; then+    CC=""+  else+    case $cross_compiling:$ac_tool_warned in+yes:)+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5+printf "%s\n" "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;}+ac_tool_warned=yes ;;+esac+    CC=$ac_ct_CC+  fi+else+  CC="$ac_cv_prog_CC"+fi++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;}+as_fn_error $? "no acceptable C compiler found in \$PATH+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+set X $ac_compile+ac_compiler=$2+for ac_option in --version -v -V -qversion -version; do+  { { ac_try="$ac_compiler $ac_option >&5"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_compiler $ac_option >&5") 2>conftest.err+  ac_status=$?+  if test -s conftest.err; then+    sed '10a\+... rest of stderr output deleted ...+         10q' conftest.err >conftest.er1+    cat conftest.er1 >&5+  fi+  rm -f conftest.er1 conftest.err+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+done++cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out"+# Try to create an executable without -o first, disregard a.out.+# It will help us diagnose broken compilers, and finding out an intuition+# of exeext.+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5+printf %s "checking whether the C compiler works... " >&6; }+ac_link_default=`printf "%s\n" "$ac_link" | sed 's/ -o *conftest[^ ]*//'`++# The possible output files:+ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*"++ac_rmfiles=+for ac_file in $ac_files+do+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    * ) ac_rmfiles="$ac_rmfiles $ac_file";;+  esac+done+rm -f $ac_rmfiles++if { { ac_try="$ac_link_default"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link_default") 2>&5+  ac_status=$?+  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'+# 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.+for ac_file in $ac_files ''+do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj )+	;;+    [ab].out )+	# We found the default executable, but exeext='' is most+	# certainly right.+	break;;+    *.* )+	if test ${ac_cv_exeext+y} && test "$ac_cv_exeext" != no;+	then :; else+	   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'+	# 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.+	break;;+    * )+	break;;+  esac+done+test "$ac_cv_exeext" = no && ac_cv_exeext=++else $as_nop+  ac_file=''+fi+if test -z "$ac_file"+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: no" >&5+printf "%s\n" "no" >&6; }+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;}+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; }+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; }+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5+printf "%s\n" "$ac_file" >&6; }+ac_exeext=$ac_cv_exeext++rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out+ac_clean_files=$ac_clean_files_save+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5+printf %s "checking for suffix of executables... " >&6; }+if { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  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'.+for ac_file in conftest.exe conftest conftest.*; do+  test -f "$ac_file" || continue+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;;+    *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'`+	  break;;+    * ) 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;}+as_fn_error $? "cannot compute suffix of executables: cannot compile and link+See \`config.log' for more details" "$LINENO" 5; }+fi+rm -f conftest conftest$ac_cv_exeext+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5+printf "%s\n" "$ac_cv_exeext" >&6; }++rm -f conftest.$ac_ext+EXEEXT=$ac_cv_exeext+ac_exeext=$EXEEXT+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+#include <stdio.h>+int+main (void)+{+FILE *f = fopen ("conftest.out", "w");+ return ferror (f) || fclose (f) != 0;++  ;+  return 0;+}+_ACEOF+ac_clean_files="$ac_clean_files conftest.out"+# Check that the compiler produces executables we can run.  If not, either+# the compiler is broken, or we cross compile.+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5+printf %s "checking whether we are cross compiling... " >&6; }+if test "$cross_compiling" != yes; then+  { { ac_try="$ac_link"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_link") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+  if { ac_try='./conftest$ac_cv_exeext'+  { { case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_try") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }; }; then+    cross_compiling=no+  else+    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;}+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; }+    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+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+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+rm -f conftest.o conftest.obj+if { { ac_try="$ac_compile"+case "(($ac_try" in+  *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;;+  *) ac_try_echo=$ac_try;;+esac+eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\""+printf "%s\n" "$ac_try_echo"; } >&5+  (eval "$ac_compile") 2>&5+  ac_status=$?+  printf "%s\n" "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5+  test $ac_status = 0; }+then :+  for ac_file in conftest.o conftest.obj conftest.*; do+  test -f "$ac_file" || continue;+  case $ac_file in+    *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;;+    *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'`+       break;;+  esac+done+else $as_nop+  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;}+as_fn_error $? "cannot compute suffix of object files: cannot compile+See \`config.log' for more details" "$LINENO" 5; }+fi+rm -f conftest.$ac_cv_objext conftest.$ac_ext+fi+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5+printf "%s\n" "$ac_cv_objext" >&6; }+OBJEXT=$ac_cv_objext+ac_objext=$OBJEXT+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether the compiler supports GNU C" >&5+printf %s "checking whether the compiler supports GNU C... " >&6; }+if test ${ac_cv_c_compiler_gnu+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{+#ifndef __GNUC__+       choke me+#endif++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  ac_compiler_gnu=yes+else $as_nop+  ac_compiler_gnu=no+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+ac_cv_c_compiler_gnu=$ac_compiler_gnu++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; }+ac_compiler_gnu=$ac_cv_c_compiler_gnu++if test $ac_compiler_gnu = yes; then+  GCC=yes+else+  GCC=+fi+ac_test_CFLAGS=${CFLAGS+y}+ac_save_CFLAGS=$CFLAGS+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5+printf %s "checking whether $CC accepts -g... " >&6; }+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+   ac_c_werror_flag=yes+   ac_cv_prog_cc_g=no+   CFLAGS="-g"+   cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_g=yes+else $as_nop+  CFLAGS=""+      cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :++else $as_nop+  ac_c_werror_flag=$ac_save_c_werror_flag+	 CFLAGS="-g"+	 cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */++int+main (void)+{++  ;+  return 0;+}+_ACEOF+if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_g=yes+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam conftest.$ac_ext+   ac_c_werror_flag=$ac_save_c_werror_flag+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; }+if test $ac_test_CFLAGS; then+  CFLAGS=$ac_save_CFLAGS+elif test $ac_cv_prog_cc_g = yes; then+  if test "$GCC" = yes; then+    CFLAGS="-g -O2"+  else+    CFLAGS="-g"+  fi+else+  if test "$GCC" = yes; then+    CFLAGS="-O2"+  else+    CFLAGS=+  fi+fi+ac_prog_cc_stdc=no+if test x$ac_prog_cc_stdc = xno+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C11 features" >&5+printf %s "checking for $CC option to enable C11 features... " >&6; }+if test ${ac_cv_prog_cc_c11+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_cv_prog_cc_c11=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$ac_c_conftest_c11_program+_ACEOF+for ac_arg in '' -std=gnu11+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_c11=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam+  test "x$ac_cv_prog_cc_c11" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC+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+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+printf "%s\n" "$ac_cv_prog_cc_c11" >&6; }+     CC="$CC $ac_cv_prog_cc_c11"+fi+  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c11+  ac_prog_cc_stdc=c11+fi+fi+if test x$ac_prog_cc_stdc = xno+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C99 features" >&5+printf %s "checking for $CC option to enable C99 features... " >&6; }+if test ${ac_cv_prog_cc_c99+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_cv_prog_cc_c99=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$ac_c_conftest_c99_program+_ACEOF+for ac_arg in '' -std=gnu99 -std=c99 -c99 -qlanglvl=extc1x -qlanglvl=extc99 -AC99 -D_STDC_C99=+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_c99=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam+  test "x$ac_cv_prog_cc_c99" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC+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+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+printf "%s\n" "$ac_cv_prog_cc_c99" >&6; }+     CC="$CC $ac_cv_prog_cc_c99"+fi+  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99+  ac_prog_cc_stdc=c99+fi+fi+if test x$ac_prog_cc_stdc = xno+then :+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: checking for $CC option to enable C89 features" >&5+printf %s "checking for $CC option to enable C89 features... " >&6; }+if test ${ac_cv_prog_cc_c89+y}+then :+  printf %s "(cached) " >&6+else $as_nop+  ac_cv_prog_cc_c89=no+ac_save_CC=$CC+cat confdefs.h - <<_ACEOF >conftest.$ac_ext+/* end confdefs.h.  */+$ac_c_conftest_c89_program+_ACEOF+for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"+do+  CC="$ac_save_CC $ac_arg"+  if ac_fn_c_try_compile "$LINENO"+then :+  ac_cv_prog_cc_c89=$ac_arg+fi+rm -f core conftest.err conftest.$ac_objext conftest.beam+  test "x$ac_cv_prog_cc_c89" != "xno" && break+done+rm -f conftest.$ac_ext+CC=$ac_save_CC+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+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+printf "%s\n" "$ac_cv_prog_cc_c89" >&6; }+     CC="$CC $ac_cv_prog_cc_c89"+fi+  ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89+  ac_prog_cc_stdc=c89+fi+fi++ac_ext=c+ac_cpp='$CPP $CPPFLAGS'+ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'+ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'+ac_compiler_gnu=$ac_cv_c_compiler_gnu+++ac_header= ac_cache=+for ac_item in $ac_header_c_list+do+  if test $ac_cache; then+    ac_fn_c_check_header_compile "$LINENO" $ac_header ac_cv_header_$ac_cache "$ac_includes_default"+    if eval test \"x\$ac_cv_header_$ac_cache\" = xyes; then+      printf "%s\n" "#define $ac_item 1" >> confdefs.h+    fi+    ac_header= ac_cache=+  elif test $ac_header; then+    ac_cache=$ac_item+  else+    ac_header=$ac_item+  fi+done+++++++++if test $ac_cv_header_stdlib_h = yes && test $ac_cv_header_string_h = yes+then :++printf "%s\n" "#define STDC_HEADERS 1" >>confdefs.h++fi+ac_fn_c_check_header_compile "$LINENO" "time.h" "ac_cv_header_time_h" "$ac_includes_default"+if test "x$ac_cv_header_time_h" = xyes+then :+  printf "%s\n" "#define HAVE_TIME_H 1" >>confdefs.h++fi++ac_fn_c_check_func "$LINENO" "clock_gettime" "ac_cv_func_clock_gettime"+if test "x$ac_cv_func_clock_gettime" = xyes+then :+  printf "%s\n" "#define HAVE_CLOCK_GETTIME 1" >>confdefs.h++fi+++# Output+ac_config_headers="$ac_config_headers src/config.h"++cat >confcache <<\_ACEOF+# This file is a shell script that caches the results of configure+# tests run on this system so they can be shared between configure+# scripts and configure runs, see configure's option --config-cache.+# It is not useful on other systems.  If it contains results you don't+# want to keep, you may remove or edit it.+#+# 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+# following values.++_ACEOF++# The following way of writing the cache mishandles newlines in values,+# but we know of no workaround that is simple, portable, and efficient.+# So, we kill variables containing newlines.+# Ultrix sh set writes to stderr and can't be redirected directly,+# and sets the high bit in the cache file unless we assign to the vars.+(+  for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do+    eval ac_val=\$$ac_var+    case $ac_val in #(+    *${as_nl}*)+      case $ac_var in #(+      *_cv_*) { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5+printf "%s\n" "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;+      esac+      case $ac_var in #(+      _ | IFS | as_nl) ;; #(+      BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(+      *) { eval $ac_var=; unset $ac_var;} ;;+      esac ;;+    esac+  done++  (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+      # 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.+      sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"+      ;;+    esac |+    sort+) |+  sed '+     /^ac_cv_env_/b end+     t clear+     :clear+     s/^\([^=]*\)=\(.*[{}].*\)$/test ${\1+y} || &/+     t end+     s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/+     :end' >>confcache+if diff "$cache_file" confcache >/dev/null 2>&1; then :; else+  if test -w "$cache_file"; then+    if test "x$cache_file" != "x/dev/null"; then+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5+printf "%s\n" "$as_me: updating cache $cache_file" >&6;}+      if test ! -f "$cache_file" || test -h "$cache_file"; then+	cat confcache >"$cache_file"+      else+        case $cache_file in #(+        */* | ?:*)+	  mv -f confcache "$cache_file"$$ &&+	  mv -f "$cache_file"$$ "$cache_file" ;; #(+        *)+	  mv -f confcache "$cache_file" ;;+	esac+      fi+    fi+  else+    { printf "%s\n" "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5+printf "%s\n" "$as_me: not updating unwritable cache $cache_file" >&6;}+  fi+fi+rm -f confcache++test "x$prefix" = xNONE && prefix=$ac_default_prefix+# Let make expand exec_prefix.+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'++DEFS=-DHAVE_CONFIG_H++ac_libobjs=+ac_ltlibobjs=+U=+for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue+  # 1. Remove the extension, and $U if already installed.+  ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'+  ac_i=`printf "%s\n" "$ac_i" | sed "$ac_script"`+  # 2. Prepend LIBOBJDIR.  When used with automake>=1.10 LIBOBJDIR+  #    will be set to the directory where LIBOBJS objects are built.+  as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"+  as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'+done+LIBOBJS=$ac_libobjs++LTLIBOBJS=$ac_ltlibobjs++++: "${CONFIG_STATUS=./config.status}"+ac_write_fail=0+ac_clean_files_save=$ac_clean_files+ac_clean_files="$ac_clean_files $CONFIG_STATUS"+{ printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5+printf "%s\n" "$as_me: creating $CONFIG_STATUS" >&6;}+as_write_fail=0+cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1+#! $SHELL+# Generated by $as_me.+# Run this file to recreate the current configuration.+# Compiler output produced by configure, useful for debugging+# configure, is in config.log if it exists.++debug=false+ac_cs_recheck=false+ac_cs_silent=false++SHELL=\${CONFIG_SHELL-$SHELL}+export SHELL+_ASEOF+cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1+## -------------------- ##+## M4sh Initialization. ##+## -------------------- ##++# 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+  NULLCMD=:+  # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which+  # 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 #(+  *posix*) :+    set -o posix ;; #(+  *) :+     ;;+esac+fi++++# Reset variables that may have inherited troublesome values from+# the environment.++# IFS needs to be set, to space, tab, and newline, in precisely that order.+# (If _AS_PATH_WALK were called with IFS unset, it would have the+# side effect of setting IFS to empty, thus disabling word splitting.)+# Quoting is to prevent editors from complaining about space-tab.+as_nl='+'+export as_nl+IFS=" ""	$as_nl"++PS1='$ '+PS2='> '+PS4='+ '++# Ensure predictable behavior from utilities with locale-dependent output.+LC_ALL=C+export LC_ALL+LANGUAGE=C+export LANGUAGE++# We cannot yet rely on "unset" to work, but we need these variables+# to be unset--not just set to an empty or harmless value--now, to+# avoid bugs in old shells (e.g. pre-3.0 UWIN ksh).  This construct+# also avoids known problems related to "unset" and subshell syntax+# in other old shells (e.g. bash 2.01 and pdksh 5.2.14).+for as_var in BASH_ENV ENV MAIL MAILPATH CDPATH+do eval test \${$as_var+y} \+  && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :+done++# Ensure that fds 0, 1, and 2 are open.+if (exec 3>&0) 2>/dev/null; then :; else exec 0</dev/null; fi+if (exec 3>&1) 2>/dev/null; then :; else exec 1>/dev/null; fi+if (exec 3>&2)            ; then :; else exec 2>/dev/null; fi++# The user is always right.+if ${PATH_SEPARATOR+false} :; then+  PATH_SEPARATOR=:+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {+    (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||+      PATH_SEPARATOR=';'+  }+fi+++# Find who we are.  Look in the path if we contain no directory separator.+as_myself=+case $0 in #((+  *[\\/]* ) as_myself=$0 ;;+  *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR+for as_dir in $PATH+do+  IFS=$as_save_IFS+  case $as_dir in #(((+    '') as_dir=./ ;;+    */) ;;+    *) as_dir=$as_dir/ ;;+  esac+    test -r "$as_dir$0" && as_myself=$as_dir$0 && break+  done+IFS=$as_save_IFS++     ;;+esac+# 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+fi+if test ! -f "$as_myself"; then+  printf "%s\n" "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2+  exit 1+fi++++# as_fn_error STATUS ERROR [LINENO LOG_FD]+# ----------------------------------------+# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are+# provided, also output the error to LOG_FD, referencing LINENO. Then exit the+# script with STATUS, using 1 if that was 0.+as_fn_error ()+{+  as_status=$1; test $as_status -eq 0 && as_status=1+  if test "$4"; then+    as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack+    printf "%s\n" "$as_me:${as_lineno-$LINENO}: error: $2" >&$4+  fi+  printf "%s\n" "$as_me: error: $2" >&2+  as_fn_exit $as_status+} # as_fn_error++++# as_fn_set_status STATUS+# -----------------------+# Set $? to STATUS, without forking.+as_fn_set_status ()+{+  return $1+} # as_fn_set_status++# as_fn_exit STATUS+# -----------------+# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.+as_fn_exit ()+{+  set +e+  as_fn_set_status $1+  exit $1+} # as_fn_exit++# as_fn_unset VAR+# ---------------+# Portably unset VAR.+as_fn_unset ()+{+  { eval $1=; unset $1;}+}+as_unset=as_fn_unset++# as_fn_append VAR VALUE+# ----------------------+# Append the text in VALUE to the end of the definition contained in VAR. Take+# advantage of any shell optimizations that allow amortized linear growth over+# repeated appends, instead of the typical quadratic growth present in naive+# implementations.+if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null+then :+  eval 'as_fn_append ()+  {+    eval $1+=\$2+  }'+else $as_nop+  as_fn_append ()+  {+    eval $1=\$$1\$2+  }+fi # as_fn_append++# as_fn_arith ARG...+# ------------------+# Perform arithmetic evaluation on the ARGs, and store the result in the+# global $as_val. Take advantage of shells that can avoid forks. The arguments+# must be portable across $(()) and expr.+if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null+then :+  eval 'as_fn_arith ()+  {+    as_val=$(( $* ))+  }'+else $as_nop+  as_fn_arith ()+  {+    as_val=`expr "$@" || test $? -eq 1`+  }+fi # as_fn_arith+++if expr a : '\(a\)' >/dev/null 2>&1 &&+   test "X`expr 00001 : '.*\(...\)'`" = X001; then+  as_expr=expr+else+  as_expr=false+fi++if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then+  as_basename=basename+else+  as_basename=false+fi++if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then+  as_dirname=dirname+else+  as_dirname=false+fi++as_me=`$as_basename -- "$0" ||+$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \+	 X"$0" : 'X\(//\)$' \| \+	 X"$0" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X/"$0" |+    sed '/^.*\/\([^/][^/]*\)\/*$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\/\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`++# Avoid depending upon Character Ranges.+as_cr_letters='abcdefghijklmnopqrstuvwxyz'+as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'+as_cr_Letters=$as_cr_letters$as_cr_LETTERS+as_cr_digits='0123456789'+as_cr_alnum=$as_cr_Letters$as_cr_digits+++# Determine whether it's possible to make 'echo' print without a newline.+# These variables are no longer used directly by Autoconf, but are AC_SUBSTed+# for compatibility with existing Makefiles.+ECHO_C= ECHO_N= ECHO_T=+case `echo -n x` in #(((((+-n*)+  case `echo 'xy\c'` in+  *c*) ECHO_T='	';;	# ECHO_T is single tab character.+  xy)  ECHO_C='\c';;+  *)   echo `echo ksh88 bug on AIX 6.1` > /dev/null+       ECHO_T='	';;+  esac;;+*)+  ECHO_N='-n';;+esac++# For backward compatibility with old third-party macros, we provide+# the shell variables $as_echo and $as_echo_n.  New code should use+# AS_ECHO(["message"]) and AS_ECHO_N(["message"]), respectively.+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+else+  rm -f conf$$.dir+  mkdir conf$$.dir 2>/dev/null+fi+if (echo >conf$$.file) 2>/dev/null; then+  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'.+    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+    as_ln_s=ln+  else+    as_ln_s='cp -pR'+  fi+else+  as_ln_s='cp -pR'+fi+rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file+rmdir conf$$.dir 2>/dev/null+++# as_fn_mkdir_p+# -------------+# Create "$as_dir" as a directory, including parents if necessary.+as_fn_mkdir_p ()+{++  case $as_dir in #(+  -*) as_dir=./$as_dir;;+  esac+  test -d "$as_dir" || eval $as_mkdir_p || {+    as_dirs=+    while :; do+      case $as_dir in #(+      *\'*) as_qdir=`printf "%s\n" "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(+      *) as_qdir=$as_dir;;+      esac+      as_dirs="'$as_qdir' $as_dirs"+      as_dir=`$as_dirname -- "$as_dir" ||+$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$as_dir" : 'X\(//\)[^/]' \| \+	 X"$as_dir" : 'X\(//\)$' \| \+	 X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$as_dir" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+      test -d "$as_dir" && break+    done+    test -z "$as_dirs" || eval "mkdir $as_dirs"+  } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"+++} # as_fn_mkdir_p+if mkdir -p . 2>/dev/null; then+  as_mkdir_p='mkdir -p "$as_dir"'+else+  test -d ./-p && rmdir ./-p+  as_mkdir_p=false+fi+++# as_fn_executable_p FILE+# -----------------------+# Test if FILE is an executable regular file.+as_fn_executable_p ()+{+  test -f "$1" && test -x "$1"+} # as_fn_executable_p+as_test_x='test -x'+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'"++# Sed expression to map a string onto a valid variable name.+as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"+++exec 6>&1+## ----------------------------------- ##+## Main body of $CONFIG_STATUS script. ##+## ----------------------------------- ##+_ASEOF+test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# Save the log message, to keep $0 and so on meaningful, and to+# 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++  CONFIG_FILES    = $CONFIG_FILES+  CONFIG_HEADERS  = $CONFIG_HEADERS+  CONFIG_LINKS    = $CONFIG_LINKS+  CONFIG_COMMANDS = $CONFIG_COMMANDS+  $ $0 $@++on `(hostname || uname -n) 2>/dev/null | sed 1q`+"++_ACEOF+++case $ac_config_headers in *"+"*) set x $ac_config_headers; shift; ac_config_headers=$*;;+esac+++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+# Files that config.status was made for.+config_headers="$ac_config_headers"++_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+ac_cs_usage="\+\`$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.++Usage: $0 [OPTION]... [TAG]...++  -h, --help       print this help, then exit+  -V, --version    print version number and configuration settings, then exit+      --config     print configuration, then exit+  -q, --quiet, --silent+                   do not print progress messages+  -d, --debug      don't remove temporary files+      --recheck    update $as_me by reconfiguring in the same conditions+      --header=FILE[:TEMPLATE]+                   instantiate the configuration header FILE++Configuration headers:+$config_headers++Report bugs to <streamly@composewell.com>.+streamly-core home page: <https://streamly.composewell.com>."++_ACEOF+ac_cs_config=`printf "%s\n" "$ac_configure_args" | sed "$ac_safe_unquote"`+ac_cs_config_escaped=`printf "%s\n" "$ac_cs_config" | sed "s/^ //; s/'/'\\\\\\\\''/g"`+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,+  with options \\"\$ac_cs_config\\"++Copyright (C) 2021 Free Software Foundation, Inc.+This config.status script is free software; the Free Software Foundation+gives unlimited permission to copy, distribute and modify it."++ac_pwd='$ac_pwd'+srcdir='$srcdir'+test -n "\$AWK" || AWK=awk+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+# The default lists apply if the user does not specify any file.+ac_need_defaults=:+while test $# != 0+do+  case $1 in+  --*=?*)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`+    ac_shift=:+    ;;+  --*=)+    ac_option=`expr "X$1" : 'X\([^=]*\)='`+    ac_optarg=+    ac_shift=:+    ;;+  *)+    ac_option=$1+    ac_optarg=$2+    ac_shift=shift+    ;;+  esac++  case $ac_option in+  # Handling of the options.+  -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)+    ac_cs_recheck=: ;;+  --version | --versio | --versi | --vers | --ver | --ve | --v | -V )+    printf "%s\n" "$ac_cs_version"; exit ;;+  --config | --confi | --conf | --con | --co | --c )+    printf "%s\n" "$ac_cs_config"; exit ;;+  --debug | --debu | --deb | --de | --d | -d )+    debug=: ;;+  --header | --heade | --head | --hea )+    $ac_shift+    case $ac_optarg in+    *\'*) ac_optarg=`printf "%s\n" "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;+    esac+    as_fn_append CONFIG_HEADERS " '$ac_optarg'"+    ac_need_defaults=false;;+  --he | --h)+    # Conflict between --help and --header+    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 \+  | -silent | --silent | --silen | --sile | --sil | --si | --s)+    ac_cs_silent=: ;;++  # This is an error.+  -*) as_fn_error $? "unrecognized option: \`$1'+Try \`$0 --help' for more information." ;;++  *) as_fn_append ac_config_targets " $1"+     ac_need_defaults=false ;;++  esac+  shift+done++ac_configure_extra_args=++if $ac_cs_silent; then+  exec 6>/dev/null+  ac_configure_extra_args="$ac_configure_extra_args --silent"+fi++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+if \$ac_cs_recheck; then+  set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion+  shift+  \printf "%s\n" "running CONFIG_SHELL=$SHELL \$*" >&6+  CONFIG_SHELL='$SHELL'+  export CONFIG_SHELL+  exec "\$@"+fi++_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+exec 5>>config.log+{+  echo+  sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX+## Running $as_me. ##+_ASBOX+  printf "%s\n" "$ac_log"+} >&5++_ACEOF+cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+_ACEOF++cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1++# Handling of arguments.+for ac_config_target in $ac_config_targets+do+  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;;+  esac+done+++# If the user did not use the arguments to specify the items to instantiate,+# then the envvar interface is used.  Set only those that are not.+# We use the long form for the default assignment because of an extremely+# bizarre bug on SunOS 4.1.3.+if $ac_need_defaults; then+  test ${CONFIG_HEADERS+y} || CONFIG_HEADERS=$config_headers+fi++# Have a temporary directory for convenience.  Make it in the build tree+# simply because there is no reason against having it here, and in addition,+# 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'.+$debug ||+{+  tmp= ac_tmp=+  trap 'exit_status=$?+  : "${ac_tmp:=$tmp}"+  { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status+' 0+  trap 'as_fn_exit 1' 1 2 13 15+}+# Create a (secure) tmp directory for tmp files.++{+  tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&+  test -d "$tmp"+}  ||+{+  tmp=./conf$$-$RANDOM+  (umask 077 && mkdir "$tmp")+} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5+ac_tmp=$tmp++# 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'.+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+# here-document in config.status, that substitutes the proper values into+# config.h.in to produce config.h.++# Create a delimiter string that does not exist in confdefs.h, to ease+# handling of long lines.+ac_delim='%!_!# '+for ac_last_try in false false :; do+  ac_tt=`sed -n "/$ac_delim/p" confdefs.h`+  if test -z "$ac_tt"; then+    break+  elif $ac_last_try; then+    as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5+  else+    ac_delim="$ac_delim!$ac_delim _$ac_delim!! "+  fi+done++# For the awk script, D is an array of macro values keyed by name,+# likewise P contains macro parameters if any.  Preserve backslash+# newline sequences.++ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]*+sed -n '+s/.\{148\}/&'"$ac_delim"'/g+t rset+:rset+s/^[	 ]*#[	 ]*define[	 ][	 ]*/ /+t def+d+:def+s/\\$//+t bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3"/p+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2"/p+d+:bsnl+s/["\\]/\\&/g+s/^ \('"$ac_word_re"'\)\(([^()]*)\)[	 ]*\(.*\)/P["\1"]="\2"\+D["\1"]=" \3\\\\\\n"\\/p+t cont+s/^ \('"$ac_word_re"'\)[	 ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p+t cont+d+:cont+n+s/.\{148\}/&'"$ac_delim"'/g+t clear+:clear+s/\\$//+t bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/"/p+d+:bsnlc+s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p+b cont+' <confdefs.h | sed '+s/'"$ac_delim"'/"\\\+"/g' >>$CONFIG_STATUS || ac_write_fail=1++cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1+  for (key in D) D_is_set[key] = 1+  FS = ""+}+/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ {+  line = \$ 0+  split(line, arg, " ")+  if (arg[1] == "#") {+    defundef = arg[2]+    mac1 = arg[3]+  } else {+    defundef = substr(arg[1], 2)+    mac1 = arg[2]+  }+  split(mac1, mac2, "(") #)+  macro = mac2[1]+  prefix = substr(line, 1, index(line, defundef) - 1)+  if (D_is_set[macro]) {+    # Preserve the white space surrounding the "#".+    print prefix "define", macro P[macro] D[macro]+    next+  } else {+    # Replace #undef with comments.  This is necessary, for example,+    # in the case of _POSIX_SOURCE, which is predefined and required+    # on some systems where configure will not decide to define it.+    if (defundef == "undef") {+      print "/*", prefix defundef, macro, "*/"+      next+    }+  }+}+{ print }+_ACAWK+_ACEOF+cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1+  as_fn_error $? "could not setup config headers machinery" "$LINENO" 5+fi # test -n "$CONFIG_HEADERS"+++eval set X "    :H $CONFIG_HEADERS    "+shift+for ac_tag+do+  case $ac_tag in+  :[FHLC]) ac_mode=$ac_tag; continue;;+  esac+  case $ac_mode$ac_tag in+  :[FHL]*:*);;+  :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;+  :[FH]-) ac_tag=-:-;;+  :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;+  esac+  ac_save_IFS=$IFS+  IFS=:+  set x $ac_tag+  IFS=$ac_save_IFS+  shift+  ac_file=$1+  shift++  case $ac_mode in+  :L) ac_source=$1;;+  :[FH])+    ac_file_inputs=+    for ac_f+    do+      case $ac_f in+      -) 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 `:'.+	 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;;+      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+    # use $as_me), people would be surprised to read:+    #    /* config.h.  Generated by config.status.  */+    configure_input='Generated from '`+	  printf "%s\n" "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'+	`' by configure.'+    if test x"$ac_file" != x-; then+      configure_input="$ac_file.  $configure_input"+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5+printf "%s\n" "$as_me: creating $ac_file" >&6;}+    fi+    # Neutralize special characters interpreted by sed in replacement strings.+    case $configure_input in #(+    *\&* | *\|* | *\\* )+       ac_sed_conf_input=`printf "%s\n" "$configure_input" |+       sed 's/[\\\\&|]/\\\\&/g'`;; #(+    *) ac_sed_conf_input=$configure_input;;+    esac++    case $ac_tag in+    *:-:* | *:-) cat >"$ac_tmp/stdin" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;+    esac+    ;;+  esac++  ac_dir=`$as_dirname -- "$ac_file" ||+$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \+	 X"$ac_file" : 'X\(//\)[^/]' \| \+	 X"$ac_file" : 'X\(//\)$' \| \+	 X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||+printf "%s\n" X"$ac_file" |+    sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)[^/].*/{+	    s//\1/+	    q+	  }+	  /^X\(\/\/\)$/{+	    s//\1/+	    q+	  }+	  /^X\(\/\).*/{+	    s//\1/+	    q+	  }+	  s/.*/./; q'`+  as_dir="$ac_dir"; as_fn_mkdir_p+  ac_builddir=.++case "$ac_dir" in+.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;+*)+  ac_dir_suffix=/`printf "%s\n" "$ac_dir" | sed 's|^\.[\\/]||'`+  # A ".." for each directory in $ac_dir_suffix.+  ac_top_builddir_sub=`printf "%s\n" "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`+  case $ac_top_builddir_sub in+  "") ac_top_builddir_sub=. ac_top_build_prefix= ;;+  *)  ac_top_build_prefix=$ac_top_builddir_sub/ ;;+  esac ;;+esac+ac_abs_top_builddir=$ac_pwd+ac_abs_builddir=$ac_pwd$ac_dir_suffix+# for backward compatibility:+ac_top_builddir=$ac_top_build_prefix++case $srcdir in+  .)  # We are building in place.+    ac_srcdir=.+    ac_top_srcdir=$ac_top_builddir_sub+    ac_abs_top_srcdir=$ac_pwd ;;+  [\\/]* | ?:[\\/]* )  # Absolute name.+    ac_srcdir=$srcdir$ac_dir_suffix;+    ac_top_srcdir=$srcdir+    ac_abs_top_srcdir=$srcdir ;;+  *) # Relative name.+    ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix+    ac_top_srcdir=$ac_top_build_prefix$srcdir+    ac_abs_top_srcdir=$ac_pwd/$srcdir ;;+esac+ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix+++  case $ac_mode in++  :H)+  #+  # CONFIG_HEADER+  #+  if test x"$ac_file" != x-; then+    {+      printf "%s\n" "/* $configure_input  */" >&1 \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs"+    } >"$ac_tmp/config.h" \+      || as_fn_error $? "could not create $ac_file" "$LINENO" 5+    if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then+      { printf "%s\n" "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5+printf "%s\n" "$as_me: $ac_file is unchanged" >&6;}+    else+      rm -f "$ac_file"+      mv "$ac_tmp/config.h" "$ac_file" \+	|| as_fn_error $? "could not create $ac_file" "$LINENO" 5+    fi+  else+    printf "%s\n" "/* $configure_input  */" >&1 \+      && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \+      || as_fn_error $? "could not create -" "$LINENO" 5+  fi+ ;;+++  esac++done # for ac_tag+++as_fn_exit 0+_ACEOF+ac_clean_files=$ac_clean_files_save++test $ac_write_fail = 0 ||+  as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5+++# configure is writing to config.log, and then calls config.status.+# config.status does its own redirection, appending to config.log.+# Unfortunately, on DOS this fails, as config.log is still kept open+# by configure, so config.status won't be able to write to it; its+# output is simply discarded.  So we exec the FD to /dev/null,+# effectively closing config.log, so it can be properly (re)opened and+# appended to by config.status.  When coming back to configure, we+# need to make the FD available again.+if test "$no_create" != yes; then+  ac_cs_success=:+  ac_config_status_args=+  test "$silent" = yes &&+    ac_config_status_args="$ac_config_status_args --quiet"+  exec 5>/dev/null+  $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false+  exec 5>>config.log+  # Use ||, not &&, to avoid exiting from the if with $? = 1, which+  # would make configure fail if this is the last instruction.+  $ac_cs_success || as_fn_exit 1+fi+if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then+  { printf "%s\n" "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5+printf "%s\n" "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}+fi++
+ configure.ac view
@@ -0,0 +1,17 @@+# Input file for autoconf to generate the configure script.++# 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])++# To suppress "WARNING: unrecognized options: --with-compiler"+AC_ARG_WITH([compiler], [GHC])++# Check headers and functions required+AC_CHECK_HEADERS([time.h])+AC_CHECK_FUNCS([clock_gettime])++# Output+AC_CONFIG_HEADERS([src/config.h])+AC_OUTPUT
+ docs/ApiChangelogs/0.1.0.txt view
@@ -0,0 +1,405 @@+---------------------------------+Terminology+---------------------------------++[A]: Added+[R]: Removed+[C]: Changed+[D]: Deprecated+[O]: Old+[N]: New++---------------------------------+Difference+---------------------------------++The moved modules have been compared with their version in streamly v0.8.3++[A] Streamly.Unicode.String+    [A] str :: QuasiQuoter+[C] Streamly.Unicode.Stream+    [C] encodeUtf8'+        [O] encodeUtf8' :: (Monad m, IsStream t) => t m Char -> t m Word8+        [N] encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8+    [C] encodeUtf8+        [O] encodeUtf8 :: (Monad m, IsStream t) => t m Char -> t m Word8+        [N] encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8+    [C] encodeStrings+        [O] encodeStrings :: (MonadIO m, IsStream t) => (SerialT m Char -> SerialT m Word8) -> t m String -> t m (Array Word8)+        [N] encodeStrings :: MonadIO m => (Stream m Char -> Stream m Word8) -> Stream m String -> Stream m (Array Word8)+    [C] encodeLatin1'+        [O] encodeLatin1' :: (IsStream t, Monad m) => t m Char -> t m Word8+        [N] encodeLatin1' :: Monad m => Stream m Char -> Stream m Word8+    [C] encodeLatin1+        [O] encodeLatin1 :: (IsStream t, Monad m) => t m Char -> t m Word8+        [N] encodeLatin1 :: Monad m => Stream m Char -> Stream m Word8+    [A] decodeUtf8Chunks :: MonadIO m => Stream m (Array Word8) -> Stream m Char+    [C] decodeUtf8'+        [O] decodeUtf8' :: (Monad m, IsStream t) => t m Word8 -> t m Char+        [N] decodeUtf8' :: Monad m => Stream m Word8 -> Stream m Char+    [C] decodeUtf8+        [O] decodeUtf8 :: (Monad m, IsStream t) => t m Word8 -> t m Char+        [N] decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char+    [C] decodeLatin1+        [O] decodeLatin1 :: (IsStream t, Monad m) => t m Word8 -> t m Char+        [N] decodeLatin1 :: Monad m => Stream m Word8 -> Stream m Char+[A] Streamly.Unicode.Parser+    [A] upper :: Monad m => Parser Char m Char+    [A] symbol :: Monad m => Parser Char m Char+    [A] stringIgnoreCase :: Monad m => String -> Parser Char m String+    [A] string :: Monad m => String -> Parser Char m String+    [A] space :: Monad m => Parser Char m Char+    [A] signed :: (Num a, Monad m) => Parser Char m a -> Parser Char m a+    [A] separator :: Monad m => Parser Char m Char+    [A] punctuation :: Monad m => Parser Char m Char+    [A] printable :: Monad m => Parser Char m Char+    [A] octDigit :: Monad m => Parser Char m Char+    [A] numeric :: Monad m => Parser Char m Char+    [A] mark :: Monad m => Parser Char m Char+    [A] lower :: Monad m => Parser Char m Char+    [A] letter :: Monad m => Parser Char m Char+    [A] latin1 :: Monad m => Parser Char m Char+    [A] hexadecimal :: (Monad m, Integral a, Bits a) => Parser Char m a+    [A] hexDigit :: Monad m => Parser Char m Char+    [A] dropSpace1 :: Monad m => Parser Char m ()+    [A] dropSpace :: Monad m => Parser Char m ()+    [A] digit :: Monad m => Parser Char m Char+    [A] decimal :: (Monad m, Integral a) => Parser Char m a+    [A] charIgnoreCase :: Monad m => Char -> Parser Char m Char+    [A] char :: Monad m => Char -> Parser Char m Char+    [A] asciiUpper :: Monad m => Parser Char m Char+    [A] asciiLower :: Monad m => Parser Char m Char+    [A] ascii :: Monad m => Parser Char m Char+    [A] alphaNum :: Monad m => Parser Char m Char+    [A] alpha :: Monad m => Parser Char m Char+[C] Streamly.FileSystem.Handle+    [D] writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()+    [A] writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()+    [C] writeChunks+        [O] writeChunks :: (MonadIO m, Storable a) => Handle -> Fold m (Array a) ()+        [N] writeChunks :: MonadIO m => Handle -> Fold m (Array a) ()+    [A] readerWith :: MonadIO m => Unfold m (Int, Handle) Word8+    [A] reader :: MonadIO m => Unfold m Handle Word8+    [D] readWithBufferOf :: MonadIO m => Unfold m (Int, Handle) Word8+    [D] readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)+    [D] readChunks :: MonadIO m => Unfold m Handle (Array Word8)+    [D] read :: MonadIO m => Unfold m Handle Word8+    [C] putChunk+        [O] putChunk :: (MonadIO m, Storable a) => Handle -> Array a -> m ()+        [N] putChunk :: MonadIO m => Handle -> Array a -> m ()+    [A] chunkReaderWith :: MonadIO m => Unfold m (Int, Handle) (Array Word8)+    [A] chunkReader :: MonadIO m => Unfold m Handle (Array Word8)+[A] Streamly.FileSystem.File+    [A] writeWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Fold m Word8 ()+    [A] writeChunks :: (MonadIO m, MonadCatch m) => FilePath -> Fold m (Array a) ()+    [A] write :: (MonadIO m, MonadCatch m) => FilePath -> Fold m Word8 ()+    [A] withFile :: (MonadIO m, MonadCatch m) => FilePath -> IOMode -> (Handle -> Stream m a) -> Stream m a+    [A] readChunksWith :: (MonadIO m, MonadCatch m) => Int -> FilePath -> Stream m (Array Word8)+    [A] readChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array Word8)+    [A] read :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8+[A] Streamly.FileSystem.Dir+    [A] readEither :: MonadIO m => FilePath -> Stream m (Either FilePath FilePath)+    [A] read :: MonadIO m => FilePath -> Stream m FilePath+[C] Streamly.Data.Unfold+    [C] take+        [O] take :: Monad m => Int -> Unfold m a b -> Unfold m a b+        [N] take :: Applicative m => Int -> Unfold m a b -> Unfold m a b+    [C] replicateM+        [O] replicateM :: Monad m => Int -> Unfold m (m a) a+        [N] replicateM :: Applicative m => Unfold m (Int, m a) a+    [C] repeatM+        [O] repeatM :: Monad m => Unfold m (m a) a+        [N] repeatM :: Applicative m => Unfold m (m a) a+    [C] many+        [O] many :: Monad m => Unfold m a b -> Unfold m b c -> Unfold m a c+        [N] many :: Monad m => Unfold m b c -> Unfold m a b -> Unfold m a c+    [C] iterateM+        [O] iterateM :: Monad m => (a -> m a) -> Unfold m (m a) a+        [N] iterateM :: Applicative m => (a -> m a) -> Unfold m (m a) a+    [C] fromStream+        [O] fromStream :: (IsStream t, Monad m) => Unfold m (t m a) a+        [N] fromStream :: Applicative m => Unfold m (Stream m a) a+    [C] fromListM+        [O] fromListM :: Monad m => Unfold m [m a] a+        [N] fromListM :: Applicative m => Unfold m [m a] a+    [C] fromList+        [O] fromList :: Monad m => Unfold m [a] a+        [N] fromList :: Applicative m => Unfold m [a] a+    [C] drop+        [O] drop :: Monad m => Int -> Unfold m a b -> Unfold m a b+        [N] drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b+[A] Streamly.Data.StreamK+    [A] StreamK+    [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] uncons :: Applicative m => StreamK m a -> m (Maybe (a, StreamK m a))+    [A] toStream :: Applicative m => StreamK m a -> Stream m a+    [A] sortBy :: Monad m => (a -> a -> Ordering) -> StreamK m a -> StreamK m a+    [A] reverse :: StreamK m a -> StreamK m a+    [A] parseChunks :: (Monad m, Unbox a) => ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b)+    [A] parseBreakChunks :: (Monad m, Unbox a) => ParserK a m b -> StreamK m (Array a) -> m (Either ParseError b, StreamK m (Array a))+    [A] nilM :: Applicative m => m b -> StreamK m a+    [A] nil :: 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] 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] interleave :: StreamK m a -> StreamK m a -> StreamK m a+    [A] fromStream :: Monad m => Stream m a -> StreamK m a+    [A] fromPure :: a -> StreamK m a+    [A] fromFoldable :: Foldable f => f a -> StreamK m a+    [A] fromEffect :: Monad m => m a -> StreamK m a+    [A] crossWith :: Monad m => (a -> b -> c) -> StreamK m a -> StreamK m b -> StreamK m c+    [A] consM :: Monad m => m a -> StreamK m a -> StreamK m a+    [A] cons :: 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] concatEffect :: Monad m => m (StreamK m a) -> StreamK m a+    [A] append :: StreamK m a -> StreamK m a -> StreamK m a+[A] Streamly.Data.Stream+    [A] class Enum a => Enumerable a+    [A] Stream+    [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] 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] unfoldMany :: 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] trace :: Monad m => (a -> m b) -> Stream m a -> Stream m a+    [A] toList :: Monad m => Stream m a -> 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] takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] take :: Applicative m => Int -> Stream m a -> Stream m a+    [A] stripPrefix :: (Monad m, Eq a) => Stream m a -> Stream m a -> m (Maybe (Stream m a))+    [A] sequence :: Monad m => Stream m (m a) -> Stream m a+    [A] scanMaybe :: Monad m => Fold m a (Maybe 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] 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] repeatM :: Monad m => m a -> Stream m a+    [A] repeat :: Monad m => a -> Stream m a+    [A] postscan :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] parseMany :: Monad m => Parser a m b -> Stream m a -> Stream m (Either ParseError b)+    [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] 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] 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] 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 -> Stream m b+    [A] liftInner :: (Monad m, MonadTrans t, Monad (t m)) => Stream m a -> Stream (t m) a+    [A] iterateM :: Monad m => (a -> m a) -> m a -> Stream m a+    [A] iterate :: Monad m => (a -> a) -> a -> Stream m a+    [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] intersperseM_ :: 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] 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] indexed :: Monad m => Stream m a -> Stream m (Int, a)+    [A] handle :: (MonadCatch m, Exception e) => (e -> Stream m a) -> Stream m a -> Stream m a+    [A] fromPure :: Applicative m => a -> Stream m a+    [A] fromList :: Applicative m => [a] -> Stream m a+    [A] fromEffect :: Applicative m => m a -> Stream m a+    [A] foldrM :: Monad m => (a -> m b -> m b) -> m b -> Stream m a -> m b+    [A] foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b+    [A] foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b+    [A] foldBreak :: Monad m => Fold m a b -> Stream m a -> m (b, Stream m a)+    [A] fold :: Monad m => Fold m a b -> Stream m a -> m b+    [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] filter :: Monad m => (a -> Bool) -> Stream 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] enumerateFromTo :: (Enumerable a, Monad m) => a -> a -> Stream m a+    [A] enumerateFromThenTo :: (Enumerable a, Monad m) => a -> a -> a -> Stream m a+    [A] enumerateFromThen :: (Enumerable a, Monad m) => 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] dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a+    [A] dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a+    [A] drop :: Monad m => Int -> 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] 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] concatEffect :: Monad m => m (Stream m a) -> Stream m a+    [A] cmpBy :: Monad m => (a -> b -> Ordering) -> Stream m a -> Stream m b -> m Ordering+    [A] chunksOf :: forall m a. (MonadIO m, Unbox a) => Int -> Stream m a -> Stream m (Array a)+    [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] 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] afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a+[A] Streamly.Data.ParserK+    [A] ParserK+    [A] fromPure :: b -> ParserK a m b+    [A] fromParser :: (Monad m, Unbox a) => Parser a m b -> ParserK a m b+    [A] fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK a m b+    [A] fromEffect :: Monad m => m b -> ParserK a m b+    [A] die :: String -> ParserK a m b+[A] Streamly.Data.Parser+    [A] Parser+    [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] wordBy :: Monad m => (a -> Bool) -> Fold m a 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] takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b+    [A] streamEqBy :: Monad m => (a -> a -> Bool) -> Stream m a -> Parser a m ()+    [A] some :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [A] satisfy :: Monad m => (a -> Bool) -> Parser a m a+    [A] rmapM :: Monad m => (b -> m c) -> Parser a m b -> 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] one :: Monad m => Parser a m a+    [A] noneOf :: (Monad m, Eq a, Foldable f) => f a -> Parser a m a+    [A] manyTill :: Monad m => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c+    [A] many :: Monad m => Parser a m b -> Fold m b c -> Parser a m c+    [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] groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b+    [A] fromPure :: Monad m => 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] eof :: Monad m => Parser a m ()+    [A] dropWhile :: Monad m => (a -> Bool) -> Parser a m ()+    [A] die :: Monad m => String -> Parser a m b+    [A] deintercalate :: Monad m => Parser a m x -> Parser a m y -> Fold m (Either x y) z -> Parser a m z+[A] Streamly.Data.MutArray.Generic+    [A] MutArray+    [A] writeN :: MonadIO m => Int -> Fold m a (MutArray a)+    [A] toList :: MonadIO m => MutArray a -> m [a]+    [A] snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+    [A] reader :: MonadIO m => Unfold m (MutArray a) a+    [A] putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()+    [A] new :: forall m a. MonadIO m => Int -> m (MutArray a)+    [A] modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+    [A] getIndex :: MonadIO m => Int -> MutArray a -> m a+[A] Streamly.Data.MutArray+    [A] class Unbox a+    [A] MutArray+    [A] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> 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] toList :: forall m a. (MonadIO m, Unbox a) => MutArray a -> m [a]+    [A] snoc :: forall m a. (MonadIO m, Unbox a) => MutArray a -> a -> m (MutArray a)+    [A] sizeOf :: (Unbox a, SizeOfRep (Rep a)) => Proxy a -> Int+    [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] putIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> a -> m ()+    [A] pokeByteIndex :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutableByteArray -> a -> IO ()+    [A] peekByteIndex :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutableByteArray -> IO a+    [A] newPinned :: forall m a. (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] new :: (MonadIO m, Unbox a) => Int -> m (MutArray a)+    [A] length :: forall a. Unbox a => MutArray a -> Int+    [A] getIndex :: forall m a. (MonadIO m, Unbox a) => Int -> MutArray a -> m a+    [A] fromListN :: (MonadIO m, Unbox a) => Int -> [a] -> m (MutArray a)+    [A] fromList :: (MonadIO m, Unbox a) => [a] -> m (MutArray a)+    [A] cast :: forall a b. Unbox b => MutArray a -> Maybe (MutArray b)+    [A] asBytes :: MutArray a -> MutArray Word8+[C] Streamly.Data.Fold+    [A] Tee+        [A] [unTee] :: Tee m a b -> Fold m a b+        [A] Tee :: Fold m a b -> Tee m a b+    [D] variance :: (Monad m, Fractional a) => Fold m a a+    [A] uniqBy :: Monad m => (a -> a -> Bool) -> Fold m a (Maybe a)+    [A] topBy :: (MonadIO m, Unbox a) => (a -> a -> Ordering) -> Int -> Fold m a (MutArray a)+    [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] the :: (Monad m, Eq a) => Fold m a (Maybe a)+    [D] stdDev :: (Monad m, Floating a) => Fold m a a+    [A] splitWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+    [D] serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+    [A] scanMaybe :: Monad m => Fold m a (Maybe b) -> Fold m b c -> Fold m a c+    [A] scan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [A] postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+    [A] one :: Monad m => Fold m a (Maybe a)+    [A] nubInt :: Monad m => Fold m Int (Maybe Int)+    [A] nub :: (Monad m, Ord a) => Fold m a (Maybe a)+    [A] morphInner :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b+    [A] latest :: Monad m => Fold m a (Maybe a)+    [D] last :: Monad m => Fold m a (Maybe a)+    [D] head :: Monad m => Fold m a (Maybe a)+    [A] groupsOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c+    [A] frequency :: (Monad m, Ord a) => Fold m a (Map a Int)+    [A] foldr' :: Monad m => (a -> b -> b) -> b -> Fold m a b+    [D] foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b+    [A] foldlM1' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+    [A] foldl1' :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)+    [A] findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)+    [A] findIndices :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)+    [A] elemIndices :: (Monad m, Eq a) => a -> Fold m a (Maybe Int)+    [A] duplicate :: Monad m => Fold m a b -> Fold m a (Fold m a b)+    [A] drive :: Monad m => Stream m a -> Fold m a b -> m b+    [A] drainMapM :: Monad m => (a -> m b) -> Fold m a ()+    [D] drainBy :: Monad m => (a -> m b) -> Fold m a ()+    [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] demuxIO :: (MonadIO m, Ord k) => (a -> k) -> (a -> m (Fold m a b)) -> Fold m a (m (Map k b), Maybe (k, 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] deleteBy :: Monad m => (a -> a -> Bool) -> a -> Fold m a (Maybe a)+    [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] classify :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))+    [D] chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c+    [A] catRights :: Monad m => Fold m b c -> Fold m (Either a b) c+    [A] catLefts :: Monad m => Fold m a c -> Fold m (Either a b) c+    [A] catEithers :: Fold m a b -> Fold m (Either a a) b+    [A] addStream :: Monad m => Stream m a -> Fold m a b -> m (Fold m a b)+    [A] addOne :: Monad m => a -> Fold m a b -> m (Fold m a b)+[A] Streamly.Data.Array.Generic+    [A] Array+    [A] writeN :: MonadIO m => Int -> Fold m a (Array a)+    [A] write :: MonadIO m => Fold m a (Array a)+    [A] reader :: Monad m => Unfold m (Array a) a+    [A] readRev :: Monad m => Array a -> Stream m a+    [A] read :: MonadIO m => Array a -> Stream m a+    [A] length :: Array a -> Int+    [A] fromListN :: Int -> [a] -> Array a+    [A] fromList :: [a] -> Array a+[A] Streamly.Data.Array+    [A] class Unbox a+    [A] Array+    [A] writeN :: forall m a. (MonadIO m, Unbox a) => Int -> Fold m a (Array a)+    [A] writeLastN :: (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)+    [A] write :: forall m a. (MonadIO m, Unbox a) => Fold m a (Array a)+    [A] toList :: Unbox a => Array a -> [a]+    [A] sizeOf :: (Unbox a, SizeOfRep (Rep a)) => Proxy a -> Int+    [A] readerRev :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+    [A] reader :: forall m a. (Monad m, Unbox a) => Unfold m (Array a) a+    [A] pokeByteIndex :: (Unbox a, Generic a, PokeRep (Rep a)) => Int -> MutableByteArray -> a -> IO ()+    [A] peekByteIndex :: (Unbox a, Generic a, PeekRep (Rep a)) => Int -> MutableByteArray -> IO a+    [A] length :: Unbox a => Array a -> Int+    [A] getIndex :: forall a. Unbox a => Int -> Array a -> Maybe a+    [A] fromListN :: Unbox a => Int -> [a] -> Array a+    [A] fromList :: Unbox a => [a] -> Array a+    [A] cast :: forall a b. Unbox b => Array a -> Maybe (Array b)+    [A] asBytes :: Array a -> Array Word8+[C] Streamly.Console.Stdio+    [A] reader :: MonadIO m => Unfold m () Word8+    [D] readChunks :: MonadIO m => Unfold m () (Array Word8)+    [D] read :: MonadIO m => Unfold m () Word8+    [A] chunkReader :: MonadIO m => Unfold m () (Array Word8)
+ docs/Changelog.md view
@@ -0,0 +1,32 @@+# Changelog++## 0.1.0 (March 2023)++Also see [streamly-core-0.1.0 API Changelog](/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+has only GHC boot library depdendecies, and (2) `streamly` that contains+higher level operations (including concurrent ones) with additional+dependencies.++* Moved the following modules from `streamly` package to the+  `streamly-core` package:+  * Streamly.Console.Stdio+  * Streamly.Data.Fold+  * Streamly.Data.Unfold+  * Streamly.FileSystem.Handle+  * Streamly.Unicode.Stream+* Added the following new modules:+  * Streamly.Data.Array+  * Streamly.Data.Array.Generic+  * Streamly.Data.MutArray+  * Streamly.Data.MutArray.Generic+  * Streamly.Data.Parser+  * Streamly.Data.ParserK+  * Streamly.Data.Stream+  * Streamly.Data.StreamK+  * Streamly.FileSystem.Dir+  * Streamly.FileSystem.File+  * Streamly.Unicode.Parser+  * Streamly.Unicode.String
+ docs/Readme.md view
@@ -0,0 +1,1 @@+Please refer to the "streamly" package for tutorials and other documentation.
+ jsbits/clock.js view
@@ -0,0 +1,31 @@+function h$clock_gettime_js(when, p_d, p_o) {+  /* XXX: guess if we have to write 64 bit values:++            alloca is often used and will give us 16 bytes+            if timespec contains two 64 bit values++          but we really should fix this by not having hsc2hs values+          from the build system leak here+   */+  var is64 = p_d.i3.length == 4 && p_o == 0;+  var o  = p_o >> 2,+      t  = Date.now ? Date.now() : new Date().getTime(),+      tf = Math.floor(t / 1000),+      tn = 1000000 * (t - (1000 * tf));+  if(is64) {+    p_d.i3[o]   = tf|0;+    p_d.i3[o+1] = 0;+    p_d.i3[o+2] = tn|0;+    p_d.i3[o+3] = 0;+  } else {+    p_d.i3[o]   = tf|0;+    p_d.i3[o+1] = tn|0;+  }+  return 0;+}+/* Hack! Supporting code for "clock" package+ * "hspec" depends on clock.+ */+function h$hs_clock_darwin_gettime(when, p_d, p_o) {+      h$clock_gettime_js(when, p_d, p_o);+}
+ src/DocTestDataArray.hs view
@@ -0,0 +1,14 @@+{- $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 view
@@ -0,0 +1,28 @@+{- $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 view
@@ -0,0 +1,10 @@+{- $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 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.Array.Generic.Mut.Type as MutArray+-}
+ src/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/DocTestDataStream.hs view
@@ -0,0 +1,37 @@+{- $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 view
@@ -0,0 +1,20 @@+{- $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 view
@@ -0,0 +1,12 @@+{- $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
@@ -0,0 +1,56 @@+-- |+-- Module      : Streamly.Console.Stdio+-- Copyright   : (c) 2021 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Combinators to work with standard input, output and error streams.+--+-- See also: "Streamly.Internal.Console.Stdio"++module Streamly.Console.Stdio+    (+    -- * Unfolds (stdin)+      reader+    , chunkReader++    -- * Write (stdout)+    , write+    , writeChunks++    -- * 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
+ src/Streamly/Data/Array.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Array+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Unboxed immutable arrays with streaming interfaces.+--+-- Please refer to "Streamly.Internal.Data.Array" for functions that have not+-- yet been released.+--+-- For arrays that work on boxed types, not requiring the 'Unbox' constraint,+-- please refer to "Streamly.Data.Array.Generic". For arrays that can be+-- mutated in-place, please see "Streamly.Data.MutArray".++module Streamly.Data.Array+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Overview+    -- $overview++    -- * The Array Type+      A.Array++    -- * Construction+    -- | When performance matters, the fastest way to generate an array is+    -- 'writeN'. '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++    -- Monadic APIs+    , A.writeN      -- drop new+    , A.write       -- full buffer+    , writeLastN    -- drop old (ring buffer)++    -- * Conversion+    -- 'GHC.Exts.toList' from "GHC.Exts" can be used to convert an array to a+    -- list.+    , A.toList++    -- * Unfolds+    , A.reader+    , A.readerRev++    -- * Casting+    , cast+    , asBytes++    -- * Random Access+    , A.length+    -- , (!!)+    , A.getIndex++    -- * Unbox Type Class+    , Unbox (..)++    -- * Deprecated+    , read+    , readRev+    )+where++#include "inline.hs"++import Streamly.Internal.Data.Unfold (Unfold)+import Streamly.Internal.Data.Array as A hiding (read, readRev)++import Streamly.Internal.Data.Unboxed (Unbox (..))+import Prelude hiding (read)++#include "DocTestDataArray.hs"++-- $overview+--+-- This module provides APIs to create and use unboxed immutable arrays. Once+-- created, their contents cannot be modified. Only types that are unboxable+-- via the 'Unbox' type class can be stored in these arrays. Note that the+-- array memory grows automatically when creating a new array, therefore, an+-- array can be created from a variable length stream.+--+-- == Folding Arrays+--+-- Convert array to stream, and fold the stream:+--+-- >>> fold f arr = Stream.unfold Array.reader arr & Stream.fold f+-- >>> fold Fold.sum (Array.fromList [1,2,3::Int])+-- 6+--+-- == Transforming Arrays+--+-- 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 (+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.+--+-- Unpinned arrays have the advantage of allowing automatic defragmentation of+-- the memory by GC. Whereas pinned arrays have the advantage of not requiring+-- a copy by GC. Normally you would want to use unpinned arrays. However, in+-- some cases, for example, for long lived large data storage, and for+-- interfacing with the operating system or foreign (non-Haskell) consumers you+-- may want to use pinned arrays.+--+-- == 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:+--+-- The 'MonadIO' based folds can be morphed to 'Identity' stream folds:+--+-- >>> purely = Fold.morphInner (Identity . unsafePerformIO)+-- >>> Stream.fold (purely Array.write) $ Stream.fromList [1,2,3::Int]+-- Identity fromList [1,2,3]+--+-- Since it is a pure stream we can use 'unsafePerformIO' to extract the result+-- of fold from IO.+--+-- Alternatively, 'Identity' streams can be generalized to IO streams:+--+-- >>> 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]+--+-- == 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
@@ -0,0 +1,43 @@+-- |+-- Module      : Streamly.Data.Array.Generic+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Unconstrained version of "Streamly.Data.Array" module.+--+-- See the "Streamly.Data.Array" module for documentation.+--+module Streamly.Data.Array.Generic+    ( Array++    -- * Construction+    , A.fromListN+    , A.fromList++    -- MonadicAPIs+    , A.writeN+    , A.write++    -- * Streams+    , A.read+    , A.readRev++    -- * Unfolds+    , A.reader++    -- * Random Access+    , A.length++    -- -- * Folding Arrays+    -- , A.streamFold+    -- , A.fold+    )+where++import Streamly.Internal.Data.Array.Generic (Array)++import qualified Streamly.Internal.Data.Array.Generic as A
+ src/Streamly/Data/Fold.hs view
@@ -0,0 +1,382 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Fold+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Fast, composable stream consumers with ability to terminate, supporting+-- stream fusion.+--+-- Please refer to "Streamly.Internal.Data.Fold" for more functions that have+-- not yet been released.++module Streamly.Data.Fold+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Overview+    -- $overview++    -- * Running A Fold+      drive+    -- XXX Should we have a stream returning function in fold module?+    -- , breakStream++    -- * Fold Type++    , Fold -- (..)+    , Tee (..)++    -- * Constructors+    , foldl'+    , foldlM'+    , foldl1'+    , foldlM1'+    , foldr'++    -- * Folds+    -- ** Accumulators+    -- | Folds that never terminate, these folds 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 folds we could write Monoids and turn them into folds.++    -- Monoids+    , sconcat+    , mconcat+    , foldMap+    , foldMapM++    -- Reducers+    , drain+    , drainMapM+    , length+    , countDistinct+    , countDistinctInt+    , frequency+    , sum+    , product+    , mean+    , rollingHash+    , rollingHashWithSalt++    -- Collectors+    , toList+    , toListRev+    , toSet+    , toIntSet+    , toMap+    , toMapIO+    , demuxToMap+    , demuxToMapIO+    , 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 'scanMaybe'+    -- combinator.+    , findIndices+    , elemIndices+    , deleteBy+    -- , uniq+    , uniqBy+    , nub+    , nubInt+    , classify+    , classifyIO+    , demux+    , demuxIO++    -- ** Terminating Folds+    , one+    , null+    -- , satisfy+    -- , maybe++    , index+    , the+    , find+    , findM+    , lookup+    , findIndex+    , elemIndex+    , elem+    , notElem+    , all+    , any+    , 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+    -- applied either on the input side (contravariant) or on the output side+    -- (covariant).  Therefore, combinators are of 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)+    --+    -- The input side transformations are more interesting for folds.  Most of+    -- the following sections describe the input transformation operations on a+    -- fold. 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 fold maps on the output of the fold:+    --+    -- >>> Stream.fold (fmap show Fold.sum) (Stream.enumerateFromTo 1 100)+    -- "5050"+    --+    , rmapM++    -- ** Mapping on Input+    , lmap+    , lmapM++    -- ** Scanning and Filtering+    , scan+    , postscan+    , scanMaybe+    , filter+    , filterM++    -- -- ** Mapping Filters+    , mapMaybe+    , catMaybes+    , catLefts+    , catRights+    , catEithers++    -- ** Trimming+    , take+    -- , takeInterval+    , takeEndBy+    , takeEndBy_++    -- ** Serial Append+    , splitWith++    -- ** Parallel Distribution+    -- | For applicative composition using distribution see+    -- "Streamly.Internal.Data.Fold.Tee".++    , teeWith+    --, teeWithFst+    --, teeWithMin+    , tee+    , distribute++    -- ** Partitioning+    -- | Direct items in the input stream to different folds using a binary+    -- fold selector.++    , partition+    --, partitionByM+    --, partitionByFstM+    --, partitionByMinM+    --, partitionBy++    -- ** Unzipping+    , unzip++    -- ** Splitting+    , many+    , groupsOf+    -- , intervalsOf++    -- ** Nesting+    , concatMap++    -- * Transforming the Monad+    , morphInner++    -- * Deprecated+    , chunksOf+    , foldr+    , drainBy+    , last+    , head+    , sequence+    , mapM+    , variance+    , stdDev+    , serialWith+    )+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,+               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+--------------------------------------------------------------------------------++{-# DEPRECATED chunksOf "Please use 'groupsOf' instead" #-}+{-# INLINE chunksOf #-}+chunksOf :: Monad m => Int -> Fold m a b -> Fold m b c -> Fold m a c+chunksOf = groupsOf
+ src/Streamly/Data/MutArray.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.MutArray+-- Copyright   : (c) 2022 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- This module provides a mutable version of "Streamly.Data.Array". The+-- 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+-- not yet been released.+--+-- For mutable arrays that work on boxed types, not requiring the 'Unbox'+-- constraint, please refer to "Streamly.Data.MutArray.Generic".++module Streamly.Data.MutArray+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Mutable Array Type+      MutArray++    -- * Construction++    -- Uninitialized Arrays+    , new+    , newPinned++    -- From containers+    , fromListN+    , fromList+    , writeN      -- drop new+    , write       -- full buffer+    -- writeLastN++    -- * Appending elements+    , snoc++    -- * Appending streams+    , writeAppendN+    , writeAppend++    -- * Inplace mutation+    , putIndex++    -- * Random access+    , getIndex++    -- * Conversion+    , toList++    -- * Unfolds+    , reader+    , readerRev++    -- * Casting+    , cast+    , asBytes++    -- * Size+    , length++    -- * Unbox Type Class+    , Unbox (..)+    )+where++import Prelude hiding (length, read)+import Streamly.Internal.Data.Array.Mut+import Streamly.Internal.Data.Unboxed (Unbox (..))++#include "DocTestDataMutArray.hs"
+ src/Streamly/Data/MutArray/Generic.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.MutArray.Generic+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Unconstrained version of "Streamly.Data.MutArray" module.+--+-- See the "Streamly.Data.MutArray" module for documentation.+--+module Streamly.Data.MutArray.Generic+(+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Type+      MutArray++    -- * Construction+    , writeN++    -- * Appending elements+    , new+    , snoc++    -- * Conversion+    , toList++    -- * Unfolds+    , reader++    -- * Random reads+    , getIndex++    -- * Inplace mutation+    , putIndex+    , modifyIndex+    )+where++import Streamly.Internal.Data.Array.Generic.Mut.Type++#include "DocTestDataMutArrayGeneric.hs"
+ src/Streamly/Data/Parser.hs view
@@ -0,0 +1,177 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Parser+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- 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.+--+-- Please refer to "Streamly.Internal.Data.Parser" for functions that have+-- not yet been released.+--+module Streamly.Data.Parser+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Overview+    -- $overview++    -- * Parser Type+      Parser++    -- -- * Downgrade to Fold+    -- , toFold++    -- * Parsers+    -- ** From Folds+    , fromFold++    -- ** Without Input+    -- , fromFoldMaybe+    , fromPure+    , fromEffect+    , die+    -- , dieM+    , peek+    , eof++    -- ** Element parsers++    -- All of these can be expressed in terms of either+    , one+    -- , oneEq+    -- , oneNotEq+    , oneOf+    , noneOf+    , satisfy+    -- , maybe+    -- , either++    -- ** Sequences+    , streamEqBy+    , listEqBy+    , listEq++    -- * Combinators+    -- Mapping on output+    -- , rmapM++    -- ** Mapping on input+    , lmap+    , lmapM++     -- * Map on output+    , rmapM++    -- ** Filtering+    , filter++    -- ** Look Ahead+    , lookAhead++    -- ** Tokenize by length+    -- , takeBetween+    , takeEQ+    -- , takeGE+    -- , takeP++    -- ** Tokenize by predicate+    -- , takeWhileP+    , takeWhile+    , takeWhile1+    , dropWhile+    -- , takeEndBy+    -- , takeEndByEsc+    -- , takeStartBy+    , wordBy++    -- ** Grouping+    , groupBy+    -- , groupByRolling+    -- , groupByRollingEither++    -- ** Framing+    -- , wordFramedBy+    , wordWithQuotes+    -- , wordProcessQuotes+    -- , wordKeepQuotes++    -- -- * Alternative+    -- , alt++    -- ** Splitting+    , many+    , some+    , manyTill++    -- ** De-interleaving+    , deintercalate+    )++where++import Streamly.Internal.Data.Parser+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
@@ -0,0 +1,44 @@+-- |+-- Module      : Streamly.Data.ParserK+-- Copyright   : (c) 2023 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- 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.+--+-- To run a 'ParserK' use 'Streamly.Data.StreamK.parseChunks'.+--+module Streamly.Data.ParserK+    (+    -- * Parser Type+      ParserK++    -- * Parsers+    -- ** Conversions+    , fromFold+    , fromParser+    -- , toParser++    -- ** Without Input+    , fromPure+    , fromEffect+    , die+    )++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.Parser.ParserK.Type++-- | Convert a 'Fold' to a 'ParserK'.+--+{-# INLINE fromFold #-}+fromFold :: (MonadIO m, Unbox a) => Fold m a b -> ParserK a m b+fromFold = fromParser . ParserD.fromFold
+ src/Streamly/Data/Stream.hs view
@@ -0,0 +1,581 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.Stream+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Fast, composable stream producers with ability to terminate, supporting+-- stream fusion.+--+-- Please refer to "Streamly.Internal.Data.Stream" for more functions that have+-- not yet been released.+--+-- For continuation passing style (CPS) stream type, please refer to+-- the "Streamly.Data.StreamK" module.+--+-- Checkout the <https://github.com/composewell/streamly-examples>+-- repository for many more real world examples of stream programming.++module Streamly.Data.Stream+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Overview+    -- $overview++    -- * The Stream Type+      Stream++    -- * Construction+    -- | Functions ending in the general shape @b -> Stream m a@.+    --+    -- See also: "Streamly.Internal.Data.Stream.Generate" for+    -- @Pre-release@ functions.++    -- ** 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.+    , nil+    , nilM+    , cons+    , consM++    -- ** Unfolding+    -- | 'unfoldrM' is the most general way of generating a stream efficiently.+    -- All other generation operations can be expressed using it.+    , unfoldr+    , unfoldrM++    -- ** From Values+    -- | Generate a monadic stream from a seed value or values.+    , fromPure+    , fromEffect+    , 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:+    --+    -- @+    -- 'fromList' $ 'Prelude.enumFromThen' from then+    -- @+    --+    -- However, this is not particularly efficient.+    -- The 'Enumerable' type class provides corresponding functions that+    -- generate a stream instead of a list, efficiently.++    , 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.+    , fromList++    -- ** From Unfolds+    -- | Most of the above stream generation operations can also be expressed+    -- using the corresponding unfolds in the "Streamly.Data.Unfold" module.+    , unfold -- XXX rename to fromUnfold?++    -- * Elimination+    -- | 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.+-- Left and right folds both use a fold function @f@ and an identity element+-- @z@ (@zero@) to deconstruct a recursive data structure and reconstruct a+-- new data structure. The new structure may be a recursive construction (a+-- container) or a non-recursive single value reduction of the original+-- structure.+--+-- Both right and left folds are mathematical duals of each other, they are+-- functionally equivalent.  Operationally, a left fold on a left associated+-- structure behaves exactly in the same way as a right fold on a right+-- associated structure. Similarly, a left fold on a right associated structure+-- behaves in the same way as a right fold on a left associated structure.+-- However, the behavior of a right fold on a right associated structure is+-- operationally different (even though functionally equivalent) than a left+-- fold on the same structure.+--+-- On right associated structures like Haskell @cons@ lists or Streamly+-- streams, a lazy right fold is naturally suitable for lazy recursive+-- reconstruction of a new structure, while a strict left fold is naturally+-- suitable for efficient reduction. In right folds control is in the hand of+-- the @puller@ whereas in left folds the control is in the hand of the+-- @pusher@.+--+-- The behavior of right and left folds are described in detail in the+-- individual fold's documentation.  To illustrate the two folds for right+-- associated @cons@ lists:+--+-- > foldr :: (a -> b -> b) -> b -> [a] -> b+-- > foldr f z [] = z+-- > foldr f z (x:xs) = x `f` foldr f z xs+-- >+-- > foldl :: (b -> a -> b) -> b -> [a] -> b+-- > foldl f z [] = z+-- > foldl f z (x:xs) = foldl f (z `f` x) xs+--+-- @foldr@ is conceptually equivalent to:+--+-- > foldr f z [] = z+-- > foldr f z [x] = f x z+-- > foldr f z xs = foldr f (foldr f z (tail xs)) [head xs]+--+-- @foldl@ is conceptually equivalent to:+--+-- > foldl f z [] = z+-- > foldl f z [x] = f z x+-- > foldl f z xs = foldl f (foldl f z (init xs)) [last xs]+--+-- Left and right folds are duals of each other.+--+-- @+-- foldr f z xs = foldl (flip f) z (reverse xs)+-- foldl f z xs = foldr (flip f) z (reverse xs)+-- @+--+-- More generally:+--+-- @+-- foldr f z xs = foldl g id xs z where g k x = k . f x+-- foldl f z xs = foldr g id xs z where g x k = k . flip f x+-- @+--++-- NOTE: Folds are inherently serial as each step needs to use the result of+-- the previous step. However, it is possible to fold parts of the stream in+-- parallel and then combine the results using a monoid.++    -- ** Primitives+    -- Consuming a part of the stream and returning the rest. Functions+    -- ending in the general shape @Stream m a -> m (b, Stream m a)@+    , uncons++    -- ** Strict Left Folds+    -- XXX Need to have a general parse operation here which can be used to+    -- express all others.+    , fold -- XXX rename to run? We can have a Stream.run and Fold.run.+    -- XXX fold1 can be achieved using Monoids or Refolds.+    -- XXX We can call this just "break" and parseBreak as "munch"+    , foldBreak++    -- XXX should we have a Fold returning function in stream module?+    -- , foldAdd+    -- , buildl++    -- ** Parsing+    , parse+    -- , parseBreak++    -- ** Lazy Right Folds+    -- | Consuming a stream to build a right associated expression, suitable+    -- for lazy evaluation. Evaluation of the input happens when the output of+    -- the fold is evaluated, the fold output is a lazy thunk.+    --+    -- This is suitable for stream transformation operations, for example,+    -- operations like mapping a function over the stream.+    , foldrM+    , foldr++    -- ** 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+    , toList++    -- * Mapping+    -- | Stateless one-to-one transformations. Use 'fmap' for mapping a pure+    -- function on a stream.++    -- EXPLANATION:+    -- In imperative terms a map operation can be considered as a loop over+    -- the stream that transforms the stream into another stream by performing+    -- an operation on each element of the stream.+    --+    -- 'map' is the least powerful transformation operation with strictest+    -- guarantees.  A map, (1) is a stateless loop which means that no state is+    -- allowed to be carried from one iteration to another, therefore,+    -- operations on different elements are guaranteed to not affect each+    -- other, (2) is a strictly one-to-one transformation of stream elements+    -- which means it guarantees that no elements can be added or removed from+    -- the stream, it can merely transform them.+    , sequence+    , mapM+    , trace+    , tap+    , delay++    -- * Scanning+    -- | Stateful one-to-one transformations.+    --+    -- See also: "Streamly.Internal.Data.Stream.Transform" for+    -- @Pre-release@ functions.++    {-+    -- ** Left scans+    -- | We can perform scans using folds with the 'scan' combinator in the+    -- next section. However, the combinators supplied in this section are+    -- better amenable to stream fusion when combined with other operations.+    -- Note that 'postscan' using folds fuses well and does not require custom+    -- combinators like these.+    , scanl'+    , scanlM'+    , scanl1'+    , scanl1M'+    -}++    -- ** Scanning By 'Fold'+    , scan+    , postscan+    -- XXX postscan1 can be implemented using Monoids or Refolds.++    -- ** Specific scans+    -- Indexing can be considered as a special type of zipping where we zip a+    -- stream with an index stream.+    , indexed++    -- * Insertion+    -- | Add elements to the stream.++    -- Inserting elements is a special case of interleaving/merging streams.+    , insertBy+    , intersperseM+    , intersperseM_+    , intersperse++    -- * Filtering+    -- | Remove elements from the stream.++    -- ** Stateless Filters+    -- | 'mapMaybeM' is the most general stateless filtering operation. All+    -- other filtering operations can be expressed using it.++    -- EXPLANATION:+    -- In imperative terms a filter over a stream corresponds to a loop with a+    -- @continue@ clause for the cases when the predicate fails.++    , mapMaybe+    , mapMaybeM+    , filter+    , filterM++    -- Filter and concat+    , catMaybes+    , catLefts+    , catRights+    , catEithers++    -- ** Stateful Filters+    -- | '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+    , take+    , takeWhile+    , takeWhileM+    , drop+    , dropWhile+    , dropWhileM++    -- XXX These are available as scans in folds. We need to check the+    -- performance though. If these are common and we need convenient stream+    -- ops then we can expose these.++    -- , deleteBy+    -- , uniq+    -- , uniqBy++    -- -- ** Sampling+    -- , strideFromThen++    -- -- ** Searching+    -- Finding the presence or location of an element, a sequence of elements+    -- or another stream within a stream.++    -- -- ** Searching Elements+    -- , findIndices+    -- , elemIndices++    -- * Combining Two Streams+    -- ** Appending+    , append++    -- ** Interleaving+    -- | When interleaving more than two streams you may want to interleave+    -- them pairwise creating a balanced binary merge tree.+    , interleave++    -- ** Merging+    -- | When merging more than two streams you may want to merging them+    -- pairwise creating a balanced binary merge tree.+    --+    -- Merging of @n@ streams can be performed by combining the streams pair+    -- wise using 'mergeMapWith' to give O(n * log n) time complexity. If used+    -- with 'concatMapWith' it will have O(n^2) performance.++    , mergeBy+    , mergeByM++    -- ** Zipping+    -- | When zipping more than two streams you may want to zip them+    -- pairwise creating a balanced binary tree.+    --+    -- Zipping of @n@ streams can be performed by combining the streams pair+    -- wise using 'mergeMapWith' with O(n * log n) time complexity. If used+    -- with 'concatMapWith' it will have O(n^2) performance.+    , zipWith+    , zipWithM+    -- , ZipStream (..)++    -- ** Cross Product+    -- XXX The argument order in this operation is such that it seems we are+    -- transforming the first stream using the second stream because the second+    -- stream is evaluated many times or buffered and better be finite, first+    -- stream could potentially be infinite. In the tradition of using the+    -- transformed stream at the end we can have a flipped version called+    -- "crossMap" or "nestWith".+    , crossWith+    -- , cross+    -- , joinInner+    -- , CrossStream (..)++    -- * Unfold Each+    , unfoldMany+    , intercalate+    , intercalateSuffix++    -- * Stream of streams+    -- | Stream operations like map and filter represent loop processing 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:+    --+    -- > map f m = S.concatMap (\x -> S.fromPure (f x)) m+    --+    -- Similarly, 'concatMap' can perform filtering by mapping an element to a+    -- 'nil' stream:+    --+    -- > filter p m = S.concatMap (\x -> if p x then S.fromPure x else S.nil) m+    --++    , concatEffect+    , concatMap+    , concatMapM++    -- * Repeated Fold+    , foldMany -- XXX Rename to foldRepeat+    , parseMany+    , Array.chunksOf++    -- * Buffered Operations+    -- | Operations that require buffering of the stream.+    -- Reverse is essentially a left fold followed by an unfold.+    , reverse++    -- * Multi-Stream folds+    -- | Operations that consume multiple streams at the same time.+    , eqBy+    , cmpBy+    , isPrefixOf+    , isSubsequenceOf++    -- trimming sequences+    , stripPrefix++    -- 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+    -- 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.+    , before+    , afterIO+    , finallyIO+    , bracketIO+    , bracketIO3++    -- * Transforming Inner Monad++    , morphInner+    , liftInner+    , runReaderT+    , runStateT++    -- -- * Stream Types+    -- $serial+    -- , Interleave+    -- , Zip+    )+where++import qualified Streamly.Internal.Data.Array.Type as Array+import Streamly.Internal.Data.Stream.StreamD+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)++#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
+ src/Streamly/Data/Stream/Zip.hs view
@@ -0,0 +1,16 @@+-- |+-- 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
@@ -0,0 +1,153 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Data.StreamK+-- Copyright   : (c) 2017 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- 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.+--+-- Please refer to "Streamly.Internal.Data.Stream.StreamK" for more functions+-- that have not yet been released.++-- Notes:+--+-- primitive/open loop operations that can be used recursively e.g. uncons,+-- foldBreak, parseBreak should not be converted from StreamD for use in+-- StreamK, instead native StreamK impl should be used.+--+-- Closed loop operations like repeat, replicate, iterate etc can be converted+-- from StreamD.+--+-- In the last phase any operation like (toStreamK . f . toStreamD) should be+-- rewritten to a K version of f.+-- XXX Need to add rewrite rules for all missing StreamD operations.+--+module Streamly.Data.StreamK+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Overview+    -- $overview++    -- * Type+      StreamK++    -- * Construction+    -- ** Primitives+    , nil+    , nilM+    , cons+    , consM++    -- ** From Values+    , fromPure+    , fromEffect++    -- ** From Stream+    , fromStream+    , toStream++    -- ** From Containers+    , fromFoldable++    -- * Elimination++    -- ** Primitives+    , uncons+    , drain++    -- -- ** Folding+    -- , foldBreak++    -- ** Parsing+    -- , parseBreak+    , parseBreakChunks+    , parseChunks++    -- * Transformation+    , mapM+    , dropWhile+    , take++    -- * Combining Two Streams+    -- ** Appending+    , append++    -- ** Interleaving+    , interleave++    -- ** Merging+    , mergeBy+    , mergeByM++    -- ** Zipping+    , zipWith+    , zipWithM++    -- ** Cross Product+    -- XXX is "bind/concatFor" better to have than crossWith?+    -- crossWith f xs1 xs2 = concatFor xs1 (\x -> fmap (f x) xs2)+    , crossWith+    -- , cross+    -- , joinInner+    -- , CrossStreamK (..)++    -- * Stream of streams+    , concatEffect+    -- , concatMap+    , concatMapWith+    , mergeMapWith++    -- * Buffered Operations+    , reverse+    , sortBy+    )+where++import Streamly.Internal.Data.Stream.StreamK+import Prelude hiding (reverse, zipWith, mapM, dropWhile, take)++#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
@@ -0,0 +1,228 @@+{-# LANGUAGE CPP #-}++-- |+-- Module      : Streamly.Data.Unfold+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- 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+-- 'Unfold' type, is a fully fusible alternative to+-- 'Streamly.Data.Stream.concatMap'.+--+-- Please refer to "Streamly.Internal.Data.Unfold" for more functions that have+-- not yet been released.+--+-- Exception combinators are not exposed, we would like to encourage the use of+-- 'Stream' type instead whenever exception handling is required. We can+-- consider exposing the unfold exception functions if there is a compelling+-- use case to use unfolds instead of stream.++module Streamly.Data.Unfold+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Overview+    -- $overview++    -- * Unfold Type+      Unfold++    -- * Unfolds+    -- One to one correspondence with+    -- "Streamly.Internal.Data.Stream.Generate"++    -- ** Basic Constructors+    , unfoldrM+    , unfoldr+    , function+    , functionM++    -- ** Generators+    -- | Generate a monadic stream from a seed.+    , repeatM+    , replicateM+    , iterateM++    -- ** From Containers+    , fromList+    , fromListM+    , fromStream++    -- * Combinators+    -- ** Mapping on Input+    , lmap+    , lmapM++    -- ** Mapping on Output+    , mapM++    -- ** Filtering+    , takeWhileM+    , takeWhile+    , take+    , filter+    , filterM+    , drop+    , dropWhile+    , dropWhileM++    -- ** Zipping+    , zipWith++    -- ** Cross Product+    , crossWith++    -- ** Nesting+    , many++    )+where++import Prelude hiding+    ( concat, map, mapM, takeWhile, take, filter, const, drop, dropWhile+    , zipWith+    )+import Streamly.Internal.Data.Unfold++#include "DocTestDataUnfold.hs"++-- $overview+--+-- An 'Unfold' is a source or a producer of a stream of values.  It takes a+-- seed value as an input and unfolds it into a sequence of values.+--+-- For example, the 'fromList' Unfold generates a stream of values from a+-- supplied list.  Unfolds can be converted to 'Streamly.Internal.Data.Stream'+-- using the 'Stream.unfold' operation.+--+-- >>> stream = Stream.unfold Unfold.fromList [1..100]+-- >>> Stream.fold Fold.sum stream+-- 5050+--+-- The input seed of an unfold can be transformed using 'lmap':+--+-- >>> u = Unfold.lmap (fmap (+1)) Unfold.fromList+-- >>> Stream.fold Fold.toList $ Stream.unfold u [1..5]+-- [2,3,4,5,6]+--+-- Output stream of an 'Unfold' can be transformed using transformation+-- combinators. For example, to retain only the first two elements of an+-- unfold:+--+-- >>> u = Unfold.take 2 Unfold.fromList+-- >>> Stream.fold Fold.toList $ Stream.unfold u [1..100]+-- [1,2]+--+-- Unfolds can be nested efficiently. For example, to implement nested looping:+--+-- >>> u1 = Unfold.lmap fst Unfold.fromList+-- >>> u2 = Unfold.lmap snd Unfold.fromList+-- >>> u = Unfold.crossWith (,) u1 u2+-- >>> Stream.fold Fold.toList $ Stream.unfold u ([1,2,3], [4,5,6])+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+-- 'Unfold' @u1@ generates a stream from the first list in the input tuple,+-- @u2@ generates another stream from the second list. The combines 'Unfold'+-- @u@ nests the two streams i.e. for each element in first stream, for each+-- element in second stream apply the supplied function (i.e. @(,)@) to the+-- pair of elements.+--+-- This is the equivalent of the nested looping construct from imperative+-- languages, also known as the cross product of two streams in functional+-- parlance.+--+-- Please see "Streamly.Internal.Data.Unfold" for additional @Pre-release@+-- functions.+--+-- == Creating New Unfolds+--+-- There are many commonly used unfolds provided in this module. However, you+-- can always create your own as well.  An 'Unfold' is just a data+-- representation of a stream generator function. It consists of an @inject@+-- function which covnerts the supplied seed into an internal state of the+-- unfold, and a @step@ function which takes the state and generates the next+-- output in the stream. For those familiar with the list "Data.List.unfoldr"+-- function, this is a data representation of the same.+--+-- Smart constructor functions are provided in this module for constructing new+-- 'Unfolds'. For example, you can use the 'Unfold.unfoldr' constructor to+-- create an 'Unfold' from a pure step function, unfoldr uses 'id' as the+-- @inject@ function.+--+-- Let's define a simple pure step function:+--+-- >>> :{+--  f [] = Nothing+--  f (x:xs) = Just (x, xs)+-- :}+--+-- Create an 'Unfold' from the step function:+--+-- >>> u = Unfold.unfoldr f+--+-- Run the 'Unfold':+--+-- >>> Stream.fold Fold.toList $ Stream.unfold u [1,2,3]+-- [1,2,3]+--+-- The 'Unfold.unfoldr' smart constructor is essentially the same as the list+-- "Data.List.unfoldr" function. We can use the same step function in both::+--+-- >>> Data.List.unfoldr f [1,2,3]+-- [1,2,3]+--+-- == Unfolds vs. Streams+--+-- The 'Unfold' abstraction for representing streams was introduced in Streamly+-- to provide C like performance for nested looping of streams. 'Unfold' and+-- 'Stream' abstractions are similar with the following differences:+--+-- * 'Stream' is less efficient than 'Unfold' for nesting.+-- * 'Stream' is more powerful than 'Unfold'.+-- * 'Stream' API is more convenient for programming+--+-- Unfolds can be easily converted to streams using 'Stream.unfold', however,+-- vice versa is not possible. To provide a familiar analogy, 'Unfold' is to+-- 'Stream' as 'Applicative' is to 'Monad'.+--+-- To demonstrate the efficiency of unfolds, the nested loop example in the+-- previous section can be implemented with concatMap or Monad instance of+-- streams as follows:+--+-- @+--  do+--      x <- Stream.unfold Unfold.fromList [1,2,3]+--      y <- Stream.unfold Unfold.fromList [4,5,6]+--      return (x, y)+-- @+--+-- As you can see, this is more convenient to write than using the 'crossWith'+-- unfold combinator. However, this turns out to be many times slower than the+-- unfold implementation. The Unfold version is equivalent in performance to+-- the C implementation of the same nested loop. Similarly, unfolds can be+-- nested with streams using the 'unfoldMany' combinator which is a much more+-- efficient alternative to the 'concatMap' operation.+--+-- Streams use a hybrid implementation approach using direct style as well as+-- CPS. Unfolds do not use CPS, therefore, lack the power that is afforded to+-- streams by CPS. The CPS implementation allows infinitely scalable @cons@ and+-- @append@ operations in streams. It is also used to implement concurrency in+-- streams.+--+-- To summarize, unfolds are a high performance solution to the nesting+-- problem. Since streams provide a more palatable API for programming, work+-- with streams unless you need unfolds for better performance in nesting+-- situations. There is little difference in the way in which unfolds and+-- streams are written, it is easy to adapt a stream to an unfold. If you are+-- writing an unfold you can convert it to stream for free using+-- 'Stream.unfold'.
+ src/Streamly/FileSystem/Dir.hs view
@@ -0,0 +1,23 @@+-- |+-- Module      : Streamly.FileSystem.Dir+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC+--+-- Warning\: The API of this module is subject to change in future releases.+-- Especially the type for representing paths may change from 'FilePath' to+-- something else.++module Streamly.FileSystem.Dir+    (+    -- * Streams+      read+    , readEither+    )+where++import Streamly.Internal.FileSystem.Dir+import Prelude hiding (read)
+ src/Streamly/FileSystem/File.hs view
@@ -0,0 +1,60 @@+-- |+-- Module      : Streamly.FileSystem.File+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC+--+-- Warning\: The API of this module is subject to change in future releases.+-- Especially the type for representing paths may change from 'FilePath' to+-- something else.+--+-- Read and write streams and arrays to and from files specified by their paths+-- in the file system. Unlike the handle based APIs which can have a read/write+-- session consisting of multiple reads and writes to the handle, these APIs+-- are one shot read or write APIs. These APIs open the file handle, perform+-- the requested operation and close the handle. These are safer compared to+-- the handle based APIs as there is no possibility of a file descriptor+-- leakage.+--+-- >>> import qualified Streamly.FileSystem.File as File+--+module Streamly.FileSystem.File+    (+    -- * 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++    -- ** Folds+    , write+    , writeWith+    , writeChunks+    )+where++import Streamly.Internal.FileSystem.File+import Prelude hiding (read)
+ src/Streamly/FileSystem/Handle.hs view
@@ -0,0 +1,131 @@+#include "inline.hs"++-- |+-- Module      : Streamly.FileSystem.Handle+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- >>> import qualified Streamly.FileSystem.Handle as Handle+--+-- Read and write byte streams and array streams to and from file handles+-- ('Handle').+--+-- The 'TextEncoding', 'NewLineMode', and 'Buffering' 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+-- the input stream on any other type of boundaries.+--+-- To set the read or write start position use 'hSeek' on the 'Handle', the+-- 'Streamly.Data.Stream.before' combinator may be used to do that on a+-- streaming combinator.  To restrict the length of read or write use the stream+-- trimming operations like 'Streamly.Data.Stream.take'.+--+-- Note that a 'Handle' is inherently stateful, therefore, we cannot use these+-- APIs from multiple threads without serialization; reading or writing in one+-- thread would affect the file position for other threads.+--+-- For additional, experimental APIs take a look at+-- "Streamly.Internal.FileSystem.Handle" module.++-- Design notes:+--+-- By design, file handle IO APIs are quite similar to+-- "Streamly.Data.Array" read write APIs. In that regard, arrays can be+-- considered as in-memory files or files can be considered as on-disk arrays.+--+module Streamly.FileSystem.Handle+    (+    -- * Singleton IO+    -- | Read or write a single buffer.+      getChunk+    , putChunk++    -- * Streaming IO+    -- | Read or write a stream of data to or from a file or device+    -- sequentially.+    --+    -- Read requests to the IO device are performed in chunks limited to a+    -- maximum size of 'Streamly.Internal.System.IO.defaultChunkSize'.  Note+    -- that the size of the actual chunks in the resulting stream may be less+    -- than the @defaultChunkSize@ but it can never exceed it.  If the whole+    -- stream is not consumed, it is possible that we may have read slightly+    -- more from the IO device than what the consumer needed.+    --+    -- Unless specified otherwise in the API, writes are collected into chunks+    -- of 'Streamly.Internal.System.IO.defaultChunkSize' before they are+    -- written to the IO device.++    -- Internal notes:+    --+    -- 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.++    -- ** Reading+    -- | 'TextEncoding', 'NewLineMode', and 'Buffering' options of the+    -- underlying handle are ignored. The read occurs from the current seek+    -- position of the file handle. The stream ends as soon as EOF is+    -- encountered.++    -- -- *** Streams+    -- , read+    -- , readWith+    -- , readChunks+    -- , readChunksWith++    -- -- *** Unfolds+    , reader+    , readerWith+    , chunkReader+    , chunkReaderWith++    -- ** Folds+    -- | 'TextEncoding', 'NewLineMode', and 'Buffering' options of the+    -- underlying handle are ignored. The write occurs from the current seek+    -- position of the file handle.  The write behavior depends on the 'IOMode'+    -- of the handle.++    , write+    , writeWith+    , 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 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
+ src/Streamly/Internal/BaseCompat.hs view
@@ -0,0 +1,37 @@+-- |+-- Module      : Streamly.Internal.BaseCompat+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Compatibility functions for "base" package.+--+module Streamly.Internal.BaseCompat+    (+      (#.)+    , unsafeWithForeignPtr+    )+where++import Data.Coerce (Coercible, coerce)+import GHC.ForeignPtr (ForeignPtr(..))+import GHC.Ptr (Ptr(..))++#if MIN_VERSION_base(4,15,0)+import qualified GHC.ForeignPtr as GHCForeignPtr+#else+import Foreign.ForeignPtr (withForeignPtr)+#endif+++{-# INLINE (#.) #-}+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)+(#.) _f = coerce++unsafeWithForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b+#if MIN_VERSION_base(4,15,0)+unsafeWithForeignPtr = GHCForeignPtr.unsafeWithForeignPtr+#else+unsafeWithForeignPtr = withForeignPtr+#endif
+ src/Streamly/Internal/Console/Stdio.hs view
@@ -0,0 +1,228 @@+-- |+-- Module      : Streamly.Internal.Console.Stdio+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Console.Stdio+    (+    -- * Streams+      read+    , readChars+    , 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++    -- * Unfolds+    , reader+    , chunkReader++    -- * Folds+    , write+    , writeChunks+    , writeErr+    , writeErrChunks++    -- * Stream writes+    , putBytes  -- Buffered (32K)+    , putChars+    , putChunks -- Unbuffered+    , putStringsWith+    , putStrings+    , putStringsLn+    )+where++#include "inline.hs"++import Control.Monad.IO.Class (MonadIO(..))+import Data.Word (Word8)+import System.IO (stdin, stdout, stderr)+import Prelude hiding (read)++import Streamly.Internal.Data.Array.Type (Array(..))+import Streamly.Internal.Data.Stream.StreamD (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.Unfold as Unfold+import qualified Streamly.Internal.FileSystem.Handle as Handle+import qualified Streamly.Internal.Unicode.Stream as Unicode++-------------------------------------------------------------------------------+-- Reads+-------------------------------------------------------------------------------++-- | Unfold standard input into a stream of 'Word8'.+--+{-# INLINE reader #-}+reader :: MonadIO m => Unfold m () Word8+reader = Unfold.lmap (\() -> stdin) Handle.reader++-- | Read a byte stream from standard input.+--+-- > read = Handle.read stdin+-- > read = Stream.unfold Stdio.reader ()+--+-- /Pre-release/+--+{-# INLINE read #-}+read :: MonadIO m => Stream m Word8+read = Handle.read stdin++-- | Read a character stream from Utf8 encoded standard input.+--+-- > readChars = Unicode.decodeUtf8 Stdio.read+--+-- /Pre-release/+--+{-# INLINE readChars #-}+readChars :: MonadIO m => Stream m Char+readChars = Unicode.decodeUtf8 read++-- | Unfolds standard input into a stream of 'Word8' arrays.+--+{-# INLINE chunkReader #-}+chunkReader :: MonadIO m => Unfold m () (Array Word8)+chunkReader = Unfold.lmap (\() -> stdin) Handle.chunkReader++-- | Read a stream of chunks from standard input.  The maximum size of a single+-- chunk is limited to @defaultChunkSize@. The actual size read may be less+-- than @defaultChunkSize@.+--+-- > readChunks = Handle.readChunks stdin+-- > readChunks = Stream.unfold Stdio.chunkReader ()+--+-- /Pre-release/+--+{-# INLINE readChunks #-}+readChunks :: MonadIO m => Stream m (Array Word8)+readChunks = Handle.readChunks stdin++{-+-- | Read UTF8 encoded lines from standard input.+--+-- You may want to process the input byte stream directly using appropriate+-- folds for more efficient processing.+--+-- /Pre-release/+--+{-# INLINE getChunksLn #-}+getChunksLn :: MonadIO m => Stream m (Array Word8)+getChunksLn = (Stream.splitWithSuffix (== '\n') f) getChars++    -- XXX Need to implement Fold.unfoldMany, should be easy for+    -- non-terminating folds, but may be tricky for terminating folds. See+    -- Array Stream folds.+    where f = Fold.unfoldMany Unicode.readCharUtf8 Array.write+-}++-------------------------------------------------------------------------------+-- Writes+-------------------------------------------------------------------------------++-- | Fold a stream of 'Word8' to standard output.+--+{-# INLINE write #-}+write :: MonadIO m => Fold m Word8 ()+write = Handle.write stdout++-- | Fold a stream of 'Word8' to standard error.+--+{-# INLINE writeErr #-}+writeErr :: MonadIO m => Fold m Word8 ()+writeErr = Handle.write stderr++-- | Write a stream of bytes to standard output.+--+-- > putBytes = Handle.putBytes stdout+-- > putBytes = Stream.fold Stdio.write+--+-- /Pre-release/+--+{-# INLINE putBytes #-}+putBytes :: MonadIO m => Stream m Word8 -> m ()+putBytes = Handle.putBytes stdout++-- | Encode a character stream to Utf8 and write it to standard output.+--+-- > putChars = Stdio.putBytes . Unicode.encodeUtf8+--+-- /Pre-release/+--+{-# INLINE putChars #-}+putChars :: MonadIO m => Stream m Char -> m ()+putChars = putBytes . Unicode.encodeUtf8++-- | Fold a stream of @Array Word8@ to standard output.+--+{-# INLINE writeChunks #-}+writeChunks :: MonadIO m => Fold m (Array Word8) ()+writeChunks = Handle.writeChunks stdout++-- | Fold a stream of @Array Word8@ to standard error.+--+{-# INLINE writeErrChunks #-}+writeErrChunks :: MonadIO m => Fold m (Array Word8) ()+writeErrChunks = Handle.writeChunks stderr++-- | Write a stream of chunks to standard output.+--+-- > putChunks = Handle.putChunks stdout+-- > putChunks = Stream.fold Stdio.writeChunks+--+-- /Pre-release/+--+{-# INLINE putChunks #-}+putChunks :: MonadIO m => Stream m (Array Word8) -> m ()+putChunks = Handle.putChunks stdout++-------------------------------------------------------------------------------+-- Line buffered+-------------------------------------------------------------------------------++-- XXX We need to write transformations as pipes so that they can be applied to+-- 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.+--+-- /Pre-release/+--+{-# INLINE putStringsWith #-}+putStringsWith :: MonadIO m+    => (Stream m Char -> Stream m Word8) -> Stream m String -> m ()+putStringsWith encode = putChunks . Unicode.encodeStrings encode++-- | Write a stream of strings to standard output using UTF8 encoding.  Output+-- is flushed to the device for each string.+--+-- /Pre-release/+--+{-# INLINE putStrings #-}+putStrings :: MonadIO m => Stream m String -> m ()+putStrings = putStringsWith Unicode.encodeUtf8++-- | Like 'putStrings' but adds a newline at the end of each string.+--+-- XXX This is not portable, on Windows we need to use "\r\n" instead.+--+-- /Pre-release/+--+{-# INLINE putStringsLn #-}+putStringsLn :: MonadIO m => Stream m String -> m ()+putStringsLn =+      putChunks+    . Stream.intersperseMSuffix (return $ Array.fromList [10])+    . Unicode.encodeStrings Unicode.encodeUtf8
+ src/Streamly/Internal/Control/Exception.hs view
@@ -0,0 +1,38 @@+-- |+-- Module      : Streamly.Internal.Control.Exception+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Additional "Control.Exception" utilities.++module Streamly.Internal.Control.Exception+    ( verify+    , verifyM+    )+where++-- | Like 'assert' but is not removed by the compiler, it is always present in+-- production code.+--+-- /Pre-release/+--+{-# INLINE verify #-}+verify :: Bool -> a -> a+verify predicate val =+    if predicate+    -- XXX it would be nice if we can print the predicate expr.+    then error "verify failed"+    else val++-- Like 'verify' but returns @()@ in an 'Applicative' context so that it can be+-- used as an independent statement in a @do@ block.+--+-- /Pre-release/+--+{-# INLINE verifyM #-}+verifyM :: Applicative f => Bool -> f ()+verifyM predicate = verify predicate (pure ())
+ src/Streamly/Internal/Control/ForkIO.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module      : Streamly.Internal.Control.ForkIO+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Control.ForkIO+    ( rawForkIO+    , forkIOManaged+    , forkManagedWith+    )+where++import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Monad.IO.Class (MonadIO(..))+import GHC.Conc (ThreadId(..))+import GHC.Exts+import GHC.IO (IO(..))+import System.Mem.Weak (addFinalizer)++-- | Stolen from the async package. The perf improvement is modest, 2% on a+-- thread heavy benchmark (parallel composition using noop computations).+-- A version of forkIO that does not include the outer exception+-- handler: saves a bit of time when we will be installing our own+-- exception handler.+{-# INLINE rawForkIO #-}+rawForkIO :: IO () -> IO ThreadId+rawForkIO (IO action) = IO $ \ s ->+   case fork# action s of (# s1, tid #) -> (# s1, ThreadId tid #)++-- | Fork a thread that is automatically killed as soon as the reference to the+-- returned threadId is garbage collected.+--+{-# INLINABLE forkManagedWith #-}+forkManagedWith :: MonadIO m => (m () -> m ThreadId) -> m () -> m ThreadId+forkManagedWith fork action = do+    tid <- fork action+    liftIO $ addFinalizer tid (killThread tid)+    return tid++-- | Fork a thread that is automatically killed as soon as the reference to the+-- returned threadId is garbage collected.+--+{-# INLINABLE forkIOManaged #-}+forkIOManaged :: IO () -> IO ThreadId+forkIOManaged = forkManagedWith forkIO
+ src/Streamly/Internal/Control/Monad.hs view
@@ -0,0 +1,26 @@+-- |+-- Module      : Streamly.Internal.Control.Monad+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Additional "Control.Monad" utilities.++module Streamly.Internal.Control.Monad+    ( discard+    )+where++import Control.Monad (void)+import Control.Monad.Catch (MonadCatch, catch, SomeException)++-- | Discard any exceptions or value returned by an effectful action.+--+-- /Pre-release/+--+{-# INLINE discard #-}+discard :: MonadCatch m => m b -> m ()+discard action = void action `catch` (\(_ :: SomeException) -> return ())
+ src/Streamly/Internal/Data/Array.hs view
@@ -0,0 +1,573 @@+{-# LANGUAGE CPP #-}+-- |+-- 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)
+ src/Streamly/Internal/Data/Array/ArrayMacros.h view
@@ -0,0 +1,43 @@+-------------------------------------------------------------------------------+-- Macros to access Storable pointers+-------------------------------------------------------------------------------++-- The Storable instance of () has size 0. We ensure that the size is non-zero+-- to avoid a zero sized element and issues due to that.+-- See https://mail.haskell.org/pipermail/libraries/2022-January/thread.html+--+-- XXX Check the core to see if max can be statically eliminated. llvm can+-- eliminate the comparison, but not sure if GHC NCG can.+#define STORABLE_SIZE_OF(a) max 1 (sizeOf (undefined :: a))++-- Move the pointer to ith element of specified type. Type is specified as the+-- type variable in the signature of the function where this macro is used.+#define PTR_NEXT(ptr,a) ptr `plusPtr` STORABLE_SIZE_OF(a)+#define PTR_PREV(ptr,a) ptr `plusPtr` negate (STORABLE_SIZE_OF(a))++#define PTR_INDEX(ptr,i,a) ptr `plusPtr` (STORABLE_SIZE_OF(a) * i)+#define PTR_RINDEX(ptr,i,a) ptr `plusPtr` negate (STORABLE_SIZE_OF(a) * (i + 1))++-- XXX If we know that the array is guaranteed to have size multiples of the+-- element size then we can use a simpler check saying "ptr < end". Since we+-- always allocate in multiples of elem we can use the simpler check and assert+-- the rigorous check.+#define PTR_VALID(ptr,end,a) ptr `plusPtr` STORABLE_SIZE_OF(a) <= end+#define PTR_INVALID(ptr,end,a) ptr `plusPtr` STORABLE_SIZE_OF(a) > end++-------------------------------------------------------------------------------+-- Macros to access array indices (using Unbox type class)+-------------------------------------------------------------------------------++-- This macro was originally defined as a wrapper to sizeOf so that we can+-- avoid a sizeOf value of 0 and make it 1.+#define SIZE_OF(a) sizeOf (Proxy :: Proxy a)++#define INDEX_NEXT(i,a) i + SIZE_OF(a)+#define INDEX_PREV(i,a) i - SIZE_OF(a)++#define INDEX_OF(base,i,a) base + (SIZE_OF(a) * i)+#define RINDEX_OF(base,i,a) base - (SIZE_OF(a) * (i + 1))++#define INDEX_VALID(i,end,a) i + SIZE_OF(a) <= end+#define INDEX_INVALID(i,end,a) i + SIZE_OF(a) > end
+ src/Streamly/Internal/Data/Array/Generic.hs view
@@ -0,0 +1,281 @@+-- |+-- Module      : Streamly.Internal.Data.Array.Generic+-- Copyright   : (c) 2019 Composewell Technologies+--+-- 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++    -- * Random Access+    , getIndexUnsafe+    , getSliceUnsafe+    , strip+    )+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)++{-# INLINE_NORMAL read #-}+read :: Monad m => Array a -> Stream m a+read arr@Array{..} =+    D.map (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)++{-# INLINE_NORMAL readRev #-}+readRev :: Monad m => Array a -> Stream m a+readRev arr@Array{..} =+    D.map (`getIndexUnsafe` arr)+        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0++-------------------------------------------------------------------------------+-- Elimination - using Folds+-------------------------------------------------------------------------------++{-# INLINE_NORMAL foldl' #-}+foldl' :: (b -> a -> b) -> b -> Array a -> b+foldl' f z arr = unsafePerformIO $ D.foldl' f z $ read arr++{-# INLINE_NORMAL foldr #-}+foldr :: (a -> b -> b) -> b -> Array a -> b+foldr f z arr = unsafePerformIO $ D.foldr f z $ read arr++{-# INLINE fold #-}+fold :: Monad m => Fold m a b -> Array a -> m b+fold f arr = D.fold f (read arr)++{-# INLINE streamFold #-}+streamFold :: Monad m => (Stream m a -> m b) -> Array a -> m b+streamFold f arr = f (read arr)++-------------------------------------------------------------------------------+-- 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 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++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
+ src/Streamly/Internal/Data/Array/Generic/Mut/Type.hs view
@@ -0,0 +1,796 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE UnboxedTuples #-}+-- |+-- Module      : Streamly.Internal.Data.Array.Generic.Mut.Type+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD3-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Array.Generic.Mut.Type+(+    -- * Type+    -- $arrayNotes+      MutArray (..)++    -- * Constructing and Writing+    -- ** Construction+    , nil++    -- *** Uninitialized Arrays+    , new+    -- , newArrayWith++    -- *** From streams+    , writeNUnsafe+    , writeN+    , writeWith+    , write++    -- , writeRevN+    -- , writeRev++    -- ** From containers+    -- , fromListN+    -- , fromList+    -- , fromStreamDN+    -- , fromStreamD++    -- * Random writes+    , putIndex+    , putIndexUnsafe+    , putIndices+    -- , putFromThenTo+    -- , putFrom -- start writing at the given position+    -- , putUpto -- write from beginning up to the given position+    -- , putFromTo+    -- , putFromRev+    -- , putUptoRev+    , modifyIndexUnsafe+    , modifyIndex+    -- , modifyIndices+    -- , modify+    -- , swapIndices++    -- * Growing and Shrinking+    -- Arrays grow only at the end, though it is possible to grow on both sides+    -- and therefore have a cons as well as snoc. But that will require two+    -- bounds in the array representation.++    -- ** Reallocation+    , realloc+    , uninit++    -- ** Appending elements+    , snocWith+    , snoc+    -- , snocLinear+    -- , snocMay+    , snocUnsafe++    -- ** Appending streams+    -- , writeAppendNUnsafe+    -- , writeAppendN+    -- , writeAppendWith+    -- , writeAppend++    -- ** Truncation+    -- These are not the same as slicing the array at the beginning, they may+    -- reduce the length as well as the capacity of the array.+    -- , truncateWith+    -- , truncate+    -- , truncateExp++    -- * Eliminating and Reading++    -- ** Unfolds+    , reader+    -- , readerRev+    , producerWith -- experimental+    , producer -- experimental++    -- ** To containers+    , toStreamD+    , readRev+    , toStreamK+    -- , toStreamKRev+    , toList++    -- ** Random reads+    , getIndex+    , getIndexUnsafe+    -- , getIndices+    -- , getFromThenTo+    -- , getIndexRev++    -- * Size+    , length++    -- * In-place Mutation Algorithms+    , strip+    -- , reverse+    -- , permute+    -- , partitionBy+    -- , shuffleBy+    -- , divideBy+    -- , mergeBy++    -- * Folding+    -- , foldl'+    -- , foldr+    , cmp+    , eq++    -- * Arrays of arrays+    --  We can add dimensionality parameter to the array type to get+    --  multidimensional arrays. Multidimensional arrays would just be a+    --  convenience wrapper on top of single dimensional arrays.++    -- | Operations dealing with multiple arrays, streams of arrays or+    -- multidimensional array representations.++    -- ** Construct from streams+    -- , chunksOf+    -- , arrayStreamKFromStreamD+    -- , writeChunks++    -- ** Eliminate to streams+    -- , flattenArrays+    -- , flattenArraysRev+    -- , fromArrayStreamK++    -- ** Construct from arrays+    -- get chunks without copying+    , getSliceUnsafe+    , getSlice+    -- , getSlicesFromLenN+    -- , splitAt -- XXX should be able to express using getSlice+    -- , breakOn++    -- ** Appending arrays+    -- , spliceCopy+    -- , spliceWith+    -- , splice+    -- , spliceExp+    , putSliceUnsafe+    -- , appendSlice+    -- , appendSliceFrom++    , clone+    )+where++#include "inline.hs"+#include "assert.hs"++import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO(..))+import GHC.Base+    ( MutableArray#+    , RealWorld+    , copyMutableArray#+    , newArray#+    , readArray#+    , writeArray#+    )+import GHC.IO (IO(..))+import GHC.Int (Int(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.Producer.Type (Producer (..))+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import qualified Streamly.Internal.Data.Fold.Type as FL+import qualified Streamly.Internal.Data.Producer as Producer+import qualified Streamly.Internal.Data.Stream.StreamD.Type as D+import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D+import qualified Streamly.Internal.Data.Stream.StreamK.Type as K++import Prelude hiding (read, length)++#include "DocTestDataMutArrayGeneric.hs"++-------------------------------------------------------------------------------+-- MutArray Data Type+-------------------------------------------------------------------------------++data MutArray a =+    MutArray+        { arrContents# :: MutableArray# RealWorld a+          -- ^ The internal contents of the array representing the entire array.++        , arrStart :: {-# UNPACK #-}!Int+          -- ^ The starting index of this slice.++        , arrLen :: {-# UNPACK #-}!Int+          -- ^ The length of this slice.++        , arrTrueLen :: {-# UNPACK #-}!Int+          -- ^ This is the true length of the array. Coincidentally, this also+          -- represents the first index beyond the maximum acceptable index of+          -- the array. This is specific to the array contents itself and not+          -- dependent on the slice. This value should not change and is shared+          -- across all the slices.+        }++{-# INLINE bottomElement #-}+bottomElement :: a+bottomElement =+    error+        $ unwords+              [ funcName+              , "This is the bottom element of the array."+              , "This is a place holder and should never be reached!"+              ]++    where++    funcName = "Streamly.Internal.Data.Array.Generic.Mut.Type.bottomElement:"++-- XXX Would be nice if GHC can provide something like newUninitializedArray# so+-- that we do not have to write undefined or error in the whole array.++-- | @new count@ allocates a zero length array that can be extended to hold+-- up to 'count' items without reallocating.+--+-- /Pre-release/+{-# INLINE new #-}+new :: MonadIO m => Int -> m (MutArray a)+new n@(I# n#) =+    liftIO+        $ IO+        $ \s# ->+              case newArray# n# bottomElement s# of+                  (# s1#, arr# #) ->+                      let ma = MutArray arr# 0 0 n+                       in (# s1#, ma #)++-- XXX This could be pure?++-- |+-- Definition:+--+-- >>> nil = MutArray.new 0+{-# INLINE nil #-}+nil :: MonadIO m => m (MutArray a)+nil = new 0++-------------------------------------------------------------------------------+-- Random writes+-------------------------------------------------------------------------------++-- | Write the given element to the given index of the array. Does not check if+-- the index is out of bounds of the array.+--+-- /Pre-release/+{-# INLINE putIndexUnsafe #-}+putIndexUnsafe :: forall m a. MonadIO m => Int -> MutArray a -> a -> m ()+putIndexUnsafe i MutArray {..} x =+    assert (i >= 0 && i < arrLen)+    (liftIO+        $ IO+        $ \s# ->+              case i + arrStart of+                  I# n# ->+                      let s1# = writeArray# arrContents# n# x s#+                       in (# s1#, () #))++invalidIndex :: String -> Int -> a+invalidIndex label i =+    error $ label ++ ": invalid array index " ++ show i++-- | /O(1)/ Write the given element at the given index in the array.+-- Performs in-place mutation of the array.+--+-- >>> putIndex ix arr val = MutArray.modifyIndex ix arr (const (val, ()))+--+-- /Pre-release/+{-# INLINE putIndex #-}+putIndex :: MonadIO m => Int -> MutArray a -> a -> m ()+putIndex i arr@MutArray {..} x =+    if i >= 0 && i < arrLen+    then putIndexUnsafe i arr x+    else invalidIndex "putIndex" i++-- | Write an input stream of (index, value) pairs to an array. Throws an+-- error if any index is out of bounds.+--+-- /Pre-release/+{-# INLINE putIndices #-}+putIndices :: MonadIO m+    => MutArray a -> Fold m (Int, a) ()+putIndices arr = FL.foldlM' step (return ())++    where++    step () (i, x) = liftIO (putIndex i arr x)++-- | Modify a given index of an array using a modifier function without checking+-- the bounds.+--+-- Unsafe because it does not check the bounds of the array.+--+-- /Pre-release/+modifyIndexUnsafe :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndexUnsafe i MutArray {..} f = do+    liftIO+        $ IO+        $ \s# ->+              case i + arrStart of+                  I# n# ->+                      case readArray# arrContents# n# s# of+                          (# s1#, a #) ->+                              let (a1, b) = f a+                                  s2# = writeArray# arrContents# n# a1 s1#+                               in (# s2#, b #)++-- | Modify a given index of an array using a modifier function.+--+-- /Pre-release/+modifyIndex :: MonadIO m => Int -> MutArray a -> (a -> (a, b)) -> m b+modifyIndex i arr@MutArray {..} f = do+    if i >= 0 && i < arrLen+    then modifyIndexUnsafe i arr f+    else invalidIndex "modifyIndex" i++-------------------------------------------------------------------------------+-- Resizing+-------------------------------------------------------------------------------++-- | Reallocates the array according to the new size. This is a safe function+-- that always creates a new array and copies the old array into the new one.+-- If the reallocated size is less than the original array it results in a+-- truncated version of the original array.+--+realloc :: MonadIO m => Int -> MutArray a -> m (MutArray a)+realloc n arr = do+    arr1 <- new n+    let !newLen@(I# newLen#) = min n (arrLen arr)+        !(I# arrS#) = arrStart arr+        !(I# arr1S#) = arrStart arr1+        arrC# = arrContents# arr+        arr1C# = arrContents# arr1+    liftIO+        $ IO+        $ \s# ->+              let s1# = copyMutableArray# arrC# arrS# arr1C# arr1S# newLen# s#+               in (# s1#, arr1 {arrLen = newLen, arrTrueLen = n} #)++reallocWith ::+       MonadIO m => String -> (Int -> Int) -> Int -> MutArray a -> m (MutArray a)+reallocWith label sizer reqSize arr = do+    let oldSize = arrLen arr+        newSize = sizer oldSize+        safeSize = max newSize (oldSize + reqSize)+    assert (newSize >= oldSize + reqSize || error badSize) (return ())+    realloc safeSize arr++    where++    badSize = concat+        [ label+        , ": new array size is less than required size "+        , show reqSize+        , ". Please check the sizing function passed."+        ]++-------------------------------------------------------------------------------+-- Snoc+-------------------------------------------------------------------------------++-- XXX Not sure of the behavior of writeArray# if we specify an index which is+-- out of bounds. This comment should be rewritten based on that.+-- | Really really unsafe, appends the element into the first array, may+-- cause silent data corruption or if you are lucky a segfault if the index+-- is out of bounds.+--+-- /Internal/+{-# INLINE snocUnsafe #-}+snocUnsafe :: MonadIO m => MutArray a -> a -> m (MutArray a)+snocUnsafe arr@MutArray {..} a = do+    assert (arrStart + arrLen < arrTrueLen) (return ())+    let arr1 = arr {arrLen = arrLen + 1}+    putIndexUnsafe arrLen arr1 a+    return arr1++-- NOINLINE to move it out of the way and not pollute the instruction cache.+{-# NOINLINE snocWithRealloc #-}+snocWithRealloc :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+snocWithRealloc sizer arr x = do+    arr1 <- reallocWith "snocWithRealloc" sizer 1 arr+    snocUnsafe arr1 x++-- | @snocWith sizer arr elem@ mutates @arr@ to append @elem@. The length of+-- the array increases by 1.+--+-- If there is no reserved space available in @arr@ it is reallocated to a size+-- in bytes determined by the @sizer oldSize@ function, where @oldSize@ is the+-- original size of the array.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- /Pre-release/+{-# INLINE snocWith #-}+snocWith :: MonadIO m => (Int -> Int) -> MutArray a -> a -> m (MutArray a)+snocWith sizer arr@MutArray {..} x = do+    if arrStart + arrLen < arrTrueLen+    then snocUnsafe arr x+    else snocWithRealloc sizer arr x++-- XXX round it to next power of 2.++-- | The array is mutated to append an additional element to it. If there is no+-- reserved space available in the array then it is reallocated to double the+-- original size.+--+-- This is useful to reduce allocations when appending unknown number of+-- elements.+--+-- Note that the returned array may be a mutated version of the original array.+--+-- >>> snoc = MutArray.snocWith (* 2)+--+-- Performs O(n * log n) copies to grow, but is liberal with memory allocation.+--+-- /Pre-release/+{-# INLINE snoc #-}+snoc :: MonadIO m => MutArray a -> a -> m (MutArray a)+snoc = snocWith (* 2)++-- | Make the uninitialized memory in the array available for use extending it+-- by the supplied length beyond the current length of the array. The array may+-- be reallocated.+--+{-# INLINE uninit #-}+uninit :: MonadIO m => MutArray a -> Int -> m (MutArray a)+uninit arr@MutArray{..} len =+    if arrStart + arrLen + len <= arrTrueLen+    then return $ arr {arrLen = arrLen + len}+    else realloc (arrLen + len) arr++-------------------------------------------------------------------------------+-- Random reads+-------------------------------------------------------------------------------++-- | Return the element at the specified index without checking the bounds.+--+-- Unsafe because it does not check the bounds of the array.+{-# INLINE_NORMAL getIndexUnsafe #-}+getIndexUnsafe :: MonadIO m => Int -> MutArray a -> m a+getIndexUnsafe n MutArray {..} =+    liftIO+        $ IO+        $ \s# ->+              let !(I# i#) = arrStart + n+               in readArray# arrContents# i# s#++-- | /O(1)/ Lookup the element at the given index. Index starts from 0.+--+{-# INLINE getIndex #-}+getIndex :: MonadIO m => Int -> MutArray a -> m a+getIndex i arr@MutArray {..} =+    if i >= 0 && i < arrLen+    then getIndexUnsafe i arr+    else invalidIndex "getIndex" i++-------------------------------------------------------------------------------+-- Subarrays+-------------------------------------------------------------------------------++-- XXX We can also get immutable slices.++-- | /O(1)/ Slice an array in constant time.+--+-- Unsafe: The bounds of the slice are not checked.+--+-- /Unsafe/+--+-- /Pre-release/+{-# INLINE getSliceUnsafe #-}+getSliceUnsafe+    :: Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSliceUnsafe index len arr@MutArray {..} =+    assert (index >= 0 && len >= 0 && index + len <= arrLen)+        $ arr {arrStart = arrStart + index, arrLen = len}++-- | /O(1)/ Slice an array in constant time. Throws an error if the slice+-- extends out of the array bounds.+--+-- /Pre-release/+{-# INLINE getSlice #-}+getSlice+    :: Int -- ^ from index+    -> Int -- ^ length of the slice+    -> MutArray a+    -> MutArray a+getSlice index len arr@MutArray{..} =+    if index >= 0 && len >= 0 && index + len <= arrLen+    then arr {arrStart = arrStart + index, arrLen = len}+    else error+             $ "getSlice: invalid slice, index "+             ++ show index ++ " length " ++ show len++-------------------------------------------------------------------------------+-- to Lists and streams+-------------------------------------------------------------------------------++-- XXX Maybe faster to create a list explicitly instead of mapM, if list fusion+-- does not work well.++-- | Convert an 'Array' into a list.+--+-- /Pre-release/+{-# INLINE toList #-}+toList :: MonadIO m => MutArray a -> m [a]+toList arr@MutArray{..} = mapM (`getIndexUnsafe` arr) [0 .. (arrLen - 1)]++-- | Use the 'read' unfold instead.+--+-- @toStreamD = D.unfold read@+--+-- We can try this if the unfold has any performance issues.+{-# INLINE_NORMAL toStreamD #-}+toStreamD :: MonadIO m => MutArray a -> D.Stream m a+toStreamD arr@MutArray{..} =+    D.mapM (`getIndexUnsafe` arr) $ D.enumerateFromToIntegral 0 (arrLen - 1)++-- Check equivalence with StreamK.fromStream . toStreamD and remove+{-# INLINE toStreamK #-}+toStreamK :: MonadIO m => MutArray a -> K.StreamK m a+toStreamK arr@MutArray{..} = K.unfoldrM step 0++    where++    step i+        | i == arrLen = return Nothing+        | otherwise = do+            x <- getIndexUnsafe i arr+            return $ Just (x, i + 1)++{-# INLINE_NORMAL readRev #-}+readRev :: MonadIO m => MutArray a -> D.Stream m a+readRev arr@MutArray{..} =+    D.mapM (`getIndexUnsafe` arr)+        $ D.enumerateFromThenToIntegral (arrLen - 1) (arrLen - 2) 0++-------------------------------------------------------------------------------+-- Folds+-------------------------------------------------------------------------------++-- XXX deduplicate this across unboxed array and this module?++-- | The default chunk size by which the array creation routines increase the+-- size of the array when the array is grown linearly.+arrayChunkSize :: Int+arrayChunkSize = 1024++-- | Like 'writeN' but does not check the array bounds when writing. The fold+-- driver must not call the step function more than 'n' times otherwise it will+-- corrupt the memory and crash. This function exists mainly because any+-- conditional in the step function blocks fusion causing 10x performance+-- slowdown.+--+-- /Pre-release/+{-# INLINE_NORMAL writeNUnsafe #-}+writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)+writeNUnsafe n = Fold step initial return++    where++    initial = FL.Partial <$> new (max n 0)++    step arr x = FL.Partial <$> snocUnsafe arr x++-- | @writeN n@ folds a maximum of @n@ elements from the input stream to an+-- 'Array'.+--+-- >>> writeN n = Fold.take n (MutArray.writeNUnsafe n)+--+-- /Pre-release/+{-# INLINE_NORMAL writeN #-}+writeN :: MonadIO m => Int -> Fold m a (MutArray a)+writeN n = FL.take n $ writeNUnsafe n++-- >>> f n = MutArray.writeAppendWith (* 2) (MutArray.newPinned n)+-- >>> writeWith n = Fold.rmapM MutArray.rightSize (f n)+-- >>> writeWith n = Fold.rmapM MutArray.fromArrayStreamK (MutArray.writeChunks n)++-- | @writeWith minCount@ folds the whole input to a single array. The array+-- starts at a size big enough to hold minCount elements, the size is doubled+-- every time the array needs to be grown.+--+-- /Caution! Do not use this on infinite streams./+--+-- /Pre-release/+{-# INLINE_NORMAL writeWith #-}+writeWith :: MonadIO m => Int -> Fold m a (MutArray a)+-- writeWith n = FL.rmapM rightSize $ writeAppendWith (* 2) (newPinned n)+writeWith elemCount = FL.rmapM extract $ FL.foldlM' step initial++    where++    initial = do+        when (elemCount < 0) $ error "writeWith: elemCount is negative"+        liftIO $ new elemCount++    step arr@(MutArray _ start end bound) x+        | end == bound = do+        let oldSize = end - start+            newSize = max (oldSize * 2) 1+        arr1 <- liftIO $ realloc newSize arr+        snocUnsafe arr1 x+    step arr x = snocUnsafe arr x++    -- extract = liftIO . rightSize+    extract = return++-- | Fold the whole input to a single array.+--+-- Same as 'writeWith' using an initial array size of 'arrayChunkSize' bytes+-- rounded up to the element size.+--+-- /Caution! Do not use this on infinite streams./+--+{-# INLINE write #-}+write :: MonadIO m => Fold m a (MutArray a)+write = writeWith arrayChunkSize++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producerWith #-}+producerWith :: Monad m => (forall b. IO b -> m b) -> Producer m (MutArray a) a+producerWith liftio = Producer step inject extract++    where++    {-# INLINE inject #-}+    inject arr = return (arr, 0)++    {-# INLINE extract #-}+    extract (arr, i) =+        return $ arr {arrStart = arrStart arr + i, arrLen = arrLen arr - i}++    {-# INLINE_LATE step #-}+    step (arr, i)+        | assert (arrLen arr >= 0) (i == arrLen arr) = return D.Stop+    step (arr, i) = do+        x <- liftio $ getIndexUnsafe i arr+        return $ D.Yield x (arr, i + 1)++-- | Resumable unfold of an array.+--+{-# INLINE_NORMAL producer #-}+producer :: MonadIO m => Producer m (MutArray a) a+producer = producerWith liftIO++-- | Unfold an array into a stream.+--+{-# INLINE_NORMAL reader #-}+reader :: MonadIO m => Unfold m (MutArray a) a+reader = Producer.simplify producer++--------------------------------------------------------------------------------+-- Appending arrays+--------------------------------------------------------------------------------++-- | Put a sub range of a source array into a subrange of a destination array.+-- This is not safe as it does not check the bounds.+{-# INLINE putSliceUnsafe #-}+putSliceUnsafe :: MonadIO m =>+    MutArray a -> Int -> MutArray a -> Int -> Int -> m ()+putSliceUnsafe src srcStart dst dstStart len = liftIO $ do+    assertM(len <= arrLen dst)+    assertM(len <= arrLen src)+    let !(I# srcStart#) = srcStart + arrStart src+        !(I# dstStart#) = dstStart + arrStart dst+        !(I# len#) = len+    let arrS# = arrContents# src+        arrD# = arrContents# dst+    IO $ \s# -> (# copyMutableArray#+                    arrS# srcStart# arrD# dstStart# len# s#+                , () #)++{-# INLINE clone #-}+clone :: MonadIO m => MutArray a -> m (MutArray a)+clone src = liftIO $ do+    let len = arrLen src+    dst <- new len+    putSliceUnsafe src 0 dst 0 len+    return dst++-------------------------------------------------------------------------------+-- Size+-------------------------------------------------------------------------------++{-# INLINE length #-}+length :: MutArray a -> Int+length = arrLen++-------------------------------------------------------------------------------+-- Equality+-------------------------------------------------------------------------------++-- | Compare the length of the arrays. If the length is equal, compare the+-- lexicographical ordering of two underlying byte arrays otherwise return the+-- result of length comparison.+--+-- /Pre-release/+{-# INLINE cmp #-}+cmp :: (MonadIO m, Ord a) => MutArray a -> MutArray a -> m Ordering+cmp a1 a2 =+    case compare lenA1 lenA2 of+        EQ -> loop (lenA1 - 1)+        x -> return x++    where++    lenA1 = length a1+    lenA2 = length a2++    loop i+        | i < 0 = return EQ+        | otherwise = do+            v1 <- getIndexUnsafe i a1+            v2 <- getIndexUnsafe i a2+            case compare v1 v2 of+                EQ -> loop (i - 1)+                x -> return x++{-# INLINE eq #-}+eq :: (MonadIO m, Eq a) => MutArray a -> MutArray a -> m Bool+eq a1 a2 =+    if lenA1 == lenA2+    then loop (lenA1 - 1)+    else return False++    where++    lenA1 = length a1+    lenA2 = length a2++    loop i+        | i < 0 = return True+        | otherwise = do+            v1 <- getIndexUnsafe i a1+            v2 <- getIndexUnsafe i a2+            if v1 == v2+            then loop (i - 1)+            else return False++{-# INLINE strip #-}+strip :: MonadIO m => (a -> Bool) -> MutArray a -> m (MutArray a)+strip p arr = liftIO $ do+    let lastIndex = length arr - 1+    indexR <- getIndexR lastIndex -- last predicate failing index+    if indexR < 0+    then nil+    else do+        indexL <- getIndexL 0 -- first predicate failing index+        if indexL == 0 && indexR == lastIndex+        then return arr+        else+           let newLen = indexR - indexL + 1+            in return $ getSliceUnsafe indexL newLen arr++    where++    getIndexR idx+        | idx < 0 = return idx+        | otherwise = do+            r <- getIndexUnsafe idx arr+            if p r+            then getIndexR (idx - 1)+            else return idx++    getIndexL idx = do+        r <- getIndexUnsafe idx arr+        if p r+        then getIndexL (idx + 1)+        else return idx
+ src/Streamly/Internal/Data/Array/Mut.hs view
@@ -0,0 +1,86 @@+-- |+-- 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 view
@@ -0,0 +1,323 @@+-- |+-- 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 view
@@ -0,0 +1,2356 @@+{-# 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/Type.hs view
@@ -0,0 +1,592 @@+{-# 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 = (<>)
+ src/Streamly/Internal/Data/Builder.hs view
@@ -0,0 +1,80 @@+-- |+-- Module      : Streamly.Internal.Data.Builder+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Builder+    (+    -- * Imports+    -- $setup++    -- * Types+      Builder (..)+    )+where++import Control.Applicative (liftA2)++------------------------------------------------------------------------------+-- The Builder type+------------------------------------------------------------------------------++-- | A simple stateful function composing monad that chains state passing+-- functions. This can be considered as a simplified version of the State monad+-- 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))++-- | 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)++{-# INLINE fromPure #-}+fromPure :: Applicative m => b -> Builder s m b+fromPure b = Builder (\s -> pure (s, b))++-- | Chain the actions and zip the outputs.+{-# INLINE sequenceWith #-}+sequenceWith :: Monad m =>+    (a -> b -> c) -> Builder x m a -> Builder x m b -> Builder x m c+sequenceWith func (Builder stepL) (Builder stepR) = Builder step++    where++    step s = do+        (s1, x) <- stepL s+        (s2, y) <- stepR s1+        pure (s2, func x y)++instance Monad m => Applicative (Builder a m) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = sequenceWith id++    {-# INLINE (*>) #-}+    (*>) = sequenceWith (const id)++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++instance Monad m => Monad (Builder a m) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (Builder stepL) >>= f = Builder step++        where++        step s = do+            (s1, x) <- stepL s+            let Builder stepR = f x+            (s2, y) <- stepR s1+            pure (s2, y)
+ src/Streamly/Internal/Data/Either/Strict.hs view
@@ -0,0 +1,57 @@+-- |+-- Module      : Streamly.Internal.Data.Either.Strict+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- | Strict data types to be used as accumulator for strict left folds and+-- scans. For more comprehensive strict data types see+-- https://hackage.haskell.org/package/strict-base-types . The names have been+-- suffixed by a prime so that programmers can easily distinguish the strict+-- versions from the lazy ones.+--+-- One major advantage of strict data structures as accumulators in folds and+-- scans is that it helps the compiler optimize the code much better by+-- unboxing. In a big tight loop the difference could be huge.+--+module Streamly.Internal.Data.Either.Strict+    ( Either' (..)+    -- XXX Remove these and add lazyEither/strictEither to convert to and from+    -- lazy Either type.+    , isLeft'+    , isRight'+    , fromLeft'+    , fromRight'+    )+where++-- | A strict 'Either'+data Either' a b = Left' !a | Right' !b deriving Show++-- | Return 'True' if the given value is a Left', 'False' otherwise.+{-# INLINABLE isLeft' #-}+isLeft' :: Either' a b -> Bool+isLeft' (Left'  _) = True+isLeft' (Right' _) = False++-- | Return 'True' if the given value is a Right', 'False' otherwise.+{-# INLINABLE isRight' #-}+isRight' :: Either' a b -> Bool+isRight' (Left'  _) = False+isRight' (Right' _) = True++-- XXX This is partial. We can use a default value instead.+-- | Return the contents of a Left'-value or errors out.+{-# INLINABLE fromLeft' #-}+fromLeft' :: Either' a b -> a+fromLeft' (Left' a) = a+fromLeft' _ = error "fromLeft' expecting a Left'-value"++-- | Return the contents of a Right'-value or errors out.+{-# INLINABLE fromRight' #-}+fromRight' :: Either' a b -> b+fromRight' (Right' b) = b+fromRight' _ = error "fromRight' expecting a Right'-value"
+ src/Streamly/Internal/Data/Fold.hs view
@@ -0,0 +1,2598 @@+{-# 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"
+ src/Streamly/Internal/Data/Fold/Chunked.hs view
@@ -0,0 +1,377 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Chunked+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Use "Streamly.Data.Parser.Chunked" 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@.+--+-- Though @Fold m a b@ in this module works on a stream of @Array a@ it is+-- different from @Data.Fold m (Array a) b@.  While the latter works on arrays+-- as a whole treating them as atomic elements, the folds in this module can+-- work on the stream of arrays as if it is an element stream with all the+-- arrays coalesced together. This module allows adapting the element stream+-- 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+--+-- >>> f = ChunkFold.fromFold (Fold.take 7 Fold.toList)+-- >>> s = Stream.chunksOf 5 $ Stream.fromList "hello world"+-- >>> ArrayStream.runArrayFold f (StreamK.fromStream s)+-- Right "hello w"+--+module Streamly.Internal.Data.Fold.Chunked+    (+      ChunkFold (..)++    -- * Construction+    , fromFold+    , adaptFold+    , fromParser+    , fromParserD++    -- * Mapping+    , rmapM++    -- * Applicative+    , fromPure+    , fromEffect+    , splitWith++    -- * Monad+    , concatMap++    -- * Combinators+    , take+    )+where++#include "ArrayMacros.h"++import Control.Applicative (liftA2)+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 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.Tuple.Strict (Tuple'(..))++import qualified Streamly.Internal.Data.Array 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 Parser++import Prelude hiding (concatMap, take)++-- | Array stream fold.+--+-- An array stream fold is basically an array stream "Parser" that does not+-- fail.  In case of array stream folds the count in 'Partial', 'Continue' and+-- 'Done' is a count of elements that includes the leftover element count in+-- the array that is currently being processed by the parser. If none of the+-- elements is consumed by the parser the count is at least the whole array+-- length. If the whole array is consumed by the parser then the count will be+-- 0.+--+-- /Pre-release/+--+newtype ChunkFold m a b = ChunkFold (ParserD.Parser (Array a) m b)++-------------------------------------------------------------------------------+-- Constructing array stream folds from element folds and parsers+-------------------------------------------------------------------------------++-- | Convert an element 'Fold' into an array stream fold.+--+-- /Pre-release/+{-# 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))++    where++    initial = do+        res <- finitial+        return+            $ case res of+                  Fold.Partial s1 -> IPartial s1+                  Fold.Done b -> IDone b++    step s (Array contents start end) = do+        goArray SPEC start s++        where++        goArray !_ !cur !fs | cur >= end = do+            assert (cur == end) (return ())+            return $ Partial 0 fs+        goArray !_ !cur !fs = do+            x <- liftIO $ peekWith contents cur+            res <- fstep fs x+            let elemSize = SIZE_OF(a)+                next = INDEX_NEXT(cur,a)+            case res of+                Fold.Done b ->+                    return $ Done ((end - next) `div` elemSize) b+                Fold.Partial fs1 ->+                    goArray SPEC next fs1++-- | Convert an element 'ParserD.Parser' into an array stream fold. If the+-- parser fails the fold would throw an exception.+--+-- /Pre-release/+{-# INLINE fromParserD #-}+fromParserD :: forall m a b. (MonadIO m, Unbox a) =>+    ParserD.Parser a m b -> ChunkFold m a b+fromParserD (ParserD.Parser step1 initial1 extract1) =+    ChunkFold (ParserD.Parser step initial1 extract1)++    where++    step s (Array contents start end) = do+        if start >= end+        then return $ Continue 0 s+        else goArray SPEC start s++        where++        {-# INLINE partial #-}+        partial arrRem cur next elemSize st n fs1 = do+            let next1 = next - (n * elemSize)+            if next1 >= start && cur < end+            then goArray SPEC next1 fs1+            else return $ st (arrRem + n) fs1++        goArray !_ !cur !fs = do+            x <- liftIO $ peekWith contents cur+            liftIO $ touch contents+            res <- step1 fs x+            let elemSize = SIZE_OF(a)+                next = INDEX_NEXT(cur,a)+                arrRem = (end - next) `div` elemSize+            case res of+                ParserD.Done n b -> do+                    return $ Done (arrRem + n) b+                ParserD.Partial n fs1 ->+                    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++-- | Convert an element 'Parser.Parser' into an array stream fold. If the+-- parser fails the fold would throw an exception.+--+-- /Pre-release/+{-# INLINE fromParser #-}+fromParser :: forall m a b. (MonadIO m, Unbox a) =>+    Parser.Parser a m b -> ChunkFold m a b+fromParser = fromParserD++-- | Adapt an array stream fold.+--+-- /Pre-release/+{-# INLINE adaptFold #-}+adaptFold :: forall m a b. (MonadIO m) =>+    Fold.Fold m (Array a) b -> ChunkFold m a b+adaptFold f = ChunkFold $ ParserD.fromFold f++-------------------------------------------------------------------------------+-- Functor+-------------------------------------------------------------------------------++-- | Maps a function over the result of fold.+--+-- /Pre-release/+instance Functor m => Functor (ChunkFold m a) where+    {-# INLINE fmap #-}+    fmap f (ChunkFold p) = ChunkFold $ fmap f p++-- | Map a monadic function on the output of a fold.+--+-- /Pre-release/+{-# INLINE rmapM #-}+rmapM :: Monad m => (b -> m c) -> ChunkFold m a b -> ChunkFold m a c+rmapM f (ChunkFold p) = ChunkFold $ ParserD.rmapM f p++-------------------------------------------------------------------------------+-- Sequential applicative+-------------------------------------------------------------------------------++-- | A fold that always yields a pure value without consuming any input.+--+-- /Pre-release/+--+{-# INLINE fromPure #-}+fromPure :: Monad m => b -> ChunkFold m a b+fromPure = ChunkFold . ParserD.fromPure++-- | A fold that always yields the result of an effectful action without+-- consuming any input.+--+-- /Pre-release/+--+{-# INLINE fromEffect #-}+fromEffect :: Monad m => m b -> ChunkFold m a b+fromEffect = ChunkFold . ParserD.fromEffect++-- | Applies two folds sequentially on the input stream and combines their+-- results using the supplied function.+--+-- /Pre-release/+{-# INLINE split_ #-}+split_ :: Monad m =>+    ChunkFold m x a -> ChunkFold m x b -> ChunkFold m x b+split_ (ChunkFold p1) (ChunkFold p2) =+    ChunkFold $ ParserD.noErrorUnsafeSplit_ p1 p2++-- | Applies two folds sequentially on the input stream and combines their+-- results using the supplied function.+--+-- /Pre-release/+{-# INLINE splitWith #-}+splitWith :: Monad m+    => (a -> b -> c) -> ChunkFold m x a -> ChunkFold m x b -> ChunkFold m x c+splitWith f (ChunkFold p1) (ChunkFold p2) =+    ChunkFold $ ParserD.noErrorUnsafeSplitWith f p1 p2++-- | 'Applicative' form of 'splitWith'.+-- > (<*>) = splitWith id+instance Monad m => Applicative (ChunkFold m a) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = splitWith id++    {-# INLINE (*>) #-}+    (*>) = split_++    {-# INLINE liftA2 #-}+    liftA2 f x = (<*>) (fmap f x)++-------------------------------------------------------------------------------+-- Monad+-------------------------------------------------------------------------------++-- XXX This should be implemented using CPS+--+-- | Applies a fold on the input stream, generates the next fold from the+-- output of the previously applied fold and then applies that fold.+--+-- /Pre-release/+--+{-# INLINE concatMap #-}+concatMap :: Monad m =>+    (b -> ChunkFold m a c) -> ChunkFold m a b -> ChunkFold m a c+concatMap func (ChunkFold p) =+    let f x = let ChunkFold y = func x in y+     in ChunkFold $ ParserD.noErrorUnsafeConcatMap f p++-- | Monad instance applies folds sequentially. Next fold can depend on the+-- output of the previous fold. See 'concatMap'.+--+-- > (>>=) = flip concatMap+instance Monad m => Monad (ChunkFold m a) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap++    {-# INLINE (>>) #-}+    (>>) = (*>)++-------------------------------------------------------------------------------+-- Array to Array folds+-------------------------------------------------------------------------------++-- | Take @n@ array elements (@a@) from a stream of arrays (@Array a@).+{-# INLINE take #-}+take :: forall m a b. (Monad m, Unbox a) =>+    Int -> ChunkFold m a b -> ChunkFold m a b+take n (ChunkFold (ParserD.Parser step1 initial1 extract1)) =+    ChunkFold $ ParserD.Parser step initial extract++    where++    -- XXX Need to make the Initial type Step to remove this+    iextract s = do+        r <- extract1 s+        return $ case r of+            Done _ b -> IDone b+            Error err -> IError err+            _ -> error "Bug: ChunkFold take invalid state in initial"++    initial = do+        res <- initial1+        case res of+            IPartial s ->+                if n > 0+                then return $ IPartial $ Tuple' n s+                else iextract s+            IDone b -> return $ IDone b+            IError err -> return $ IError err++    {-# INLINE partial #-}+    partial i1 st j s =+        let i2 = i1 + j+         in if i2 > 0+            then return $ st j (Tuple' i2 s)+            else do+                -- 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"++    -- Tuple' (how many more items to take) (fold state)+    step (Tuple' i r) arr = do+        let len = Array.length arr+            i1 = i - len+        if i1 >= 0+        then do+            res <- step1 r arr+            case res of+                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+        else do+            let !(Array contents start _) = arr+                end = INDEX_OF(start,i,a)+                -- Supply only the required slice of array+                arr1 = Array contents start end+                remaining = negate i1 -- i1 is negative here+            res <- step1 r arr1+            case res of+                Partial 0 s ->+                    ParserD.bimapOverrideCount+                        remaining (Tuple' 0) id <$> extract1 s+                Partial j s -> return $ Partial (remaining + j) (Tuple' j s)+                Continue 0 s ->+                    ParserD.bimapOverrideCount+                        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++    extract (Tuple' i r) = first (Tuple' i) <$> extract1 r
+ src/Streamly/Internal/Data/Fold/Container.hs view
@@ -0,0 +1,704 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Container+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.Data.Fold.Container+    (+    -- * Imports+    -- $setup++    -- * Set operations+      toSet+    , toIntSet+    , countDistinct+    , countDistinctInt+    , nub+    , nubInt++    -- * Map operations+    , frequency++    -- ** Demultiplexing+    -- | Direct values in the input stream to different folds using an n-ary+    -- fold selector. 'demux' is a generalization of 'classify' (and+    -- 'partition') where each key of the classifier can use a different fold.+    , demuxKvToContainer+    , demuxKvToMap++    , demuxToContainer+    , demuxToContainerIO+    , demuxToMap+    , demuxToMapIO++    , 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 fold.+    --+    -- 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 (length)+import Streamly.Internal.Data.Fold++-- $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++-- | Fold the input to a set.+--+-- Definition:+--+-- >>> toSet = Fold.foldl' (flip Set.insert) Set.empty+--+{-# INLINE toSet #-}+toSet :: (Monad m, Ord a) => Fold m a (Set a)+toSet = foldl' (flip Set.insert) Set.empty++-- | Fold the input to an int set. For integer inputs this performs better than+-- 'toSet'.+--+-- Definition:+--+-- >>> toIntSet = Fold.foldl' (flip IntSet.insert) IntSet.empty+--+{-# INLINE toIntSet #-}+toIntSet :: Monad m => Fold m Int IntSet+toIntSet = foldl' (flip IntSet.insert) IntSet.empty++-- XXX Name as nubOrd? Or write a nubGeneric++-- | Used as a scan. 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.fold Fold.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)++-- | 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)++-- 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 Fold.toSet+-- >>> countDistinct = Fold.postscan Fold.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+-- terminate if the count reaches more than a threshold.+--+-- /Space/: \(\mathcal{O}(n)\)+--+-- /Pre-release/+--+{-# INLINE countDistinct #-}+countDistinct :: (Monad m, Ord a) => Fold 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 Fold.toIntSet+-- >>> countDistinctInt = Fold.postscan Fold.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 = 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.+--+-- 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.++{-# 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++    where++    initial = return $ Tuple' IsMap.mapEmpty Nothing++    {-# INLINE runFold #-}+    runFold kv (Fold step1 initial1 extract1) (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+                             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))++    step (Tuple' kv _) a = do+        let k = getKey a+        case IsMap.mapLookup k kv of+            Nothing -> do+                fld <- getFold a+                runFold kv fld (k, a)+            Just f -> runFold kv f (k, a)++    extract (Tuple' kv x) = (Prelude.mapM f kv, x)++        where++        f (Fold _ i e) = do+            r <- i+            case r of+                Partial s -> e s+                Done b -> return b++-- | 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.+--+-- This can be used to scan a stream and collect the results from the scan+-- output.+--+-- /Pre-release/+--+{-# INLINE demux #-}+demux :: (Monad m, Ord k) =>+       (a -> k)+    -> (a -> m (Fold m a b))+    -> Fold m a (m (Map k b), Maybe (k, b))+demux = demuxGeneric++{-# 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++    where++    initial = return $ Tuple' IsMap.mapEmpty Nothing++    {-# INLINE initFold #-}+    initFold kv (Fold step1 initial1 extract1) (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+                        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+         res <- initial1+         case res of+            Partial s -> do+                res1 <- step1 s a+                case res1 of+                        Partial _ -> do+                            let fld = Fold step1 (return res1) extract1+                            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+                f <- getFold a+                initFold kv f (k, a)+            Just ref -> do+                f <- liftIO $ readIORef ref+                runFold kv ref f (k, a)++    extract (Tuple' kv x) = (Prelude.mapM f kv, x)++        where++        f ref = do+            (Fold _ i e) <- liftIO $ readIORef ref+            r <- i+            case r of+                Partial s -> e s+                Done b -> return b++-- | This is specialized version of 'demux' that uses mutable IO cells as+-- fold accumulators for better performance.+--+{-# INLINE demuxIO #-}+demuxIO :: (MonadIO m, Ord k) =>+       (a -> k)+    -> (a -> m (Fold m a b))+    -> Fold m a (m (Map k b), Maybe (k, b))+demuxIO = demuxGenericIO++{-# INLINE demuxToContainer #-}+demuxToContainer :: (Monad m, IsMap f, Traversable f) =>+    (a -> Key f) -> (a -> m (Fold m a b)) -> Fold 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) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+demuxToMap = demuxToContainer++{-# INLINE demuxToContainerIO #-}+demuxToContainerIO :: (MonadIO m, IsMap f, Traversable f) =>+    (a -> Key f) -> (a -> m (Fold m a b)) -> Fold 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) -> (a -> m (Fold m a b)) -> Fold m a (Map k b)+demuxToMapIO = demuxToContainerIO++{-# 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))++-- | 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 (Fold m a b)) -> Fold 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.++{-# 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) -> 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++    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) = (Prelude.mapM extract1 kv, x)++-- | 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+-- the in-progress folds.+--+-- Once the fold for a key is done, any future values of the key are ignored.+--+-- Definition:+--+-- >>> classify f fld = Fold.demux f (const fld)+--+{-# 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++-- 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 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++    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) =+        (Prelude.mapM (\ref -> liftIO (readIORef ref) >>= extract1) kv, x)++-- | 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)+--+{-# 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 toContainer #-}+toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>+    (a -> Key f) -> Fold m a b -> Fold 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) -> 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)+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) -> Fold m a b -> Fold 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) => Fold m a b -> Fold 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) => Fold m a (Map a Int)+frequency = toMap id length
+ src/Streamly/Internal/Data/Fold/Step.hs view
@@ -0,0 +1,83 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.Step+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Fold.Step+    (+    -- * Types+      Step (..)++    , mapMStep+    , chainStepM+    )+where++import Data.Bifunctor (Bifunctor(..))+import Fusion.Plugin.Types (Fuse(..))++------------------------------------------------------------------------------+-- Step of a fold+------------------------------------------------------------------------------++-- The Step functor around b allows expressing early termination like a right+-- fold. Traditional list right folds use function composition and laziness to+-- terminate early whereas we use data constructors. It allows stream fusion in+-- contrast to the foldr/build fusion when composing with functions.++-- | 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.+-- 'Done' returns the final result and the fold cannot be driven further.+--+-- /Pre-release/+--+{-# ANN type Step Fuse #-}+data Step s b+    = Partial !s+    | Done !b++-- | 'first' maps over 'Partial' and 'second' maps over 'Done'.+--+instance Bifunctor Step where+    {-# INLINE bimap #-}+    bimap f _ (Partial a) = Partial (f a)+    bimap _ g (Done b) = Done (g b)++    {-# INLINE first #-}+    first f (Partial a) = Partial (f a)+    first _ (Done x) = Done x++    {-# INLINE second #-}+    second _ (Partial x) = Partial x+    second f (Done a) = Done (f a)++-- | 'fmap' maps over 'Done'.+--+-- @+-- fmap = 'second'+-- @+--+instance Functor (Step s) where+    {-# INLINE fmap #-}+    fmap = second++-- | 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 s -> pure $ Partial s+        Done b -> Done <$> f b++-- | If 'Partial' then map the state, if 'Done' then call the next step.+{-# INLINE chainStepM #-}+chainStepM :: Applicative m =>+    (s1 -> m s2) -> (a -> m (Step s2 b)) -> Step s1 a -> m (Step s2 b)+chainStepM f _ (Partial s) = Partial <$> f s+chainStepM _ g (Done b) = g b
+ src/Streamly/Internal/Data/Fold/Tee.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.Tee+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A newtype wrapper over the 'Fold' type providing distributing 'Applicative',+-- 'Semigroup', 'Monoid', 'Num', 'Floating' and 'Fractional' instances.+--+module Streamly.Internal.Data.Fold.Tee+    ( Tee(..)+    , toFold+    )+where++import Control.Applicative (liftA2)+import Streamly.Internal.Data.Fold.Type (Fold)++import qualified Streamly.Internal.Data.Fold.Type as Fold++#include "DocTestDataFold.hs"++-- | @Tee@ is a newtype wrapper over the 'Fold' type providing distributing+-- 'Applicative', 'Semigroup', 'Monoid', 'Num', 'Floating' and 'Fractional'+-- instances.+--+-- The input received by the composed 'Tee' is replicated and distributed to+-- the constituent folds of the 'Tee'.+--+-- For example, to compute the average of numbers in a stream without going+-- through the stream twice:+--+-- >>> avg = (/) <$> (Tee Fold.sum) <*> (Tee $ fmap fromIntegral Fold.length)+-- >>> Stream.fold (unTee avg) $ Stream.fromList [1.0..100.0]+-- 50.5+--+-- Similarly, the 'Semigroup' and 'Monoid' instances of 'Tee' distribute the+-- input to both the folds and combine the outputs using Monoid or Semigroup+-- instances of the output types:+--+-- >>> import Data.Monoid (Sum(..))+-- >>> t = Tee Fold.one <> Tee Fold.latest+-- >>> Stream.fold (unTee t) (fmap Sum $ Stream.enumerateFromTo 1.0 100.0)+-- Just (Sum {getSum = 101.0})+--+-- The 'Num', 'Floating', and 'Fractional' instances work in the same way.+--+newtype Tee m a b =+    Tee { unTee :: Fold m a b }+    deriving (Functor)++{-# DEPRECATED toFold "Please use 'unTee' instead." #-}+toFold :: Tee m a b -> Fold m a b+toFold = unTee++-- | '<*>' distributes the input to both the argument 'Tee's and combines their+-- outputs using function application.+--+instance Monad m => Applicative (Tee m a) where++    {-# INLINE pure #-}+    pure a = Tee (Fold.fromPure a)++    {-# INLINE (<*>) #-}+    (<*>) a b = Tee (Fold.teeWith ($) (unTee a) (unTee b))++-- | '<>' distributes the input to both the argument 'Tee's and combines their+-- outputs using the 'Semigroup' instance of the output type.+--+instance (Semigroup b, Monad m) => Semigroup (Tee m a b) where+    {-# INLINE (<>) #-}+    (<>) = liftA2 (<>)++-- | '<>' 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+    {-# INLINE mempty #-}+    mempty = pure mempty++    {-# INLINE mappend #-}+    mappend = (<>)++-- | Binary 'Num' operations distribute the input to both the argument 'Tee's+-- and combine their outputs using the 'Num' instance of the output type.+--+instance (Monad m, Num b) => Num (Tee m a b) where+    {-# INLINE fromInteger #-}+    fromInteger = pure . fromInteger++    {-# INLINE negate #-}+    negate = fmap negate++    {-# INLINE abs #-}+    abs = fmap abs++    {-# INLINE signum #-}+    signum = fmap signum++    {-# INLINE (+) #-}+    (+) = liftA2 (+)++    {-# INLINE (*) #-}+    (*) = liftA2 (*)++    {-# INLINE (-) #-}+    (-) = liftA2 (-)++-- | Binary 'Fractional' operations distribute the input to both the argument+-- 'Tee's and combine their outputs using the 'Fractional' instance of the+-- output type.+--+instance (Monad m, Fractional b) => Fractional (Tee m a b) where+    {-# INLINE fromRational #-}+    fromRational = pure . fromRational++    {-# INLINE recip #-}+    recip = fmap recip++    {-# INLINE (/) #-}+    (/) = liftA2 (/)++-- | Binary 'Floating' operations distribute the input to both the argument+-- 'Tee's and combine their outputs using the 'Floating' instance of the output+-- type.+instance (Monad m, Floating b) => Floating (Tee m a b) where+    {-# INLINE pi #-}+    pi = pure pi++    {-# INLINE exp #-}+    exp = fmap exp++    {-# INLINE sqrt #-}+    sqrt = fmap sqrt++    {-# INLINE log #-}+    log = fmap log++    {-# INLINE sin #-}+    sin = fmap sin++    {-# INLINE tan #-}+    tan = fmap tan++    {-# INLINE cos #-}+    cos = fmap cos++    {-# INLINE asin #-}+    asin = fmap asin++    {-# INLINE atan #-}+    atan = fmap atan++    {-# INLINE acos #-}+    acos = fmap acos++    {-# INLINE sinh #-}+    sinh = fmap sinh++    {-# INLINE tanh #-}+    tanh = fmap tanh++    {-# INLINE cosh #-}+    cosh = fmap cosh++    {-# INLINE asinh #-}+    asinh = fmap asinh++    {-# INLINE atanh #-}+    atanh = fmap atanh++    {-# INLINE acosh #-}+    acosh = fmap acosh++    {-# INLINE (**) #-}+    (**) = liftA2 (**)++    {-# INLINE logBase #-}+    logBase = liftA2 logBase
+ src/Streamly/Internal/Data/Fold/Type.hs view
@@ -0,0 +1,1856 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Fold.Type+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- = Stream Consumers+--+-- We can classify stream consumers in the following categories in order of+-- increasing complexity and power:+--+-- * Accumulators: Tee/Zip is simple, cannot be appended, good for scanning.+-- * Terminating folds: Tee/Zip varies based on termination, can be appended,+--   good for scanning, nesting (many) is easy.+-- * Non-failing (backtracking only) parsers: cannot be used as scans because+--   of backtracking, nesting is complicated because of backtracking, appending+--   is efficient because of no Alternative, Alternative does not make sense+--   because it cannot fail.+-- * Parsers: Alternative on failure, appending is not as efficient because of+--   buffering for Alternative.+--+-- First two are represented by the 'Fold' type and the last two by the+-- 'Parser' type.+--+-- == Folds that never terminate (Accumulators)+--+-- An @Accumulator@ is the simplest type of fold, it never fails and never+-- terminates. It can always accept more inputs (never terminates) and the+-- accumulator is always valid.  For example 'Streamly.Internal.Data.Fold.sum'.+-- Traditional Haskell left folds like 'foldl' are accumulators.+--+-- Accumulators can be composed in parallel where we distribute the input+-- stream to all accumulators.  Since accumulators never terminate they cannot+-- be appended.+--+-- An accumulator can be represented as:+--+-- @+-- data Fold0 m a b =+--   forall s. Fold0+--      (s -> a -> m s) -- step+--      (m s)           -- initial+--      (s -> m b)      -- extract+-- @+--+-- This is just a traditional left fold, compare with @foldl@. The driver of+-- the fold would call @initial@ at the beginning and then keep accumulating+-- inputs into its result using @step@ and finally extract the result using+-- @extract@.+--+-- == Folds that terminate after one or more input+--+-- @Terminating folds@ are accumulators that can terminate, like accumulators+-- they do not fail. Once a fold terminates it no longer accepts any more+-- inputs.  Terminating folds can be appended, the next fold can be+-- applied after the first one terminates.  Because they cannot fail, they do+-- not need backtracking.+--+-- The 'Streamly.Internal.Data.Fold.take' operation is an example of a+-- terminating fold. It terminates after consuming @n@ items. Coupled with an+-- accumulator (e.g. sum) it can be used to process the stream into chunks of+-- fixed size.+--+-- A terminating fold can be represented as:+--+-- @+-- data Step s b+--     = Partial !s -- the fold can accept more input+--     | Done !b    -- the fold is done+--+-- data Fold1 m a b =+--   forall s. Fold1+--      (s -> a -> m (Step s b)) -- step+--      (m s)                    -- initial+--      (s -> m b)               -- extract+-- @+--+-- The fold driver stops driving the fold as soon as the fold returns a @Done@.+-- @extract@ is required only if the fold has not stopped yet and the input+-- ends. @extract@ can never be called if the fold is @Done@.+--+-- Notice that the @initial@ of `Fold1` type does not return a "Step" type,+-- therefore, it cannot say "Done" in initial. It always has to consume at+-- least one element before it can say "Done" for termination, via the @step@+-- function.+--+-- == Folds that terminate after 0 or more input+--+-- The `Fold1` type makes combinators like @take 0@ impossible to implement+-- because they need to terminate even before they can consume any elements at+-- all.  Implementing this requires the @initial@ function to be able to return+-- @Done@.+--+-- @+-- data Fold m a b =+--   forall s. Fold+--      (s -> a -> m (Step s b)) -- step+--      (m (Step s b))           -- initial+--      (s -> m b)               -- extract+-- @+--+-- This is also required if we want to compose terminating folds using an+-- Applicative or Monadic composition. @pure@ needs to yield an output without+-- having to consume an input.+--+-- @initial@ now has the ability to terminate the fold without consuming any+-- input based on the state of the monad.+--+-- In some cases it does not make sense to use a fold that does not consume any+-- items at all, and it may even lead to an infinite loop. It might make sense+-- to use a `Fold1` type for such cases because it guarantees to consume at+-- least one input, therefore, guarantees progress. For example, in+-- classifySessionsBy or any other splitting operations it may not make sense+-- to pass a fold that never consumes an input. However, we do not have a+-- separate Fold1 type for the sake of simplicity of types/API.+--+-- Adding this capability adds a certain amount of complexity in the+-- implementation of fold combinators. @initial@ has to always handle two cases+-- now.  We could potentially not implement this in folds to keep fold+-- implementation simpler, and these use cases can be transferred to the parser+-- type. However, it would be a bit inconvenient to not have a `take` operation+-- or to not be able to use `take 0` if we have it. Also, applicative and+-- monadic composition of folds would not be possible.+--+-- == Terminating Folds with backtracking+--+-- Consider the example of @takeWhile@ operation, it needs to inspect an+-- element for termination decision. However, it does not consume the element+-- on which it terminates. To implement @takeWhile@ a terminating fold will+-- have to implement a way to return the unconsumed input to the fold driver.+--+-- Single element leftover case is quite common and its easy to implement it in+-- terminating folds by adding a @Done1@ constructor in the 'Step' type which+-- indicates that the last element was not consumed by the fold. The following+-- additional operations can be implemented as terminating folds if we do that.+--+-- @+-- takeWhile+-- groupBy+-- wordBy+-- @+--+-- However, it creates several complications. The most important one is that we+-- cannot use such folds for scanning. We cannot backtrack after producing an+-- output in a scan.+--+-- === Nested backtracking+--+-- Nesting of backtracking folds increases the amount of backtracking required+-- exponentially.+--+-- For example, the combinator @many inner outer@ applies the outer fold on the+-- input stream and applies the inner fold on the results of the outer fold.+--+-- many :: Monad m => Fold m b c -> Fold m a b -> Fold m a c+--+-- If the inner fold itself returns a @Done1@ then we need to backtrack all+-- the elements that have been consumed by the outer fold to generate that+-- value. We need backtracking of more than one element.+--+-- Arbitrary backtracking requires arbitrary buffering. However, we do not want+-- to buffer unconditionally, only if the buffer is needed. One way to do this+-- is to use a "Continue" constructor like parsers. When we have nested folds,+-- the top level fold always returns a "Continue" to the driver until an output+-- is generated by it, this means the top level driver keeps buffering until an+-- output is generated via Partial or Done. Intermediate level "Continue" keep+-- propagating up to the top level.+--+-- === Parallel backtracking+--+-- In compositions like Alternative and Distributive we may have several+-- branches. Each branch can backtrack independently. We need to keep the input+-- as long as any of the branches need it. We can use a single copy of the+-- buffer and maintain it based on all the branches, or we can make each branch+-- have its own buffer. The latter approach may be simpler to implement.+-- Whenever we branch we can introduce an independent buffer for backtracking.+-- Or we can use a newtype that allows branched composition to handle+-- backtracking.+--+-- === Implementation Approach+--+-- To avoid these issues we can enforce, by using types, that the collecting+-- folds can never return a leftover.  This leads us to define a type that can+-- never return a leftover. The use cases of single leftover can be transferred+-- to parsers where we have general backtracking mechanism and single leftover+-- is just a special case of backtracking.+--+-- 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+-- will be equivalent to just throwing an error. They won't have an+-- alternative.+--+-- Because of the complexity of implementing a distributive composition in+-- presence of backtracking we could possibly have a type without backtracking+-- but with the "Continue" constructor, and use either the Parser type or+-- another type for backtracking.+--+-- == Folds with an additional input+--+-- The `Fold` type does not allow a dynamic input to be used to generate the+-- initial value of the fold accumulator. We can extend the type further to+-- allow that:+--+-- @+-- data Refold m i a b =+--   forall s. Refold+--      (s -> a -> m (Step s b)) -- step+--      (i -> m (Step s b))      -- initial+--      (s -> m b)               -- extract+-- @+--+-- == Parsers+--+-- The next upgrade after terminating folds with a leftover are parsers.+-- Parsers are terminating folds that can fail and backtrack. Parsers can be+-- composed using an @alternative@ style composition where they can backtrack+-- and apply another parser if one parser fails.+-- 'Streamly.Internal.Data.Parser.satisfy' is a simple example of a parser, it+-- 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+-- skip producing an output or to backtrack. We also add the ability to+-- backtrack in @Partial@ and @Done@.:+--+-- Also @extract@ now needs to be able to express an error. We could have it+-- return the @Step@ type as well but that makes the implementation more+-- complicated.+--+-- @+-- data Step s b =+--       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+--+-- data Parser a m b =+--   forall s. Fold+--      (s -> a -> m (Step s b))   -- step+--      (m (Step s b))             -- initial+--      (s -> m (Either String b)) -- extract+-- @+--+-- = Types for Stream Consumers+--+-- We do not have a separate type for accumulators. Terminating folds are a+-- superset of accumulators and to avoid too many types we represent both using+-- the same type, 'Fold'.+--+-- We do not club the leftovers functionality with terminating folds because of+-- the reasons explained earlier. Instead combinators that require leftovers+-- are implemented as the 'Streamly.Internal.Data.Parser.Parser' type.  This is+-- a sweet spot to balance ease of use, type safety and performance.  Using+-- separate Accumulator and terminating fold types would encode more+-- information in types but it would make ease of use, implementation,+-- maintenance effort worse. Combining Accumulator, terminating folds and+-- Parser into a single 'Streamly.Internal.Data.Parser.Parser' type would make+-- ease of use even better but type safety and performance worse.+--+-- One of the design requirements that we have placed for better ease of use+-- and code reuse is that 'Streamly.Internal.Data.Parser.Parser' type should be+-- a strict superset of the 'Fold' type i.e. it can do everything that a 'Fold'+-- can do and more. Therefore, folds can be easily upgraded to parsers and we+-- can use parser combinators on folds as well when needed.+--+-- = Fold Design+--+-- A fold is represented by a collection of "initial", "step" and "extract"+-- functions. The "initial" action generates the initial state of the fold. The+-- state is internal to the fold and maintains the accumulated output. The+-- "step" function is invoked using the current state and the next input value+-- and results in a @Partial@ or @Done@. A @Partial@ returns the next intermediate+-- state of the fold, a @Done@ indicates that the fold has terminated and+-- returns the final value of the accumulator.+--+-- Every @Partial@ indicates that a new accumulated output is available.  The+-- accumulated output can be extracted from the state at any point using+-- "extract". "extract" can never fail. A fold returns a valid output even+-- without any input i.e. even if you call "extract" on "initial" state it+-- provides an output. This is not true for parsers.+--+-- In general, "extract" is used in two cases:+--+-- * When the fold is used as a scan @extract@ is called on the intermediate+-- state every time it is yielded by the fold, the resulting value is yielded+-- as a stream.+-- * When the fold is used as a regular fold, @extract@ is called once when+-- we are done feeding input to the fold.+--+-- = Alternate Designs+--+-- An alternate and simpler design would be to return the intermediate output+-- via @Partial@ along with the state, instead of using "extract" on the yielded+-- state and remove the extract function altogether.+--+-- This may even facilitate more efficient implementation.  Extract from the+-- intermediate state after each yield may be more costly compared to the fold+-- step itself yielding the output. The fold may have more efficient ways to+-- retrieve the output rather than stuffing it in the state and using extract+-- on the state.+--+-- However, removing extract altogether may lead to less optimal code in some+-- cases because the driver of the fold needs to thread around the intermediate+-- output to return it if the stream stops before the fold could return @Done@.+-- When using this approach, the @parseMany (FL.take filesize)@ benchmark shows+-- a 2x worse performance even after ensuring everything fuses.  So we keep the+-- "extract" approach to ensure better perf in all cases.+--+-- But we could still yield both state and the output in @Partial@, the output+-- can be used for the scan use case, instead of using extract. Extract would+-- then be used only for the case when the stream stops before the fold+-- completes.+--+-- = Monoids+--+-- Monoids allow generalized, modular folding.  The accumulators in this module+-- can be expressed using 'mconcat' and a suitable 'Monoid'.  Instead of+-- writing folds we can write Monoids and turn them into folds.+--+module Streamly.Internal.Data.Fold.Type+    (+    -- * Imports+    -- $setup++    -- * Types+      Step (..)+    , Fold (..)++    -- * Constructors+    , foldl'+    , foldlM'+    , foldl1'+    , foldlM1'+    , foldt'+    , foldtM'+    , foldr'+    , foldrM'++    -- * Folds+    , fromPure+    , fromEffect+    , fromRefold+    , drain+    , toList+    , toStreamK+    , toStreamKRev++    -- * Combinators++    -- ** Mapping output+    , rmapM++    -- ** Mapping Input+    , lmap+    , lmapM+    , postscan++    -- ** Filtering+    , catMaybes+    , scanMaybe+    , filter+    , filtering+    , filterM+    , catLefts+    , catRights+    , catEithers++    -- ** Trimming+    , take+    , taking+    , 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+    , teeWithMin++    -- ** Parallel Alternative+    , shortest+    , longest++    -- * Running A Fold+    , extractM+    , reduce+    , snoc+    , addOne+    , snocM+    , snocl+    , snoclM+    , close+    , isClosed++    -- * Transforming inner monad+    , morphInner+    , generalizeInner++    -- * Deprecated+    , foldr+    , serialWith+    )+where++#include "inline.hs"++import Control.Applicative (liftA2)+import Control.Monad ((>=>))+import Data.Bifunctor (Bifunctor(..))+import Data.Either (fromLeft, fromRight, isLeft, isRight)+import Data.Functor.Identity (Identity(..))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep, chainStepM)+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))+import Streamly.Internal.Data.Refold.Type (Refold(..))++import qualified Streamly.Internal.Data.Stream.StreamK.Type as K++import Prelude hiding (concatMap, filter, foldr, map, take)++#include "DocTestDataFold.hs"++------------------------------------------------------------------------------+-- The Fold 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".++-- | 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@.+--+-- 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.+--+-- 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)++------------------------------------------------------------------------------+-- Mapping on the output+------------------------------------------------------------------------------++-- | Map a monadic function on the output of a fold.+--+{-# 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)++    where++    initial1 = initial >>= mapMStep f+    step1 s a = step s a >>= mapMStep f++------------------------------------------------------------------------------+-- Left fold constructors+------------------------------------------------------------------------------++-- | Make a fold from a left fold style pure step function and initial value of+-- the accumulator.+--+-- If your 'Fold' returns only 'Partial' (i.e. never returns a 'Done') then you+-- can use @foldl'*@ constructors.+--+-- A fold with an extract function can be expressed using fmap:+--+-- @+-- mkfoldlx :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b+-- mkfoldlx step initial extract = fmap extract (foldl' step initial)+-- @+--+{-# 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++-- | Make a fold from a left fold style monadic step function and initial value+-- of the accumulator.+--+-- A fold with an extract function can be expressed using rmapM:+--+-- @+-- mkFoldlxM :: Functor m => (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b+-- mkFoldlxM step initial extract = rmapM extract (foldlM' step initial)+-- @+--+{-# 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++-- | Make a strict left fold, for non-empty streams, using first element as the+-- starting value. Returns Nothing if the stream is empty.+--+-- /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++-- | Like 'foldl1\'' but with a monadic step function.+--+-- /Pre-release/+{-# INLINE foldlM1' #-}+foldlM1' :: Monad m => (a -> a -> m a) -> Fold m a (Maybe a)+foldlM1' step = fmap toMaybe $ foldlM' step1 (return Nothing')++    where++    step1 Nothing' a = return $ Just' a+    step1 (Just' x) a = Just' <$> step x a++------------------------------------------------------------------------------+-- Right fold constructors+------------------------------------------------------------------------------++-- | Make a fold 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:+--+-- >>> foldr' f z = fmap (flip appEndo z) $ Fold.foldMap (Endo . f)+-- >>> foldr' f z = fmap ($ z) $ Fold.foldl' (\g x -> g . f x) id+--+-- Example:+--+-- >>> Stream.fold (Fold.foldr' (:) []) $ Stream.enumerateFromTo 1 5+-- [1,2,3,4,5]+--+{-# 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++{-# DEPRECATED foldr "Please use foldr' instead." #-}+{-# INLINE foldr #-}+foldr :: Monad m => (a -> b -> b) -> b -> Fold m a b+foldr = foldr'++-- XXX we have not seen any use of this yet, not releasing until we have a use+-- case.++-- | Like foldr' but with a monadic step function.+--+-- Example:+--+-- >>> toList = Fold.foldrM' (\a xs -> return $ a : xs) (return [])+--+-- See also: 'Streamly.Internal.Data.Stream.foldrM'+--+-- /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)++------------------------------------------------------------------------------+-- General fold 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 -> Fold 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 fold using a pure step function, a pure initial state+-- and a pure state extraction function.+--+-- /Pre-release/+--+{-# 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)++-- | Make a terminating fold with an effectful step function and initial state,+-- and a state extraction function.+--+-- >>> foldtM' = Fold.Fold+--+--  We can just use 'Fold' but it is provided for completeness.+--+-- /Pre-release/+--+{-# INLINE foldtM' #-}+foldtM' :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b+foldtM' = Fold++------------------------------------------------------------------------------+-- 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 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++------------------------------------------------------------------------------+-- Basic Folds+------------------------------------------------------------------------------++-- | A fold that drains all its input, running the effects and discarding the+-- results.+--+-- >>> drain = Fold.drainMapM (const (return ()))+-- >>> drain = Fold.foldl' (\_ _ -> ()) ()+--+{-# INLINE drain #-}+drain :: Monad m => Fold m a ()+drain = foldl' (\_ _ -> ()) ()++-- | Folds the input stream to a list.+--+-- /Warning!/ working on large lists accumulated as buffers in memory could be+-- very inefficient, consider using "Streamly.Data.Array"+-- instead.+--+-- >>> toList = Fold.foldr' (:) []+--+{-# INLINE toList #-}+toList :: Monad m => Fold m a [a]+toList = foldr' (:) []++-- | Buffers the input stream to a pure stream in the reverse order of the+-- input.+--+-- >>> toStreamKRev = Foldable.foldl' (flip StreamK.cons) StreamK.nil+--+-- 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 => Fold m a (K.StreamK n a)+toStreamKRev = foldl' (flip K.cons) K.nil++-- | A fold that buffers its input to a pure stream.+--+-- >>> toStreamK = foldr StreamK.cons StreamK.nil+-- >>> toStreamK = fmap StreamK.reverse Fold.toStreamKRev+--+-- /Internal/+{-# INLINE toStreamK #-}+toStreamK :: Monad m => Fold m a (K.StreamK n a)+toStreamK = foldr K.cons K.nil++------------------------------------------------------------------------------+-- Instances+------------------------------------------------------------------------------++-- | 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)++        where++        initial = fmap2 f initial1+        step s b = fmap2 f (step1 s b)+        fmap2 g = fmap (fmap g)++-- 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 fold that yields the supplied value without consuming any further+-- input.+--+-- /Pre-release/+--+{-# INLINE fromPure #-}+fromPure :: Applicative m => b -> Fold m a b+fromPure b = Fold undefined (pure $ Done b) pure++-- | Make a fold that yields the result of the supplied effectful action+-- without consuming any further input.+--+-- /Pre-release/+--+{-# INLINE fromEffect #-}+fromEffect :: Applicative m => m b -> Fold m a b+fromEffect b = Fold undefined (Done <$> b) 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 = Fold.take 8 Fold.toList+-- >>> line = Fold.takeEndBy (== '\n') Fold.toList+-- >>> f = Fold.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. When you need+-- scaling use parser monad instead.+--+-- /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++    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++    extract (SeqFoldR f sR) = fmap f (extractR sR)+    extract (SeqFoldL sL) = do+        rL <- extractL sL+        res <- initialR+        fmap (func rL)+            $ case res of+                Partial sR -> extractR sR+                Done rR -> return rR++{-# DEPRECATED serialWith "Please use \"splitWith\" instead" #-}+{-# INLINE serialWith #-}+serialWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c+serialWith = splitWith++{-# 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 _) (Fold stepR initialR extractR) =+    Fold step initial extract++    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++    extract (SeqFoldR_ sR) = extractR sR+    extract (SeqFoldL_ _) = do+        res <- initialR+        case res of+            Partial sR -> extractR 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++-- | @teeWith k f1 f2@ distributes its input to both @f1@ and @f2@ until both+-- of them terminate and combines their output using @k@.+--+-- Definition:+--+-- >>> teeWith k f1 f2 = fmap (uncurry k) (Fold.tee f1 f2)+--+-- Example:+--+-- >>> avg = Fold.teeWith (/) Fold.sum (fmap fromIntegral Fold.length)+-- >>> Stream.fold avg $ Stream.fromList [1.0..100.0]+-- 50.5+--+-- For applicative composition using this combinator see+-- "Streamly.Data.Fold.Tee".+--+-- See also: "Streamly.Data.Fold.Tee"+--+-- Note that nested applications of teeWith do not fuse.+--+{-# 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++    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++{-# ANN type TeeFstState Fuse #-}+data TeeFstState sL sR b+    = TeeFstBoth !sL !sR+    | TeeFstLeft !b !sL++-- | Like 'teeWith' but terminates as soon as the first fold terminates.+--+-- /Pre-release/+--+{-# 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++    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 -> extractR 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++-- | Like 'teeWith' but terminates as soon as any one of the two folds+-- terminates.+--+-- /Pre-release/+--+{-# 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++    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) <$> extractL sl++            Done bl -> do+                Done . f bl <$>+                    case resR of+                        Partial sr -> extractR 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++-- | 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 => 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++    where++    {-# INLINE runBoth #-}+    runBoth actionL actionR = do+        resL <- actionL+        resR <- actionR+        return $+            case resL of+                Partial sL -> bimap (Tuple' sL) Right resR+                Done bL -> 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++{-# 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 => 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++    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++    left sL = Left <$> extractL sL+    extract (LongestLeft sL) = left sL+    extract (LongestRight sR) = Right <$> extractR sR+    extract (LongestBoth sL _) = left sL++data ConcatMapState m sa a c+    = B !sa+    | forall s. C (s -> a -> m (Step s c)) !s (s -> m c)++-- | Map a 'Fold' returning function on the result of a 'Fold' and run the+-- returned fold. This operation can be used to express data dependencies+-- between fold operations.+--+-- 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 Fold.one+-- >>> total n = Fold.take n Fold.sum+-- >>> Stream.fold (Fold.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 -> Fold m a c) -> Fold m a b -> Fold m a c+concatMap f (Fold stepa initiala extracta) = Fold stepc initialc extractc+  where+    initialc = do+        r <- initiala+        case r of+            Partial s -> return $ Partial (B s)+            Done b -> initInnerFold (f b)++    stepc (B s) a = do+        r <- stepa s a+        case r of+            Partial s1 -> return $ Partial (B s1)+            Done b -> initInnerFold (f b)++    stepc (C stepInner s extractInner) a = do+        r <- stepInner s a+        return $ case r of+            Partial sc -> Partial (C stepInner sc extractInner)+            Done c -> Done c++    extractc (B s) = do+        r <- extracta s+        initExtract (f r)+    extractc (C _ sInner extractInner) = extractInner sInner++    initInnerFold (Fold step i e) = do+        r <- i+        return $ case r of+            Partial s -> Partial (C step s e)+            Done c -> Done c++    initExtract (Fold _ i e) = do+        r <- i+        case r of+            Partial s -> e s+            Done c -> return c++------------------------------------------------------------------------------+-- Mapping on input+------------------------------------------------------------------------------++-- | @lmap f fold@ maps the function @f@ on the input of the fold.+--+-- Definition:+--+-- >>> lmap = Fold.lmapM return+--+-- Example:+--+-- >>> sumSquared = Fold.lmap (\x -> x * x) Fold.sum+-- >>> Stream.fold sumSquared (Stream.enumerateFromTo 1 100)+-- 338350+--+{-# INLINE lmap #-}+lmap :: (a -> b) -> Fold m b r -> Fold m a r+lmap f (Fold step begin done) = Fold step' begin done+    where+    step' x a = step x (f a)++-- | @lmapM f fold@ maps the monadic function @f@ on the input of the fold.+--+{-# 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+    where+    step' x a = f a >>= step x++-- | Postscan the input of a 'Fold' to change it in a stateful manner using+-- another 'Fold'.+--+-- @postscan scanner collector@+--+-- /Pre-release/+{-# INLINE postscan #-}+postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c+postscan (Fold stepL initialL extractL) (Fold stepR initialR extractR) =+    Fold step initial extract++    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 <$> 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+        rL <- initialL+        case r of+            Partial sR ->+                case rL of+                    Done _ -> Done <$> extractR sR+                    Partial sL -> return $ Partial (sL, sR)+            Done b -> return $ Done b++    step (sL, sR) x = runStep (stepL sL x) sR++    extract = extractR . snd++------------------------------------------------------------------------------+-- Filtering+------------------------------------------------------------------------------++-- | Modify a fold to receive a 'Maybe' input, the 'Just' values are unwrapped+-- and sent to the original fold, 'Nothing' values are discarded.+--+-- >>> catMaybes = Fold.mapMaybe id+-- >>> catMaybes = Fold.filter isJust . Fold.lmap fromJust+--+{-# INLINE_NORMAL catMaybes #-}+catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b+catMaybes (Fold step initial extract) = Fold step1 initial extract++    where++    step1 s a =+        case a of+            Nothing -> return $ Partial s+            Just x -> step s x++-- | Use a 'Maybe' returning fold as a filtering scan.+--+-- >>> scanMaybe p f = Fold.postscan p (Fold.catMaybes f)+--+-- /Pre-release/+{-# 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)++-- | A scanning fold for filtering elements based on a predicate.+--+{-# INLINE filtering #-}+filtering :: Monad m => (a -> Bool) -> Fold m a (Maybe a)+filtering f = foldl' step Nothing++    where++    step _ a = if f a then Just a else Nothing++-- | Include only those elements that pass a predicate.+--+-- >>> 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+    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 = Fold.mapMaybeM (f p)+--+{-# 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+    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) => Fold m a c -> Fold 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) => Fold m b c -> Fold 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 = Fold.lmap (either id id)+--+-- /Pre-release/+--+{-# INLINE catEithers #-}+catEithers :: Fold m a b -> Fold 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 -> 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++{-# 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++-- | Take at most @n@ input elements and fold them using the supplied fold. A+-- negative count is treated as 0.+--+-- >>> Stream.fold (Fold.take 2 Fold.toList) $ Stream.fromList [1..10]+-- [1,2]+--+{-# 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++    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 <$> fextract 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++------------------------------------------------------------------------------+-- 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 => 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)++    where++    initial = second fromPure <$> initial1++    step s a = second fromPure <$> step1 s a++-- 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.++-- | 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 => Fold m a b -> m (Fold m a b)+reduce (Fold step initial extract) = do+    i <- initial+    return $ Fold step (return i) extract++-- 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 => Fold m a b -> m a -> Fold m a b+snoclM (Fold fstep finitial fextract) action = Fold fstep initial fextract++    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 = Fold.snoclM f . return+--+-- Example:+--+-- >>> import qualified Data.Foldable as Foldable+-- >>> Fold.extractM $ 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++    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 = Fold.reduce . Fold.snoclM f+--+-- /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+    res <- initial+    r <- case res of+          Partial fs -> action >>= step fs+          Done _ -> return res+    return $ Fold step (return r) extract++-- Definitions:+--+-- >>> snoc f = Fold.reduce . Fold.snocl f+-- >>> snoc f = Fold.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 Fold.snoc Fold.toList [1..3] >>= Fold.drive Stream.nil+-- [1,2,3]+--+-- /Pre-release/+{-# INLINE snoc #-}+snoc :: Monad m => Fold m a b -> a -> m (Fold m a b)+snoc (Fold step initial extract) a = do+    res <- initial+    r <- case res of+          Partial fs -> step fs a+          Done _ -> return res+    return $ Fold step (return r) extract++-- | Append a singleton value to the fold.+--+-- See examples under 'addStream'.+--+-- /Pre-release/+{-# INLINE addOne #-}+addOne :: Monad m => a -> Fold m a b -> m (Fold 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 = Fold.drive Stream.nil+--+-- Example:+--+-- >>> Fold.extractM Fold.toList+-- []+--+-- /Pre-release/+{-# 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++-- | 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++    where++    initial = do+        res <- initial1+        case res of+              Partial s -> Done <$> extract1 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 => Fold m a b -> m Bool+isClosed (Fold _ 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.++{-# 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 = Fold.take 2 Fold.toList+-- >>> twos = Fold.many two Fold.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 => 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++    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++-- | 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 => 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++    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++-- | @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 = Fold.many (Fold.take n split)+--+-- Example:+--+-- >>> twos = Fold.groupsOf 2 Fold.toList Fold.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 -> Fold m a b -> Fold m b c -> Fold 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 => Fold m a b -> Refold m x b c -> Refold m x a c+refoldMany (Fold sstep sinitial sextract) (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 -> Fold m b c -> Refold m x a c+refoldMany1 (Refold sstep sinject sextract) (Fold cstep cinitial 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 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 -> Fold m a b -> Fold m a c+refold (Refold step inject extract) f =+    Fold step (extractM f >>= inject) extract++------------------------------------------------------------------------------+-- morphInner+------------------------------------------------------------------------------++-- | Change the underlying monad of a fold. Also known as hoist.+--+-- /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)++-- | Adapt a pure fold to any monad.+--+-- >>> generalizeInner = Fold.morphInner (return . runIdentity)+--+-- /Pre-release/+generalizeInner :: Monad m => Fold Identity a b -> Fold m a b+generalizeInner = morphInner (return . runIdentity)
+ src/Streamly/Internal/Data/Fold/Window.hs view
@@ -0,0 +1,351 @@+-- |+-- Module      : Streamly.Internal.Data.Fold.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 fold can be driven either using the Ring.slidingWindow+-- combinator or by zipping nthLast fold and last fold.++module Streamly.Internal.Data.Fold.Window+    (+    -- * Incremental Folds+    -- | Folds of type @Fold m (a, Maybe a) b@ are incremental sliding window+    -- folds. An input of type @(a, Nothing)@ 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 @(a, Just a)@+    -- indicates that the first element is being inserted in the window and the+    -- second element is being removed from 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 sliding+    -- window folds by keeping the second element of the input tuple as+    -- @Nothing@.+    --+      lmap+    , cumulative++    , rollingMap+    , rollingMapM++    -- ** Sums+    , length+    , sum+    , sumInt+    , powerSum+    , powerSumFrac++    -- ** Location+    , minimum+    , maximum+    , range+    , mean+    )+where++import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.Bifunctor(bimap)+import Foreign.Storable (Storable, peek)++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 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)++-------------------------------------------------------------------------------+-- Utilities+-------------------------------------------------------------------------------++-- | Map a function on the incoming as well as outgoing element of a rolling+-- window fold.+--+-- >>> 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 <$>))++-- | Convert an incremental fold to a cumulative fold using the entire input+-- stream as a single window.+--+-- >>> cumulative f = Fold.lmap (\x -> (x, Nothing)) f+--+{-# INLINE cumulative #-}+cumulative :: Fold m (a, Maybe a) b -> Fold m a b+cumulative = Fold.lmap (, Nothing)++-- XXX Exchange the first two arguments of rollingMap or exchange the order in+-- the fold input tuple.++-- | Apply an effectful function on the latest and the oldest element of the+-- window.+{-# INLINE rollingMapM #-}+rollingMapM :: Monad m =>+    (Maybe a -> a -> m (Maybe b)) -> Fold m (a, Maybe a) (Maybe b)+rollingMapM f = Fold.foldlM' f1 initial++    where++    initial = return Nothing++    f1 _ (a, ma) = f ma a++-- | Apply a pure function on the latest and the oldest element of the window.+--+-- >>> rollingMap f = FoldW.rollingMapM (\x y -> return $ f x y)+--+{-# INLINE rollingMap #-}+rollingMap :: Monad m =>+    (Maybe a -> a -> Maybe b) -> Fold m (a, Maybe a) (Maybe b)+rollingMap f = Fold.foldl' f1 initial++    where++    initial = Nothing++    f1 _ (a, ma) = f ma a++-------------------------------------------------------------------------------+-- Sum+-------------------------------------------------------------------------------++-- XXX Overflow.+--+-- | The sum of all the elements in a rolling window. The input elements are+-- required to be intergal numbers.+--+-- This was written in the hope that it would be a tiny bit faster than 'sum'+-- for 'Integral' values. But turns out that 'sum' is 2% faster than this even+-- for intergal values!+--+-- /Internal/+--+{-# INLINE sumInt #-}+sumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a+sumInt = Fold step initial extract++    where++    initial = return $ Partial (0 :: a)++    step s (a, ma) =+        return+            $ Partial+                $ case ma of+                    Nothing -> s + a+                    Just old -> s + a - 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.+--+-- >>> sum = powerSum 1+--+-- Uses Kahan-Babuska-Neumaier style summation for numerical stability of+-- floating precision arithmetic.+--+-- /Space/: \(\mathcal{O}(1)\)+--+-- /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++    where++    initial =+        return+            $ Partial+            $ Tuple'+                (0 :: a) -- running sum+                (0 :: a) -- accumulated rounding error++    step (Tuple' total err) (new, mOld) =+        let incr =+                case mOld of+                    -- XXX new may be large and err may be small we may lose it+                    Nothing -> new - err+                    -- XXX if (new - old) is large we may lose err+                    Just old -> (new - old) - err+            -- 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 Nothing case above we may lose err, therefore we+            -- should use ((total1 - total) - new) + err here.+            -- Or even in the just 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++    extract (Tuple' total _) = return total++-- | The number of elements in the rolling window.+--+-- This is the \(0\)th power sum.+--+-- >>> length = powerSum 0+--+{-# INLINE length #-}+length :: (Monad m, Num b) => Fold m (a, Maybe a) b+length = Fold.foldl' step 0++    where++    step w (_, Nothing) = w + 1+    step w _ = w++-- | Sum of the \(k\)th power of all the elements in a rolling window:+--+-- \(S_k = \sum_{i=1}^n x_{i}^k\)+--+-- >>> powerSum k = lmap (^ k) sum+--+-- /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++-- | Like 'powerSum' but powers can be negative or fractional. This is slower+-- than 'powerSum' for positive intergal powers.+--+-- >>> powerSumFrac p = lmap (** p) sum+--+{-# INLINE powerSumFrac #-}+powerSumFrac :: (Monad m, Floating a) => a -> Fold m (a, Maybe a) a+powerSumFrac p = lmap (** p) sum++-------------------------------------------------------------------------------+-- Location+-------------------------------------------------------------------------------++-- XXX Remove MonadIO constraint++-- | Determine the maximum and minimum in a rolling window.+--+-- If you want to compute the range of the entire stream @Fold.teeWith (,)+-- Fold.maximum Fold.minimum@ 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 range #-}+range :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))+range n = Fold step initial 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)++    -- 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++    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++-- | Find the minimum element in a rolling window.+--+-- This implementation traverses the entire window buffer to compute the+-- minimum 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 minimum of the entire stream+-- 'Streamly.Data.Fold.minimum' is much faster.+--+-- /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++-- | The maximum element in a rolling window.+--+-- See the performance related comments in 'minimum'.+--+-- If you want to compute the maximum of the entire stream 'Fold.maximum' would+-- be much faster.+--+-- /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++-- | 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.+--+-- >>> mean = Fold.teeWith (/) sum length+--+-- /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
+ src/Streamly/Internal/Data/IOFinalizer.hs view
@@ -0,0 +1,91 @@+-- |+-- Module      : Streamly.Internal.Data.IOFinalizer+-- Copyright   : (c) 2020 Composewell Technologies and Contributors+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A value associated with an IO action that is automatically called whenever+-- the value is garbage collected.++module Streamly.Internal.Data.IOFinalizer+    (+      IOFinalizer(..)+    , newIOFinalizer+    , runIOFinalizer+    , clearingIOFinalizer+    )+where++import Control.Exception (mask_)+import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO(..))+import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef, IORef)++-- | An 'IOFinalizer' has an associated IO action that is automatically called+-- whenever the finalizer is garbage collected. The action can be run and+-- cleared prematurely.+--+-- You can hold a reference to the finalizer in your data structure, if the+-- data structure gets garbage collected the finalizer will be called.+--+-- It is implemented using 'mkWeakIORef'.+--+-- /Pre-release/+newtype IOFinalizer = IOFinalizer (IORef (Maybe (IO ())))++-- | GC hook to run an IO action stored in a finalized IORef.+runFinalizerGC :: IORef (Maybe (IO ())) -> IO ()+runFinalizerGC ref = do+    res <- readIORef ref+    case res of+        Nothing -> return ()+        Just f -> f++-- | Create a finalizer that calls the supplied function automatically when the+-- it is garbage collected.+--+-- /The finalizer is always run using the state of the monad that is captured+-- at the time of calling 'newFinalizer'./+--+-- Note: To run it on garbage collection we have no option but to use the monad+-- state captured at some earlier point of time.  For the case when the+-- finalizer is run manually before GC we could run it with the current state+-- of the monad but we want to keep both the cases consistent.+--+-- /Pre-release/+newIOFinalizer :: MonadIO m => IO a -> m IOFinalizer+newIOFinalizer finalizer = liftIO $ do+    let f = void finalizer+    ref <- newIORef $ Just f+    _ <- mkWeakIORef ref (runFinalizerGC ref)+    return $ IOFinalizer ref++-- | Run the action associated with the finalizer and deactivate it so that it+-- never runs again.  Note, the finalizing action runs with async exceptions+-- masked.+--+-- /Pre-release/+runIOFinalizer :: MonadIO m => IOFinalizer -> m ()+runIOFinalizer (IOFinalizer ref) = liftIO $ do+    res <- readIORef ref+    case res of+        Nothing -> return ()+        Just action -> do+            -- if an async exception comes after writing 'Nothing' then the+            -- finalizing action will never be run. We need to do this+            -- atomically wrt async exceptions.+            mask_ $ do+                writeIORef ref Nothing+                action++-- | Run an action clearing the finalizer atomically wrt async exceptions. The+-- action is run with async exceptions masked.+--+-- /Pre-release/+clearingIOFinalizer :: MonadIO m => IOFinalizer -> IO a -> m a+clearingIOFinalizer (IOFinalizer ref) action = do+    liftIO $ mask_ $ do+        writeIORef ref Nothing+        action
+ src/Streamly/Internal/Data/IORef/Unboxed.hs view
@@ -0,0 +1,100 @@+-- |+-- 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
@@ -0,0 +1,52 @@+-- |+-- Module      : Streamly.Internal.Data.IsMap+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.IsMap (IsMap(..)) where++import Data.Kind (Type)+import Data.Map.Strict (Map)++import qualified Data.IntMap.Strict as IntMap+import qualified Data.Map.Strict as Map++-- XXX Try unpacked-containers++class IsMap f where+    type Key f :: Type++    mapEmpty :: f a+    mapAlterF :: Functor g =>+        (Maybe a -> g (Maybe a)) -> Key f -> f a -> g (f a)+    -- These can be implemented in terms of alterF itself+    mapLookup :: Key f -> f a -> Maybe a+    mapInsert :: Key f -> a -> f a -> f a+    mapDelete :: Key f -> f a -> f a+    mapUnion :: f a -> f a -> f a+    mapNull :: f a -> Bool++instance Ord k => IsMap (Map k) where+    type Key (Map k) = k++    mapEmpty = Map.empty+    mapAlterF = Map.alterF+    mapLookup = Map.lookup+    mapInsert = Map.insert+    mapDelete = Map.delete+    mapUnion = Map.union+    mapNull = Map.null++instance IsMap IntMap.IntMap where+    type Key IntMap.IntMap = Int++    mapEmpty = IntMap.empty+    mapAlterF = IntMap.alterF+    mapLookup = IntMap.lookup+    mapInsert = IntMap.insert+    mapDelete = IntMap.delete+    mapUnion = IntMap.union+    mapNull = IntMap.null
+ src/Streamly/Internal/Data/List.hs view
@@ -0,0 +1,169 @@+{-# 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/Maybe/Strict.hs view
@@ -0,0 +1,57 @@+-- |+-- Module      : Streamly.Internal.Data.Maybe.Strict+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- | Strict data types to be used as accumulator for strict left folds and+-- scans. For more comprehensive strict data types see+-- https://hackage.haskell.org/package/strict-base-types . The names have been+-- suffixed by a prime so that programmers can easily distinguish the strict+-- versions from the lazy ones.+--+-- One major advantage of strict data structures as accumulators in folds and+-- scans is that it helps the compiler optimize the code much better by+-- unboxing. In a big tight loop the difference could be huge.++-- Notes: The purpose of the strict Maybe type is to force storing an evaluated+-- value instead of a lazy thunk. To enforce that we use a strict Maybe type in+-- a data structure. If we need to operate on such strict values, the simplest+-- way to do that is to convert it to a lazy type and operate on that.+-- Therefore, we do not provide any other operations other than ways to+-- construct a strict type and convert it to a lazy type.+--+module Streamly.Internal.Data.Maybe.Strict+    ( Maybe' (..)+    -- XXX rename to lazyMaybe, also supply a strictMaybe function.+    , toMaybe+    -- XXX Remove these, use isJust . toMaybe etc instead.+    , isJust'+    , fromJust'+    )+where++-- | A strict 'Maybe'+data Maybe' a = Just' !a | Nothing' deriving Show++-- | Convert strict Maybe' to lazy Maybe+{-# INLINE toMaybe #-}+toMaybe :: Maybe' a -> Maybe a+toMaybe  Nothing' = Nothing+toMaybe (Just' a) = Just a++-- | Extract the element out of a Just' and throws an error if its argument is+-- Nothing'.+{-# INLINE fromJust' #-}+fromJust' :: Maybe' a -> a+fromJust' (Just' a) = a+fromJust' Nothing' = error "fromJust' cannot be run in Nothing'"++-- | Returns True iff its argument is of the form "Just' _".+{-# INLINE isJust' #-}+isJust' :: Maybe' a -> Bool+isJust' (Just' _) = True+isJust' Nothing' = False
+ src/Streamly/Internal/Data/Parser.hs view
@@ -0,0 +1,14 @@+-- |+-- 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
+ src/Streamly/Internal/Data/Parser/ParserD.hs view
@@ -0,0 +1,3629 @@+{-# 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 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.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 view
@@ -0,0 +1,1429 @@+{-# 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 view
@@ -0,0 +1,545 @@+-- |+-- 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/Pipe.hs view
@@ -0,0 +1,276 @@+-- |+-- Module      : Streamly.Internal.Data.Pipe+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- 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").+-- 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.+--+-- > 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+-}+    )+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
@@ -0,0 +1,443 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.Data.Pipe.Type+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Pipe.Type+    ( Step (..)+    , Pipe (..)+    , PipeState (..)+    , zipWith+    , tee+    , map+    , compose+    )+where++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 qualified Prelude++------------------------------------------------------------------------------+-- 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.+--+-- 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.+--+-- 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.+--+-- 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.+--+data Step s a =+      Yield a s+    | Continue s++-- | Represents a stateful transformation over an input stream of values of+-- type @a@ to outputs of type @b@ in 'Monad' @m@.++-- 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.+--+-- 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.+--+-- 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.+--+-- XXX In general the starting state could either be for generation or for+-- consumption. Currently we are only starting with a consumption state.+--+-- An explicit either type for better readability of the code+data PipeState s1 s2 = Consume s1 | Produce s2++isProduce :: PipeState s1 s2 -> Bool+isProduce s =+    case s of+        Produce _ -> True+        Consume _ -> False++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++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_LATE produce' #-}+        produce' st = do+            r <- produce st+            return $ case r of+                Yield x s -> Yield (f x) s+                Continue s -> Continue s++-- XXX move this to a separate module+data Deque a = Deque [a] [a]++{-# INLINE null #-}+null :: Deque a -> Bool+null (Deque [] []) = True+null _ = False++{-# INLINE snoc #-}+snoc :: a -> Deque a -> Deque a+snoc a (Deque snocList consList) = Deque (a : snocList) consList++{-# INLINE uncons #-}+uncons :: Deque a -> Maybe (a, Deque a)+uncons (Deque snocList consList) =+  case consList of+    h : t -> Just (h, Deque snocList t)+    _ ->+      case Prelude.reverse snocList of+        h : t -> Just (h, Deque [] t)+        _ -> Nothing++-- | The composed pipe distributes the input to both the constituent pipes and+-- zips the output of the two using a supplied zipping function.+--+-- @since 0.7.0+{-# INLINE_NORMAL zipWith #-}+zipWith :: Monad m => (a -> b -> c) -> Pipe m i a -> Pipe m i b -> Pipe m i c+zipWith f (Pipe consumeL produceL stateL) (Pipe consumeR produceR stateR) =+                    Pipe consume produce state+        where++        -- Left state means we need to consume input from the source. A Right+        -- state means we either have buffered input or we are in generation+        -- mode so we do not need input from source in either case.+        --+        state = Tuple' (Consume stateL, Nothing, Nothing)+                       (Consume stateR, Nothing, Nothing)++        -- XXX for heavy buffering we need to have the (ring) buffer in pinned+        -- memory using the Storable instance.+        {-# INLINE_LATE consume #-}+        consume (Tuple' (sL, resL, lq) (sR, resR, rq)) a = do+            s1 <- drive sL resL lq consumeL produceL a+            s2 <- drive sR resR rq consumeR produceR a+            yieldOutput s1 s2++            where++            {-# INLINE drive #-}+            drive st res queue fConsume fProduce val =+                case res of+                    Nothing -> goConsume st queue val fConsume fProduce+                    Just x -> return $+                        case queue of+                            Nothing -> (st, Just x, Just $ Deque [val] [])+                            Just q  -> (st, Just x, Just $ snoc val q)++            {-# INLINE goConsume #-}+            goConsume stt queue val fConsume stp2 =+                case stt of+                    Consume st ->+                        case queue of+                            Nothing -> do+                                r <- fConsume st val+                                return $ case r of+                                    Yield x s  -> (s, Just x, Nothing)+                                    Continue s -> (s, Nothing, Nothing)+                            Just queue' ->+                                case uncons queue' of+                                    Just (v, q) -> do+                                        r <- fConsume st v+                                        let q' = snoc val q+                                        return $ case r of+                                            Yield x s  -> (s, Just x, Just q')+                                            Continue s -> (s, Nothing, Just q')+                                    Nothing -> undefined -- never occurs+                    Produce st -> do+                        r <- stp2 st+                        return $ case r of+                            Yield x s  -> (s, Just x, queue)+                            Continue s -> (s, Nothing, queue)++        {-# INLINE_LATE produce #-}+        produce (Tuple' (sL, resL, lq) (sR, resR, rq)) = do+            s1 <- drive sL resL lq consumeL produceL+            s2 <- drive sR resR rq consumeR produceR+            yieldOutput s1 s2++            where++            {-# INLINE drive #-}+            drive stt res q fConsume fProduce =+                case res of+                    Nothing -> goProduce stt q fConsume fProduce+                    Just x -> return (stt, Just x, q)++            {-# INLINE goProduce #-}+            goProduce stt queue fConsume fProduce =+                case stt of+                    Consume st ->+                        case queue of+                            -- See yieldOutput. We enter produce mode only when+                            -- each pipe is either in Produce state or the+                            -- queue is non-empty. So this case cannot occur.+                            Nothing -> undefined+                            Just queue' ->+                                case uncons queue' of+                                    Just (v, q) -> do+                                        r <- fConsume st v+                                        -- We provide a guarantee that if the+                                        -- queue is "Just" it is always+                                        -- non-empty. yieldOutput and goConsume+                                        -- depend on it.+                                        let q' = if null q+                                                 then Nothing+                                                 else Just q+                                        return $ case r of+                                            Yield x s  -> (s, Just x, q')+                                            Continue s -> (s, Nothing, q')+                                    Nothing -> return (stt, Nothing, Nothing)+                    Produce st -> do+                        r <- fProduce st+                        return $ case r of+                            Yield x s  -> (s, Just x, queue)+                            Continue s -> (s, Nothing, queue)++        {-# INLINE yieldOutput #-}+        yieldOutput s1@(sL', resL', lq') s2@(sR', resR', rq') = return $+            -- switch to produce mode if we do not need input+            if (isProduce sL' || isJust lq') && (isProduce sR' || isJust rq')+            then+                case (resL', resR') of+                    (Just xL, Just xR) ->+                        Yield (f xL xR) (Produce (Tuple' (clear s1) (clear s2)))+                    _ -> Continue (Produce (Tuple' s1 s2))+            else+                case (resL', resR') of+                    (Just xL, Just xR) ->+                        Yield (f xL xR) (Consume (Tuple' (clear s1) (clear s2)))+                    _ -> Continue (Consume (Tuple' s1 s2))+            where clear (s, _, q) = (s, Nothing, q)++instance Monad m => Applicative (Pipe m a) where+    {-# INLINE pure #-}+    pure b = Pipe (\_ _ -> pure $ Yield b (Consume ())) undefined ()++    (<*>) = 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+    where++    state = Tuple' (Consume stateL) (Consume stateR)++    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))+                -}++    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)++    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))++instance Monad m => Semigroup (Pipe m a b) where+    {-# INLINE (<>) #-}+    (<>) = tee++-- | Lift a pure function to a 'Pipe'.+--+-- @since 0.7.0+{-# INLINE map #-}+map :: Monad m => (a -> b) -> Pipe m a b+map f = Pipe consume undefined ()+    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+-}++-- | Compose two pipes such that the output of the second pipe is attached to+-- the input of the first pipe.+--+-- @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++    where++    state = Tuple' (Consume stateL) (Consume stateR)++    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++    -- 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)++instance Monad m => Category (Pipe m) where+    {-# INLINE id #-}+    id = map Prelude.id++    {-# INLINE (.) #-}+    (.) = compose++unzip :: Pipe m a x -> Pipe m b y -> Pipe m (a, b) (x, y)+unzip = undefined++instance Monad m => Arrow (Pipe m) where+    {-# INLINE arr #-}+    arr = map++    {-# INLINE (***) #-}+    (***) = unzip++    {-# INLINE (&&&) #-}+    (&&&) = zipWith (,)
+ src/Streamly/Internal/Data/Producer.hs view
@@ -0,0 +1,88 @@+-- |+-- Module      : Streamly.Internal.Data.Producer+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A 'Producer' is an 'Unfold' with an 'extract' function added to extract+-- the state. It is more powerful but less general than an Unfold.+--+-- A 'Producer' represents steps of a loop generating a sequence of elements.+-- While unfolds are closed representation of imperative loops with some opaque+-- internal state, producers are open loops with the state being accessible to+-- the user.+--+-- Unlike an unfold, which runs a loop till completion, a producer can be+-- stopped in the middle, its state can be extracted, examined, changed, and+-- then it can be resumed later from the stopped state.+--+-- A producer can be used in places where a CPS stream would otherwise be+-- needed, because the state of the loop can be passed around. However, it can+-- be much more efficient than CPS because it allows stream fusion and+-- unecessary function calls can be avoided.++module Streamly.Internal.Data.Producer+    ( Producer (..)++    -- * 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.SVar.Type (defState)+import Streamly.Internal.Data.Unfold.Type (Unfold(..))++import Streamly.Internal.Data.Producer.Type+import Prelude hiding (concat)++-- XXX We should write unfolds as producers where possible and define+-- unfolds using "simplify".+--+-------------------------------------------------------------------------------+-- Converting to unfolds+-------------------------------------------------------------------------------++-- | Simplify a producer to an unfold.+--+-- /Pre-release/+{-# INLINE simplify #-}+simplify :: Producer m a b -> Unfold m a b+simplify (Producer step inject _) = Unfold step inject++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- | Convert a StreamD stream into a producer.+--+-- /Pre-release/+{-# INLINE_NORMAL fromStreamD #-}+fromStreamD :: Monad m => Producer m (Stream m a) a+fromStreamD = Producer step return return++    where++    {-# INLINE_LATE step #-}+    step (UnStream step1 state1) = do+        r <- step1 defState state1+        return $ case r of+            Yield x s -> Yield x (Stream step1 s)+            Skip s    -> Skip (Stream step1 s)+            Stop      -> Stop
+ src/Streamly/Internal/Data/Producer/Source.hs view
@@ -0,0 +1,290 @@+-- |+-- Module      : Streamly.Internal.Data.Producer.Source+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- A 'Source' is a seed that can be unfolded to a stream with a buffer.  Allows+-- to 'unread' data i.e.  push unused data back to the source buffer. This is+-- useful in parsing applications with backtracking.+--++module Streamly.Internal.Data.Producer.Source+    ( Source++    -- * Creation+    , source++    -- * Transformation+    , unread++    -- * Consumption+    , isEmpty+    , producer++    -- * Parsing+    , parse+    , parseMany+    , parseManyD+    )+where++#include "inline.hs"++import Control.Exception (assert)+import GHC.Exts (SpecConstrAnnotation(..))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Parser.ParserD (ParseError(..), Step(..))+import Streamly.Internal.Data.Producer.Type (Producer(..))+import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))++import qualified Streamly.Internal.Data.Parser.ParserD as ParserD+-- import qualified Streamly.Internal.Data.Parser.ParserK.Type as ParserK++import Prelude hiding (read)++-- | A seed with a buffer. It allows us to 'unread' or return some data+-- after reading it. Useful in backtracked parsing.+--+data Source a b = Source [b] (Maybe a)++-- | Make a source from a seed value. The buffer would start as empty.+--+-- /Pre-release/+source :: Maybe a -> Source a b+source = Source []++-- | Return some unused data back to the source. The data is prepended (or+-- consed) to the source.+--+-- /Pre-release/+unread :: [b] -> Source a b -> Source a b+unread xs (Source ys seed) = Source (xs ++ ys) seed++-- | Determine if the source is empty.+isEmpty :: Source a b -> Bool+isEmpty (Source [] Nothing) = True+isEmpty _ = False++-- | Convert a producer to a producer from a buffered source. Any buffered data+-- is read first and then the seed is unfolded.+--+-- /Pre-release/+{-# INLINE_NORMAL producer #-}+producer :: Monad m => Producer m a b -> Producer m (Source a b) b+producer (Producer step1 inject1 extract1) = Producer step inject extract++    where++    inject (Source [] (Just a)) = do+        s <- inject1 a+        return $ Left s+    inject (Source xs a) = return $ Right (xs, a)++    {-# INLINE_LATE step #-}+    step (Left s) = do+        r <- step1 s+        return $ case r of+            Yield x s1 -> Yield x (Left s1)+            Skip s1 -> Skip (Left s1)+            Stop -> Stop+    step (Right ([], Nothing)) = return Stop+    step (Right ([], Just _)) = error "Bug: unreachable"+    step (Right (x:[], Just a)) = do+        s <- inject1 a+        return $ Yield x (Left s)+    step (Right (x:xs, a)) = return $ Yield x (Right (xs, a))++    extract (Left s) = Source [] . Just <$> extract1 s+    extract (Right (xs, a)) = return $ Source xs a++-------------------------------------------------------------------------------+-- Parsing+-------------------------------------------------------------------------------++-- 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]}++{-# INLINE_NORMAL parse #-}+parse+    :: Monad m =>+    ParserD.Parser a m b+    -> Producer m (Source s a) a+    -> Source s a+    -> m (Either ParseError b, Source s a)+parse+    (ParserD.Parser pstep initial extract)+    (Producer ustep uinject uextract)+    seed = do++    res <- initial+    case res of+        ParserD.IPartial s -> do+            state <- uinject seed+            go SPEC state (List []) s+        ParserD.IDone b -> return (Right b, seed)+        ParserD.IError err -> return (Left (ParseError 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+        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+                        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+                        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+                        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+                        s1 <- uextract s+                        return (Left (ParseError err), unread [x] s1)+            Skip s -> go SPEC s buf pst+            Stop -> goStop buf pst++    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+            Partial 0 pst1 ->+                gobuf SPEC s (List []) (List xs) pst1+            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+            Continue 0 pst1 ->+                gobuf SPEC s (List (x:getList buf)) (List xs) pst1+            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+            Done n b -> do+                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+                    s1 <- uextract s+                    return (Left (ParseError err), unread (x:xs) s1)++    -- This is a simplified gobuf+    goExtract !_ buf (List []) !pst = goStop buf pst+    goExtract !_ buf (List (x:xs)) !pst = do+        pRes <- pstep pst x+        case pRes of+            Partial 0 pst1 ->+                goExtract SPEC (List []) (List xs) pst1+            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+            Continue 0 pst1 ->+                goExtract SPEC (List (x:getList buf)) (List xs) pst1+            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+            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, unread src (source Nothing))+            Error err ->+                    return (Left (ParseError err), unread (x:xs) (source Nothing))++    -- This is a simplified goExtract+    {-# INLINE goStop #-}+    goStop buf pst = do+        pRes <- extract pst+        case pRes of+            Partial _ _ -> error "Bug: parseD: Partial in extract"+            Continue 0 pst1 ->+                goStop buf pst1+            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+            Done 0 b -> return (Right b, source Nothing)+            Done n b -> do+                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)++{-+-- | Parse a buffered source using a parser, returning the parsed value and the+-- remaining source.+--+-- /Pre-release/+{-# INLINE [3] parseK #-}+parseK :: Monad m =>+       ParserK.Parser a m b+    -> Producer m (Source s a) a+    -> Source s a+    -> m (Either ParseError b, Source s a)+parseK = parse . ParserK.toParser+-}++-------------------------------------------------------------------------------+-- Nested parsing+-------------------------------------------------------------------------------++{-# INLINE parseManyD #-}+parseManyD :: Monad m =>+       ParserD.Parser a m b+    -> Producer m (Source x a) a+    -> Producer m (Source x a) (Either ParseError b)+parseManyD parser reader = Producer step return return++    where++    {-# INLINE_LATE step #-}+    step src = do+        if isEmpty src+        then return Stop+        else do+            (b, s1) <- parse parser reader src+            case b of+                Right b1 -> return $ Yield (Right b1) s1+                Left _ -> return Stop++-- | Apply a parser repeatedly on a buffered source producer to generate a+-- producer of parsed values.+--+-- /Pre-release/+{-# INLINE parseMany #-}+parseMany :: Monad m =>+       ParserD.Parser a m b+    -> Producer m (Source x a) a+    -> Producer m (Source x a) (Either ParseError b)+parseMany = parseManyD
+ src/Streamly/Internal/Data/Producer/Type.hs view
@@ -0,0 +1,186 @@+-- |+-- Module      : Streamly.Internal.Data.Producer.Type+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- See "Streamly.Internal.Data.Producer" for introduction.+--++module Streamly.Internal.Data.Producer.Type+    (+    -- * Type+    Producer (..)++    -- * Producers+    , nil+    , nilM+    , unfoldrM+    , fromList++    -- * Mapping+    , translate+    , lmap++    -- * Nesting+    , NestedLoop (..)+    , concat+    )+where++#include "inline.hs"++import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Stream.StreamD.Step (Step(..))+import Prelude hiding (concat, map)++------------------------------------------------------------------------------+-- Type+------------------------------------------------------------------------------++-- | 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@.+--+-- /Pre-release/++data Producer m a b =+    -- | @Producer step inject extract@+    forall s. Producer (s -> m (Step s b)) (a -> m s) (s -> m a)++------------------------------------------------------------------------------+-- Producers+------------------------------------------------------------------------------++{-# INLINE nilM #-}+nilM :: Monad m => (a -> m c) -> Producer m a b+nilM f = Producer step return return++    where++    {-# INLINE_LATE step #-}+    step x = f x >> return Stop++{-# INLINE nil #-}+nil :: Monad m => Producer m a b+nil = nilM (\_ -> return ())++{-# INLINE unfoldrM #-}+unfoldrM :: Monad m => (a -> m (Maybe (b, a))) -> Producer m a b+unfoldrM next = Producer step return return++    where++    {-# INLINE_LATE step #-}+    step st = do+        r <- next st+        return $ case r of+            Just (x, s) -> Yield x s+            Nothing -> Stop++-- | Convert a list of pure values to a 'Stream'+--+-- /Pre-release/+{-# INLINE_LATE fromList #-}+fromList :: Monad m => Producer m [a] a+fromList = Producer step return return++    where++    {-# INLINE_LATE step #-}+    step (x:xs) = return $ Yield x xs+    step [] = return Stop++------------------------------------------------------------------------------+-- Mapping+------------------------------------------------------------------------------++-- | Interconvert the producer between two interconvertible input types.+--+-- /Pre-release/+{-# INLINE_NORMAL translate #-}+translate :: Functor m =>+    (a -> c) -> (c -> a) -> Producer m c b -> Producer m a b+translate f g (Producer step inject extract) =+    Producer step (inject . f) (fmap g . extract)++-- | Map the producer input to another value of the same type.+--+-- /Pre-release/+{-# INLINE_NORMAL lmap #-}+lmap :: (a -> a) -> Producer m a b -> Producer m a b+lmap f (Producer step inject extract) = Producer step (inject . f) extract++------------------------------------------------------------------------------+-- Functor+------------------------------------------------------------------------------++-- | Map a function on the output of the producer (the type @b@).+--+-- /Pre-release/+{-# INLINE_NORMAL map #-}+map :: Functor m => (b -> c) -> Producer m a b -> Producer m a c+map f (Producer ustep uinject uextract) = Producer step uinject uextract++    where++    {-# INLINE_LATE step #-}+    step st = fmap (fmap f) (ustep st)++-- | Maps a function on the output of the producer (the type @b@).+instance Functor m => Functor (Producer m a) where+    {-# INLINE fmap #-}+    fmap = map++------------------------------------------------------------------------------+-- Nesting+------------------------------------------------------------------------------++-- | State representing a nested loop.+{-# ANN type NestedLoop Fuse #-}+data NestedLoop s1 s2 = OuterLoop s1 | InnerLoop s1 s2++-- | Apply the second unfold to each output element of the first unfold and+-- flatten the output in a single stream.+--+-- /Pre-release/+--+{-# INLINE_NORMAL concat #-}+concat :: Monad m =>+    Producer m a b -> Producer m b c -> Producer m (NestedLoop a b) c+concat (Producer step1 inject1 extract1) (Producer step2 inject2 extract2) =+    Producer step inject extract++    where++    inject (OuterLoop x) = do+        s <- inject1 x+        return $ OuterLoop s+    inject (InnerLoop x y) = do+        s1 <- inject1 x+        s2 <- inject2 y+        return $ InnerLoop s1 s2++    {-# INLINE_LATE step #-}+    step (OuterLoop st) = do+        r <- step1 st+        case r of+            Yield x s -> do+                innerSt <- inject2 x+                return $ Skip (InnerLoop s innerSt)+            Skip s    -> return $ Skip (OuterLoop s)+            Stop      -> return Stop++    step (InnerLoop ost ist) = do+        r <- step2 ist+        return $ case r of+            Yield x s -> Yield x (InnerLoop ost s)+            Skip s    -> Skip (InnerLoop ost s)+            Stop      -> Skip (OuterLoop ost)++    extract (OuterLoop s1) = OuterLoop <$> extract1 s1+    extract (InnerLoop s1 s2) = do+        r1 <- extract1 s1+        r2 <- extract2 s2+        return (InnerLoop r1 r2)
+ src/Streamly/Internal/Data/Refold/Type.hs view
@@ -0,0 +1,251 @@+-- |+-- Module      : Streamly.Internal.Data.Refold.Type+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- The 'Fold' type embeds a default initial value, therefore, it is like a+-- 'Monoid' whereas the 'Refold' type has to be supplied with an initial+-- value, therefore, it is more like a 'Semigroup' operation.+--+-- Refolds can be appended to each other or to a fold to build the fold+-- incrementally. This is useful in incremental builder like use cases.+--+-- See the file splitting example in the @streamly-examples@ repository for an+-- application of the 'Refold' type. The 'Fold' type does not perform as well+-- in this situation.+--+-- 'Refold' type is to 'Fold' as 'Unfold' type is to 'Stream'. 'Unfold'+-- provides better optimizaiton than stream in nested operations, similarly,+-- 'Refold' provides better optimization than 'Fold'.+--+module Streamly.Internal.Data.Refold.Type+    (+    -- * Types+      Refold (..)++    -- * Constructors+    , foldl'++    -- * Refolds+    -- ** Accumulators+    , sconcat+    , drainBy+    , iterate++    -- * Combinators+    , lmapM+    , rmapM+    , append+    , take+    )+where++import Control.Monad ((>=>))+import Fusion.Plugin.Types (Fuse(..))+import Streamly.Internal.Data.Fold.Step (Step(..), mapMStep)++import Prelude hiding (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.Stream as Stream++-- All folds in the Fold module should be implemented using Refolds.+--+-- | Like 'Fold' except that the initial state of the accmulator can be+-- generated using a dynamically supplied input. This affords better stream+-- fusion optimization in nested fold operations where the initial fold state+-- is determined based on a dynamic value.+--+-- /Internal/+data Refold m c a b =+  -- | @Fold @ @ step @ @ inject @ @ extract@+  forall s. Refold (s -> a -> m (Step s b)) (c -> m (Step s b)) (s -> m b)++------------------------------------------------------------------------------+-- Left fold constructors+------------------------------------------------------------------------------++-- | Make a consumer from a left fold style pure step function.+--+-- If your 'Fold' returns only 'Partial' (i.e. never returns a 'Done') then you+-- can use @foldl'*@ constructors.+--+-- See also: @Streamly.Data.Fold.foldl'@+--+-- /Internal/+--+{-# INLINE foldl' #-}+foldl' :: Monad m => (b -> a -> b) -> Refold m b a b+foldl' step =+    Refold+        (\s a -> return $ Partial $ step s a)+        (return . Partial)+        return++------------------------------------------------------------------------------+-- Mapping on input+------------------------------------------------------------------------------++-- | @lmapM f fold@ maps the monadic function @f@ on the input of the fold.+--+-- /Internal/+{-# INLINE lmapM #-}+lmapM :: Monad m => (a -> m b) -> Refold m c b r -> Refold m c a r+lmapM f (Refold step inject extract) = Refold step1 inject extract++    where++    step1 x a = f a >>= step x++------------------------------------------------------------------------------+-- Mapping on the output+------------------------------------------------------------------------------++-- | Map a monadic function on the output of a fold.+--+-- /Internal/+{-# INLINE rmapM #-}+rmapM :: Monad m => (b -> m c) -> Refold m x a b -> Refold m x a c+rmapM f (Refold step inject extract) = Refold step1 inject1 (extract >=> f)++    where++    inject1 x = inject x >>= mapMStep f+    step1 s a = step s a >>= mapMStep f++------------------------------------------------------------------------------+-- Refolds+------------------------------------------------------------------------------++-- |+--+-- /Internal/+{-# INLINE drainBy #-}+drainBy ::  Monad m => (c -> a -> m b) -> Refold m c a ()+drainBy f = Refold step inject extract++    where++    inject = return . Partial++    step c a = f c a >> return (Partial c)++    extract _ = return ()++------------------------------------------------------------------------------+-- Semigroup+------------------------------------------------------------------------------++-- | Append the elements of an input stream to a provided starting value.+--+-- >>> stream = fmap Data.Monoid.Sum $ Stream.enumerateFromTo 1 10+-- >>> Stream.fold (Fold.fromRefold Refold.sconcat 10) stream+-- Sum {getSum = 65}+--+-- >>> sconcat = Refold.foldl' (<>)+--+-- /Internal/+{-# INLINE sconcat #-}+sconcat :: (Monad m, Semigroup a) => Refold m a a a+sconcat = foldl' (<>)++------------------------------------------------------------------------------+-- append+------------------------------------------------------------------------------++-- | Supply the output of the first consumer as input to the second consumer.+--+-- /Internal/+{-# INLINE append #-}+append :: Monad m => Refold m x a b -> Refold m b a b -> Refold m x a b+append (Refold step1 inject1 extract1) (Refold step2 inject2 extract2) =+    Refold step inject extract++    where++    goLeft r = do+        case r of+            Partial s -> return $ Partial $ Left s+            Done b -> do+                r1 <- inject2 b+                return $ case r1 of+                    Partial s -> Partial $ Right s+                    Done b1 -> Done b1++    inject x = inject1 x >>= goLeft++    step (Left s) a = step1 s a >>= goLeft++    step (Right s) a = do+        r <- step2 s a+        case r of+            Partial s1 -> return $ Partial (Right s1)+            Done b -> return $ Done b++    extract (Left s) = extract1 s+    extract (Right s) = extract2 s++-- | Keep running the same consumer over and over again on the input, feeding+-- the output of the previous run to the next.+--+-- /Internal/+iterate :: Monad m => Refold m b a b -> Refold m b a b+iterate (Refold step1 inject1 extract1) =+    Refold step inject extract1++    where++    go r =+        case r of+            Partial s -> return $ Partial s+            Done b -> inject b++    inject x = inject1 x >>= go++    step s a = step1 s a >>= go++------------------------------------------------------------------------------+-- Transformation+------------------------------------------------------------------------------++-- 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++-- | Take at most @n@ input elements and fold them using the supplied fold. A+-- negative count is treated as 0.+--+-- /Internal/+{-# INLINE take #-}+take :: Monad m => Int -> Refold m x a b -> Refold m x a b+take n (Refold fstep finject fextract) = Refold step inject extract++    where++    inject x = do+        res <- finject x+        case res of+            Partial s ->+                if n > 0+                then return $ Partial $ Tuple'Fused 0 s+                else Done <$> fextract s+            Done b -> return $ Done b++    step (Tuple'Fused i r) a = do+        res <- fstep r a+        case res of+            Partial sres -> do+                let i1 = i + 1+                    s1 = Tuple'Fused i1 sres+                if i1 < n+                then return $ Partial s1+                else Done <$> fextract sres+            Done bres -> return $ Done bres++    extract (Tuple'Fused _ r) = fextract r
+ src/Streamly/Internal/Data/Ring.hs view
@@ -0,0 +1,164 @@+-- |+-- 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 view
@@ -0,0 +1,615 @@+-- |+-- 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/SVar/Type.hs view
@@ -0,0 +1,540 @@+-- |+-- Module      : Streamly.Internal.Data.SVar.Type+-- Copyright   : (c) 2017 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.SVar.Type+    (+    -- * Parent child communication+      ThreadAbort (..)+    , ChildEvent (..)+    , RunInIO(..)+    , AheadHeapEntry (..)++    -- * SVar+    , Count (..)+    , Limit (..)+    , SVarStyle (..)+    , SVarStopStyle (..)+    , SVarStats (..)+    , WorkerInfo (..)+    , PushBufferPolicy(..)+    , LatencyRange (..)+    , YieldRateInfo (..)+    , SVar (..)++    -- * State threaded around the stream+    , Rate (..)+    , State (streamVar)++    -- ** Default State+    , magicMaxBuffer+    , defState++    -- ** Type cast+    , adaptState++    -- ** State accessors+    , getMaxThreads+    , setMaxThreads+    , getMaxBuffer+    , setMaxBuffer+    , getStreamRate+    , setStreamRate+    , getStreamLatency+    , setStreamLatency+    , getYieldLimit+    , setYieldLimit+    , getInspectMode+    , setInspectMode+    )+where++import Control.Concurrent (ThreadId)+import Control.Concurrent.MVar (MVar)+import Control.Exception (SomeException(..), Exception)+#ifndef USE_UNLIFTIO+import Control.Monad.Trans.Control (MonadBaseControl(StM))+#endif+import Data.Heap (Heap, Entry(..))+import Data.Int (Int64)+import Data.IORef (IORef)+import Data.Kind (Type)+import Data.Set (Set)++import Streamly.Internal.Data.Time.Units (AbsTime, NanoSecond64(..))++newtype Count = Count Int64+    deriving ( Eq+             , Read+             , Show+             , Enum+             , Bounded+             , Num+             , Real+             , Integral+             , Ord+             )++------------------------------------------------------------------------------+-- Parent child thread communication type+------------------------------------------------------------------------------++data ThreadAbort = ThreadAbort deriving Show++instance Exception ThreadAbort++-- | Events that a child thread may send to a parent thread.+data ChildEvent a =+      ChildYield a+    | ChildStop ThreadId (Maybe SomeException)++#ifdef USE_UNLIFTIO+newtype RunInIO m = RunInIO { runInIO :: forall b. m b -> IO b }+#else+newtype RunInIO m = RunInIO { runInIO :: forall b. m b -> IO (StM m b) }+#endif++-- | Sorting out-of-turn outputs in a heap for Ahead style streams+data AheadHeapEntry (t :: (Type -> Type) -> Type -> Type) m a =+      AheadEntryNull+    | AheadEntryPure a+    | AheadEntryStream (RunInIO m, t m a)+#undef Type++------------------------------------------------------------------------------+-- SVar: the state for thread management+------------------------------------------------------------------------------++-- | Identify the type of the SVar. Two computations using the same style can+-- be scheduled on the same SVar.+data SVarStyle =+      AsyncVar             -- depth first concurrent+    | WAsyncVar            -- breadth first concurrent+    | ParallelVar          -- all parallel+    | AheadVar             -- Concurrent look ahead+    deriving (Eq, Show)++-- | An SVar or a Stream Var is a conduit to the output from multiple streams+-- running concurrently and asynchronously. An SVar can be thought of as an+-- asynchronous IO handle. We can write any number of streams to an SVar in a+-- non-blocking manner and then read them back at any time at any pace.  The+-- SVar would run the streams asynchronously and accumulate results. An SVar+-- may not really execute the stream completely and accumulate all the results.+-- However, it ensures that the reader can read the results at whatever paces+-- it wants to read. The SVar monitors and adapts to the consumer's pace.+--+-- An SVar is a mini scheduler, it has an associated workLoop that holds the+-- stream tasks to be picked and run by a pool of worker threads. It has an+-- associated output queue where the output stream elements are placed by the+-- worker threads. A outputDoorBell is used by the worker threads to intimate the+-- consumer thread about availability of new results in the output queue. More+-- workers are added to the SVar by 'fromStreamVar' on demand if the output+-- produced is not keeping pace with the consumer. On bounded SVars, workers+-- block on the output queue to provide throttling of the producer  when the+-- consumer is not pulling fast enough.  The number of workers may even get+-- reduced depending on the consuming pace.+--+-- New work is enqueued either at the time of creation of the SVar or as a+-- result of executing the parallel combinators i.e. '<|' and '<|>' when the+-- already enqueued computations get evaluated. See 'joinStreamVarAsync'.++-- We measure the individual worker latencies to estimate the number of workers+-- needed or the amount of time we have to sleep between dispatches to achieve+-- a particular rate when controlled pace mode it used.+data WorkerInfo = WorkerInfo+    { workerYieldMax   :: Count -- 0 means unlimited+    -- total number of yields by the worker till now+    , workerYieldCount    :: IORef Count+    -- yieldCount at start, timestamp+    , workerLatencyStart  :: IORef (Count, AbsTime)+    }++data LatencyRange = LatencyRange+    { minLatency :: NanoSecond64+    , maxLatency :: NanoSecond64+    } deriving Show++-- Rate control.+data YieldRateInfo = YieldRateInfo+    { svarLatencyTarget    :: NanoSecond64+    , svarLatencyRange     :: LatencyRange+    , svarRateBuffer       :: Int++    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- read by the worker threads+    , svarGainedLostYields :: IORef Count++    -- Actual latency/througput as seen from the consumer side, we count the+    -- yields and the time it took to generates those yields. This is used to+    -- increase or decrease the number of workers needed to achieve the desired+    -- rate. The idle time of workers is adjusted in this, so that we only+    -- account for the rate when the consumer actually demands data.+    -- XXX interval latency is enough, we can move this under diagnostics build+    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- read by the worker threads+    , svarAllTimeLatency :: IORef (Count, AbsTime)++    -- XXX Worker latency specified by the user to be used before the first+    -- actual measurement arrives. Not yet implemented+    , workerBootstrapLatency :: Maybe NanoSecond64++    -- After how many yields the worker should update the latency information.+    -- If the latency is high, this count is kept lower and vice-versa.  XXX If+    -- the latency suddenly becomes too high this count may remain too high for+    -- long time, in such cases the consumer can change it.+    -- 0 means no latency computation+    -- XXX this is derivable from workerMeasuredLatency, can be removed.+    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- read by the worker threads+    , workerPollingInterval :: IORef Count++    -- This is in progress latency stats maintained by the workers which we+    -- empty into workerCollectedLatency stats at certain intervals - whenever+    -- we process the stream elements yielded in this period. The first count+    -- is all yields, the second count is only those yields for which the+    -- latency was measured to be non-zero (note that if the timer resolution+    -- is low the measured latency may be zero e.g. on JS platform).+    -- [LOCKING] Locked access. Modified by the consumer thread as well as+    -- worker threads. Workers modify it periodically based on+    -- workerPollingInterval and not on every yield to reduce the locking+    -- overhead.+    -- (allYieldCount, yieldCount, timeTaken)+    , workerPendingLatency   :: IORef (Count, Count, NanoSecond64)++    -- This is the second level stat which is an accmulation from+    -- workerPendingLatency stats. We keep accumulating latencies in this+    -- bucket until we have stats for a sufficient period and then we reset it+    -- to start collecting for the next period and retain the computed average+    -- latency for the last period in workerMeasuredLatency.+    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- read by the worker threads+    -- (allYieldCount, yieldCount, timeTaken)+    , workerCollectedLatency :: IORef (Count, Count, NanoSecond64)++    -- Latency as measured by workers, aggregated for the last period.+    -- [LOCKING] Unlocked access. Modified by the consumer thread and unsafely+    -- read by the worker threads+    , workerMeasuredLatency :: IORef NanoSecond64+    }++data SVarStats = SVarStats {+      totalDispatches  :: IORef Int+    , maxWorkers       :: IORef Int+    , maxOutQSize      :: IORef Int+    , maxHeapSize      :: IORef Int+    , maxWorkQSize     :: IORef Int+    , avgWorkerLatency :: IORef (Count, NanoSecond64)+    , minWorkerLatency :: IORef NanoSecond64+    , maxWorkerLatency :: IORef NanoSecond64+    , svarStopTime     :: IORef (Maybe AbsTime)+}++-- This is essentially a 'Maybe Word' type+data Limit = Unlimited | Limited Word deriving Show++instance Eq Limit where+    Unlimited == Unlimited = True+    Unlimited == Limited _ = False+    Limited _ == Unlimited = False+    Limited x == Limited y = x == y++instance Ord Limit where+    Unlimited <= Unlimited = True+    Unlimited <= Limited _ = False+    Limited _ <= Unlimited = True+    Limited x <= Limited y = x <= y++-- When to stop the composed stream.+data SVarStopStyle =+      StopNone -- stops only when all streams are finished+    | StopAny  -- stop when any stream finishes+    | StopBy   -- stop when a specific stream finishes+    deriving (Eq, Show)++-- | Buffering policy for persistent push workers (in ParallelT).  In a pull+-- style SVar (in AsyncT, AheadT etc.), the consumer side dispatches workers on+-- demand, workers terminate if the buffer is full or if the consumer is not+-- cosuming fast enough.  In a push style SVar, a worker is dispatched only+-- once, workers are persistent and keep pushing work to the consumer via a+-- bounded buffer. If the buffer becomes full the worker either blocks, or it+-- can drop an item from the buffer to make space.+--+-- Pull style SVars are useful in lazy stream evaluation whereas push style+-- SVars are useful in strict left Folds.+--+-- XXX Maybe we can separate the implementation in two different types instead+-- of using a common SVar type.+--+data PushBufferPolicy =+      PushBufferDropNew  -- drop the latest element and continue+    | PushBufferDropOld  -- drop the oldest element and continue+    | PushBufferBlock    -- block the thread until space+                         -- becomes available++-- IMPORTANT NOTE: we cannot update the SVar after generating it as we have+-- references to the original SVar stored in several functions which will keep+-- pointing to the original data and the new updates won't reflect there.+-- Any updateable parts must be kept in mutable references (IORef).+--+data SVar t m a = SVar+    {+    -- Read only state+      svarStyle       :: SVarStyle+    , svarMrun        :: RunInIO m+    , svarStopStyle   :: SVarStopStyle+    , svarStopBy      :: IORef ThreadId++    -- Shared output queue (events, length)+    -- XXX For better efficiency we can try a preallocated array type (perhaps+    -- something like a vector) that allows an O(1) append. That way we will+    -- avoid constructing and reversing the list. Possibly we can also avoid+    -- the GC copying overhead. When the size increases we should be able to+    -- allocate the array in chunks.+    --+    -- [LOCKING] Frequent locked access. This is updated by workers on each+    -- yield and once in a while read by the consumer thread. This could have+    -- big locking overhead if the number of workers is high.+    --+    -- XXX We can use a per-CPU data structure to reduce the locking overhead.+    -- However, a per-cpu structure cannot guarantee the exact sequence in+    -- which the elements were added, though that may not be important.+    , outputQueue    :: IORef ([ChildEvent a], Int)++    -- [LOCKING] Infrequent MVar. Used when the outputQ transitions from empty+    -- to non-empty, or a work item is queued by a worker to the work queue and+    -- needDoorBell is set by the consumer.+    , outputDoorBell :: MVar ()  -- signal the consumer about output+    , readOutputQ    :: m [ChildEvent a]+    , postProcess    :: m Bool++    -- channel to send events from the consumer to the worker. Used to send+    -- exceptions from a fold driver to the fold computation running as a+    -- consumer thread in the concurrent fold cases. Currently only one event+    -- is sent by the fold so we do not really need a queue for it.+    , outputQueueFromConsumer :: IORef ([ChildEvent a], Int)+    , outputDoorBellFromConsumer :: MVar ()++    -- Combined/aggregate parameters+    -- This is truncated to maxBufferLimit if set to more than that. Otherwise+    -- potentially each worker may yield one value to the buffer in the worst+    -- case exceeding the requested buffer size.+    , maxWorkerLimit :: Limit+    , maxBufferLimit :: Limit+    -- These two are valid and used only when maxBufferLimit is Limited.+    , pushBufferSpace  :: IORef Count+    , pushBufferPolicy :: PushBufferPolicy+    -- [LOCKING] The consumer puts this MVar after emptying the buffer, workers+    -- block on it when the buffer becomes full. No overhead unless the buffer+    -- becomes full.+    , pushBufferMVar :: MVar ()++    -- [LOCKING] Read only access by consumer when dispatching a worker.+    -- Decremented by workers when picking work and undo decrement if the+    -- worker does not yield a value.+    , remainingWork  :: Maybe (IORef Count)+    , yieldRateInfo  :: Maybe YieldRateInfo++    -- Used only by bounded SVar types+    , enqueue        :: (RunInIO m, t m a) -> IO ()+    , isWorkDone     :: IO Bool+    , isQueueDone    :: IO Bool+    , needDoorBell   :: IORef Bool+    , workLoop       :: Maybe WorkerInfo -> m ()++    -- Shared, thread tracking+    -- [LOCKING] Updated unlocked only by consumer thread in case of+    -- Async/Ahead style SVars. Updated locked by worker threads in case of+    -- Parallel style.+    , workerThreads  :: IORef (Set ThreadId)+    -- [LOCKING] Updated locked by consumer thread when dispatching a worker+    -- and by the worker threads when the thread stops. This is read unsafely+    -- at several places where we want to rely on an approximate value.+    , workerCount    :: IORef Int+    , accountThread  :: ThreadId -> m ()+    , workerStopMVar :: MVar ()++    , svarStats      :: SVarStats+    -- to track garbage collection of SVar+    , svarRef        :: Maybe (IORef ())++    -- Only for diagnostics+    , svarInspectMode :: Bool+    , svarCreator    :: ThreadId+    , outputHeap     :: IORef ( Heap (Entry Int (AheadHeapEntry t m a))+                              , Maybe Int)+    -- Shared work queue (stream, seqNo)+    , aheadWorkQueue :: IORef ([t m a], Int)+    }++-------------------------------------------------------------------------------+-- Overall state threaded around a stream+-------------------------------------------------------------------------------++-- | Specifies the stream yield rate in yields per second (@Hertz@).+-- We keep accumulating yield credits at 'rateGoal'. At any point of time we+-- allow only as many yields as we have accumulated as per 'rateGoal' since the+-- start of time. If the consumer or the producer is slower or faster, the+-- actual rate may fall behind or exceed 'rateGoal'.  We try to recover the gap+-- between the two by increasing or decreasing the pull rate from the producer.+-- However, if the gap becomes more than 'rateBuffer' we try to recover only as+-- much as 'rateBuffer'.+--+-- 'rateLow' puts a bound on how low the instantaneous rate can go when+-- recovering the rate gap.  In other words, it determines the maximum yield+-- latency.  Similarly, 'rateHigh' puts a bound on how high the instantaneous+-- rate can go when recovering the rate gap.  In other words, it determines the+-- minimum yield latency. We reduce the latency by increasing concurrency,+-- therefore we can say that it puts an upper bound on concurrency.+--+-- If the 'rateGoal' is 0 or negative the stream never yields a value.+-- If the 'rateBuffer' is 0 or negative we do not attempt to recover.+--+-- /Since: 0.5.0 ("Streamly")/+--+-- @since 0.8.0+data Rate = Rate+    { rateLow    :: Double -- ^ The lower rate limit+    , rateGoal   :: Double -- ^ The target rate we want to achieve+    , rateHigh   :: Double -- ^ The upper rate limit+    , rateBuffer :: Int    -- ^ Maximum slack from the goal+    }++-- XXX we can put the resettable fields in a oneShotConfig field and others in+-- a persistentConfig field. That way reset would be fast and scalable+-- irrespective of the number of fields.+--+-- XXX make all these Limited types and use phantom types to distinguish them+data State t m a = State+    { -- one shot configuration, automatically reset for each API call+      streamVar   :: Maybe (SVar t m a)+    , _yieldLimit  :: Maybe Count++    -- persistent configuration, state that remains valid until changed by+    -- an explicit setting via a combinator.+    , _threadsHigh    :: Limit+    , _bufferHigh     :: Limit+    -- XXX these two can be collapsed into a single type+    , _streamLatency  :: Maybe NanoSecond64 -- bootstrap latency+    , _maxStreamRate  :: Maybe Rate+    , _inspectMode    :: Bool+    }++-------------------------------------------------------------------------------+-- State defaults and reset+-------------------------------------------------------------------------------++-- A magical value for the buffer size arrived at by running the smallest+-- possible task and measuring the optimal value of the buffer for that.  This+-- is obviously dependent on hardware, this figure is based on a 2.2GHz intel+-- core-i7 processor.+magicMaxBuffer :: Word+magicMaxBuffer = 1500++defaultMaxThreads, defaultMaxBuffer :: Limit+defaultMaxThreads = Limited magicMaxBuffer+defaultMaxBuffer = Limited magicMaxBuffer++-- The fields prefixed by an _ are not to be accessed or updated directly but+-- via smart accessor APIs.+defState :: State t m a+defState = State+    { streamVar = Nothing+    , _yieldLimit = Nothing+    , _threadsHigh = defaultMaxThreads+    , _bufferHigh = defaultMaxBuffer+    , _maxStreamRate = Nothing+    , _streamLatency = Nothing+    , _inspectMode = False+    }++-- XXX if perf gets affected we can have all the Nothing params in a single+-- structure so that we reset is fast. We can also use rewrite rules such that+-- reset occurs only in concurrent streams to reduce the impact on serial+-- streams.+-- We can optimize this so that we clear it only if it is a Just value, it+-- results in slightly better perf for zip/zipM but the performance of scan+-- worsens a lot, it does not fuse.+--+-- XXX This has a side effect of clearing the SVar and yieldLimit, therefore it+-- should not be used to convert from the same type to the same type, unless+-- you want to clear the SVar. For clearing the SVar you should be using the+-- appropriate unStream functions instead.+--+-- | Adapt the stream state from one type to another.+adaptState :: State t m a -> State t n b+adaptState st = st+    { streamVar = Nothing+    , _yieldLimit = Nothing+    }++-------------------------------------------------------------------------------+-- Smart get/set routines for State+-------------------------------------------------------------------------------++-- Use get/set routines instead of directly accessing the State fields+setYieldLimit :: Maybe Int64 -> State t m a -> State t m a+setYieldLimit lim st =+    st { _yieldLimit =+            case lim of+                Nothing -> Nothing+                Just n  ->+                    if n <= 0+                    then Just 0+                    else Just (fromIntegral n)+       }++getYieldLimit :: State t m a -> Maybe Count+getYieldLimit = _yieldLimit++setMaxThreads :: Int -> State t m a -> State t m a+setMaxThreads n st =+    st { _threadsHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxThreads+                 else Limited (fromIntegral n)+       }++getMaxThreads :: State t m a -> Limit+getMaxThreads = _threadsHigh++setMaxBuffer :: Int -> State t m a -> State t m a+setMaxBuffer n st =+    st { _bufferHigh =+            if n < 0+            then Unlimited+            else if n == 0+                 then defaultMaxBuffer+                 else Limited (fromIntegral n)+       }++getMaxBuffer :: State t m a -> Limit+getMaxBuffer = _bufferHigh++setStreamRate :: Maybe Rate -> State t m a -> State t m a+setStreamRate r st = st { _maxStreamRate = r }++getStreamRate :: State t m a -> Maybe Rate+getStreamRate = _maxStreamRate++setStreamLatency :: Int -> State t m a -> State t m a+setStreamLatency n st =+    st { _streamLatency =+            if n <= 0+            then Nothing+            else Just (fromIntegral n)+       }++getStreamLatency :: State t m a -> Maybe NanoSecond64+getStreamLatency = _streamLatency++setInspectMode :: State t m a -> State t m a+setInspectMode st = st { _inspectMode = True }++getInspectMode :: State t m a -> Bool+getInspectMode = _inspectMode
+ src/Streamly/Internal/Data/Stream.hs view
@@ -0,0 +1,14 @@+-- |+-- Module      : Streamly.Internal.Data.Stream+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Stream+    ( module Streamly.Internal.Data.Stream.StreamD+    )+where++import Streamly.Internal.Data.Stream.StreamD
+ src/Streamly/Internal/Data/Stream/Bottom.hs view
@@ -0,0 +1,670 @@+-- |+-- 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 view
@@ -0,0 +1,1215 @@+-- |+-- 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 view
@@ -0,0 +1,105 @@+{-# 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/Cross.hs view
@@ -0,0 +1,143 @@+{-# 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
@@ -0,0 +1,377 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Eliminate+-- Copyright   : (c) 2017 Composewell Technologies+-- 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@.++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++    -- * Stream Deconstruction+    -- | foldr and foldl do not provide the remaining stream.  'uncons' is more+    -- general, as it can be used to implement those as well.  It allows to use+    -- the stream one element at a time, and we have the remaining stream all+    -- the time.+    , uncons+    , init++    -- * Right Folds+    , foldrM+    , foldr++    -- * Left Folds+    -- Lazy left folds are useful only for reversing the stream+    , foldlS++    -- * Multi-Stream folds+    -- Full equivalence+    , eqBy+    , cmpBy++    -- finding subsequences+    , isPrefixOf+    , isInfixOf+    , isSuffixOf+    , isSubsequenceOf++    -- trimming sequences+    , stripPrefix+    -- , stripInfix+    , stripSuffix+    )+where++#include "inline.hs"++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 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 Prelude hiding (foldr, init, reverse)++-- $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++------------------------------------------------------------------------------+-- Deconstruction+------------------------------------------------------------------------------++-- | 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)++------------------------------------------------------------------------------+-- Left Folds+------------------------------------------------------------------------------++-- | 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+------------------------------------------------------------------------------++-- | Parse a stream using the supplied ParserD 'PRD.Parser'.+--+-- /Internal/+--+{-# INLINE_NORMAL parseD #-}+parseD :: Monad m => PRD.Parser a m b -> Stream m a -> m (Either ParseError b)+parseD p = D.parseD p . toStreamD++-- XXX Drive directly as parserK rather than converting to parserD first.++-- | Parse a stream using the supplied ParserK 'PRK.Parser'.+--+-- /Internal/+--{-# INLINE parseK #-}+--parseK :: Monad m => PRK.Parser a m b -> Stream m a -> m (Either ParseError b)+--parseK = parse++-- | 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 => Parser a m b -> Stream m a -> m (Either ParseError b)+parse = parseD++{-# 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)++-- | Parse a stream using the supplied 'Parser'.+--+-- /CPS/+--+--{-# INLINE parseBreak #-}+--parseBreak :: Monad m => Parser a m b -> Stream m a -> m (Either ParseError b, Stream m a)+--parseBreak p strm = D.parseBreak p strm++------------------------------------------------------------------------------+-- 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 isPrefixOf #-}+isPrefixOf :: (Monad m, Eq a) => Stream m a -> Stream m a -> m Bool+isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)++-- | 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 <- D.null $ D.drop 1 $ D.splitOnSeq arr Fold.drain $ toStreamD 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 = 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.++-- | @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)++-- | 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 reverse <$> stripPrefix (reverse m1) (reverse m2)
+ src/Streamly/Internal/Data/Stream/Enumerate.hs view
@@ -0,0 +1,560 @@+-- |+-- 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
@@ -0,0 +1,222 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Exception+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Exception+    (+      before+    , afterUnsafe+    , afterIO+    , bracketUnsafe+    , bracketIO+    , bracketIO3+    , onException+    , finallyUnsafe+    , finallyIO+    , ghandle+    , handle+    )+where++import Control.Exception (Exception)+import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO)+import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)++import qualified Streamly.Internal.Data.Stream.StreamD as D++-- $setup+-- >>> :m+-- >>> import qualified Streamly.Internal.Data.Stream as Stream++------------------------------------------------------------------------------+-- Exceptions+------------------------------------------------------------------------------++-- | 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 #-}+before :: Monad m => m b -> Stream m a -> Stream m a+before action xs = fromStreamD $ D.before action $ toStreamD xs++-- | 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 afterUnsafe #-}+afterUnsafe :: Monad m => m b -> Stream m a -> Stream m a+afterUnsafe action xs = fromStreamD $ D.afterUnsafe action $ toStreamD xs++-- | 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 afterIO #-}+afterIO :: MonadIO m => IO b -> Stream m a -> Stream m a+afterIO action xs = fromStreamD $ D.afterIO action $ toStreamD xs++-- | 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 onException #-}+onException :: MonadCatch m => m b -> Stream m a -> Stream m a+onException action xs = fromStreamD $ D.onException action $ toStreamD xs++-- | 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++-- | 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++-- | 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 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++-- 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 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)++-- | 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 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++-- | 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 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
+ src/Streamly/Internal/Data/Stream/Expand.hs view
@@ -0,0 +1,893 @@+-- |+-- 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
@@ -0,0 +1,460 @@+{-# 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
+ src/Streamly/Internal/Data/Stream/Lift.hs view
@@ -0,0 +1,95 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Lift+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Lift+    (+    -- * Generalize Inner Monad+      morphInner+    , generalizeInner++    -- * Transform Inner Monad+    , liftInnerWith+    , runInnerWith+    , runInnerWithState+    )+where++import Data.Functor.Identity (Identity (..))+import Streamly.Internal.Data.Stream.Type+    (Stream, fromStreamD, toStreamD, fromStreamK, toStreamK)++import qualified Streamly.Internal.Data.Stream.StreamD as D+import qualified Streamly.Internal.Data.Stream.StreamK as K++-- $setup+-- >>> :m+-- >>> import Data.Functor.Identity (runIdentity)+-- >>> import Streamly.Internal.Data.Stream as Stream++------------------------------------------------------------------------------+-- Generalize the underlying 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.+--+-- /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)++-- | Generalize the inner monad of the stream from 'Identity' to any monad.+--+-- Definition:+--+-- >>> 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+------------------------------------------------------------------------------++-- | 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)++-- | Evaluate the inner monad of a stream using the supplied runner function.+--+{-# INLINE runInnerWith #-}+runInnerWith :: (Monad m, Applicative (t m)) =>+    (forall b. t m b -> m b) -> Stream (t m) a -> Stream m a+runInnerWith run xs = fromStreamD $ D.runInnerWith run (toStreamD xs)++-- | 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))+    -> m s+    -> Stream (t m) a+    -> Stream m (s, a)+runInnerWithState run initial xs =+    fromStreamD $ D.runInnerWithState run initial (toStreamD xs)
+ src/Streamly/Internal/Data/Stream/Reduce.hs view
@@ -0,0 +1,444 @@+-- |+-- 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/StreamD.hs view
@@ -0,0 +1,42 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.StreamD+-- 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.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+    (+      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+    )+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
+ src/Streamly/Internal/Data/Stream/StreamD/Container.hs view
@@ -0,0 +1,302 @@+{-# 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 view
@@ -0,0 +1,833 @@+{-# 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 view
@@ -0,0 +1,479 @@+{-# 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 view
@@ -0,0 +1,1205 @@+{-# 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 view
@@ -0,0 +1,129 @@+{-# 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 view
@@ -0,0 +1,3111 @@+{-# 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 view
@@ -0,0 +1,39 @@+-- |+-- 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 view
@@ -0,0 +1,353 @@+{-# 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 view
@@ -0,0 +1,1945 @@+{-# 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 view
@@ -0,0 +1,182 @@+{-# 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 view
@@ -0,0 +1,2074 @@+{-# 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 view
@@ -0,0 +1,52 @@+-- |+-- 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 view
@@ -0,0 +1,1372 @@+{-# 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 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.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 view
@@ -0,0 +1,79 @@+-- |+-- 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 view
@@ -0,0 +1,2063 @@+{-# 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/Transform.hs view
@@ -0,0 +1,1056 @@+-- |+-- 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)
+ src/Streamly/Internal/Data/Stream/Transformer.hs view
@@ -0,0 +1,135 @@+-- |+-- Module      : Streamly.Internal.Data.Stream.Transformer+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Stream.Transformer+    (+      foldlT+    , foldrT++    , liftInner+    , usingReaderT+    , runReaderT+    , evalStateT+    , usingStateT+    , runStateT+    )+where++import Control.Monad.Trans.Class (MonadTrans)+import Control.Monad.Trans.Reader (ReaderT)+import Control.Monad.Trans.State.Strict (StateT)+import Streamly.Internal.Data.Stream.Type (Stream, fromStreamD, toStreamD)++import qualified Streamly.Internal.Data.Stream.StreamD.Transformer as D++-- $setup+-- >>> :m+-- >>> import Control.Monad.Trans.Class (lift)+-- >>> import Control.Monad.Trans.Identity (runIdentityT)+-- >>> import qualified Streamly.Internal.Data.Stream as Stream++-- | Lazy left fold to a transformer monad.+--+{-# INLINE 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)++-- | 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 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)++------------------------------------------------------------------------------+-- Add and remove a monad transformer+------------------------------------------------------------------------------++-- | Lift the inner monad @m@ of @Stream m a@ to @t m@ where @t@ is a monad+-- transformer.+--+{-# INLINE liftInner #-}+liftInner :: (Monad m, MonadTrans t, Monad (t m))+    => Stream m a -> Stream (t m) a+liftInner xs = fromStreamD $ D.liftInner (toStreamD xs)++------------------------------------------------------------------------------+-- Sharing read only state in a stream+------------------------------------------------------------------------------++-- | Evaluate the inner monad of a stream as 'ReaderT'.+--+{-# INLINE runReaderT #-}+runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a+runReaderT s xs = fromStreamD $ D.runReaderT s (toStreamD xs)++-- | Run a stream transformation using a given environment.+--+-- See also: 'Serial.map'+--+-- / Internal/+--+{-# 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+--+-- / Internal/+--+{-# 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)++-- | Run a stateful (StateT) stream transformation using a given state.+--+-- >>> usingStateT s f = Stream.evalStateT s . f . Stream.liftInner+--+-- 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 m a+usingStateT s f = evalStateT s . f . liftInner++-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting+-- state and value pair after each step.+--+{-# INLINE runStateT #-}+runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)+runStateT s xs = fromStreamD $ D.runStateT s (toStreamD xs)
+ src/Streamly/Internal/Data/Stream/Type.hs view
@@ -0,0 +1,491 @@+{-# 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
+ src/Streamly/Internal/Data/Stream/Zip.hs view
@@ -0,0 +1,91 @@+{-# 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/Time/Clock.hs view
@@ -0,0 +1,180 @@+-- |+-- Module      : Streamly.Internal.Data.Time.Clock+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC++module Streamly.Internal.Data.Time.Clock+    (+    -- * System clock+      Clock(..)+    , getTime++    -- * Async clock+    , asyncClock+    , readClock++    -- * Adjustable Timer+    , Timer+    , timer+    , resetTimer+    , extendTimer+    , shortenTimer+    , readTimer+    , waitTimer+    )+where++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++------------------------------------------------------------------------------+-- Async clock+------------------------------------------------------------------------------++{-# INLINE updateTimeVar #-}+updateTimeVar :: Clock -> Unboxed.IORef MicroSecond64 -> IO ()+updateTimeVar clock timeVar = do+    t <- fromAbsTime <$> getTime clock+    Unboxed.modifyIORef' timeVar (const t)++{-# INLINE updateWithDelay #-}+updateWithDelay :: RealFrac a =>+    Clock -> a -> Unboxed.IORef MicroSecond64 -> IO ()+updateWithDelay clock precision timeVar = do+    threadDelay (delayTime precision)+    updateTimeVar clock timeVar++    where++    -- Keep the minimum at least a millisecond to avoid high CPU usage+    {-# INLINE delayTime #-}+    delayTime g+        | g' >= fromIntegral (maxBound :: Int) = maxBound+        | g' < 1000 = 1000+        | otherwise = round g'++        where++        g' = g * 10 ^ (6 :: Int)++-- | @asyncClock g@ starts a clock thread that updates an IORef with current+-- time as a 64-bit value in microseconds, every 'g' seconds. The IORef can be+-- read asynchronously.  The thread exits automatically when the reference to+-- the returned 'ThreadId' is lost.+--+-- Minimum granularity of clock update is 1 ms. Higher is better for+-- performance.+--+-- CAUTION! This is safe only on a 64-bit machine. On a 32-bit machine a 64-bit+-- 'Var' cannot be read consistently without a lock while another thread is+-- writing to it.+asyncClock :: Clock -> Double -> IO (ThreadId, Unboxed.IORef MicroSecond64)+asyncClock clock g = do+    timeVar <- Unboxed.newIORef 0+    updateTimeVar clock timeVar+    tid <- forkIOManaged $ forever (updateWithDelay clock g timeVar)+    return (tid, timeVar)++{-# INLINE readClock #-}+readClock :: (ThreadId, Unboxed.IORef MicroSecond64) -> IO MicroSecond64+readClock (_, timeVar) = Unboxed.readIORef timeVar++------------------------------------------------------------------------------+-- Adjustable Timer+------------------------------------------------------------------------------++-- | Adjustable periodic timer.+data Timer = Timer ThreadId (MVar ()) (IO ())++-- Set the expiry to current time + timer period+{-# INLINE resetTimerExpiry #-}+resetTimerExpiry :: Clock -> MicroSecond64 -> Unboxed.IORef MicroSecond64 -> IO ()+resetTimerExpiry clock period timeVar = do+    t <- getTime clock+    let t1 = addToAbsTime t (toRelTime period)+    Unboxed.modifyIORef' timeVar (const (fromAbsTime t1))++{-# INLINE processTimerTick #-}+processTimerTick :: RealFrac a =>+    Clock -> a -> Unboxed.IORef MicroSecond64 -> MVar () -> IO () -> IO ()+processTimerTick clock precision timeVar mvar reset = do+    threadDelay (delayTime precision)+    t <- fromAbsTime <$> getTime clock+    expiry <- Unboxed.readIORef timeVar+    when (t >= expiry) $ do+        -- non-blocking put so that we can process multiple timers in a+        -- non-blocking manner in future.+        void $ tryPutMVar mvar ()+        reset++    where++    -- Keep the minimum at least a millisecond to avoid high CPU usage+    {-# INLINE delayTime #-}+    delayTime g+        | g' >= fromIntegral (maxBound :: Int) = maxBound+        | g' < 1000 = 1000+        | otherwise = round g'++        where++        g' = g * 10 ^ (6 :: Int)++-- XXX In future we can add a timer in a heap of timers.+--+-- | @timer clockType granularity period@ creates a timer.  The timer produces+-- timer ticks at specified time intervals that can be waited upon using+-- 'waitTimer'.  If the previous tick is not yet processed, the new tick is+-- lost.+timer :: Clock -> Double -> Double -> IO Timer+timer clock g period = do+    mvar <- newEmptyMVar+    timeVar <- Unboxed.newIORef 0+    let p = round (period * 1e6) :: Int+        p1 = fromIntegral p :: MicroSecond64+        reset = resetTimerExpiry clock p1 timeVar+        process = processTimerTick clock g timeVar mvar reset+    reset+    tid <- forkIOManaged $ forever process+    return $ Timer tid mvar reset++-- | Blocking wait for a timer tick.+{-# INLINE waitTimer #-}+waitTimer :: Timer -> IO ()+waitTimer (Timer _ mvar _) = takeMVar mvar++-- | Resets the current period.+{-# INLINE resetTimer #-}+resetTimer :: Timer -> IO ()+resetTimer (Timer _ _ reset) = reset++-- | Elongates the current period by specified amount.+--+-- /Unimplemented/+{-# INLINE extendTimer #-}+extendTimer :: Timer -> Double -> IO ()+extendTimer = undefined++-- | Shortens the current period by specified amount.+--+-- /Unimplemented/+{-# INLINE shortenTimer #-}+shortenTimer :: Timer -> Double -> IO ()+shortenTimer = undefined++-- | Show the remaining time in the current time period.+--+-- /Unimplemented/+{-# INLINE readTimer #-}+readTimer :: Timer -> IO Double+readTimer = undefined
+ src/Streamly/Internal/Data/Time/Clock/Darwin.c view
@@ -0,0 +1,36 @@+/*+ * Code taken from the Haskell "clock" package.+ *+ * Copyright (c) 2009-2012, Cetin Sert+ * Copyright (c) 2010, Eugene Kirpichov+ *+ * OS X code was contributed by Gerolf Seitz on 2013-10-15.+ */++#ifdef __MACH__+#include <time.h>+#include <mach/clock.h>+#include <mach/mach.h>++void clock_gettime_darwin(clock_id_t clock, struct timespec *ts)+{+    clock_serv_t cclock;+    mach_timespec_t mts;+    host_get_clock_service(mach_host_self(), clock, &cclock);+    clock_get_time(cclock, &mts);+    mach_port_deallocate(mach_task_self(), cclock);+    ts->tv_sec = mts.tv_sec;+    ts->tv_nsec = mts.tv_nsec;+}++void clock_getres_darwin(clock_id_t clock, struct timespec *ts)+{+    clock_serv_t cclock;+    int nsecs;+    mach_msg_type_number_t count;+    host_get_clock_service(mach_host_self(), clock, &cclock);+    clock_get_attributes(cclock, CLOCK_GET_TIME_RES, (clock_attr_t)&nsecs, &count);+    mach_port_deallocate(mach_task_self(), cclock);+}++#endif  /* __MACH__ */
+ src/Streamly/Internal/Data/Time/Clock/Type.hsc view
@@ -0,0 +1,252 @@+{-# OPTIONS_GHC -Wno-identities          #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++#ifndef __GHCJS__+#include "config.h"+#endif++#include "Streamly/Internal/Data/Time/Clock/config-clock.h"++-- |+-- Module      : Streamly.Internal.Data.Time.Clock.Type+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2009-2012, Cetin Sert+--               (c) 2010, Eugene Kirpichov+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- A majority of the code below has been stolen from the "clock" package.++module Streamly.Internal.Data.Time.Clock.Type+    (+    -- * get time from the system clock+      Clock(..)+    , getTime+    )+where++import Data.Int (Int32, Int64)+import Data.Typeable (Typeable)+import Data.Word (Word32)+import Foreign.C (CInt(..), throwErrnoIfMinus1_, CTime(..), CLong(..))+import Foreign.Marshal.Alloc (alloca)+import Foreign.Ptr (Ptr)+import Foreign.Storable (Storable(..), peek)+import GHC.Generics (Generic)++import Streamly.Internal.Data.Time.Units (TimeSpec(..), AbsTime(..))++-------------------------------------------------------------------------------+-- Clock Types+-------------------------------------------------------------------------------++#if HS_CLOCK_POSIX+#include <time.h>++#if defined(CLOCK_MONOTONIC_RAW)+#define HAVE_CLOCK_MONOTONIC_RAW+#endif++-- XXX this may be RAW on apple not RAW on linux+#if __linux__ && defined(CLOCK_MONOTONIC_COARSE)+#define HAVE_CLOCK_MONOTONIC_COARSE+#endif++#if __APPLE__ && defined(CLOCK_MONOTONIC_RAW_APPROX)+#define HAVE_CLOCK_MONOTONIC_COARSE+#endif++#if __linux__ && defined(CLOCK_BOOTTIME)+#define HAVE_CLOCK_MONOTONIC_UPTIME+#endif++#if __APPLE__ && defined(CLOCK_UPTIME_RAW)+#define HAVE_CLOCK_MONOTONIC_UPTIME+#endif++#if __linux__ && defined(CLOCK_REALTIME_COARSE)+#define HAVE_CLOCK_REALTIME_COARSE+#endif++#endif++-- | Clock types. A clock may be system-wide (that is, visible to all processes)+--   or per-process (measuring time that is meaningful only within a process).+--   All implementations shall support CLOCK_REALTIME. (The only suspend-aware+--   monotonic is CLOCK_BOOTTIME on Linux.)+data Clock++    -- | The identifier for the system-wide monotonic clock, which is defined as+    --   a clock measuring real time, whose value cannot be set via+    --   @clock_settime@ and which cannot have negative clock jumps. The maximum+    --   possible clock jump shall be implementation defined. For this clock,+    --   the value returned by 'getTime' represents the amount of time (in+    --   seconds and nanoseconds) since an unspecified point in the past (for+    --   example, system start-up time, or the Epoch). This point does not+    --   change after system start-up time. Note that the absolute value of the+    --   monotonic clock is meaningless (because its origin is arbitrary), and+    --   thus there is no need to set it. Furthermore, realtime applications can+    --   rely on the fact that the value of this clock is never set.+  = Monotonic++    -- | The identifier of the system-wide clock measuring real time. For this+    --   clock, the value returned by 'getTime' represents the amount of time (in+    --   seconds and nanoseconds) since the Epoch.+  | Realtime++#ifndef HS_CLOCK_GHCJS+    -- | The identifier of the CPU-time clock associated with the calling+    --   process. For this clock, the value returned by 'getTime' represents the+    --   amount of execution time of the current process.+  | ProcessCPUTime++    -- | The identifier of the CPU-time clock associated with the calling OS+    --   thread. For this clock, the value returned by 'getTime' represents the+    --   amount of execution time of the current OS thread.+  | ThreadCPUTime+#endif++#if defined (HAVE_CLOCK_MONOTONIC_RAW)+    -- | (since Linux 2.6.28; Linux and Mac OSX)+    --   Similar to CLOCK_MONOTONIC, but provides access to a+    --   raw hardware-based time that is not subject to NTP+    --   adjustments or the incremental adjustments performed by+    --   adjtime(3).+  | MonotonicRaw+#endif++#if defined (HAVE_CLOCK_MONOTONIC_COARSE)+    -- | (since Linux 2.6.32; Linux and Mac OSX)+    --   A faster but less precise version of CLOCK_MONOTONIC.+    --   Use when you need very fast, but not fine-grained timestamps.+  | MonotonicCoarse+#endif++#if defined (HAVE_CLOCK_MONOTONIC_UPTIME)+    -- | (since Linux 2.6.39; Linux and Mac OSX)+    --   Identical to CLOCK_MONOTONIC, except it also includes+    --   any time that the system is suspended.  This allows+    --   applications to get a suspend-aware monotonic clock+    --   without having to deal with the complications of+    --   CLOCK_REALTIME, which may have discontinuities if the+    --   time is changed using settimeofday(2).+  | Uptime+#endif++#if defined (HAVE_CLOCK_REALTIME_COARSE)+    -- | (since Linux 2.6.32; Linux-specific)+    --   A faster but less precise version of CLOCK_REALTIME.+    --   Use when you need very fast, but not fine-grained timestamps.+  | RealtimeCoarse+#endif++  deriving (Eq, Enum, Generic, Read, Show)++-------------------------------------------------------------------------------+-- Translate the Haskell "Clock" type to C+-------------------------------------------------------------------------------++#if HS_CLOCK_POSIX+-- Posix systems (Linux and Mac OSX 10.12 and later)+clockToPosixClockId :: Clock -> #{type clockid_t}+clockToPosixClockId Monotonic      = #const CLOCK_MONOTONIC+clockToPosixClockId Realtime       = #const CLOCK_REALTIME+clockToPosixClockId ProcessCPUTime = #const CLOCK_PROCESS_CPUTIME_ID+clockToPosixClockId ThreadCPUTime  = #const CLOCK_THREAD_CPUTIME_ID++#if defined(CLOCK_MONOTONIC_RAW)+clockToPosixClockId MonotonicRaw = #const CLOCK_MONOTONIC_RAW+#endif++#if __linux__ && defined (CLOCK_MONOTONIC_COARSE)+clockToPosixClockId MonotonicCoarse = #const CLOCK_MONOTONIC_COARSE+#elif __APPLE__ && defined(CLOCK_MONOTONIC_RAW_APPROX)+clockToPosixClockId MonotonicCoarse = #const CLOCK_MONOTONIC_RAW_APPROX+#endif++#if __linux__ && defined (CLOCK_REALTIME_COARSE)+clockToPosixClockId RealtimeCoarse = #const CLOCK_REALTIME_COARSE+#endif++#if __linux__ && defined(CLOCK_BOOTTIME)+clockToPosixClockId Uptime = #const CLOCK_BOOTTIME+#elif __APPLE__ && defined(CLOCK_UPTIME_RAW)+clockToPosixClockId Uptime = #const CLOCK_UPTIME_RAW+#endif++#elif HS_CLOCK_OSX+-- Mac OSX versions prior to 10.12+#include <time.h>+#include <mach/clock.h>++clockToOSXClockId :: Clock -> #{type clock_id_t}+clockToOSXClockId Monotonic      = #const SYSTEM_CLOCK+clockToOSXClockId Realtime       = #const CALENDAR_CLOCK+clockToOSXClockId ProcessCPUTime = #const SYSTEM_CLOCK+clockToOSXClockId ThreadCPUTime  = #const SYSTEM_CLOCK+#elif HS_CLOCK_GHCJS+-- XXX need to implement a monotonic clock for JS using performance.now()+clockToJSClockId :: Clock -> CInt+clockToJSClockId Monotonic      = 0+clockToJSClockId Realtime       = 0+#endif++-------------------------------------------------------------------------------+-- Clock time+-------------------------------------------------------------------------------++{-# INLINE getTimeWith #-}+getTimeWith :: (Ptr TimeSpec -> IO ()) -> IO AbsTime+getTimeWith f = do+    t <- alloca (\ptr -> f ptr >> peek ptr)+    return $ AbsTime t++#if HS_CLOCK_GHCJS++foreign import ccall unsafe "time.h clock_gettime_js"+    clock_gettime_js :: CInt -> Ptr TimeSpec -> IO CInt++{-# INLINABLE getTime #-}+getTime :: Clock -> IO AbsTime+getTime clock =+    getTimeWith (throwErrnoIfMinus1_ "clock_gettime" .+        clock_gettime_js (clockToJSClockId clock))++#elif HS_CLOCK_POSIX++foreign import ccall unsafe "time.h clock_gettime"+    clock_gettime :: #{type clockid_t} -> Ptr TimeSpec -> IO CInt++{-# INLINABLE getTime #-}+getTime :: Clock -> IO AbsTime+getTime clock =+    getTimeWith (throwErrnoIfMinus1_ "clock_gettime" .+        clock_gettime (clockToPosixClockId clock))++#elif HS_CLOCK_OSX++-- XXX perform error checks inside c implementation+foreign import ccall+    clock_gettime_darwin :: #{type clock_id_t} -> Ptr TimeSpec -> IO ()++{-# INLINABLE getTime #-}+getTime :: Clock -> IO AbsTime+getTime clock = getTimeWith $ clock_gettime_darwin (clockToOSXClockId clock)++#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 ()++{-# INLINABLE getTime #-}+getTime :: Clock -> IO AbsTime+getTime Monotonic = getTimeWith $ clock_gettime_win32_monotonic+getTime Realtime = getTimeWith $ clock_gettime_win32_realtime+getTime ProcessCPUTime = getTimeWith $ clock_gettime_win32_processtime+getTime ThreadCPUTime = getTimeWith $ clock_gettime_win32_threadtime+#endif
+ src/Streamly/Internal/Data/Time/Clock/Windows.c view
@@ -0,0 +1,115 @@+/*+ * Code taken from the Haskell "clock" package.+ *+ * Copyright (c) 2009-2012, Cetin Sert+ * Copyright (c) 2010, Eugene Kirpichov+ */++#ifdef _WIN32+#include <windows.h>++#if defined(_MSC_VER) || defined(_MSC_EXTENSIONS)+  #define U64(x) x##Ui64+#else+  #define U64(x) x##ULL+#endif++#define DELTA_EPOCH_IN_100NS  U64(116444736000000000)++static long ticks_to_nanos(LONGLONG subsecond_time, LONGLONG frequency)+{+    return (long)((1e9 * subsecond_time) / frequency);+}++static ULONGLONG to_quad_100ns(FILETIME ft)+{+    ULARGE_INTEGER li;+    li.LowPart = ft.dwLowDateTime;+    li.HighPart = ft.dwHighDateTime;+    return li.QuadPart;+}++static void to_timespec_from_100ns(ULONGLONG t_100ns, long long *t)+{+    t[0] = (long)(t_100ns / 10000000UL);+    t[1] = 100*(long)(t_100ns % 10000000UL);+}++void clock_gettime_win32_monotonic(long long* t)+{+   LARGE_INTEGER time;+   LARGE_INTEGER frequency;+   QueryPerformanceCounter(&time);+   QueryPerformanceFrequency(&frequency);+   // seconds+   t[0] = time.QuadPart / frequency.QuadPart;+   // nanos =+   t[1] = ticks_to_nanos(time.QuadPart % frequency.QuadPart, frequency.QuadPart);+}++void clock_gettime_win32_realtime(long long* t)+{+    FILETIME ft;+    ULONGLONG tmp;++    GetSystemTimeAsFileTime(&ft);++    tmp = to_quad_100ns(ft);+    tmp -= DELTA_EPOCH_IN_100NS;++    to_timespec_from_100ns(tmp, t);+}++void clock_gettime_win32_processtime(long long* t)+{+    FILETIME creation_time, exit_time, kernel_time, user_time;+    ULONGLONG time;++    GetProcessTimes(GetCurrentProcess(), &creation_time, &exit_time, &kernel_time, &user_time);+    // Both kernel and user, acc. to http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_117++    time = to_quad_100ns(user_time) + to_quad_100ns(kernel_time);+    to_timespec_from_100ns(time, t);+}++void clock_gettime_win32_threadtime(long long* t)+{+    FILETIME creation_time, exit_time, kernel_time, user_time;+    ULONGLONG time;++    GetThreadTimes(GetCurrentThread(), &creation_time, &exit_time, &kernel_time, &user_time);+    // Both kernel and user, acc. to http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap03.html#tag_03_117++    time = to_quad_100ns(user_time) + to_quad_100ns(kernel_time);+    to_timespec_from_100ns(time, t);+}++void clock_getres_win32_monotonic(long long* t)+{+    LARGE_INTEGER frequency;+    QueryPerformanceFrequency(&frequency);++    ULONGLONG resolution = U64(1000000000)/frequency.QuadPart;+    t[0] = resolution / U64(1000000000);+    t[1] = resolution % U64(1000000000);+}++void clock_getres_win32_realtime(long long* t)+{+    t[0] = 0;+    t[1] = 100;+}++void clock_getres_win32_processtime(long long* t)+{+    t[0] = 0;+    t[1] = 100;+}++void clock_getres_win32_threadtime(long long* t)+{+    t[0] = 0;+    t[1] = 100;+}++#endif  /* _WIN32 */
+ src/Streamly/Internal/Data/Time/Clock/config-clock.h view
@@ -0,0 +1,11 @@+#if __GHCJS__+#define HS_CLOCK_GHCJS 1+#elif defined(_WIN32)+#define HS_CLOCK_WINDOWS 1+#elif HAVE_TIME_H && HAVE_CLOCK_GETTIME+#define HS_CLOCK_POSIX 1+#elif __APPLE__+#define HS_CLOCK_OSX 1+#else+#error "Time/Clock functionality not implemented for this system"+#endif
+ src/Streamly/Internal/Data/Time/TimeSpec.hsc view
@@ -0,0 +1,152 @@+{-# OPTIONS_GHC -Wno-identities          #-}++#ifndef __GHCJS__+#include "config.h"+#endif++#include "Streamly/Internal/Data/Time/Clock/config-clock.h"++#include "MachDeps.h"++-- |+-- Module      : Streamly.Internal.Data.Time.TimeSpec+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++module Streamly.Internal.Data.Time.TimeSpec+    (+      TimeSpec(..)+    )+where++import Data.Int (Int64)+#if (WORD_SIZE_IN_BITS == 32)+import Data.Int (Int32)+#endif+import Foreign.Storable (Storable(..), peek)++#ifdef HS_CLOCK_GHCJS+import Foreign.C (CTime(..), CLong(..))+#endif++-------------------------------------------------------------------------------+-- Some constants+-------------------------------------------------------------------------------++{-# INLINE tenPower9 #-}+tenPower9 :: Int64+tenPower9 = 1000000000++-------------------------------------------------------------------------------+-- TimeSpec representation+-------------------------------------------------------------------------------++-- A structure storing seconds and nanoseconds as 'Int64' is the simplest and+-- fastest way to store practically large quantities of time with efficient+-- arithmetic operations. If we store nanoseconds using 'Integer' it can store+-- practically unbounded quantities but it may not be as efficient to+-- manipulate in performance critical applications. XXX need to measure the+-- performance.+--+-- | Data type to represent practically large quantities of time efficiently.+-- It can represent time up to ~292 billion years at nanosecond resolution.+data TimeSpec = TimeSpec+  { sec  :: {-# UNPACK #-} !Int64 -- ^ seconds+  , nsec :: {-# UNPACK #-} !Int64 -- ^ nanoseconds+  } deriving (Eq, Read, Show)++-- We assume that nsec is always less than 10^9. When TimeSpec is negative then+-- both sec and nsec are negative.+instance Ord TimeSpec where+    compare (TimeSpec s1 ns1) (TimeSpec s2 ns2) =+        if s1 == s2+        then compare ns1 ns2+        else compare s1 s2++-- make sure nsec is less than 10^9+{-# INLINE addWithOverflow #-}+addWithOverflow :: TimeSpec -> TimeSpec -> TimeSpec+addWithOverflow (TimeSpec s1 ns1) (TimeSpec s2 ns2) =+    let nsum = ns1 + ns2+        (s', ns) = if nsum > tenPower9 || nsum < negate tenPower9+                    then nsum `divMod` tenPower9+                    else (0, nsum)+    in TimeSpec (s1 + s2 + s') ns++-- make sure both sec and nsec have the same sign+{-# INLINE adjustSign #-}+adjustSign :: TimeSpec -> TimeSpec+adjustSign t@(TimeSpec s ns)+    | s > 0 && ns < 0 = TimeSpec (s - 1) (ns + tenPower9)+    | s < 0 && ns > 0 = TimeSpec (s + 1) (ns - tenPower9)+    | otherwise = t++{-# INLINE timeSpecToInteger #-}+timeSpecToInteger :: TimeSpec -> Integer+timeSpecToInteger (TimeSpec s ns) = toInteger $ s * tenPower9 + ns++instance Num TimeSpec where+    {-# INLINE (+) #-}+    t1 + t2 = adjustSign (addWithOverflow t1 t2)++    -- XXX will this be more optimal if imlemented without "negate"?+    {-# INLINE (-) #-}+    t1 - t2 = t1 + negate t2+    t1 * t2 = fromInteger $ timeSpecToInteger t1 * timeSpecToInteger t2++    {-# INLINE negate #-}+    negate (TimeSpec s ns) = TimeSpec (negate s) (negate ns)+    {-# INLINE abs #-}+    abs    (TimeSpec s ns) = TimeSpec (abs s) (abs ns)+    {-# INLINE signum #-}+    signum (TimeSpec s ns) | s == 0    = TimeSpec (signum ns) 0+                           | otherwise = TimeSpec (signum s) 0+    -- This is fromNanoSecond64 Integer+    {-# INLINE fromInteger #-}+    fromInteger nanosec = TimeSpec (fromInteger s) (fromInteger ns)+        where (s, ns) = nanosec `divMod` toInteger tenPower9++#if HS_CLOCK_POSIX+#include <time.h>+#endif++#ifdef HS_CLOCK_GHCJS+instance Storable TimeSpec where+  sizeOf _ = 8+  alignment _ = 4+  peek p = do+    CTime  s <- peekByteOff p 0+    CLong ns <- peekByteOff p 4+    return (TimeSpec (fromIntegral s) (fromIntegral ns))+  poke p (TimeSpec s ns) = do+    pokeByteOff p 0 ((fromIntegral s) :: CTime)+    pokeByteOff p 4 ((fromIntegral ns) :: CLong)++#elif HS_CLOCK_WINDOWS+instance Storable TimeSpec where+  sizeOf _ = sizeOf (undefined :: Int64) * 2+  alignment _ = alignment (undefined :: Int64)+  peek ptr = do+    s <- peekByteOff ptr 0+    ns <- peekByteOff ptr (sizeOf (undefined :: Int64))+    return (TimeSpec s ns)+  poke ptr ts = do+      pokeByteOff ptr 0 (sec ts)+      pokeByteOff ptr (sizeOf (undefined :: Int64)) (nsec ts)+#else+instance Storable TimeSpec where+  sizeOf _ = #{size struct timespec}+  alignment _ = #{alignment struct timespec}+  peek ptr = do+      s :: #{type time_t} <- #{peek struct timespec, tv_sec} ptr+      ns :: #{type long} <- #{peek struct timespec, tv_nsec} ptr+      return $ TimeSpec (fromIntegral s) (fromIntegral ns)+  poke ptr ts = do+      let s :: #{type time_t} = fromIntegral $ sec ts+          ns :: #{type long} = fromIntegral $ nsec ts+      #{poke struct timespec, tv_sec} ptr (s)+      #{poke struct timespec, tv_nsec} ptr (ns)+#endif
+ src/Streamly/Internal/Data/Time/Units.hs view
@@ -0,0 +1,414 @@+{-# LANGUAGE TypeInType #-}+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module      : Streamly.Internal.Data.Time.Units+-- Copyright   : (c) 2019 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC++module Streamly.Internal.Data.Time.Units+    (+    -- * Time Unit Conversions+      TimeUnit()+    -- , TimeUnitWide()+    , TimeUnit64()++    -- * Time Units+    , TimeSpec(..)+    , NanoSecond64(..)+    , MicroSecond64(..)+    , MilliSecond64(..)+    , showNanoSecond64++    -- * Absolute times (using TimeSpec)+    , AbsTime(..)+    , toAbsTime+    , fromAbsTime++    -- * Relative times (using TimeSpec)+    , RelTime+    , toRelTime+    , fromRelTime+    , diffAbsTime+    , addToAbsTime++    -- * Relative times (using NanoSecond64)+    , RelTime64+    , toRelTime64+    , fromRelTime64+    , diffAbsTime64+    , addToAbsTime64+    , showRelTime64+    )+where++#include "inline.hs"++import Text.Printf (printf)++import Data.Int+import Foreign.Storable (Storable)+import Streamly.Internal.Data.Unboxed (Unbox)+import Streamly.Internal.Data.Time.TimeSpec++-------------------------------------------------------------------------------+-- Some constants+-------------------------------------------------------------------------------++{-# INLINE tenPower3 #-}+tenPower3 :: Int64+tenPower3 = 1000++{-# INLINE tenPower6 #-}+tenPower6 :: Int64+tenPower6 = 1000000++{-# INLINE tenPower9 #-}+tenPower9 :: Int64+tenPower9 = 1000000000+++-------------------------------------------------------------------------------+-- Time Unit Representations+-------------------------------------------------------------------------------++-- XXX We should be able to use type families to use different represenations+-- for a unit.+--+-- Second Rational+-- Second Double+-- Second Int64+-- Second Integer+-- NanoSecond Int64+-- ...++-- Double or Fixed would be a much better representation so that we do not lose+-- information between conversions. However, for faster arithmetic operations+-- we use an 'Int64' here. When we need convservation of values we can use a+-- different system of units with a Fixed precision.++-------------------------------------------------------------------------------+-- Integral Units+-------------------------------------------------------------------------------++-- | An 'Int64' time representation with a nanosecond resolution. It can+-- represent time up to ~292 years.+newtype NanoSecond64 = NanoSecond64 Int64+    deriving ( Eq+             , Read+             , Show+             , Enum+             , Bounded+             , Num+             , Real+             , Integral+             , Ord+             , Storable+             , Unbox+             )++-- | An 'Int64' time representation with a microsecond resolution.+-- It can represent time up to ~292,000 years.+newtype MicroSecond64 = MicroSecond64 Int64+    deriving ( Eq+             , Read+             , Show+             , Enum+             , Bounded+             , Num+             , Real+             , Integral+             , Ord+             , Storable+             , Unbox+             )++-- | An 'Int64' time representation with a millisecond resolution.+-- It can represent time up to ~292 million years.+newtype MilliSecond64 = MilliSecond64 Int64+    deriving ( Eq+             , Read+             , Show+             , Enum+             , Bounded+             , Num+             , Real+             , Integral+             , Ord+             , Storable+             , Unbox+             )++-------------------------------------------------------------------------------+-- Fractional Units+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Time unit conversions+-------------------------------------------------------------------------------++-- TODO: compare whether using TimeSpec instead of Integer provides significant+-- performance boost. If not then we can just use Integer nanoseconds and get+-- rid of TimeUnitWide.+--+-- | A type class for converting between time units using 'Integer' as the+-- intermediate and the widest representation with a nanosecond resolution.+-- This system of units can represent arbitrarily large times but provides+-- least efficient arithmetic operations due to 'Integer' arithmetic.+--+-- NOTE: Converting to and from units may truncate the value depending on the+-- original value and the size and resolution of the destination unit.+{-+class TimeUnitWide a where+    toTimeInteger   :: a -> Integer+    fromTimeInteger :: Integer -> a+-}++-- | A type class for converting between units of time using 'TimeSpec' as the+-- intermediate representation.  This system of units can represent up to ~292+-- billion years at nanosecond resolution with reasonably efficient arithmetic+-- operations.+--+-- NOTE: Converting to and from units may truncate the value depending on the+-- original value and the size and resolution of the destination unit.+class TimeUnit a where+    toTimeSpec   :: a -> TimeSpec+    fromTimeSpec :: TimeSpec -> a++-- XXX we can use a fromNanoSecond64 for conversion with overflow check and+-- fromNanoSecond64Unsafe for conversion without overflow check.+--+-- | A type class for converting between units of time using 'Int64' as the+-- intermediate representation with a nanosecond resolution.  This system of+-- units can represent up to ~292 years at nanosecond resolution with fast+-- arithmetic operations.+--+-- NOTE: Converting to and from units may truncate the value depending on the+-- original value and the size and resolution of the destination unit.+class TimeUnit64 a where+    toNanoSecond64   :: a -> NanoSecond64+    fromNanoSecond64 :: NanoSecond64 -> a++-------------------------------------------------------------------------------+-- Time units+-------------------------------------------------------------------------------++instance TimeUnit TimeSpec where+    toTimeSpec = id+    fromTimeSpec = id++instance TimeUnit NanoSecond64 where+    {-# INLINE toTimeSpec #-}+    toTimeSpec (NanoSecond64 t) = TimeSpec s ns+        where (s, ns) = t `divMod` tenPower9++    {-# INLINE fromTimeSpec #-}+    fromTimeSpec (TimeSpec s ns) =+        NanoSecond64 $ s * tenPower9 + ns++instance TimeUnit64 NanoSecond64 where+    {-# INLINE toNanoSecond64 #-}+    toNanoSecond64 = id++    {-# INLINE fromNanoSecond64 #-}+    fromNanoSecond64 = id++instance TimeUnit MicroSecond64 where+    {-# INLINE toTimeSpec #-}+    toTimeSpec (MicroSecond64 t) = TimeSpec s (us * tenPower3)+        where (s, us) = t `divMod` tenPower6++    {-# INLINE fromTimeSpec #-}+    fromTimeSpec (TimeSpec s ns) =+        -- XXX round ns to nearest microsecond?+        MicroSecond64 $ s * tenPower6 + (ns `div` tenPower3)++instance TimeUnit64 MicroSecond64 where+    {-# INLINE toNanoSecond64 #-}+    toNanoSecond64 (MicroSecond64 us) = NanoSecond64 $ us * tenPower3++    {-# INLINE fromNanoSecond64 #-}+    -- XXX round ns to nearest microsecond?+    fromNanoSecond64 (NanoSecond64 ns) = MicroSecond64 $ ns `div` tenPower3++instance TimeUnit MilliSecond64 where+    {-# INLINE toTimeSpec #-}+    toTimeSpec (MilliSecond64 t) = TimeSpec s (ms * tenPower6)+        where (s, ms) = t `divMod` tenPower3++    {-# INLINE fromTimeSpec #-}+    fromTimeSpec (TimeSpec s ns) =+        -- XXX round ns to nearest millisecond?+        MilliSecond64 $ s * tenPower3 + (ns `div` tenPower6)++instance TimeUnit64 MilliSecond64 where+    {-# INLINE toNanoSecond64 #-}+    toNanoSecond64 (MilliSecond64 ms) = NanoSecond64 $ ms * tenPower6++    {-# INLINE fromNanoSecond64 #-}+    -- XXX round ns to nearest millisecond?+    fromNanoSecond64 (NanoSecond64 ns) = MilliSecond64 $ ns `div` tenPower6++-------------------------------------------------------------------------------+-- Absolute time+-------------------------------------------------------------------------------++-- | Absolute times are relative to a predefined epoch in time. 'AbsTime'+-- represents times using 'TimeSpec' which can represent times up to ~292+-- billion years at a nanosecond resolution.+newtype AbsTime = AbsTime TimeSpec+    deriving (Eq, Ord, Show)++-- | Convert a 'TimeUnit' to an absolute time.+{-# INLINE_NORMAL toAbsTime #-}+toAbsTime :: TimeUnit a => a -> AbsTime+toAbsTime = AbsTime . toTimeSpec++-- | Convert absolute time to a 'TimeUnit'.+{-# INLINE_NORMAL fromAbsTime #-}+fromAbsTime :: TimeUnit a => AbsTime -> a+fromAbsTime (AbsTime t) = fromTimeSpec t++-- XXX We can also write rewrite rules to simplify divisions multiplications+-- and additions when manipulating units. Though, that might get simplified at+-- the assembly (llvm) level as well. Note to/from conversions may be lossy and+-- therefore this equation may not hold, but that's ok.+{-# RULES "fromAbsTime/toAbsTime" forall a. toAbsTime (fromAbsTime a) = a #-}+{-# RULES "toAbsTime/fromAbsTime" forall a. fromAbsTime (toAbsTime a) = a #-}++-------------------------------------------------------------------------------+-- Relative time using NaonoSecond64 as the underlying representation+-------------------------------------------------------------------------------++-- We use a separate type to represent relative time for safety and speed.+-- RelTime has a Num instance, absolute time doesn't.  Relative times are+-- usually shorter and for our purposes an Int64 nanoseconds can hold close to+-- thousand year duration. It is also faster to manipulate. We do not check for+-- overflows during manipulations so use it only when you know the time cannot+-- be too big. If you need a bigger RelTime representation then use RelTimeBig.++-- | Relative times are relative to some arbitrary point of time. Unlike+-- 'AbsTime' they are not relative to a predefined epoch.+newtype RelTime64 = RelTime64 NanoSecond64+    deriving ( Eq+             , Read+             , Show+             , Enum+             , Bounded+             , Num+             , Real+             , Integral+             , Ord+             )++-- | Convert a 'TimeUnit' to a relative time.+{-# INLINE_NORMAL toRelTime64 #-}+toRelTime64 :: TimeUnit64 a => a -> RelTime64+toRelTime64 = RelTime64 . toNanoSecond64++-- | Convert relative time to a 'TimeUnit'.+{-# INLINE_NORMAL fromRelTime64 #-}+fromRelTime64 :: TimeUnit64 a => RelTime64 -> a+fromRelTime64 (RelTime64 t) = fromNanoSecond64 t++{-# RULES "fromRelTime64/toRelTime64" forall a .+          toRelTime64 (fromRelTime64 a) = a #-}++{-# RULES "toRelTime64/fromRelTime64" forall a .+          fromRelTime64 (toRelTime64 a) = a #-}++-- | Difference between two absolute points of time.+{-# INLINE diffAbsTime64 #-}+diffAbsTime64 :: AbsTime -> AbsTime -> RelTime64+diffAbsTime64 (AbsTime (TimeSpec s1 ns1)) (AbsTime (TimeSpec s2 ns2)) =+    RelTime64 $ NanoSecond64 $ ((s1 - s2) * tenPower9) + (ns1 - ns2)++{-# INLINE addToAbsTime64 #-}+addToAbsTime64 :: AbsTime -> RelTime64 -> AbsTime+addToAbsTime64 (AbsTime (TimeSpec s1 ns1)) (RelTime64 (NanoSecond64 ns2)) =+    AbsTime $ TimeSpec (s1 + s) ns+    where (s, ns) = (ns1 + ns2) `divMod` tenPower9++-------------------------------------------------------------------------------+-- Relative time using TimeSpec as the underlying representation+-------------------------------------------------------------------------------++newtype RelTime = RelTime TimeSpec+    deriving ( Eq+             , Read+             , Show+             -- , Enum+             -- , Bounded+             , Num+             -- , Real+             -- , Integral+             , Ord+             )++{-# INLINE_NORMAL toRelTime #-}+toRelTime :: TimeUnit a => a -> RelTime+toRelTime = RelTime . toTimeSpec++{-# INLINE_NORMAL fromRelTime #-}+fromRelTime :: TimeUnit a => RelTime -> a+fromRelTime (RelTime t) = fromTimeSpec t++{-# RULES "fromRelTime/toRelTime" forall a. toRelTime (fromRelTime a) = a #-}+{-# RULES "toRelTime/fromRelTime" forall a. fromRelTime (toRelTime a) = a #-}++-- XXX rename to diffAbsTimes?+{-# INLINE diffAbsTime #-}+diffAbsTime :: AbsTime -> AbsTime -> RelTime+diffAbsTime (AbsTime t1) (AbsTime t2) = RelTime (t1 - t2)++{-# INLINE addToAbsTime #-}+addToAbsTime :: AbsTime -> RelTime -> AbsTime+addToAbsTime (AbsTime t1) (RelTime t2) = AbsTime $ t1 + t2++-------------------------------------------------------------------------------+-- Formatting and printing+-------------------------------------------------------------------------------++-- | Convert nanoseconds to a string showing time in an appropriate unit.+showNanoSecond64 :: NanoSecond64 -> String+showNanoSecond64 time@(NanoSecond64 ns)+    | time < 0    = '-' : showNanoSecond64 (-time)+    | ns < 1000 = fromIntegral ns `with` "ns"+#ifdef mingw32_HOST_OS+    | ns < 1000000 = (fromIntegral ns / 1000) `with` "us"+#else+    | ns < 1000000 = (fromIntegral ns / 1000) `with` "μs"+#endif+    | ns < 1000000000 = (fromIntegral ns / 1000000) `with` "ms"+    | ns < (60 * 1000000000) = (fromIntegral ns / 1000000000) `with` "s"+    | ns < (60 * 60 * 1000000000) =+        (fromIntegral ns / (60 * 1000000000)) `with` "min"+    | ns < (24 * 60 * 60 * 1000000000) =+        (fromIntegral ns / (60 * 60 * 1000000000)) `with` "hr"+    | ns < (365 * 24 * 60 * 60 * 1000000000) =+        (fromIntegral ns / (24 * 60 * 60 * 1000000000)) `with` "days"+    | otherwise =+        (fromIntegral ns / (365 * 24 * 60 * 60 * 1000000000)) `with` "years"+     where with (t :: Double) (u :: String)+               | t >= 1e9  = printf "%.4g %s" t u+               | t >= 1e3  = printf "%.0f %s" t u+               | t >= 1e2  = printf "%.1f %s" t u+               | t >= 1e1  = printf "%.2f %s" t u+               | otherwise = printf "%.3f %s" t u++-- In general we should be able to show the time in a specified unit, if we+-- omit the unit we can show it in an automatically chosen one.+{-+data UnitName =+      Nano+    | Micro+    | Milli+    | Sec+-}++showRelTime64 :: RelTime64 -> String+showRelTime64 = showNanoSecond64 . fromRelTime64
+ src/Streamly/Internal/Data/Tuple/Strict.hs view
@@ -0,0 +1,46 @@+-- |+-- Module      : Streamly.Internal.Data.Tuple.Strict+-- Copyright   : (c) 2019 Composewell Technologies+--               (c) 2013 Gabriel Gonzalez+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- | Strict data types to be used as accumulator for strict left folds and+-- scans. For more comprehensive strict data types see+-- https://hackage.haskell.org/package/strict-base-types . The names have been+-- suffixed by a prime so that programmers can easily distinguish the strict+-- versions from the lazy ones.+--+-- One major advantage of strict data structures as accumulators in folds and+-- scans is that it helps the compiler optimize the code much better by+-- unboxing. In a big tight loop the difference could be huge.+--+module Streamly.Internal.Data.Tuple.Strict+    (+      Tuple' (..)+    , Tuple3' (..)+    -- XXX Remove this type, use a fuse annotation in Tuple3' itself or use a+    -- custom type where fuse annotation is needed.+    , Tuple3Fused' (..)+    , Tuple4' (..)+    )+where++import Fusion.Plugin.Types (Fuse(..))++-- | A strict '(,)'+data Tuple' a b = Tuple' !a !b deriving Show++-- XXX Add TupleFused'++-- | A strict '(,,)'+{-# ANN type Tuple3Fused' Fuse #-}+data Tuple3' a b c = Tuple3' !a !b !c deriving Show++-- | A strict '(,,)'+data Tuple3Fused' a b c = Tuple3Fused' !a !b !c deriving Show++-- | A strict '(,,,)'+data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Show
+ src/Streamly/Internal/Data/Unboxed.hs view
@@ -0,0 +1,855 @@+{-# 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
@@ -0,0 +1,1140 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Unfold+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+module Streamly.Internal.Data.Unfold+    (+    -- * Setup+    -- | To execute the code examples provided in this module in ghci, please+    -- run the following commands first.+    --+    -- $setup++    -- * Unfold Type+      Step(..)+    , Unfold++    -- * 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+    , 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++    -- ** From Containers+    , fromList+    , fromListM++    -- ** From Memory+    , fromPtr++    -- ** From Stream+    , fromStreamK+    , fromStreamD+    , fromStream++    -- * Combinators+    -- ** Mapping on Input+    , lmap+    , lmapM+    , both+    , first+    , second+    , discardFirst+    , discardSecond+    , swap+    -- coapply+    -- comonad++    -- * 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+    , foldMany+    -- pipe++    -- ** Either Wrapped Input+    , either++    -- ** Filtering+    , takeWhileM+    , takeWhile+    , take+    , filter+    , filterM+    , drop+    , dropWhile+    , dropWhileM++    -- ** Zipping+    , zipWithM+    , zipWith++    -- ** Cross product+    , crossWithM+    , crossWith+    , cross+    , joinInnerGeneric+    , crossApply++    -- ** Nesting+    , ConcatState (..)+    , many+    , many2+    , concatMapM+    , bind++    -- ** Resource Management+    -- | 'bracket' is the most general resource management operation, all other+    -- operations can be expressed using it. These functions have IO suffix+    -- 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.+    , gbracket_+    , gbracketIO+    , before+    , afterIO+    , after_+    , finallyIO+    , finally_+    , bracketIO+    , bracket_++    -- ** Exceptions+    -- | 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.+    , onException+    , handle+    )+where++#include "inline.hs"+#include "ArrayMacros.h"++import Control.Exception (Exception, mask_)+import Control.Monad.Catch (MonadCatch)+import Data.Functor (($>))+import GHC.Types (SPEC(..))+import Streamly.Internal.Data.Fold.Type (Fold(..))+import Streamly.Internal.Data.IOFinalizer+    (newIOFinalizer, runIOFinalizer, clearingIOFinalizer)+import Streamly.Internal.Data.Stream.StreamD.Type (Stream(..), Step(..))+import Streamly.Internal.Data.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 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)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Foreign (Storable, peek, sizeOf)+import Foreign.Ptr++#include "DocTestDataUnfold.hs"++-- | 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.+--+-- @+-- discardFirst = Unfold.lmap snd+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL discardFirst #-}+discardFirst :: Unfold m a b -> Unfold m (c, a) b+discardFirst = lmap snd++-- | Convert an 'Unfold' into an unfold accepting a tuple as an argument,+-- using the argument of the original fold as the first element of tuple and+-- discarding the second element of the tuple.+--+-- @+-- discardSecond = Unfold.lmap fst+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL discardSecond #-}+discardSecond :: Unfold m a b -> Unfold m (a, c) b+discardSecond = lmap fst++-- | Convert an 'Unfold' that accepts a tuple as an argument into an unfold+-- that accepts a tuple with elements swapped.+--+-- @+-- swap = Unfold.lmap Tuple.swap+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL swap #-}+swap :: Unfold m (a, c) b -> Unfold m (c, a) b+swap = lmap Tuple.swap++-------------------------------------------------------------------------------+-- Output operations+-------------------------------------------------------------------------------++-- XXX Do we need this combinator or the stream based idiom is enough?++-- | Compose an 'Unfold' and a 'Fold'. Given an @Unfold m a b@ and a+-- @Fold m b c@, returns a monadic action @a -> m c@ representing the+-- application of the fold on the unfolded stream.+--+-- >>> Unfold.fold Fold.sum Unfold.fromList [1..100]+-- 5050+--+-- >>> fold f u = Stream.fold f . Stream.unfold u+--+-- /Pre-release/+--+{-# 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+    res <- initial+    case res of+        FL.Partial x -> inject a >>= go SPEC x+        FL.Done b -> return b++    where++    {-# INLINE_LATE go #-}+    go !_ !fs st = do+        r <- ustep st+        case r of+            Yield x s -> do+                res <- fstep fs x+                case res of+                    FL.Partial fs1 -> go SPEC fs1 s+                    FL.Done c -> return c+            Skip s -> go SPEC fs s+            Stop -> extract fs++-- {-# 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++-- | Apply a fold multiple times on the output of an unfold.+--+-- /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) =+    Unfold step inject++    where++    inject x = do+        r <- inject1 x+        return (FoldManyStart r)++    {-# 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 (FoldManyFirst fs st) = do+        r <- ustep st+        case r of+            Yield x s -> consume x s fs+            Skip s -> return $ Skip (FoldManyFirst fs s)+            Stop -> 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+                return $ Skip (FoldManyYield b FoldManyDone)+    step (FoldManyYield b next) = return $ Yield b next+    step FoldManyDone = return Stop++-------------------------------------------------------------------------------+-- Either+-------------------------------------------------------------------------------++-- | Choose left or right unfold based on an either input.+--+-- /Pre-release/+{-# INLINE_NORMAL either #-}+either :: Applicative m =>+    Unfold m a c -> Unfold m b c -> Unfold m (Either a b) c+either (Unfold stepL injectL) (Unfold stepR injectR) = Unfold step inject++    where++    inject (Left x) = Left <$> injectL x+    inject (Right x) = Right <$> injectR x++    {-# INLINE_LATE step #-}+    step (Left st) = do+        (\case+            Yield x s -> Yield x (Left s)+            Skip s -> Skip (Left s)+            Stop -> Stop) <$> stepL st+    step (Right st) = do+        (\case+            Yield x s -> Yield x (Right s)+            Skip s -> Skip (Right s)+            Stop -> Stop) <$> stepR st++-- postscan2 :: 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.+--+-- /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) =+    Unfold step inject++    where++    inject a =  do+        r <- initial+        case r of+            FL.Partial fs -> Just . (fs,) <$> injectU a+            FL.Done _ -> return Nothing++    {-# INLINE_LATE step #-}+    step (Just (fs, us)) = do+        ru <- stepU us+        case ru of+            Yield x s -> do+                rf <- stepF fs x+                case rf of+                    FL.Done v -> return $ Yield v Nothing+                    FL.Partial fs1 -> do+                        v <- extract fs1+                        return $ Yield v (Just (fs1, s))+            Skip s -> return $ Skip (Just (fs, s))+            Stop -> 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) =+    Unfold step inject++    where++    inject a = ScanInit <$> injectU a++    {-# INLINE runStep #-}+    runStep us action = do+        r <- action+        case r of+            FL.Partial fs -> do+                !b <- extract fs+                return $ Yield b (ScanDo us fs)+            FL.Done b ->+                let next = if restart then ScanInit us else ScanDone+                 in return $ Yield b next++    {-# INLINE_LATE step #-}+    step (ScanInit us) = runStep us initial+    step (ScanDo us fs) = do+        res <- stepU us+        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++-- | 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+-- >>> Unfold.fold Fold.toList u [1,2,3,4,5]+-- [0,1,3,0,3,7,0,5]+--+-- /Pre-release/+{-# INLINE_NORMAL scanMany #-}+scanMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c+scanMany = scanWith True++-- 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+-- >>> Unfold.fold Fold.toList u [1,2,3,4,5]+-- [0,1,3]+--+-- /Pre-release/+{-# INLINE_NORMAL scan #-}+scan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c+scan = scanWith False++-- | Scan the output of an 'Unfold' to change it in a stateful manner.+--+-- /Pre-release/+{-# INLINE_NORMAL postscanlM' #-}+postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Unfold m c a -> Unfold m c b+postscanlM' f z = postscan (FL.foldlM' f z)++-------------------------------------------------------------------------------+-- Convert streams into unfolds+-------------------------------------------------------------------------------++{-# INLINE_NORMAL fromStreamD #-}+fromStreamD :: Applicative m => Unfold m (Stream m a) a+fromStreamD = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step (UnStream step1 state1) =+        (\case+            Yield x s -> Yield x (Stream step1 s)+            Skip s    -> Skip (Stream step1 s)+            Stop      -> Stop) <$> step1 defState state1++{-# INLINE_NORMAL fromStreamK #-}+fromStreamK :: Applicative m => Unfold m (K.StreamK m a) a+fromStreamK = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step stream = do+        (\case+            Just (x, xs) -> Yield x xs+            Nothing -> Stop) <$> K.uncons stream++{-# INLINE fromStream #-}+fromStream :: Applicative m => Unfold m (Stream m a) a+fromStream = fromStreamD++-------------------------------------------------------------------------------+-- Unfolds+-------------------------------------------------------------------------------++-- | Lift a monadic function into an unfold generating a nil stream with a side+-- effect.+--+{-# INLINE nilM #-}+nilM :: Applicative m => (a -> m c) -> Unfold m a b+nilM f = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step x = f x $> Stop++-- | An empty stream.+{-# INLINE nil #-}+nil :: Applicative m => Unfold m a b+nil = Unfold (Prelude.const (pure Stop)) pure++-- | Prepend a monadic single element generator function to an 'Unfold'. The+-- same seed is used in the action as well as the unfold.+--+-- /Pre-release/+{-# INLINE_NORMAL consM #-}+consM :: Applicative m => (a -> m b) -> Unfold m a b -> Unfold m a b+consM action unf = Unfold step inject++    where++    inject = pure . Left++    {-# INLINE_LATE step #-}+    step (Left a) = (`Yield` Right (D.unfold unf a)) <$> action a+    step (Right (UnStream step1 st)) = do+        (\case+            Yield x s -> Yield x (Right (Stream step1 s))+            Skip s -> Skip (Right (Stream step1 s))+            Stop -> Stop) <$> step1 defState st++-- | Convert a list of monadic values to a 'Stream'+--+{-# INLINE_LATE fromListM #-}+fromListM :: Applicative m => Unfold m [m a] a+fromListM = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step (x:xs) = (`Yield` xs) <$> x+    step [] = pure Stop++{-# INLINE fromPtr #-}+fromPtr :: forall m a. (MonadIO m, Storable a) => Unfold m (Ptr a) a+fromPtr = Unfold step return++    where++    {-# INLINE_LATE step #-}+    step p = do+        x <- liftIO $ peek p+        return $ Yield x (PTR_NEXT(p, a))++------------------------------------------------------------------------------+-- Specialized Generation+------------------------------------------------------------------------------++-- | Given a seed @(n, action)@, generates a stream replicating the @action@ @n@+-- times.+--+{-# INLINE replicateM #-}+replicateM :: Applicative m => Unfold m (Int, m a) a+replicateM = Unfold step inject++    where++    inject seed = pure seed++    {-# INLINE_LATE step #-}+    step (i, action) =+        if i <= 0+        then pure Stop+        else (\x -> Yield x (i - 1, action)) <$> action++-- | Generates an infinite stream repeating the seed.+--+{-# INLINE repeatM #-}+repeatM :: Applicative m => Unfold m (m a) a+repeatM = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step action = (`Yield` action) <$> action++-- | Generates an infinite stream starting with the given seed and applying the+-- given function repeatedly.+--+{-# INLINE iterateM #-}+iterateM :: Applicative m => (a -> m a) -> Unfold m (m a) a+iterateM f = Unfold step id++    where++    {-# INLINE_LATE step #-}+    step x = Yield x <$> f x++-- | @fromIndicesM gen@ generates an infinite stream of values using @gen@+-- starting from the seed.+--+-- @+-- fromIndicesM f = Unfold.mapM f $ Unfold.enumerateFrom 0+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL fromIndicesM #-}+fromIndicesM :: Applicative m => (Int -> m a) -> Unfold m Int a+fromIndicesM gen = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step i = (`Yield` (i + 1)) <$> gen i++-------------------------------------------------------------------------------+-- Filtering+-------------------------------------------------------------------------------++-- |+-- >>> u = Unfold.take 2 Unfold.fromList+-- >>> Unfold.fold Fold.toList u [1..100]+-- [1,2]+--+{-# INLINE_NORMAL take #-}+take :: Applicative m => Int -> Unfold m a b -> Unfold m a b+take n (Unfold step1 inject1) = Unfold step inject++    where++    inject x = (, 0) <$> inject1 x++    {-# INLINE_LATE step #-}+    step (st, i) | i < n = do+        (\case+            Yield x s -> Yield x (s, i + 1)+            Skip s -> Skip (s, i)+            Stop   -> Stop) <$> step1 st+    step (_, _) = pure Stop++-- | Same as 'filter' but with a monadic predicate.+--+{-# INLINE_NORMAL filterM #-}+filterM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+filterM f (Unfold step1 inject1) = Unfold step inject1+  where+    {-# INLINE_LATE step #-}+    step st = do+        r <- step1 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.+--+{-# INLINE filter #-}+filter :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+filter f = filterM (return . f)++-- | @drop n unf@ drops @n@ elements from the stream generated by @unf@.+--+{-# INLINE_NORMAL drop #-}+drop :: Applicative m => Int -> Unfold m a b -> Unfold m a b+drop n (Unfold step inject) = Unfold step' inject'++    where++    inject' a = (, n) <$> inject a++    {-# INLINE_LATE step' #-}+    step' (st, i)+        | i > 0 = do+            (\case+                  Yield _ s -> Skip (s, i - 1)+                  Skip s -> Skip (s, i)+                  Stop -> Stop) <$> step st+        | otherwise = do+            (\case+                  Yield x s -> Yield x (s, 0)+                  Skip s -> Skip (s, 0)+                  Stop -> Stop) <$> step st++-- | @dropWhileM f unf@ drops elements from the stream generated by @unf@ while+-- the condition holds true. The condition function @f@ is /monadic/ in nature.+--+{-# INLINE_NORMAL dropWhileM #-}+dropWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+dropWhileM f (Unfold step inject) = Unfold step' inject'++    where++    inject' a = do+        b <- inject a+        return $ Left b++    {-# INLINE_LATE step' #-}+    step' (Left st) = do+        r <- step st+        case r of+            Yield x s -> do+                b <- f x+                return+                    $ if b+                      then Skip (Left s)+                      else Yield x (Right s)+            Skip s -> return $ Skip (Left s)+            Stop -> return Stop+    step' (Right st) = do+        r <- step st+        return+            $ case r of+                  Yield x s -> Yield x (Right s)+                  Skip s -> Skip (Right s)+                  Stop -> Stop++-- | Similar to 'dropWhileM' but with a pure condition function.+--+{-# INLINE dropWhile #-}+dropWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+dropWhile f = dropWhileM (return . f)++{-# INLINE_NORMAL joinInnerGeneric #-}+joinInnerGeneric :: 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++------------------------------------------------------------------------------+-- Exceptions+------------------------------------------------------------------------------++-- | Like 'gbracketIO' but with following differences:+--+-- * alloc action @a -> 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+    => (a -> m c)                           -- ^ before+    -> (forall s. m s -> m (Either e s))    -- ^ try (exception handling)+    -> (c -> m d)                           -- ^ after, on normal stop+    -> Unfold m (c, e) b                    -- ^ on exception+    -> Unfold m c b                         -- ^ unfold to run+    -> Unfold m a b+gbracket_ bef exc aft (Unfold estep einject) (Unfold step1 inject1) =+    Unfold step inject++    where++    inject x = do+        r <- bef x+        s <- inject1 r+        return $ Right (s, r)++    {-# INLINE_LATE step #-}+    step (Right (st, v)) = do+        res <- exc $ step1 st+        case res of+            Right r -> case r of+                Yield x s -> return $ Yield x (Right (s, v))+                Skip s    -> return $ Skip (Right (s, v))+                Stop      -> aft v >> return Stop+            -- XXX Do not handle async exceptions, just rethrow them.+            Left e -> do+                r <- einject (v, e)+                return $ Skip (Left r)+    step (Left st) = do+        res <- estep st+        return $ case res of+            Yield x s -> Yield x (Left s)+            Skip s    -> Skip (Left s)+            Stop      -> Stop++-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping+-- blocking operations interruptible (see 'Control.Exception.mask').  Use the+-- output @c@ as input to @Unfold m c b@ to generate an output stream. When+-- unfolding use the supplied @try@ operation @forall s. m s -> m (Either e s)@+-- to catch synchronous exceptions. If an exception occurs run the exception+-- handling unfold @Unfold m (c, e) b@.+--+-- 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 gbracketIO #-}+gbracketIO+    :: MonadIO m+    => (a -> IO c)                           -- ^ before+    -> (c -> IO d)                           -- ^ after, on normal stop, or GC+    -> (c -> IO ())                          -- ^ action on exception+    -> Unfold m e b                          -- ^ stream on exception+    -> (forall s. m s -> IO (Either e s))    -- ^ try (exception handling)+    -> Unfold m c b                         -- ^ unfold to run+    -> Unfold m a b+gbracketIO bef aft onExc (Unfold estep einject) ftry (Unfold step1 inject1) =+    Unfold step inject++    where++    inject x = do+        -- Mask asynchronous exceptions to make the execution of 'bef' and+        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.+        (r, ref) <- liftIO $ mask_ $ do+            r <- bef x+            ref <- newIOFinalizer (aft r)+            return (r, ref)+        s <- inject1 r+        return $ Right (s, r, ref)++    {-# INLINE_LATE step #-}+    step (Right (st, v, ref)) = do+        res <- liftIO $ ftry $ step1 st+        case res of+            Right r -> case r of+                Yield x s -> return $ Yield x (Right (s, v, ref))+                Skip s    -> return $ Skip (Right (s, v, ref))+                Stop      -> do+                    runIOFinalizer ref+                    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.+                liftIO $ clearingIOFinalizer ref (onExc v)+                r <- einject e+                return $ Skip (Left r)+    step (Left st) = do+        res <- estep st+        return $ case res of+            Yield x s -> Yield x (Left s)+            Skip s    -> Skip (Left s)+            Stop      -> Stop++-- | Run a side effect @a -> m c@ on the input @a@ before unfolding it using+-- @Unfold m a b@.+--+-- > before f = lmapM (\a -> f a >> return a)+--+-- /Pre-release/+{-# INLINE_NORMAL before #-}+before :: (a -> m c) -> Unfold m a b -> Unfold m a b+before action (Unfold step inject) = Unfold step (action >> inject)++-- The custom implementation of "after_" is slightly faster (5-7%) than+-- "_after".  This is just to document and make sure that we can always use+-- gbracket to implement after_ The same applies to other combinators as well.+--+{-# INLINE_NORMAL _after #-}+_after :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b+_after aft = gbracket_ return (fmap Right) aft undefined++-- | Like 'after' with following differences:+--+-- * action @a -> m c@ won't run if the stream is garbage collected+--   after partial evaluation.+-- * Monad @m@ does not require any other constraints.+--+-- /Pre-release/+{-# INLINE_NORMAL after_ #-}+after_ :: Monad m => (a -> m c) -> Unfold m a b -> Unfold m a b+after_ action (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        return (s, x)++    {-# INLINE_LATE step #-}+    step (st, v) = do+        res <- step1 st+        case res of+            Yield x s -> return $ Yield x (s, v)+            Skip s    -> return $ Skip (s, v)+            Stop      -> action v >> return Stop++-- | Unfold the input @a@ using @Unfold m a b@, run an action on @a@ whenever+-- the unfold stops normally, or if it is garbage collected after a partial+-- lazy evaluation.+--+-- The semantics of the action @a -> m c@ are similar to the cleanup action+-- semantics in 'bracket'.+--+-- /See also 'after_'/+--+-- /Pre-release/+{-# INLINE_NORMAL afterIO #-}+afterIO :: MonadIO m+    => (a -> IO c) -> Unfold m a b -> Unfold m a b+afterIO action (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        ref <- liftIO $ newIOFinalizer (action x)+        return (s, ref)++    {-# INLINE_LATE step #-}+    step (st, ref) = do+        res <- step1 st+        case res of+            Yield x s -> return $ Yield x (s, ref)+            Skip s    -> return $ Skip (s, ref)+            Stop      -> do+                runIOFinalizer ref+                return Stop++{-# INLINE_NORMAL _onException #-}+_onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b+_onException action =+    gbracket_ return MC.try+        (\_ -> return ())+        (nilM (\(a, e :: MC.SomeException) -> action a >> MC.throwM e))++-- | Unfold the input @a@ using @Unfold m a b@, run the action @a -> m c@ on+-- @a@ if the unfold aborts due to an exception.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL onException #-}+onException :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b+onException action (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        return (s, x)++    {-# INLINE_LATE step #-}+    step (st, v) = do+        res <- step1 st `MC.onException` action v+        return $ case res of+            Yield x s -> Yield x (s, v)+            Skip s    -> Skip (s, v)+            Stop      -> Stop++{-# INLINE_NORMAL _finally #-}+_finally :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b+_finally action =+    gbracket_ return MC.try action+        (nilM (\(a, e :: MC.SomeException) -> action a >> MC.throwM e))++-- | Like 'finallyIO' with following differences:+--+-- * action @a -> m c@ won't run if the stream is garbage collected+--   after partial evaluation.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL finally_ #-}+finally_ :: MonadCatch m => (a -> m c) -> Unfold m a b -> Unfold m a b+finally_ action (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        return (s, x)++    {-# INLINE_LATE step #-}+    step (st, v) = do+        res <- step1 st `MC.onException` action v+        case res of+            Yield x s -> return $ Yield x (s, v)+            Skip s    -> return $ Skip (s, v)+            Stop      -> action v >> return Stop++-- | Unfold the input @a@ using @Unfold m a b@, run an action on @a@ whenever+-- the unfold stops normally, aborts due to an exception or if it is garbage+-- collected after a partial lazy evaluation.+--+-- The semantics of the action @a -> m c@ are similar to the cleanup action+-- semantics in 'bracket'.+--+-- @+-- finally release = bracket return release+-- @+--+-- /See also 'finally_'/+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL finallyIO #-}+finallyIO :: (MonadIO m, MonadCatch m)+    => (a -> IO c) -> Unfold m a b -> Unfold m a b+finallyIO action (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        ref <- liftIO $ newIOFinalizer (action x)+        return (s, ref)++    {-# INLINE_LATE step #-}+    step (st, ref) = do+        res <- step1 st `MC.onException` runIOFinalizer ref+        case res of+            Yield x s -> return $ Yield x (s, ref)+            Skip s    -> return $ Skip (s, ref)+            Stop      -> do+                runIOFinalizer ref+                return Stop++{-# INLINE_NORMAL _bracket #-}+_bracket :: MonadCatch m+    => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b+_bracket bef aft =+    gbracket_ bef MC.try aft (nilM (\(a, e :: MC.SomeException) -> aft a >>+    MC.throwM e))++-- | Like 'bracketIO' but with following differences:+--+-- * alloc action @a -> 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 bracket_ #-}+bracket_ :: MonadCatch m+    => (a -> m c) -> (c -> m d) -> Unfold m c b -> Unfold m a b+bracket_ bef aft (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        r <- bef x+        s <- inject1 r+        return (s, r)++    {-# INLINE_LATE step #-}+    step (st, v) = do+        res <- step1 st `MC.onException` aft v+        case res of+            Yield x s -> return $ Yield x (s, v)+            Skip s    -> return $ Skip (s, v)+            Stop      -> aft v >> return Stop++-- | Run the alloc action @a -> m c@ with async exceptions disabled but keeping+-- blocking operations interruptible (see 'Control.Exception.mask').  Use the+-- output @c@ as input to @Unfold m c b@ to generate an output stream.+--+-- @c@ is usually a resource under the state of monad @m@, e.g. a file+-- handle, that requires a cleanup after use. 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.+--+-- 'bracket' 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: 'bracket_', 'gbracket'/+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL bracketIO #-}+bracketIO :: (MonadIO m, MonadCatch m)+    => (a -> IO c) -> (c -> IO d) -> Unfold m c b -> Unfold m a b+bracketIO bef aft (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        -- Mask asynchronous exceptions to make the execution of 'bef' and+        -- the registration of 'aft' atomic. See comment in 'D.gbracketIO'.+        (r, ref) <- liftIO $ mask_ $ do+            r <- bef x+            ref <- newIOFinalizer (aft r)+            return (r, ref)+        s <- inject1 r+        return (s, ref)++    {-# INLINE_LATE step #-}+    step (st, ref) = do+        res <- step1 st `MC.onException` runIOFinalizer ref+        case res of+            Yield x s -> return $ Yield x (s, ref)+            Skip s    -> return $ Skip (s, ref)+            Stop      -> do+                runIOFinalizer ref+                return Stop++-- | When unfolding @Unfold m a b@ if an exception @e@ occurs, unfold @e@ using+-- @Unfold m e b@.+--+-- /Inhibits stream fusion/+--+-- /Pre-release/+{-# INLINE_NORMAL handle #-}+handle :: (MonadCatch m, Exception e)+    => Unfold m e b -> Unfold m a b -> Unfold m a b+handle exc =+    gbracket_ return MC.try (\_ -> return ()) (discardFirst exc)
+ src/Streamly/Internal/Data/Unfold/Enumeration.hs view
@@ -0,0 +1,574 @@+-- |+-- Module      : Streamly.Internal.Data.Unfold.Enumeration+-- Copyright   : (c) 2019, 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- 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+-- operations 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.+--+module Streamly.Internal.Data.Unfold.Enumeration+    (+      Enumerable (..)++    -- ** Enumerating 'Num' Types+    , enumerateFromStepNum+    , enumerateFromNum+    , enumerateFromThenNum++    -- ** Enumerating unbounded 'Integral' Types+    , enumerateFromStepIntegral+    , enumerateFromIntegral+    , enumerateFromThenIntegral+    , enumerateFromToIntegral+    , enumerateFromThenToIntegral++    -- ** Enumerating 'Bounded' 'Integral' Types+    , enumerateFromIntegralBounded+    , enumerateFromThenIntegralBounded+    , enumerateFromToIntegralBounded+    , enumerateFromThenToIntegralBounded++    -- ** Enumerating small 'Integral' Types+    -- | Small types are always bounded.+    , enumerateFromSmallBounded+    , enumerateFromThenSmallBounded+    , enumerateFromToSmall+    , enumerateFromThenToSmall++    -- ** Enumerating 'Fractional' Types+    -- | Enumeration of 'Num' specialized to 'Fractional' types.+    , enumerateFromFractional+    , enumerateFromThenFractional+    , enumerateFromToFractional+    , enumerateFromThenToFractional+    )+where++#include "inline.hs"+import Data.Fixed+import Data.Bifunctor (bimap)+import Data.Int+import Data.Ratio+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+              , drop, dropWhile)++-- $setup+-- >>> :m+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Data.Stream as Stream+-- >>> import qualified Streamly.Internal.Data.Unfold as Unfold+-- >>> import Streamly.Internal.Data.Unfold.Type+-- >>> import Data.Word++------------------------------------------------------------------------------+-- Enumeration of Num+------------------------------------------------------------------------------++-- | Unfolds @(from, stride)@ generating an infinite stream starting from+-- @from@ and incrementing every time by @stride@.  For 'Bounded' types, after+-- the value overflows it keeps enumerating in a cycle:+--+-- @+-- >>> Stream.fold Fold.toList $ Stream.take 10 $ Stream.unfold Unfold.enumerateFromStepNum (255::Word8,1)+-- [255,0,1,2,3,4,5,6,7,8]+--+-- @+--+-- The implementation is numerically stable for floating point values.+--+-- Note 'enumerateFromStepIntegral' is faster for integrals.+--+-- /Internal/+--+{-# INLINE enumerateFromStepNum #-}+enumerateFromStepNum :: (Monad m, Num a) => Unfold m (a, a) a+enumerateFromStepNum = Unfold step inject++    where++    inject (!from, !stride) = return (from, stride, 0)++    -- Note that the counter "i" is the same type as the type being enumerated.+    -- It may overflow, for example, if we are enumerating Word8, after 255 the+    -- counter will become 0, but the overflow does not affect the enumeration+    -- behavior.+    {-# INLINE_LATE step #-}+    step (from, stride, i) =+        return $+            (Yield $! (from + i * stride)) $! (from, stride, i + 1)++-- | Same as 'enumerateFromStepNum (from, next)' using a stride of @next - from@:+--+-- @+-- >>> enumerateFromThenNum = lmap (\(from, next) -> (from, next - from)) Unfold.enumerateFromStepNum+--+-- @+--+-- Example:+-- @+-- >>> Stream.fold Fold.toList $ Stream.take 10 $ Stream.unfold enumerateFromThenNum (255::Word8,0)+-- [255,0,1,2,3,4,5,6,7,8]+--+-- @+--+-- The implementation is numerically stable for floating point values.+--+-- Note that 'enumerateFromThenIntegral' is faster for integrals.+--+-- Note that in the strange world of floating point numbers, using+-- @enumerateFromThenNum (from, from + 1)@ is almost exactly the same as+-- @enumerateFromStepNum (from, 1) but not precisely the same. Because @(from ++-- 1) - from@ is not exactly 1, it may lose some precision, the loss may also+-- be aggregated in each step, if you want that precision then use+-- 'enumerateFromStepNum' instead.+--+-- /Internal/+--+{-# INLINE enumerateFromThenNum #-}+enumerateFromThenNum :: (Monad m, Num a) => Unfold m (a, a) a+enumerateFromThenNum =+    lmap (\(from, next) -> (from, next - from)) enumerateFromStepNum++-- | Same as 'enumerateFromStepNum' using a stride of 1:+--+-- @+-- >>> enumerateFromNum = lmap (\from -> (from, 1)) Unfold.enumerateFromStepNum+-- >>> Stream.fold Fold.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9)+-- [0.9,1.9,2.9,3.9,4.9,5.9]+--+-- @+--+-- Also, same as 'enumerateFromThenNum' using a stride of 1 but see the note in+-- 'enumerateFromThenNum' about the loss of precision:+--+-- @+-- >>> enumerateFromNum = lmap (\from -> (from, from + 1)) Unfold.enumerateFromThenNum+-- >>> Stream.fold Fold.toList $ Stream.take 6 $ Stream.unfold enumerateFromNum (0.9)+-- [0.9,1.9,2.9,3.8999999999999995,4.8999999999999995,5.8999999999999995]+--+-- @+--+-- /Internal/+--+{-# INLINE enumerateFromNum #-}+enumerateFromNum :: (Monad m, Num a) => Unfold m a a+enumerateFromNum = lmap (\from -> (from, 1)) enumerateFromStepNum++------------------------------------------------------------------------------+-- Enumeration of Integrals+------------------------------------------------------------------------------++-- | Can be used to enumerate unbounded integrals. This does not check for+-- overflow or underflow for bounded integrals.+--+-- /Internal/+{-# INLINE_NORMAL enumerateFromStepIntegral #-}+enumerateFromStepIntegral :: (Monad m, Integral a) => Unfold m (a, a) a+enumerateFromStepIntegral = Unfold step inject++    where++    inject (from, stride) = from `seq` stride `seq` return (from, stride)++    {-# INLINE_LATE step #-}+    step (x, stride) = return $ Yield x $! (x + stride, stride)++-- Enumerate Unbounded Integrals ----------------------------------------------+{-# INLINE enumerateFromIntegral #-}+enumerateFromIntegral :: (Monad m, Integral a) => Unfold m a a+enumerateFromIntegral = lmap (\from -> (from, 1)) enumerateFromStepIntegral++{-# INLINE enumerateFromThenIntegral #-}+enumerateFromThenIntegral :: (Monad m, Integral a ) => Unfold m (a, a) a+enumerateFromThenIntegral =+    lmap (\(from, next) -> (from, next - from)) enumerateFromStepIntegral++{-# INLINE enumerateFromToIntegral #-}+enumerateFromToIntegral :: (Monad m, Integral a) => Unfold m (a, a) a+enumerateFromToIntegral =+    takeWhileMWithInput (\(_, to) b -> return $ b <= to)+        $ lmap (\(from, _) -> (from, 1)) enumerateFromStepIntegral++{-# INLINE enumerateFromThenToIntegral #-}+enumerateFromThenToIntegral :: (Monad m, Integral a) => Unfold m (a, a, a) a+enumerateFromThenToIntegral =+    takeWhileMWithInput cond $ lmap toFromStep enumerateFromStepIntegral++    where++    toFromStep (from, next, _) = (from, next - from)++    cond (from, next, to) b =+        return+            $ if next >= from+              then b <= to+              else b >= to++-- Enumerate Bounded Integrals ------------------------------------------------+{-# INLINE enumerateFromIntegralBounded #-}+enumerateFromIntegralBounded :: (Monad m, Integral a, Bounded a) =>+    Unfold m a a+enumerateFromIntegralBounded = second maxBound enumerateFromToIntegral++{-# INLINE enumerateFromThenIntegralBounded #-}+enumerateFromThenIntegralBounded :: (Monad m, Integral a, Bounded a ) =>+    Unfold m (a, a) a+enumerateFromThenIntegralBounded =+    takeWhileMWithInput cond $ lmap toFromStep enumerateFromStepIntegral++    where++    toFromStep (from, next) = (from, next - from)++    cond (from, next) b =+        return+            $ if next >= from+              then b <= maxBound+              else b >= minBound++{-# INLINE enumerateFromToIntegralBounded #-}+enumerateFromToIntegralBounded :: (Monad m, Integral a, Bounded a) =>+    Unfold m (a, a) a+enumerateFromToIntegralBounded =+    takeWhileMWithInput (\(_, to) b -> return $ b <= to)+        $ lmap fst enumerateFromIntegralBounded++{-# INLINE enumerateFromThenToIntegralBounded #-}+enumerateFromThenToIntegralBounded :: (Monad m, Integral a, Bounded a) =>+    Unfold m (a, a, a) a+enumerateFromThenToIntegralBounded =+    takeWhileMWithInput cond $ lmap toFromThen enumerateFromThenIntegralBounded++    where++    toFromThen (from, next, _) = (from, next)++    cond (from, next, to) b =+        return+            $ if next >= from+              then b <= to+              else b >= to++------------------------------------------------------------------------------+-- Enumeration of Fractionals+------------------------------------------------------------------------------++{-# INLINE_NORMAL enumerateFromFractional #-}+enumerateFromFractional :: (Monad m, Fractional a) => Unfold m a a+enumerateFromFractional = enumerateFromNum++{-# INLINE_NORMAL enumerateFromThenFractional #-}+enumerateFromThenFractional :: (Monad m, Fractional a) => Unfold m (a, a) a+enumerateFromThenFractional = enumerateFromThenNum++-- | Same as 'enumerateFromStepNum' with a step of 1 and enumerating up to the+-- specified upper limit rounded to the nearest integral value:+--+-- @+-- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromToFractional (0.1, 6.3)+-- [0.1,1.1,2.1,3.1,4.1,5.1,6.1]+--+-- @+--+-- /Internal/+--+{-# INLINE_NORMAL enumerateFromToFractional #-}+enumerateFromToFractional :: (Monad m, Fractional a, Ord a) =>+    Unfold m (a, a) a+enumerateFromToFractional =+    takeWhileMWithInput (\(_, to) b -> return $ b <= to + 1 / 2)+        $ lmap (\(from, _) -> (from, 1)) enumerateFromStepNum++{-# INLINE enumerateFromThenToFractional #-}+enumerateFromThenToFractional :: (Monad m, Fractional a, Ord a) =>+    Unfold m (a, a, a) a+enumerateFromThenToFractional =+    takeWhileMWithInput cond $ lmap toFromStep enumerateFromStepNum++    where++    toFromStep (from, next, _) = (from, next - from)++    cond (from, next, to) b =+        let stride = next - from+         in return+                $ if next >= from+                  then b <= to + stride / 2+                  else b >= to + stride / 2++-------------------------------------------------------------------------------+-- Enumeration of Enum types not larger than Int+-------------------------------------------------------------------------------++-- | Enumerate from given starting Enum value 'from' and to Enum value 'to'+-- with stride of 1 till to value.+--+-- /Internal/+--+{-# INLINE enumerateFromToSmall #-}+enumerateFromToSmall :: (Monad m, Enum a) => Unfold m (a, a) a+enumerateFromToSmall =+    fmap toEnum (lmap (bimap fromEnum fromEnum) enumerateFromToIntegral)++-- | Enumerate from given starting Enum value 'from' and then Enum value 'next'+-- and to Enum value 'to' with stride of (fromEnum next - fromEnum from)+-- till to value.+--+-- /Internal/+--+{-# INLINE enumerateFromThenToSmall #-}+enumerateFromThenToSmall :: (Monad m, Enum a) => Unfold m (a, a, a) a+enumerateFromThenToSmall =+    let toInts (x, y, z) = (fromEnum x, fromEnum y, fromEnum z)+     in fmap toEnum (lmap toInts enumerateFromThenToIntegral)++-------------------------------------------------------------------------------+-- Bounded Enumeration of Enum types not larger than Int+-------------------------------------------------------------------------------++-- | Enumerate from given starting Enum value 'from' with stride of 1 till+-- maxBound+--+-- /Internal/+--+{-# INLINE enumerateFromSmallBounded #-}+enumerateFromSmallBounded :: (Monad m, Enum a, Bounded a) => Unfold m a a+enumerateFromSmallBounded = second maxBound enumerateFromToSmall++-- | Enumerate from given starting Enum value 'from' and next Enum value 'next'+-- with stride of (fromEnum next - fromEnum from) till maxBound.+--+-- /Internal/+--+{-# INLINE enumerateFromThenSmallBounded #-}+enumerateFromThenSmallBounded :: forall m a. (Monad m, Enum a, Bounded a) =>+    Unfold m (a, a) a+enumerateFromThenSmallBounded =+    let adapt (from, next) =+            let frm = fromEnum from+                nxt = fromEnum next+                stride = nxt - frm+                to = if stride >= 0+                     then fromEnum (maxBound :: a)+                     else fromEnum (minBound :: a)+             in (frm, nxt, to)+     in fmap toEnum (lmap adapt enumerateFromThenToIntegral)++-------------------------------------------------------------------------------+-- Enumerable type class+-------------------------------------------------------------------------------++-- | 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.Unfold.Enumeration" module to define new instances.+--+-- /Pre-release/+class Enum a => Enumerable a where++    -- | Unfolds @from@ generating 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'.+    --+    -- >>> 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)+    -- [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+    -- [1.1,2.1,3.1,4.1]+    --+    -- @+    --+    -- /Pre-release/+    --+    enumerateFrom :: Monad m => Unfold m a a++    -- | Unfolds @(from, to)@ generating 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.+    --+    -- >>> 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)+    -- [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)+    -- [1.1,2.1,3.1,4.1]+    --+    -- >>> Stream.fold Fold.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++    -- | Unfolds @(from, then)@ generating a stream whose first element is+    -- @from@ and the successive elements are in increments of @then@.  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.+    --+    -- >>> 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)+    -- [0,2,4,6]+    --+    -- >>> Stream.fold Fold.toList $ Stream.take 4 $ Stream.unfold Unfold.enumerateFromThen (0,(-2))+    -- [0,-2,-4,-6]+    --+    -- @+    --+    -- /Pre-release/+    enumerateFromThen :: Monad m => Unfold m (a, a) a++    -- | Unfolds @(from, then, to)@ generating a finite stream whose first element+    -- is @from@ and the successive elements are in increments of @then@ up to+    -- @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)+    -- [0,2,4,6]+    --+    -- >>> Stream.fold Fold.toList $ Stream.unfold Unfold.enumerateFromThenTo (0, (-2), (-6))+    -- [0,-2,-4,-6]+    --+    -- @+    --+    -- /Pre-release/+    enumerateFromThenTo :: Monad m => Unfold m (a, a, a) a++-------------------------------------------------------------------------------+-- 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 = enumerateFromSmallBounded;         \+    {-# 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 = enumerateFromIntegralBounded;           \+    {-# INLINE enumerateFromThen #-};                       \+    enumerateFromThen = enumerateFromThenIntegralBounded;   \+    {-# INLINE enumerateFromTo #-};                         \+    enumerateFromTo = enumerateFromToIntegralBounded;       \+    {-# INLINE enumerateFromThenTo #-};                     \+    enumerateFromThenTo = enumerateFromThenToIntegralBounded }++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 = enumerateFromIntegral;                        \+    {-# INLINE enumerateFromThen #-};                             \+    enumerateFromThen = enumerateFromThenIntegral;                \+    {-# 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 =+        map Identity $ lmap runIdentity enumerateFrom+    {-# INLINE enumerateFromThen #-}+    enumerateFromThen =+        map Identity $ lmap (bimap runIdentity runIdentity) enumerateFromThen+    {-# INLINE enumerateFromTo #-}+    enumerateFromTo  =+        map Identity $ lmap (bimap runIdentity runIdentity) enumerateFromThen+    {-# INLINE enumerateFromThenTo #-}+    enumerateFromThenTo  =+        map Identity $+            lmap+            (\(from, next, to) ->+                 (runIdentity from, runIdentity next, runIdentity to))+            enumerateFromThenTo
+ src/Streamly/Internal/Data/Unfold/Type.hs view
@@ -0,0 +1,1003 @@+{-# LANGUAGE CPP #-}+-- |+-- Module      : Streamly.Internal.Data.Unfold.Type+-- Copyright   : (c) 2019 Composewell Technologies+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- An unfold is akin to a reader. It is the streaming equivalent of a reader.+-- The argument @a@ is the environment of the reader. That's the reason the+-- default unfolds in various modules are named "reader".++-- = Performance Notes+--+-- 'Unfold' representation is more efficient than using streams when combining+-- streams.  'Unfold' type allows multiple unfold actions to be composed into a+-- single unfold function in an efficient manner by enabling the compiler to+-- perform stream fusion optimization.+-- @Unfold m a b@ can be considered roughly equivalent to an action @a -> t m+-- b@ (where @t@ is a stream type). Instead of using an 'Unfold' one could just+-- use a function of the shape @a -> t m b@. However, working with stream types+-- like t'Streamly.SerialT' does not allow the compiler to perform stream fusion+-- optimization when merging, appending or concatenating multiple streams.+-- Even though stream based combinator have excellent performance, they are+-- 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'.+--+-- On the other hand, transformation operations on stream types are as+-- efficient as transformations on 'Unfold'.+--+-- We should note that in some cases working with stream types may be more+-- convenient compared to working with the 'Unfold' type.  However, if extra+-- performance boost is important then 'Unfold' based composition should be+-- preferred compared to stream based composition when merging or concatenating+-- streams.++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 (..)++    -- * Basic Constructors+    , mkUnfoldM+    , mkUnfoldrM+    , unfoldrM+    , unfoldr+    , functionM+    , function+    , identity++    -- * From Values+    , fromEffect+    , fromPure++    -- * From Containers+    , fromList++    -- * Transformations+    , lmap+    , lmapM+    , map+    , map2+    , mapM+    , mapM2+    , both+    , first+    , second++    -- * Trimming+    , takeWhileMWithInput+    , takeWhileM+    , takeWhile++    -- * Nesting+    , ConcatState (..)+    , many+    , many2+    , manyInterleave+    -- , manyInterleave2++    -- Applicative+    , crossApplySnd+    , crossApplyFst+    , crossWithM+    , crossWith+    , cross+    , crossApply++    -- Monad+    , concatMapM+    , concatMap+    , bind++    , zipWithM+    , zipWith+    )+where++#include "inline.hs"++-- import Control.Arrow (Arrow(..))+-- import Control.Category (Category(..))+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 Prelude hiding (map, mapM, concatMap, zipWith, takeWhile)++#include "DocTestDataUnfold.hs"++-- $notes+--+-- What makes streams less efficient is also what makes them more convenient to+-- use and powerful. The stream data type (Stream m a) bundles the state along+-- with the stream generator function making it opaque, whereas an unfold+-- exposes the state (Unfold m s a) to the user. This allows the Unfold to be+-- unfolded (inlined) inside a nested loop without having to bundle the state+-- and the generator together, the stream state can be saved and passed+-- independent of the generator function. On the other hand in a stream type we+-- have to bundle the stream state and the generator function together to save+-- the stream. This makes it inefficient because it requires boxing and+-- constructor allocation. However, this makes streams more convenient as we do+-- not need to pass around the state/seed separately.+--+-- Unfold Type:+--+-- The order of arguments allows 'Category' and 'Arrow' instances but precludes+-- contravariant and contra-applicative.+--+-- = Unfolds and Streams+--+-- An 'Unfold' type is the same as the direct style 'Stream' type except that+-- it uses an inject function to determine the initial state of the stream+-- based on an input.  A stream is a special case of Unfold when the static+-- input is unit or Void.+--+-- 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'+-- 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 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+-- to the consumer in case of unfolds, the consumer knows how to generate the+-- stream from a seed using a known "inject" and "step" functions.+--+-- A Stream is like a data object whereas unfold is like a function.  Being+-- function like, an Unfold is an instance of 'Category' and 'Arrow' type+-- classes.+--+-- = Unfolds and Folds+--+-- Streams forcing a closed control flow loop can be categorized under+-- two types, unfolds and folds, both of these are duals of each other.+--+-- Unfold streams are really generators of a sequence of elements, we can also+-- call them pull style streams. These are lazy producers of streams. On each+-- evaluation the producer generates the next element.  A consumer can+-- therefore pull elements from the stream whenever it wants to.  A stream+-- consumer can multiplex pull streams by pulling elements from the chosen+-- streams, therefore, pull streams allow merging or multiplexing.  On the+-- other hand, with this representation we cannot split or demultiplex a+-- stream.  So really these are stream sources that can be generated from a+-- seed and can be merged or zipped into a single stream.+--+-- The dual of Unfolds are Folds. Folds can also be called as push style+-- streams or reducers. These are strict consumers of streams. We keep pushing+-- elements to a fold and we can extract the result at any point. A driver can+-- choose which fold to push to and can also push the same element to multiple+-- folds. Therefore, folds allow splitting or demultiplexing a stream. On the+-- other hand, we cannot merge streams using this representation. So really+-- these are stream consumers that reduce the stream to a single value, these+-- consumers can be composed such that a stream can be split over multiple+-- consumers.+--+-- Performance:+--+-- Composing a tree or graph of computations with unfolds can be much more+-- efficient compared to composing with the Monad instance.  The reason is that+-- unfolds allow the compiler to statically know the state and optimize it+-- using stream fusion whereas it is not possible with the monad bind because+-- the state is determined dynamically.+--+-- Reader:+--+-- An unfold acts as a reader (see 'Reader' monad). The input to an unfold acts+-- as the read-only environment. The environment can be extracted using the+-- 'identity' unfold (equivalent to 'ask') and transformed using 'lmap'.++------------------------------------------------------------------------------+-- Monadic Unfolds+------------------------------------------------------------------------------++-- | An @Unfold m a b@ is a generator of a stream of values of type @b@ from a+-- seed of type 'a' in 'Monad' @m@.+--+data Unfold m a b =+    -- | @Unfold step inject@+    forall s. Unfold (s -> m (Step s b)) (a -> m s)++------------------------------------------------------------------------------+-- Basic constructors+------------------------------------------------------------------------------++-- | Make an unfold from @step@ and @inject@ functions.+--+-- /Pre-release/+{-# INLINE mkUnfoldM #-}+mkUnfoldM :: (s -> m (Step s b)) -> (a -> m s) -> Unfold m a b+mkUnfoldM = Unfold++-- | Make an unfold from a step function.+--+-- See also: 'unfoldrM'+--+-- /Pre-release/+{-# INLINE mkUnfoldrM #-}+mkUnfoldrM :: Applicative m => (a -> m (Step a b)) -> Unfold m a b+mkUnfoldrM step = Unfold step pure++-- The type 'Step' is isomorphic to 'Maybe'. Ideally unfoldrM should be the+-- same as mkUnfoldrM, this is for compatibility with traditional Maybe based+-- unfold step functions.++-- | 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.+--+{-# INLINE unfoldrM #-}+unfoldrM :: Applicative m => (a -> m (Maybe (b, a))) -> Unfold m a b+unfoldrM next = Unfold step pure+  where+    {-# INLINE_LATE step #-}+    step st =+        (\case+            Just (x, s) -> Yield x s+            Nothing     -> Stop) <$> next st++-- | Like 'unfoldrM' but uses a pure step function.+--+-- >>> :{+--  f [] = Nothing+--  f (x:xs) = Just (x, xs)+-- :}+--+-- >>> Unfold.fold Fold.toList (Unfold.unfoldr f) [1,2,3]+-- [1,2,3]+--+{-# INLINE unfoldr #-}+unfoldr :: Applicative m => (a -> Maybe (b, a)) -> Unfold m a b+unfoldr step = unfoldrM (pure . step)++------------------------------------------------------------------------------+-- Map input+------------------------------------------------------------------------------++-- | Map a function on the input argument of the 'Unfold'.+--+-- >>> u = Unfold.lmap (fmap (+1)) Unfold.fromList+-- >>> Unfold.fold Fold.toList u [1..5]+-- [2,3,4,5,6]+--+-- @+-- lmap f = Unfold.many (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)+-- @+--+{-# 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)+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL both #-}+both :: a -> Unfold m a b -> Unfold m Void b+both a = lmap (Prelude.const a)++-- | Supply the first component of the tuple to an unfold that accepts a tuple+-- as a seed resulting in a fold that accepts the second component of the tuple+-- as a seed.+--+-- @+-- first a = Unfold.lmap (a, )+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL first #-}+first :: a -> Unfold m (a, b) c -> Unfold m b c+first a = lmap (a, )++-- | Supply the second component of the tuple to an unfold that accepts a tuple+-- as a seed resulting in a fold that accepts the first component of the tuple+-- as a seed.+--+-- @+-- second b = Unfold.lmap (, b)+-- @+--+-- /Pre-release/+--+{-# INLINE_NORMAL second #-}+second :: b -> Unfold m (a, b) c -> Unfold m a c+second b = lmap (, b)++------------------------------------------------------------------------------+-- Filter input+------------------------------------------------------------------------------++{-# INLINE_NORMAL takeWhileMWithInput #-}+takeWhileMWithInput :: Monad m =>+    (a -> b -> m Bool) -> Unfold m a b -> Unfold m a b+takeWhileMWithInput f (Unfold step1 inject1) = Unfold step inject++    where++    inject a = do+        s <- inject1 a+        return $ Tuple' a s++    {-# INLINE_LATE step #-}+    step (Tuple' a st) = do+        r <- step1 st+        case r of+            Yield x s -> do+                b <- f a x+                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.+--+{-# INLINE_NORMAL takeWhileM #-}+takeWhileM :: Monad m => (b -> m Bool) -> Unfold m a b -> Unfold m a b+-- XXX Check if the compiler simplifies the following to the same as the custom+-- implementation below (the Tuple' should help eliminate the unused param):+--+-- takeWhileM f = takeWhileMWithInput (\_ b -> f b)+takeWhileM f (Unfold step1 inject1) = Unfold step inject1+  where+    {-# INLINE_LATE step #-}+    step st = do+        r <- step1 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 generated by the 'Unfold' as soon as the predicate fails+-- on an element.+--+{-# INLINE takeWhile #-}+takeWhile :: Monad m => (b -> Bool) -> Unfold m a b -> Unfold m a b+takeWhile f = takeWhileM (return . f)++------------------------------------------------------------------------------+-- Functor+------------------------------------------------------------------------------++{-# INLINE_NORMAL mapM2 #-}+mapM2 :: Monad m => (a -> b -> m c) -> Unfold m a b -> Unfold m a c+mapM2 f (Unfold ustep uinject) = Unfold step inject+    where+    inject a = do+        r <- uinject a+        return (a, r)++    {-# INLINE_LATE step #-}+    step (inp, st) = do+        r <- ustep st+        case r of+            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)+mapM f (Unfold ustep uinject) = Unfold step uinject+    where+    {-# INLINE_LATE step #-}+    step st = do+        r <- ustep st+        case r of+            Yield x s -> f x >>= \a -> return $ Yield a s+            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.++-- |+--+-- >>> map2 f = Unfold.mapM2 (\a b -> pure (f a b))+--+-- 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.+--+{-# 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)++    where++    func a r =+        case r of+            Yield x s -> Yield (f a x) (a, s)+            Skip s    -> Skip (a, s)+            Stop      -> Stop++    {-# INLINE_LATE step #-}+    step (a, st) = fmap (func a) (ustep st)++-- | 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+-- map f = map2 (const f)+map f (Unfold ustep uinject) = Unfold step uinject++    where++    {-# INLINE_LATE step #-}+    step st = fmap (fmap f) (ustep st)++-- | Maps a function on the output of the unfold (the type @b@).+instance Functor m => Functor (Unfold m a) where+    {-# INLINE fmap #-}+    fmap = map++------------------------------------------------------------------------------+-- Applicative+------------------------------------------------------------------------------++-- XXX Shouldn't this be Unfold m (m a) a ?++-- | The unfold discards its input and generates a function stream using the+-- supplied monadic action.+--+-- /Pre-release/+{-# INLINE fromEffect #-}+fromEffect :: Applicative m => m b -> Unfold m a b+fromEffect m = Unfold step inject++    where++    inject _ = pure False++    step False = (`Yield` True) <$> m+    step True = pure Stop++-- XXX Shouldn't this be Unfold m a a ? Which is identity. Should this function+-- even exist for Unfolds. Should we have applicative/Monad for unfolds?++-- | Discards the unfold input and always returns the argument of 'fromPure'.+--+-- > fromPure = fromEffect . pure+--+-- /Pre-release/+fromPure :: Applicative m => b -> Unfold m a b+fromPure = fromEffect Prelude.. pure++-- XXX Check if "unfold (fromList [1..10])" fuses, if it doesn't we can use+-- rewrite rules to rewrite list enumerations to unfold enumerations.++-- | Convert a list of pure values to a 'Stream'+--+{-# INLINE_LATE fromList #-}+fromList :: Applicative m => Unfold m [a] a+fromList = Unfold step pure++    where++    {-# INLINE_LATE step #-}+    step (x:xs) = pure $ Yield x xs+    step [] = pure Stop++-- | Outer product discarding the first element.+--+-- /Unimplemented/+--+{-# INLINE_NORMAL crossApplySnd #-}+crossApplySnd :: -- Monad m =>+    Unfold m a b -> Unfold m a c -> Unfold m a c+crossApplySnd (Unfold _step1 _inject1) (Unfold _step2 _inject2) = undefined++-- | Outer product discarding the second element.+--+-- /Unimplemented/+--+{-# INLINE_NORMAL crossApplyFst #-}+crossApplyFst :: -- Monad m =>+    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++{-# 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++    where++    inject a = do+        s <- inject1 a+        return $ Many2Outer a s++    {-# INLINE_LATE step #-}+    step (Many2Outer a st) = do+        r <- step1 st+        case r of+            Yield b s -> do+                innerSt <- inject2 (a, b)+                return $ Skip (Many2Inner a s innerSt)+            Skip s    -> return $ Skip (Many2Outer a s)+            Stop      -> return Stop++    step (Many2Inner a ost ist) = do+        r <- step2 ist+        return $ case r of+            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++-- | 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 =>+    (b -> c -> m d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+-- crossWithM f u1 u2 = many2 (mapM2 (\(_, b) c -> f b c) (lmap fst u2)) u1+crossWithM f (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject++    where++    inject a = do+        s1 <- inject1 a+        return $ CrossOuter a s1++    {-# INLINE_LATE step #-}+    step (CrossOuter a s1) = do+        r <- step1 s1+        case r of+            Yield b s -> do+                s2 <- inject2 a+                return $ Skip (CrossInner a s b s2)+            Skip s    -> return $ Skip (CrossOuter a s)+            Stop      -> return Stop++    step (CrossInner a s1 b s2) = do+        r <- step2 s2+        case r of+            Yield c s -> f b c >>= \d -> return $ Yield d (CrossInner a s1 b s)+            Skip s    -> return $ Skip (CrossInner a s1 b s)+            Stop      -> return $ Skip (CrossOuter a s1)++-- | Like 'crossWithM' but uses a pure combining function.+--+-- > crossWith f = crossWithM (\b c -> return $ f b c)+--+-- >>> u1 = Unfold.lmap fst Unfold.fromList+-- >>> u2 = Unfold.lmap snd Unfold.fromList+-- >>> u = Unfold.crossWith (,) u1 u2+-- >>> Unfold.fold Fold.toList u ([1,2,3], [4,5,6])+-- [(1,4),(1,5),(1,6),(2,4),(2,5),(2,6),(3,4),(3,5),(3,6)]+--+{-# INLINE crossWith #-}+crossWith :: Monad m =>+    (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+crossWith f = crossWithM (\b c -> return $ f b c)++-- | See 'crossWith'.+--+-- Definition:+--+-- >>> cross = Unfold.crossWith (,)+--+-- To create a cross product of the streams generated from a tuple we can+-- write:+--+-- >>> :{+-- cross :: Monad m => Unfold m a b -> Unfold m c d -> Unfold m (a, c) (b, d)+-- cross u1 u2 = Unfold.cross (Unfold.lmap fst u1) (Unfold.lmap snd u2)+-- :}+--+-- /Pre-release/+{-# INLINE_NORMAL cross #-}+cross :: Monad m => Unfold m a b -> Unfold m a c -> Unfold m a (b, c)+cross = crossWith (,)++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)++-- XXX Applicative makes sense for unfolds, but monad does not. Use streams for+-- monad.++{-+-- | Example:+--+-- >>> rlist = Unfold.lmap fst Unfold.fromList+-- >>> llist = Unfold.lmap snd Unfold.fromList+-- >>> Stream.fold Fold.toList $ Stream.unfold ((,) <$> rlist <*> llist) ([1,2],[3,4])+-- [(1,3),(1,4),(2,3),(2,4)]+--+instance Monad m => Applicative (Unfold m a) where+    {-# INLINE pure #-}+    pure = fromPure++    {-# INLINE (<*>) #-}+    (<*>) = apply++    -- {-# INLINE (*>) #-}+    -- (*>) = apSequence++    -- {-# INLINE (<*) #-}+    -- (<*) = apDiscardSnd+-}++------------------------------------------------------------------------------+-- Monad+------------------------------------------------------------------------------++data ConcatMapState m b s1 x =+      ConcatMapOuter x s1+    | forall s2. ConcatMapInner x s1 s2 (s2 -> m (Step s2 b))++-- XXX This is experimental. We should rather use streams if concatMap like+-- functionality is needed. This is no more efficient than streams.++-- | Map an unfold generating action to each element of an unfold and+-- flatten the results into a single stream.+--+{-# INLINE_NORMAL concatMapM #-}+concatMapM :: Monad m+    => (b -> m (Unfold m a c)) -> Unfold m a b -> Unfold m a c+concatMapM f (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        return $ ConcatMapOuter x s++    {-# INLINE_LATE step #-}+    step (ConcatMapOuter seed st) = do+        r <- step1 st+        case r of+            Yield x s -> do+                Unfold step2 inject2 <- f x+                innerSt <- inject2 seed+                return $ Skip (ConcatMapInner seed s innerSt step2)+            Skip s    -> return $ Skip (ConcatMapOuter seed s)+            Stop      -> return Stop++    step (ConcatMapInner seed ost ist istep) = do+        r <- istep ist+        return $ case r of+            Yield x s -> Yield x (ConcatMapInner seed ost s istep)+            Skip s    -> Skip (ConcatMapInner seed ost s istep)+            Stop      -> Skip (ConcatMapOuter seed ost)++{-# INLINE concatMap #-}+concatMap :: Monad m => (b -> Unfold m a c) -> Unfold m a b -> Unfold m a c+concatMap f = concatMapM (return Prelude.. f)++infixl 1 `bind`++{-# INLINE bind #-}+bind :: Monad m => Unfold m a b -> (b -> Unfold m a c) -> Unfold m a c+bind = flip concatMap++{-+-- Note: concatMap and Monad instance for unfolds have performance comparable+-- to Stream. In fact, concatMap is slower than Stream, that may be some+-- optimization issue though.+--+-- Monad allows an unfold to depend on the output of a previous unfold.+-- However, it is probably easier to use streams in such situations.+--+-- | Example:+--+-- >>> :{+--  u = do+--   x <- Unfold.enumerateFromToIntegral 4+--   y <- Unfold.enumerateFromToIntegral x+--   return (x, y)+-- :}+-- >>> Stream.fold Fold.toList $ Stream.unfold u 1+-- [(1,1),(2,1),(2,2),(3,1),(3,2),(3,3),(4,1),(4,2),(4,3),(4,4)]+--+instance Monad m => Monad (Unfold m a) where+    {-# INLINE return #-}+    return = pure++    {-# INLINE (>>=) #-}+    (>>=) = flip concatMap++    -- {-# INLINE (>>) #-}+    -- (>>) = (*>)+-}++-------------------------------------------------------------------------------+-- Category+-------------------------------------------------------------------------------++-- | Lift a monadic function into an unfold. The unfold generates a singleton+-- stream.+--+{-# INLINE functionM #-}+functionM :: Applicative m => (a -> m b) -> Unfold m a b+functionM f = Unfold step inject++    where++    inject x = pure $ Just x++    {-# INLINE_LATE step #-}+    step (Just x) = (`Yield` Nothing) <$> f x+    step Nothing = pure Stop++-- | Lift a pure function into an unfold. The unfold generates a singleton+-- stream.+--+-- > function f = functionM $ return . f+--+{-# INLINE function #-}+function :: Applicative m => (a -> b) -> Unfold m a b+function f = functionM $ pure Prelude.. f++-- | Identity unfold. The unfold generates a singleton stream having the input+-- as the only element.+--+-- > identity = function Prelude.id+--+-- /Pre-release/+{-# INLINE identity #-}+identity :: Applicative m => Unfold m a a+identity = function Prelude.id++{-# ANN type ConcatState Fuse #-}+data ConcatState s1 s2 = ConcatOuter s1 | ConcatInner s1 s2++-- | 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+-- many u1 = many2 (lmap snd u1)+many (Unfold step2 inject2) (Unfold step1 inject1) = Unfold step inject++    where++    inject x = do+        s <- inject1 x+        return $ ConcatOuter s++    {-# INLINE_LATE step #-}+    step (ConcatOuter st) = do+        r <- step1 st+        case r of+            Yield x s -> do+                innerSt <- inject2 x+                return $ Skip (ConcatInner s innerSt)+            Skip s    -> return $ Skip (ConcatOuter s)+            Stop      -> return Stop++    step (ConcatInner ost ist) = do+        r <- step2 ist+        return $ case r of+            Yield x s -> Yield x (ConcatInner ost s)+            Skip s    -> Skip (ConcatInner ost s)+            Stop      -> Skip (ConcatOuter ost)++{-+-- XXX There are multiple possible ways to combine the unfolds, "many" appends+-- them, we could also have other variants of "many" e.g. manyInterleave.+-- Should we even have a category instance or just use these functions+-- directly?+--+instance Monad m => Category (Unfold m) where+    {-# INLINE id #-}+    id = identity++    {-# INLINE (.) #-}+    (.) = many+-}++-------------------------------------------------------------------------------+-- Zipping+-------------------------------------------------------------------------------++-- | Distribute the input to two unfolds and then zip the outputs to a single+-- stream using a monadic zip function.+--+-- 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 (Unfold step1 inject1) (Unfold step2 inject2) = Unfold step inject++    where++    inject x = do+        s1 <- inject1 x+        s2 <- inject2 x+        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++-- | Like 'zipWithM' but with a pure zip function.+--+-- >>> square = fmap (\x -> x * x) Unfold.fromList+-- >>> cube = fmap (\x -> x * x * x) Unfold.fromList+-- >>> u = Unfold.zipWith (,) square cube+-- >>> Unfold.fold Fold.toList u [1..5]+-- [(1,1),(4,8),(9,27),(16,64),(25,125)]+--+-- > zipWith f = zipWithM (\a b -> return $ f a b)+--+{-# INLINE zipWith #-}+zipWith :: Monad m+    => (b -> c -> d) -> Unfold m a b -> Unfold m a c -> Unfold m a d+zipWith f = zipWithM (\a b -> return (f a b))++-------------------------------------------------------------------------------+-- Arrow+-------------------------------------------------------------------------------++{-+-- XXX There are multiple ways of combining the outputs of two unfolds, we+-- could zip, merge, append and more. What is the preferred way for Arrow+-- instance? Should we even have an arrow instance or just use these functions+-- directly?+--+-- | '***' is a zip like operation, in fact it is the same as @Unfold.zipWith+-- (,)@, '&&&' is a tee like operation  i.e. distributes the input to both the+-- unfolds and then zips the output.+--+{-# ANN module "HLint: ignore Use zip" #-}+instance Monad m => Arrow (Unfold m) where+    {-# INLINE arr #-}+    arr = function++    {-# INLINE (***) #-}+    u1 *** u2 = zipWith (,) (lmap fst u1) (lmap snd u2)+-}++------------------------------------------------------------------------------+-- Interleaving+------------------------------------------------------------------------------++-- We can possibly have an "interleave" operation to interleave the streams+-- from two seeds:+--+-- interleave :: Unfold m x a -> Unfold m x a -> Unfold m (x, x) a+--+-- Alternatively, we can use a signature like zipWith:+-- interleave :: Unfold m x a -> Unfold m x a -> Unfold m x a+--+-- We can implement this in terms of manyInterleave, but that may+-- not be as efficient as a custom implementation.+--+-- Similarly we can also have other binary combining ops like append, mergeBy.+-- We already have zipWith.+--++data ManyInterleaveState o i =+      ManyInterleaveOuter o [i]+    | ManyInterleaveInner o [i]+    | ManyInterleaveInnerL [i] [i]+    | ManyInterleaveInnerR [i] [i]++-- | 'Streamly.Internal.Data.Stream.unfoldManyInterleave' 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) =+    Unfold step inject++    where++    inject x = do+        ost <- oinject x+        return (ManyInterleaveOuter ost [])++    {-# INLINE_LATE step #-}+    step (ManyInterleaveOuter o ls) = do+        r <- ostep o+        case r of+            Yield a o' -> do+                i <- iinject a+                i `seq` return (Skip (ManyInterleaveInner o' (i : ls)))+            Skip o' -> return $ Skip (ManyInterleaveOuter o' ls)+            Stop -> return $ Skip (ManyInterleaveInnerL ls [])++    step (ManyInterleaveInner _ []) = undefined+    step (ManyInterleaveInner o (st:ls)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ManyInterleaveOuter o (s:ls))+            Skip s    -> Skip (ManyInterleaveInner o (s:ls))+            Stop      -> Skip (ManyInterleaveOuter o ls)++    step (ManyInterleaveInnerL [] []) = return Stop+    step (ManyInterleaveInnerL [] rs) =+        return $ Skip (ManyInterleaveInnerR [] rs)++    step (ManyInterleaveInnerL (st:ls) rs) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ManyInterleaveInnerL ls (s:rs))+            Skip s    -> Skip (ManyInterleaveInnerL (s:ls) rs)+            Stop      -> Skip (ManyInterleaveInnerL ls rs)++    step (ManyInterleaveInnerR [] []) = return Stop+    step (ManyInterleaveInnerR ls []) =+        return $ Skip (ManyInterleaveInnerL ls [])++    step (ManyInterleaveInnerR ls (st:rs)) = do+        r <- istep st+        return $ case r of+            Yield x s -> Yield x (ManyInterleaveInnerR (s:ls) rs)+            Skip s    -> Skip (ManyInterleaveInnerR ls (s:rs))+            Stop      -> Skip (ManyInterleaveInnerR ls rs)
+ src/Streamly/Internal/FileSystem/Dir.hs view
@@ -0,0 +1,463 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.FileSystem.Dir+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : pre-release+-- Portability : GHC++module Streamly.Internal.FileSystem.Dir+    (+    -- * Streams+      read++    -- read not just the names but also the inode attrs of the children. This+    -- abstraction makes sense because when we read the dir contents we also+    -- get the inodes, and it is cheaper to get the attrs from the inodes+    -- instead of resolving the paths and get those. This abstraction may be+    -- less portable as different platforms may have different attrs. To+    -- optimize, we can also add a filter/pattern/parser on the names of the+    -- children that we want to read. We can call that readAttrsWith? Or just+    -- have the default readAttrs do that? Usually we won't need that, so it+    -- may be better to keep that a separate API.+    -- , readAttrs++    -- recursive read requires us to read the attributes of the children to+    -- determine if something is a dirctory or not. Therefore, it may be a good+    -- idea to have a low level routine that also spits out the attributes of+    -- the files, we get that for free. We can also add a filter/pattern/parser+    -- on the names of the children that we want to read.+    --, readAttrsRecursive -- Options: acyclic, follow symlinks+    , readFiles+    , readDirs+    , readEither+    , readEitherPaths++    -- 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+    -}+    -- * Deprecated+    , toStream+    , toEither+    , toFiles+    , toDirs+    )+where++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)++-- 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++--  | Read a directory emitting a stream with names of the children. Filter out+--  "." and ".." entries.+--+--  /Internal/+--+{-# INLINE reader #-}+reader :: MonadIO m => Unfold m FilePath FilePath+reader =+    -- 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.++-- | Read directories as Left and files as Right. Filter out "." and ".."+-- entries.+--+--  /Internal/+--+{-# INLINE eitherReader #-}+eitherReader :: MonadIO m => Unfold m FilePath (Either FilePath FilePath)+eitherReader = UF.mapM2 classify reader++    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++--+-- | Read files only.+--+--  /Internal/+--+{-# INLINE fileReader #-}+fileReader :: MonadIO m => Unfold m FilePath FilePath+fileReader = fmap (fromRight undefined) $ UF.filter isRight eitherReader++-- | 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++-- | Raw read of a directory.+--+-- /Pre-release/+{-# INLINE read #-}+read :: MonadIO 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 = read++-- | 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 => 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 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 = readEither++-- | Read files only.+--+--  /Internal/+--+{-# INLINE readFiles #-}+readFiles :: MonadIO 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 = readFiles++-- | Read directories only.+--+--  /Internal/+--+{-# INLINE readDirs #-}+readDirs :: MonadIO 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 = 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/File.hs view
@@ -0,0 +1,679 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.FileSystem.File+-- 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. Unlike the handle based APIs which can have a read/write+-- session consisting of multiple reads and writes to the handle, these APIs+-- are one shot read or write APIs. These APIs open the file handle, perform+-- the requested operation and close the handle. Thease are safer compared to+-- the handle based APIs as there is no possibility of a file descriptor+-- leakage.+--+-- > import qualified Streamly.Internal.FileSystem.File as File+--++module Streamly.Internal.FileSystem.File+    (+    -- * 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 -- putBytes?+    , fromBytesWith+    , fromChunks++    -- ** Append To File+    , append+    , appendWith+    -- , appendShared+    , appendArray+    , appendChunks++    -- * Deprecated+    , readWithBufferOf+    , readChunksWithBufferOf+    , readChunksFromToWith+    , toBytes+    , toChunks+    , toChunksWithBufferOf+    , writeWithBufferOf+    , fromBytesWithBufferOf+    )+where++import Control.Monad.Catch (MonadCatch)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Word (Word8)+import System.IO (Handle, openFile, IOMode(..), hClose)+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.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.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++-------------------------------------------------------------------------------+-- 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 using 'openFile' and passes+-- the resulting handle to the computation @act@.  The handle will be+-- closed on exit from 'withFile', whether by normal termination or by+-- raising an exception.  If closing the handle raises an exception, then+-- this exception will be raised by 'withFile' rather than any exception+-- raised by 'act'.+--+-- /Pre-release/+--+{-# 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++-- | 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+-- or in case of an exception.  If closing the handle raises an exception, then+-- this exception will be raised by 'usingFile'.+--+-- /Pre-release/+--+{-# INLINE usingFile #-}+usingFile :: (MonadIO m, MonadCatch m)+    => Unfold m Handle a -> Unfold m FilePath a+usingFile = UF.bracketIO (`openFile` ReadMode) hClose++{-# INLINE usingFile2 #-}+usingFile2 :: (MonadIO m, MonadCatch m)+    => Unfold m (x, Handle) a -> Unfold m (x, FilePath) a+usingFile2 = UF.bracketIO before after++    where++    before (x, file) =  do+        h <- openFile file ReadMode+        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, FilePath) a+usingFile3 = UF.bracketIO before after++    where++    before (x, y, z, file) =  do+        h <- openFile file ReadMode+        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 :: 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)++-------------------------------------------------------------------------------+-- 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 -> FilePath -> Stream m (Array Word8)+readChunksWith size file =+    withFile file ReadMode (FH.readChunksWith size)++{-# DEPRECATED toChunksWithBufferOf "Please use 'readChunksWith' instead" #-}+{-# INLINE toChunksWithBufferOf #-}+toChunksWithBufferOf :: (MonadIO m, MonadCatch m)+    => Int -> FilePath -> Stream m (Array Word8)+toChunksWithBufferOf = readChunksWith++-- 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)+    => FilePath -> Stream m (Array Word8)+readChunks = readChunksWith defaultChunkSize++{-# DEPRECATED toChunks "Please use 'readChunks' instead" #-}+{-# INLINE toChunks #-}+toChunks :: (MonadIO m, MonadCatch m) => FilePath -> Stream m (Array Word8)+toChunks = readChunks++-------------------------------------------------------------------------------+-- 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, FilePath) (Array Word8)+chunkReaderWith = usingFile2 FH.chunkReaderWith++{-# DEPRECATED readChunksWithBufferOf+    "Please use 'chunkReaderWith' instead" #-}+{-# INLINE readChunksWithBufferOf #-}+readChunksWithBufferOf :: (MonadIO m, MonadCatch m)+    => Unfold m (Int, FilePath) (Array Word8)+readChunksWithBufferOf = 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, FilePath) (Array Word8)+chunkReaderFromToWith = usingFile3 FH.chunkReaderFromToWith++{-# DEPRECATED readChunksFromToWith+    "Please use 'chunkReaderFromToWith' instead" #-}+{-# INLINE readChunksFromToWith #-}+readChunksFromToWith :: (MonadIO m, MonadCatch m) =>+    Unfold m (Int, Int, Int, FilePath) (Array Word8)+readChunksFromToWith = chunkReaderFromToWith++-- | Unfolds a 'FilePath' 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 FilePath (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, FilePath) Word8+readerWith = usingFile2 FH.readerWith++{-# DEPRECATED readWithBufferOf "Please use 'readerWith' instead" #-}+{-# INLINE readWithBufferOf #-}+readWithBufferOf :: (MonadIO m, MonadCatch m) =>+    Unfold m (Int, FilePath) Word8+readWithBufferOf = 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 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++-- | 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) => FilePath -> Stream m Word8+read file = concatChunks $ withFile file ReadMode FH.readChunks++{-# DEPRECATED toBytes "Please use 'read' instead"  #-}+{-# INLINE toBytes #-}+toBytes :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8+toBytes = read++{-+-- | 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 -> FilePath -> 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)+    => FilePath -> 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 -> FilePath -> Stream m Word8 -> m ()+fromBytesWith n file xs = fromChunks file $ S.chunksOf n xs++{-# DEPRECATED fromBytesWithBufferOf "Please use 'fromBytesWith' instead"  #-}+{-# INLINE fromBytesWithBufferOf #-}+fromBytesWithBufferOf :: (MonadIO m, MonadCatch m)+    => Int -> FilePath -> Stream m Word8 -> m ()+fromBytesWithBufferOf = fromBytesWith++-- > 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) => FilePath -> 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 handle. Each chunk in the stream is written+-- to the device as a separate IO request.+--+-- /Pre-release/+{-# INLINE writeChunks #-}+writeChunks :: (MonadIO m, MonadCatch m)+    => FilePath -> Fold m (Array a) ()+writeChunks path = Fold step initial extract+    where+    initial = do+        h <- liftIO (openFile path WriteMode)+        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+        liftIO $ hClose h+        res <- initial1+        case res of+            FL.Partial fs -> extract1 fs+            FL.Done fb -> return fb++-- | @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 -> FilePath -> Fold m Word8 ()+writeWith n path =+    groupsOf n (writeNUnsafe n) (writeChunks path)++{-# DEPRECATED writeWithBufferOf "Please use 'writeWith' instead"  #-}+{-# INLINE writeWithBufferOf #-}+writeWithBufferOf :: (MonadIO m, MonadCatch m)+    => Int -> FilePath -> Fold m Word8 ()+writeWithBufferOf = writeWith++-- > 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) => FilePath -> Fold m Word8 ()+write = writeWith defaultChunkSize++-- | Append a stream of arrays to a file.+--+-- /Pre-release/+--+{-# INLINE appendChunks #-}+appendChunks :: (MonadIO m, MonadCatch m)+    => FilePath -> Stream m (Array a) -> m ()+appendChunks = 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 appendWith #-}+appendWith :: (MonadIO m, MonadCatch m)+    => Int -> FilePath -> Stream m Word8 -> m ()+appendWith n file xs = appendChunks file $ S.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 append #-}+append :: (MonadIO m, MonadCatch m) => FilePath -> Stream m Word8 -> m ()+append = appendWith 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
@@ -0,0 +1,713 @@+#include "inline.hs"++-- |+-- Module      : Streamly.Internal.FileSystem.Handle+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD3+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- The fundamental singleton IO APIs are 'getChunk' and 'putChunk' and the+-- fundamental stream IO APIs built on top of those are+-- 'readChunksWith' and 'writeChunks'. Rest of this module is just+-- combinatorial programming using these.+--+-- We can achieve line buffering by folding lines in the input stream into a+-- stream of arrays using Stream.splitOn or Fold.takeEndBy_ and similar+-- operations. One can wrap the input stream in 'Maybe' type and then use+-- 'writeMaybesWith' to achieve user controlled buffering.++-- TODO: Need a separate module for pread/pwrite based reading writing for+-- seekable devices.  Stateless read/write can be helpful in multithreaded+-- applications.+--+module Streamly.Internal.FileSystem.Handle+    (+    -- * Singleton APIs+      getChunk+    , getChunkOf+    , putChunk++    -- * Streams+    , read+    , readWith+    , readChunksWith+    , readChunks++    -- * Unfolds+    , reader+    -- , readUtf8+    -- , readLines+    -- , readFrames+    , readerWith+    , chunkReader+    , chunkReaderWith++    -- * Folds+    , write+    -- , writeUtf8+    -- , writeUtf8ByLines+    -- , writeByFrames+    -- , writeLines+    , writeWith+    , writeChunks+    , writeChunksWith+    , writeMaybesWith++    -- * Refolds+    , writer+    , writerWith+    , chunkWriter+    -- , chunkWriterWith++    -- * Stream writes+    , putBytes+    , putBytesWith+    , putChunksWith+    , putChunks++    -- * Random Access (Seek)+    -- | Unlike the streaming APIs listed above, these APIs apply to devices or+    -- files that have random access or seek capability.  This type of devices+    -- include disks, files, memory devices and exclude terminals, pipes,+    -- sockets and fifos.++    -- We can also generate the request pattern using a funciton.+    --+    -- , readIndex+    -- , readFrom -- read from a given position to the end of file+    -- , readFromRev -- read from a given position the beginning of file+    -- , readTo   -- read from beginning up to the given position+    -- , readToRev -- read from end to the given position in file+    -- , readFromTo+    -- , readFromThenTo++    -- , readChunksFrom+    -- , readChunksFromTo+    , chunkReaderFromToWith+    -- , readChunksFromThenToWith++    -- , writeIndex+    -- , writeFrom -- start writing at the given position+    -- , writeFromRev+    -- , writeTo   -- write from beginning up to the given position+    -- , writeToRev+    -- , writeFromTo+    -- , writeFromThenTo+    --+    -- , writeChunksFrom+    -- , writeChunksFromTo+    -- , writeChunksFromToWith+    -- , writeChunksFromThenToWith++    -- * Deprecated+    , readChunksWithBufferOf+    , readWithBufferOf+    , writeChunksWithBufferOf+    , writeWithBufferOf+    )+where++import Control.Exception (assert)+import Control.Monad.IO.Class (MonadIO(..))+import Data.Function ((&))+import Data.Maybe (isNothing, fromJust)+import Data.Word (Word8)+import Streamly.Internal.Data.Unboxed (Unbox)+import System.IO (Handle, SeekMode(..), hGetBufSome, hPutBuf, hSeek)+import Prelude hiding (read)++import Streamly.Internal.Data.Fold (Fold)+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)+-- 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.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+    (Stream(..), Step(..))+import qualified Streamly.Internal.Data.Unfold as UF+import qualified Streamly.Internal.Data.Stream.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)++-------------------------------------------------------------------------------+-- 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.++-------------------------------------------------------------------------------+-- Array IO (Input)+-------------------------------------------------------------------------------++-- | 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+-- without blocking. As a result of this behavior, it may read less than or+-- equal to the size requested.+--+{-# 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 }++-- 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+-- later requires more copying.+--+-- | Read a 'ByteArray' consisting of exactly the specified number of bytes+-- from a file handle.+--+-- /Unimplemented/+{-# INLINABLE getChunkOf #-}+getChunkOf :: Int -> Handle -> IO (Array Word8)+getChunkOf = undefined++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++-- | @getChunksWith 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 _getChunksWith #-}+_getChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8)+_getChunksWith size h = S.fromStreamK go+  where+    -- XXX use cons/nil instead+    go = K.mkStream $ \_ yld _ stp -> do+        arr <- getChunk size h+        if byteLength arr == 0+        then stp+        else yld arr go++-- | @readChunksWith 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@.+--+-- >>> readChunksWith size h = Stream.unfold Handle.chunkReaderWith (size, h)+--+{-# INLINE_NORMAL readChunksWith #-}+readChunksWith :: MonadIO m => Int -> Handle -> Stream m (Array Word8)+readChunksWith size h = D.Stream step ()+  where+    {-# INLINE_LATE step #-}+    step _ _ = do+        arr <- getChunk size h+        return $+            case byteLength 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@.+--+{-# INLINE_NORMAL chunkReaderWith #-}+chunkReaderWith :: MonadIO m => Unfold m (Int, Handle) (Array Word8)+chunkReaderWith =+     UF.lmap (uncurry getChunk) UF.repeatM+   & UF.takeWhile ((/= 0) . byteLength)++-- | Same as 'chunkReaderWith'+--+{-# DEPRECATED readChunksWithBufferOf "Please use chunkReaderWith instead." #-}+{-# INLINE_NORMAL readChunksWithBufferOf #-}+readChunksWithBufferOf :: MonadIO m => Unfold m (Int, Handle) (Array Word8)+readChunksWithBufferOf = chunkReaderWith++-- There are two ways to implement this.+--+-- 1. Idiomatic: use a scan on the output of readChunksWith to total+-- the array lengths and trim the last array to correct size.+-- 2. Simply implement it from scratch like readChunksWith.+--+-- XXX Change this to readChunksWithFromTo (bufferSize, from, to, h)?++-- | The input to the unfold is @(from, to, bufferSize, handle)@. It starts+-- reading from the offset `from` in the file and reads up to the offset `to`.+--+{-# INLINE_NORMAL chunkReaderFromToWith #-}+chunkReaderFromToWith :: MonadIO m =>+    Unfold m (Int, Int, Int, Handle) (Array Word8)+chunkReaderFromToWith = Unfold step inject++    where++    inject (from, to, bufSize, h) = do+        liftIO $ hSeek h AbsoluteSeek $ fromIntegral from+        -- XXX Use a strict Tuple?+        return (to - from + 1, bufSize, h)++    {-# INLINE_LATE step #-}+    step (remaining, bufSize, h) =+        if remaining <= 0+        then return D.Stop+        else do+            arr <- getChunk (min bufSize remaining) h+            return $+                case byteLength arr of+                    0 -> D.Stop+                    len ->+                        assert (len <= remaining)+                            $ D.Yield arr (remaining - len, bufSize, h)++-- | @getChunks 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@.+--+-- >>> readChunks = Handle.readChunksWith IO.defaultChunkSize+--+-- /Pre-release/+{-# INLINE readChunks #-}+readChunks :: MonadIO m => Handle -> Stream m (Array Word8)+readChunks = readChunksWith 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'.+--+-- >>> chunkReader = Unfold.first IO.defaultChunkSize Handle.chunkReaderWith+--+{-# INLINE chunkReader #-}+chunkReader :: MonadIO m => Unfold m Handle (Array Word8)+chunkReader = UF.first defaultChunkSize chunkReaderWith++-------------------------------------------------------------------------------+-- 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.++-- | 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+--+{-# INLINE readerWith #-}+readerWith :: MonadIO m => Unfold m (Int, Handle) Word8+readerWith = UF.many A.reader chunkReaderWith++-- | Same as 'readerWith'+--+{-# DEPRECATED readWithBufferOf "Please use 'readerWith' instead." #-}+{-# INLINE readWithBufferOf #-}+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+--+-- /Pre-release/+{-# INLINE readWith #-}+readWith :: MonadIO m => Int -> Handle -> Stream m Word8+readWith size h = concatChunks $ 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+--+{-# INLINE reader #-}+reader :: MonadIO m => Unfold m Handle Word8+reader = UF.many A.reader chunkReader++-- | Generate a byte stream from a file 'Handle'.+--+-- >>> read h = Stream.unfoldMany Array.reader $ Handle.readChunks h+--+-- /Pre-release/+{-# INLINE read #-}+read :: MonadIO m => Handle -> Stream m Word8+read = concatChunks . readChunks++-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Array IO (output)+-------------------------------------------------------------------------------++-- | Write an 'Array' to a file handle.+--+{-# INLINABLE putChunk #-}+putChunk :: 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++-------------------------------------------------------------------------------+-- Stream of Arrays IO+-------------------------------------------------------------------------------++-------------------------------------------------------------------------------+-- Writing+-------------------------------------------------------------------------------++-- XXX use an unfold to fromObjects or fromUnfold so that we can put any object+-- | Write a stream of arrays to a handle.+--+-- >>> putChunks h = Stream.fold (Fold.drainBy (Handle.putChunk h))+--+{-# INLINE putChunks #-}+putChunks :: 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+-- AS.concat is written in terms of foldMany. Once that is done we can write+-- idiomatic def in the docs.+--+-- | @putChunksWith 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.+--+{-# INLINE putChunksWith #-}+putChunksWith :: (MonadIO m, Unbox a)+    => Int -> Handle -> Stream m (Array a) -> m ()+putChunksWith n h xs = putChunks h $ AS.compact n xs++-- | @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++-- | 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.+--+-- >>> putBytes = Handle.putBytesWith IO.defaultChunkSize+--+{-# INLINE putBytes #-}+putBytes :: MonadIO m => Handle -> Stream m Word8 -> m ()+putBytes = putBytesWith defaultChunkSize++-- | Write a stream of arrays to a handle. Each array in the stream is written+-- to the device as a separate IO request.+--+-- writeChunks h = Fold.drainBy (Handle.putChunk h)+--+{-# INLINE writeChunks #-}+writeChunks :: 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 = 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+-- it emitted as it is. Multiple arrays are coalesed as long as the total size+-- remains below the specified size.+--+{-# INLINE writeChunksWith #-}+writeChunksWith :: (MonadIO m, Unbox a)+    => Int -> Handle -> Fold m (Array a) ()+writeChunksWith n h = lpackArraysChunksOf n (writeChunks h)++-- | Same as 'writeChunksWith'+--+{-# DEPRECATED writeChunksWithBufferOf "Please use writeChunksWith instead." #-}+{-# INLINE writeChunksWithBufferOf #-}+writeChunksWithBufferOf :: (MonadIO m, Unbox a)+    => Int -> Handle -> Fold m (Array a) ()+writeChunksWithBufferOf = writeChunksWith++-- 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.++-- XXX Maybe we should have a Fold.chunksOf like we have Stream.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)+--+{-# INLINE writeWith #-}+writeWith :: MonadIO m => Int -> Handle -> Fold m Word8 ()+writeWith n h = FL.groupsOf n (writeNUnsafe n) (writeChunks h)++-- | Same as 'writeWith'+--+{-# DEPRECATED writeWithBufferOf "Please use writeWith instead." #-}+{-# INLINE writeWithBufferOf #-}+writeWithBufferOf :: MonadIO m => Int -> Handle -> Fold m Word8 ()+writeWithBufferOf = writeWith++-- | Write a stream of 'Maybe' values. Keep buffering the just values in an+-- array until a 'Nothing' is encountered or the buffer size exceeds the+-- specified limit, at that point flush the buffer to the handle.+--+-- /Pre-release/+{-# INLINE writeMaybesWith #-}+writeMaybesWith :: (MonadIO m )+    => Int -> Handle -> Fold m (Maybe Word8) ()+writeMaybesWith n h =+    let writeNJusts = FL.lmap fromJust $ A.writeN n+        writeOnNothing = FL.takeEndBy_ isNothing writeNJusts+    in FL.many writeOnNothing (writeChunks h)++-- | Like 'writeWith' but uses the experimental 'Refold' API.+--+-- /Internal/+{-# INLINE writerWith #-}+writerWith :: MonadIO m => Int -> Refold m Handle Word8 ()+writerWith n =+    FL.refoldMany (FL.take n $ writeNUnsafe 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+-- to the IO device.+--+-- >>> write = Handle.writeWith IO.defaultChunkSize+--+{-# INLINE write #-}+write :: MonadIO m => Handle -> Fold m Word8 ()+write = writeWith defaultChunkSize++-- | Like 'write'  but uses the experimental 'Refold' API.+--+-- /Internal/+{-# INLINE writer #-}+writer :: MonadIO m => Refold m Handle Word8 ()+writer = writerWith defaultChunkSize++-- XXX mmap a file into an array. This could be useful for in-place operations+-- on a file. For example, we can quicksort the contents of a file by mmapping+-- it.++-------------------------------------------------------------------------------+-- IO with encoding/decoding Unicode characters+-------------------------------------------------------------------------------++{-+-- |+-- > readUtf8 = decodeUtf8 . read+--+-- Read a UTF8 encoded stream of unicode characters from a file handle.+--+{-# 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.+--+{-# 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.+--+{-# 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.+--+{-# 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.+--+{-# INLINE readFrames #-}+readFrames :: (MonadIO m, Unboxed 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@.+--+{-# INLINE writeByFrames #-}+writeByFrames :: (MonadIO m, Unboxed a)+    => Array a -> Handle -> Stream m a -> m ()+writeByFrames = undefined++-------------------------------------------------------------------------------+-- Framing by time+-------------------------------------------------------------------------------++-- | Write collecting the input in sessions of n seconds or if chunkSize+-- gets exceeded.+{-# INLINE writeByChunksOrSessionsOf #-}+writeByChunksOrSessionsOf :: MonadIO m+    => Int -> Double -> Handle -> Stream m Word8 -> m ()+writeByChunksOrSessionsOf chunkSize sessionSize h m = undefined++-- | Write collecting the input in sessions of n seconds or if defaultChunkSize+-- gets exceeded.+{-# INLINE writeBySessionsOf #-}+writeBySessionsOf :: MonadIO m => Double -> Handle -> Stream m Word8 -> m ()+writeBySessionsOf n = writeByChunksOrSessionsOf defaultChunkSize n++-------------------------------------------------------------------------------+-- 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.+--+{-# INLINE readIndex #-}+readIndex :: Unboxed 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, Unboxed 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@.+--+{-# INLINE readSlice #-}+readSlice :: (MonadIO m, Unboxed a)+    => Handle -> Int -> Int -> Stream m a+readSlice = readSliceWith A.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@.+--+{-# INLINE readSliceRev #-}+readSliceRev :: (MonadIO m, Unboxed a)+    => Handle -> Int -> Int -> Stream m a+readSliceRev h i count = undefined++-- | Write the given element at the given index in the file.+--+{-# INLINE writeIndex #-}+writeIndex :: (MonadIO m, Unboxed 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@.+--+{-# INLINE writeSlice #-}+writeSlice :: (Monad m, Unboxed 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@.+--+{-# INLINE writeSliceRev #-}+writeSliceRev :: (Monad m, Unboxed a)+    => Handle -> Int -> Int -> Stream m a -> m ()+writeSliceRev arr i len s = undefined+-}
+ src/Streamly/Internal/Serialize/FromBytes.hs view
@@ -0,0 +1,394 @@+-- |+-- 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 view
@@ -0,0 +1,374 @@+-- |+-- 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/System/IO.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE UnboxedTuples #-}++-- |+-- Module      : Streamly.Internal.System.IO+-- Copyright   : (c) 2020 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.System.IO+    ( defaultChunkSize+    , arrayPayloadSize+    , unsafeInlineIO+    , byteArrayOverhead+    )++where++-------------------------------------------------------------------------------+-- Imports+-------------------------------------------------------------------------------++#include "MachDeps.h"++import GHC.Base (realWorld#)+import GHC.IO (IO(IO))++-------------------------------------------------------------------------------+-- API+-------------------------------------------------------------------------------++{-# INLINE unsafeInlineIO #-}+unsafeInlineIO :: IO a -> a+unsafeInlineIO (IO m) = case m realWorld# of (# _, r #) -> r++-- | Returns the heap allocation overhead for allocating a byte array. Each+-- heap object contains a one word header. Byte arrays contain the size of the+-- array after the header.+--+-- See https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/rts/storage/heap-objects#arrays+--+byteArrayOverhead :: Int+byteArrayOverhead = 2 * SIZEOF_HSWORD++-- | When we allocate a byte array of size @k@ the allocator actually allocates+-- memory of size @k + byteArrayOverhead@. @arrayPayloadSize n@ returns the+-- size of the array in bytes that would result in an allocation of @n@ bytes.+--+arrayPayloadSize :: Int -> Int+arrayPayloadSize n = let size = n - byteArrayOverhead in max size 0++-- | Default maximum buffer size in bytes, for reading from and writing to IO+-- devices, the value is 32KB minus GHC allocation overhead, which is a few+-- bytes, so that the actual allocation is 32KB.+defaultChunkSize :: Int+defaultChunkSize = arrayPayloadSize (32 * 1024)
+ src/Streamly/Internal/Unicode/Array.hs view
@@ -0,0 +1,98 @@+-- |+-- Module      : Streamly.Internal.Unicode.Array+-- Copyright   : (c) 2018 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC++-- XXX Remove this or move this to Unicode.Utf32 making "Array Char" as a+-- newtype wrapper for Utf32. Is this any better than the [Char] (String) type?+-- This provides random access and the length of the string in O(1). Also,+-- better append performance.+--+module Streamly.Internal.Unicode.Array+    (+    -- * Streams of Strings+      lines+    , words+    , unlines+    , unwords+    )+where++import Control.Monad.IO.Class (MonadIO)+import Streamly.Data.Stream (Stream)+import Streamly.Internal.Data.Array (Array)++import qualified Streamly.Data.Array as A+import qualified Streamly.Internal.Unicode.Stream as S++import Prelude hiding (String, lines, words, unlines, unwords)++-- $setup+-- >>> :m+-- >>> :set -XOverloadedStrings+-- >>> import Prelude hiding (String, lines, words, unlines, unwords)+-- >>> import qualified Streamly.Data.Stream as Stream+-- >>> import qualified Streamly.Data.Fold as Fold+-- >>> import qualified Streamly.Internal.Unicode.Array as Unicode++-- | Break a string up into a stream of strings at newline characters.+-- The resulting strings do not contain newlines.+--+-- > lines = S.lines A.write+--+-- >>> Stream.fold Fold.toList $ Unicode.lines $ Stream.fromList "lines\nthis\nstring\n\n\n"+-- [fromList "lines",fromList "this",fromList "string",fromList "",fromList ""]+--+{-# INLINE lines #-}+lines :: MonadIO m => Stream m Char -> Stream m (Array Char)+lines = S.lines A.write++-- | Break a string up into a stream of strings, which were delimited+-- by characters representing white space.+--+-- > words = S.words A.write+--+-- >>> Stream.fold Fold.toList $ Unicode.words $ Stream.fromList "A  newline\nis considered white space?"+-- [fromList "A",fromList "newline",fromList "is",fromList "considered",fromList "white",fromList "space?"]+--+{-# INLINE words #-}+words :: MonadIO m => Stream m Char -> Stream m (Array Char)+words = S.words A.write++-- | Flattens the stream of @Array Char@, after appending a terminating+-- newline to each string.+--+-- 'unlines' is an inverse operation to 'lines'.+--+-- >>> Stream.fold Fold.toList $ Unicode.unlines $ Stream.fromList ["lines", "this", "string"]+-- "lines\nthis\nstring\n"+--+-- > unlines = S.unlines A.read+--+-- Note that, in general+--+-- > unlines . lines /= id+{-# INLINE unlines #-}+unlines :: MonadIO m => Stream m (Array Char) -> Stream m Char+unlines = S.unlines A.reader++-- | Flattens the stream of @Array Char@, after appending a separating+-- space to each string.+--+-- 'unwords' is an inverse operation to 'words'.+--+-- >>> Stream.fold Fold.toList $ Unicode.unwords $ Stream.fromList ["unwords", "this", "string"]+-- "unwords this string"+--+-- > unwords = S.unwords A.read+--+-- Note that, in general+--+-- > unwords . words /= id+{-# INLINE unwords #-}+unwords :: MonadIO m => Stream m (Array Char) -> Stream m Char+unwords = S.unwords A.reader
+ src/Streamly/Internal/Unicode/Parser.hs view
@@ -0,0 +1,298 @@+-- |+-- Module      : Streamly.Internal.Unicode.Parser+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- To parse a text input, use the decode routines from+-- "Streamly.Unicode.Stream" module to convert an input byte stream to a+-- Unicode Char stream and then use these parsers on the Char stream.++module Streamly.Internal.Unicode.Parser+    (+    -- * Generic+      char+    , charIgnoreCase++    -- * Sequences+    , string+    , stringIgnoreCase+    , dropSpace+    , dropSpace1++    -- * Classes+    , alpha+    , alphaNum+    , letter+    , ascii+    , asciiLower+    , asciiUpper+    , latin1+    , lower+    , upper+    , mark+    , printable+    , punctuation+    , separator+    , space+    , symbol++    -- digits+    , digit+    , octDigit+    , hexDigit+    , numeric++    -- * Numeric+    , signed+    , double+    , decimal+    , hexadecimal+    )+where++import Control.Applicative (Alternative(..))+import Data.Bits (Bits, (.|.), shiftL)+import Data.Char (ord)+import Streamly.Internal.Data.Parser (Parser)++import qualified Data.Char as Char+import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as Parser+    (+      lmap+    , satisfy+    , listEq+    , takeWhile1+    , dropWhile+    )++--------------------------------------------------------------------------------+-- Character classification+--------------------------------------------------------------------------------++-- XXX It may be possible to implement faster predicates for ASCII byte stream.+-- We can measure if there is a signficant difference and if so we can add such+-- predicates to Streamly.Unicode.Parser.Latin1.+--+#define CHAR_PARSER_SIG(NAME)         NAME :: Monad m => Parser Char m Char+-- XXX Need to use the predicates from Unicode.Char module/unicode-data package+#define CHAR_PARSER(NAME, PREDICATE)  NAME = Parser.satisfy Char.PREDICATE+#define CHAR_PARSER_DOC(PREDICATE) -- | Match any character that satisfies 'Char.PREDICATE'+#define CHAR_PARSER_INLINE(NAME)      {-# INLINE NAME #-}++CHAR_PARSER_DOC(isSpace)+CHAR_PARSER_INLINE(space)+CHAR_PARSER_SIG(space)+CHAR_PARSER(space,isSpace)++CHAR_PARSER_DOC(isLower)+CHAR_PARSER_INLINE(lower)+CHAR_PARSER_SIG(lower)+CHAR_PARSER(lower,isLower)++CHAR_PARSER_DOC(isUpper)+CHAR_PARSER_INLINE(upper)+CHAR_PARSER_SIG(upper)+CHAR_PARSER(upper,isUpper)++CHAR_PARSER_DOC(isAlpha)+CHAR_PARSER_INLINE(alpha)+CHAR_PARSER_SIG(alpha)+CHAR_PARSER(alpha,isAlpha)++CHAR_PARSER_DOC(isAlphaNum)+CHAR_PARSER_INLINE(alphaNum)+CHAR_PARSER_SIG(alphaNum)+CHAR_PARSER(alphaNum,isAlphaNum)++CHAR_PARSER_DOC(isPrint)+CHAR_PARSER_INLINE(printable)+CHAR_PARSER_SIG(printable)+CHAR_PARSER(printable,isPrint)++CHAR_PARSER_DOC(isDigit)+CHAR_PARSER_INLINE(digit)+CHAR_PARSER_SIG(digit)+CHAR_PARSER(digit,isDigit)++CHAR_PARSER_DOC(isOctDigit)+CHAR_PARSER_INLINE(octDigit)+CHAR_PARSER_SIG(octDigit)+CHAR_PARSER(octDigit,isOctDigit)++CHAR_PARSER_DOC(isHexDigit)+CHAR_PARSER_INLINE(hexDigit)+CHAR_PARSER_SIG(hexDigit)+CHAR_PARSER(hexDigit,isHexDigit)++CHAR_PARSER_DOC(isLetter)+CHAR_PARSER_INLINE(letter)+CHAR_PARSER_SIG(letter)+CHAR_PARSER(letter,isLetter)++CHAR_PARSER_DOC(isMark)+CHAR_PARSER_INLINE(mark)+CHAR_PARSER_SIG(mark)+CHAR_PARSER(mark,isMark)++CHAR_PARSER_DOC(isNumber)+CHAR_PARSER_INLINE(numeric)+CHAR_PARSER_SIG(numeric)+CHAR_PARSER(numeric,isNumber)++CHAR_PARSER_DOC(isPunctuation)+CHAR_PARSER_INLINE(punctuation)+CHAR_PARSER_SIG(punctuation)+CHAR_PARSER(punctuation,isPunctuation)++CHAR_PARSER_DOC(isSymbol)+CHAR_PARSER_INLINE(symbol)+CHAR_PARSER_SIG(symbol)+CHAR_PARSER(symbol,isSymbol)++CHAR_PARSER_DOC(isSeparator)+CHAR_PARSER_INLINE(separator)+CHAR_PARSER_SIG(separator)+CHAR_PARSER(separator,isSeparator)++CHAR_PARSER_DOC(isAscii)+CHAR_PARSER_INLINE(ascii)+CHAR_PARSER_SIG(ascii)+CHAR_PARSER(ascii,isAscii)++CHAR_PARSER_DOC(isLatin1)+CHAR_PARSER_INLINE(latin1)+CHAR_PARSER_SIG(latin1)+CHAR_PARSER(latin1,isLatin1)++CHAR_PARSER_DOC(isAsciiUpper)+CHAR_PARSER_INLINE(asciiUpper)+CHAR_PARSER_SIG(asciiUpper)+CHAR_PARSER(asciiUpper,isAsciiUpper)++CHAR_PARSER_DOC(isAsciiLower)+CHAR_PARSER_INLINE(asciiLower)+CHAR_PARSER_SIG(asciiLower)+CHAR_PARSER(asciiLower,isAsciiLower)++--------------------------------------------------------------------------------+-- Character parsers+--------------------------------------------------------------------------------++-- | Match a specific character.+{-# INLINE char #-}+char :: Monad m => Char -> Parser Char m Char+char c = Parser.satisfy (== c)++-- XXX Case conversion may lead to change in number of chars+-- | Match a specific character ignoring case.+{-# INLINE charIgnoreCase #-}+charIgnoreCase :: Monad m => Char -> Parser Char m Char+charIgnoreCase c = Parser.lmap Char.toLower (Parser.satisfy (== Char.toLower c))++--------------------------------------------------------------------------------+-- Character sequences+--------------------------------------------------------------------------------++-- | Match the input with the supplied string and return it if successful.+string :: Monad m => String -> Parser Char m String+string = Parser.listEq++-- XXX Not accurate unicode case conversion+-- | Match the input with the supplied string and return it if successful.+stringIgnoreCase :: Monad m => String -> Parser Char m String+stringIgnoreCase s =+    Parser.lmap Char.toLower (Parser.listEq (map Char.toLower s))++-- | Drop /zero/ or more white space characters.+dropSpace :: Monad m => Parser Char m ()+dropSpace = Parser.dropWhile Char.isSpace++-- | Drop /one/ or more white space characters.+dropSpace1 :: Monad m => Parser Char m ()+dropSpace1 = Parser.takeWhile1 Char.isSpace Fold.drain++--------------------------------------------------------------------------------+-- Numeric parsers+--------------------------------------------------------------------------------++-- XXX It should fail if the number is larger than the size of the type.+--+-- | Parse and decode an unsigned integral decimal number.+{-# INLINE decimal #-}+decimal :: (Monad m, Integral a) => Parser Char m a+decimal = Parser.takeWhile1 Char.isDigit (Fold.foldl' step 0)++    where++    step a c = a * 10 + fromIntegral (ord c - 48)++-- | Parse and decode an unsigned integral hexadecimal number.  The hex digits+-- @\'a\'@ through @\'f\'@ may be upper or lower case.+--+-- Note: This parser does not accept a leading @\"0x\"@ string.+{-# INLINE hexadecimal #-}+hexadecimal :: (Monad m, Integral a, Bits a) => Parser Char m a+hexadecimal = Parser.takeWhile1 isHexDigit (Fold.foldl' step 0)++    where++    isHexDigit c =+           (c >= '0' && c <= '9')+        || (c >= 'a' && c <= 'f')+        || (c >= 'A' && c <= 'F')++    step a c+        | w >= 48 && w <= 57 =+            (a `shiftL` 4) .|. fromIntegral (w - 48)+        | w >= 97 =+            (a `shiftL` 4) .|. fromIntegral (w - 87)+        | otherwise =+            (a `shiftL` 4) .|. fromIntegral (w - 55)++        where++        w = ord c++-- | Allow an optional leading @\'+\'@ or @\'-\'@ sign character before any+-- parser.+{-# INLINE signed #-}+signed :: (Num a, Monad m) => Parser Char m a -> Parser Char m a+signed p = (negate <$> (char '-' *> p)) <|> (char '+' *> p) <|> p++-- | Parse a 'Double'.+--+-- 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.+--+-- === Examples+--+-- Examples with behaviour identical to 'read', if you feed an empty+-- continuation to the first result:+--+-- > 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+--+-- Examples with behaviour identical to 'read':+--+-- > IS.parse (IS.fromList ".3")    == error "Parse failed"+-- > IS.parse (IS.fromList "e3")    == error "Parse failed"+--+-- Example of difference from 'read':+--+-- > IS.parse double (IS.fromList "3.foo") == 3.0+--+-- This function does not accept string representations of \"NaN\" or+-- \"Infinity\".+--+-- /Unimplemented/+double :: Parser Char m Double+double = undefined
+ src/Streamly/Internal/Unicode/Stream.hs view
@@ -0,0 +1,1095 @@+-- |+-- Module      : Streamly.Internal.Unicode.Stream+-- Copyright   : (c) 2018 Composewell Technologies+--               (c) Bjoern Hoehrmann 2008-2009+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--++module Streamly.Internal.Unicode.Stream+    (+    -- * Construction (Decoding)+      decodeLatin1++    -- ** UTF-8 Decoding+    , CodingFailureMode(..)+    , writeCharUtf8'+    , parseCharUtf8With+    , decodeUtf8+    , decodeUtf8'+    , decodeUtf8_++    -- ** Resumable UTF-8 Decoding+    , DecodeError(..)+    , DecodeState+    , CodePoint+    , decodeUtf8Either+    , resumeDecodeUtf8Either++    -- ** UTF-8 Array Stream Decoding+    , decodeUtf8Chunks+    , decodeUtf8Chunks'+    , decodeUtf8Chunks_++    -- * Elimination (Encoding)+    -- ** Latin1 Encoding+    , encodeLatin1+    , encodeLatin1'+    , encodeLatin1_++    -- ** UTF-8 Encoding+    , readCharUtf8'+    , readCharUtf8+    , readCharUtf8_+    , encodeUtf8+    , encodeUtf8'+    , encodeUtf8_+    , encodeStrings+    {-+    -- * Operations on character strings+    , strip -- (dropAround isSpace)+    , stripEnd+    -}++    -- * Transformation+    , stripHead+    , lines+    , words+    , unlines+    , unwords++    -- * StreamD UTF8 Encoding / Decoding transformations.+    , decodeUtf8D+    , decodeUtf8D'+    , decodeUtf8D_+    , encodeUtf8D+    , encodeUtf8D'+    , encodeUtf8D_+    , decodeUtf8EitherD+    , resumeDecodeUtf8EitherD++    -- * Decoding String Literals+    , fromStr#++    -- * Deprecations+    , decodeUtf8Lax+    , encodeLatin1Lax+    , encodeUtf8Lax+    )+where++#include "inline.hs"++import Control.Monad (void)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Bits (shiftR, shiftL, (.|.), (.&.))+import Data.Char (chr, ord)+#if MIN_VERSION_base(4,17,0)+import Data.Char (generalCategory, GeneralCategory(Space))+#endif+import Data.Word (Word8)+import Foreign.Marshal.Alloc (mallocBytes)+import Foreign.Storable (Storable(..))+#ifndef __GHCJS__+import Fusion.Plugin.Types (Fuse(..))+#endif+import GHC.Base (assert, unsafeChr)+import GHC.Exts (Addr#)+import GHC.IO.Encoding.Failure (isSurrogate)+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.Fold (Fold)+import Streamly.Internal.Data.Stream.StreamD (Stream)+import Streamly.Internal.Data.Stream.StreamD (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.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.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 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++-------------------------------------------------------------------------------+-- Latin1 decoding+-------------------------------------------------------------------------------++-- | Decode a stream of bytes to Unicode characters by mapping each byte to a+-- corresponding Unicode 'Char' in 0-255 range.+--+{-# INLINE decodeLatin1 #-}+decodeLatin1 :: Monad m => Stream m Word8 -> Stream m Char+decodeLatin1 = fmap (unsafeChr . fromIntegral)++-------------------------------------------------------------------------------+-- Latin1 encoding+-------------------------------------------------------------------------------++-- | Encode a stream of Unicode characters to bytes by mapping each character+-- to a byte in 0-255 range. Throws an error if the input stream contains+-- characters beyond 255.+--+{-# INLINE encodeLatin1' #-}+encodeLatin1' :: Monad m => Stream m Char -> Stream m Word8+encodeLatin1' = fmap convert+    where+    convert c =+        let codepoint = ord c+        in if codepoint > 255+           then error $ "Streamly.Unicode.encodeLatin1 invalid " +++                      "input char codepoint " ++ show codepoint+           else fromIntegral codepoint++-- XXX Should we instead replace the invalid chars by NUL or whitespace or some+-- other control char? That may affect the perf a bit but may be a better+-- behavior.+--+-- | Like 'encodeLatin1'' but silently maps input codepoints beyond 255 to+-- arbitrary Latin1 chars in 0-255 range. No error or exception is thrown when+-- such mapping occurs.+--+{-# INLINE encodeLatin1 #-}+encodeLatin1 :: Monad m => Stream m Char -> Stream m Word8+encodeLatin1 = fmap (fromIntegral . ord)++-- | Like 'encodeLatin1' but drops the input characters beyond 255.+--+{-# INLINE encodeLatin1_ #-}+encodeLatin1_ :: Monad m => Stream m Char -> Stream m Word8+encodeLatin1_ = fmap (fromIntegral . ord) . Stream.filter (<= chr 255)++-- | Same as 'encodeLatin1'+--+{-# DEPRECATED encodeLatin1Lax "Please use 'encodeLatin1' instead" #-}+{-# INLINE encodeLatin1Lax #-}+encodeLatin1Lax :: Monad m => Stream m Char -> Stream m Word8+encodeLatin1Lax = encodeLatin1++-------------------------------------------------------------------------------+-- UTF-8 decoding+-------------------------------------------------------------------------------++-- Int helps in cheaper conversion from Int to Char+type CodePoint = Int+type DecodeState = Word8++-- We can divide the errors in three general categories:+-- * A non-starter was encountered in a begin state+-- * A starter was encountered without completing a codepoint+-- * The last codepoint was not complete (input underflow)+--+-- Need to separate resumable and non-resumable error. In case of non-resumable+-- error we can also provide the failing byte. In case of resumable error the+-- state can be opaque.+--+data DecodeError = DecodeError !DecodeState !CodePoint deriving Show++-- See http://bjoern.hoehrmann.de/utf-8/decoder/dfa/ for details.++-- XXX Use names decodeSuccess = 0, decodeFailure = 12++decodeTable :: [Word8]+decodeTable = [+   -- The first part of the table maps bytes to character classes that+   -- to reduce the size of the transition table and create bitmasks.+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,  0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,+   1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,  9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,+   7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,+   8,8,2,2,2,2,2,2,2,2,2,2,2,2,2,2,  2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,+  10,3,3,3,3,3,3,3,3,3,3,3,3,4,3,3, 11,6,6,6,5,8,8,8,8,8,8,8,8,8,8,8,++   -- The second part is a transition table that maps a combination+   -- of a state of the automaton and a character class to a state.+   0,12,24,36,60,96,84,12,12,12,48,72, 12,12,12,12,12,12,12,12,12,12,12,12,+  12, 0,12,12,12,12,12, 0,12, 0,12,12, 12,24,12,12,12,12,12,24,12,24,12,12,+  12,12,12,12,12,12,12,24,12,12,12,12, 12,24,12,12,12,12,12,12,12,24,12,12,+  12,12,12,12,12,12,12,36,12,36,12,12, 12,36,12,12,12,12,12,36,12,36,12,12,+  12,36,12,12,12,12,12,12,12,12,12,12+  ]++{-# INLINE utf8dLength #-}+utf8dLength :: Int+utf8dLength = length decodeTable++-- | We do not want to garbage collect this and free the memory, we want to+-- keep this persistent. We don't know how to do that with GHC without having a+-- reference in some global structure. So we use a hack, use mallocBytes so+-- that the GC has no way to free it.+{-# NOINLINE utf8d #-}+utf8d :: Ptr Word8+utf8d = unsafePerformIO $ do+    let size = utf8dLength+    p <- liftIO $ mallocBytes size+    void $ D.fold+        (Fold.foldlM' (\b a -> poke b a >> return (b `plusPtr` 1)) (return p))+        (D.fromList decodeTable)+    return p++-- | Return element at the specified index without checking the bounds.+-- and without touching the foreign ptr.+{-# INLINE_NORMAL unsafePeekElemOff #-}+unsafePeekElemOff :: forall a. Storable a => Ptr a -> Int -> a+unsafePeekElemOff p i =+    let !x = unsafeInlineIO $ peekElemOff p i+     in x++-- XXX We can use a fromPtr stream to implement it.+{-# INLINE showMemory #-}+showMemory ::+    forall a. (Show a, Storable a) => Ptr a -> Ptr a -> String+showMemory cur end+    | cur < end =+        let cur1 = cur `plusPtr` sizeOf (undefined :: a)+         in show (unsafeInlineIO $ peek cur) ++ " " ++ showMemory cur1 end+showMemory _ _ = ""++-- decode is split into two separate cases to avoid branching instructions.+-- From the higher level flow we already know which case we are in so we can+-- call the appropriate decode function.+--+-- When the state is 0+{-# INLINE decode0 #-}+decode0 :: Ptr Word8 -> Word8 -> Tuple' DecodeState CodePoint+decode0 table byte =+    let !t = table `unsafePeekElemOff` fromIntegral byte+        !codep' = (0xff `shiftR` fromIntegral t) .&. fromIntegral byte+        !state' = table `unsafePeekElemOff` (256 + fromIntegral t)+     in assert ((byte > 0x7f || error showByte)+                && (state' /= 0 || error (showByte ++ showTable)))+               (Tuple' state' codep')++    where++    utf8tableEnd = table `plusPtr` 364+    showByte = "Streamly: decode0: byte: " ++ show byte+    showTable = " table: " ++ showMemory table utf8tableEnd++-- When the state is not 0+{-# INLINE decode1 #-}+decode1+    :: Ptr Word8+    -> DecodeState+    -> CodePoint+    -> Word8+    -> Tuple' DecodeState CodePoint+decode1 table state codep byte =+    -- Remember codep is Int type!+    -- Can it be unsafe to convert the resulting Int to Char?+    let !t = table `unsafePeekElemOff` fromIntegral byte+        !codep' = (fromIntegral byte .&. 0x3f) .|. (codep `shiftL` 6)+        !state' = table `unsafePeekElemOff`+                    (256 + fromIntegral state + fromIntegral t)+     in assert (codep' <= 0x10FFFF+                    || error (showByte ++ showState state codep))+               (Tuple' state' codep')+    where++    utf8tableEnd = table `plusPtr` 364+    showByte = "Streamly: decode1: byte: " ++ show byte+    showState st cp =+        " state: " ++ show st +++        " codepoint: " ++ show cp +++        " table: " ++ showMemory table utf8tableEnd++-------------------------------------------------------------------------------+-- Resumable UTF-8 decoding+-------------------------------------------------------------------------------++-- Strangely, GHCJS hangs linking template-haskell with this+#ifndef __GHCJS__+{-# ANN type UTF8DecodeState Fuse #-}+#endif+data UTF8DecodeState s a+    = UTF8DecodeInit s+    | UTF8DecodeInit1 s Word8+    | UTF8DecodeFirst s Word8+    | UTF8Decoding s !DecodeState !CodePoint+    | YieldAndContinue a (UTF8DecodeState s a)+    | Done++{-# INLINE_NORMAL resumeDecodeUtf8EitherD #-}+resumeDecodeUtf8EitherD+    :: Monad m+    => DecodeState+    -> CodePoint+    -> D.Stream m Word8+    -> D.Stream m (Either DecodeError Char)+resumeDecodeUtf8EitherD dst codep (D.Stream step state) =+    let stt =+            if dst == 0+            then UTF8DecodeInit state+            else UTF8Decoding state dst codep+    in D.Stream (step' utf8d) stt+  where+    {-# INLINE_LATE step' #-}+    step' _ gst (UTF8DecodeInit st) = do+        r <- step (adaptState gst) st+        return $ case r of+            Yield x s -> Skip (UTF8DecodeInit1 s x)+            Skip s -> Skip (UTF8DecodeInit s)+            Stop   -> Skip Done++    step' _ _ (UTF8DecodeInit1 st x) = do+        -- 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 versions, we need a more reliable+        -- "likely" primitive to control branch predication.+        case x > 0x7f of+            False ->+                return $ Skip $ YieldAndContinue+                    (Right $ unsafeChr (fromIntegral x))+                    (UTF8DecodeInit st)+            -- Using a separate state here generates a jump to a+            -- separate code block in the core which seems to perform+            -- slightly better for the non-ascii case.+            True -> return $ Skip $ UTF8DecodeFirst st x++    -- XXX should we merge it with UTF8DecodeInit1?+    step' table _ (UTF8DecodeFirst st x) = do+        let (Tuple' sv cp) = decode0 table x+        return $+            case sv of+                12 ->+                    Skip $ YieldAndContinue (Left $ DecodeError 0 (fromIntegral x))+                                            (UTF8DecodeInit st)+                0 -> error "unreachable state"+                _ -> Skip (UTF8Decoding st sv cp)++    -- We recover by trying the new byte x a starter of a new codepoint.+    -- XXX on error need to report the next byte "x" as well.+    -- XXX need to use the same recovery in array decoding routine as well+    step' table gst (UTF8Decoding st statePtr codepointPtr) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                let (Tuple' sv cp) = decode1 table statePtr codepointPtr x+                return $+                    case sv of+                        0 -> Skip $ YieldAndContinue (Right $ unsafeChr cp)+                                        (UTF8DecodeInit s)+                        12 ->+                            Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr)+                                        (UTF8DecodeInit1 s x)+                        _ -> Skip (UTF8Decoding s sv cp)+            Skip s -> return $ Skip (UTF8Decoding s statePtr codepointPtr)+            Stop -> return $ Skip $ YieldAndContinue (Left $ DecodeError statePtr codepointPtr) Done++    step' _ _ (YieldAndContinue c s) = return $ Yield c s+    step' _ _ Done = return Stop++-- XXX We can use just one API, and define InitState = 0 and InitCodePoint = 0+-- to use as starting state.+--+{-# INLINE_NORMAL decodeUtf8EitherD #-}+decodeUtf8EitherD :: Monad m+    => D.Stream m Word8 -> D.Stream m (Either DecodeError Char)+decodeUtf8EitherD = resumeDecodeUtf8EitherD 0 0++-- |+--+-- /Pre-release/+{-# INLINE decodeUtf8Either #-}+decodeUtf8Either :: Monad m+    => Stream m Word8 -> Stream m (Either DecodeError Char)+decodeUtf8Either = decodeUtf8EitherD++-- |+--+-- /Pre-release/+{-# INLINE resumeDecodeUtf8Either #-}+resumeDecodeUtf8Either+    :: Monad m+    => DecodeState+    -> CodePoint+    -> Stream m Word8+    -> Stream m (Either DecodeError Char)+resumeDecodeUtf8Either = resumeDecodeUtf8EitherD++-------------------------------------------------------------------------------+-- One shot decoding+-------------------------------------------------------------------------------++data CodingFailureMode+    = TransliterateCodingFailure+    | ErrorOnCodingFailure+    | DropOnCodingFailure+    deriving (Show)++{-# INLINE replacementChar #-}+replacementChar :: Char+replacementChar = '\xFFFD'++data UTF8CharDecodeState a+    = UTF8CharDecodeInit+    | UTF8CharDecoding !DecodeState !CodePoint++{-# INLINE parseCharUtf8WithD #-}+parseCharUtf8WithD ::+       Monad m => CodingFailureMode -> ParserD.Parser Word8 m Char+parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract++    where++    prefix = "Streamly.Internal.Data.Stream.parseCharUtf8WithD:"++    {-# INLINE initial #-}+    initial = return $ ParserD.IPartial UTF8CharDecodeInit++    handleError err souldBackTrack =+        case cfm of+            ErrorOnCodingFailure -> ParserD.Error err+            TransliterateCodingFailure ->+                case souldBackTrack of+                    True -> ParserD.Done 1 replacementChar+                    False -> ParserD.Done 0 replacementChar+            DropOnCodingFailure ->+                case souldBackTrack of+                    True -> ParserD.Continue 1 UTF8CharDecodeInit+                    False -> ParserD.Continue 0 UTF8CharDecodeInit++    {-# INLINE step' #-}+    step' table UTF8CharDecodeInit x =+        -- 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 versions, we need a more reliable+        -- "likely" primitive to control branch predication.+        return $ case x > 0x7f of+            False -> ParserD.Done 0 $ unsafeChr $ fromIntegral x+            True ->+                let (Tuple' sv cp) = decode0 table x+                 in case sv of+                        12 ->+                            let msg = prefix+                                    ++ "Invalid first UTF8 byte" ++ show x+                             in handleError msg False+                        0 -> error $ prefix ++ "unreachable state"+                        _ -> ParserD.Continue 0 (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+            12 ->+                let msg = prefix+                        ++ "Invalid subsequent UTF8 byte"+                        ++ show x+                        ++ "in state"+                        ++ show statePtr+                        ++ "accumulated value"+                        ++ show codepointPtr+                 in handleError msg True+            _ -> ParserD.Continue 0 (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"+            TransliterateCodingFailure ->+                return (ParserD.Done 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"++-- XXX This should ideally accept a "CodingFailureMode" and perform appropriate+-- error handling. This isn't possible now as "TransliterateCodingFailure"'s+-- 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)++-- XXX The initial idea was to have "parseCharUtf8" and offload the error+-- handling to another parser. So, say we had "parseCharUtf8'",+--+-- >>> parseCharUtf8Smart = parseCharUtf8' <|> Parser.fromPure replacementChar+--+-- But unfortunately parseCharUtf8Smart used in conjunction with "parseMany" -+-- that is "parseMany parseCharUtf8Smart" on a stream causes the heap to+-- overflow. Even a heap size of 500 MB was not sufficient.+--+-- This needs to be investigated futher.+{-# INLINE parseCharUtf8With #-}+parseCharUtf8With ::+       Monad m => CodingFailureMode -> Parser.Parser Word8 m Char+parseCharUtf8With = parseCharUtf8WithD++-- XXX write it as a parser and use parseMany to decode a stream, need to check+-- if that preserves the same performance. Or we can use a resumable parser+-- that parses a chunk at a time.+--+-- XXX Implement this in terms of decodeUtf8Either. Need to make sure that+-- decodeUtf8Either preserves the performance characterstics.+--+{-# INLINE_NORMAL decodeUtf8WithD #-}+decodeUtf8WithD :: Monad m+    => CodingFailureMode -> D.Stream m Word8 -> D.Stream m Char+decodeUtf8WithD cfm (D.Stream step state) =+    D.Stream (step' utf8d) (UTF8DecodeInit state)++    where++    prefix = "Streamly.Internal.Data.Stream.StreamD.decodeUtf8With: "++    {-# INLINE handleError #-}+    handleError e s =+        case cfm of+            ErrorOnCodingFailure -> error e+            TransliterateCodingFailure -> YieldAndContinue replacementChar s+            DropOnCodingFailure -> s++    {-# INLINE handleUnderflow #-}+    handleUnderflow =+        case cfm of+            ErrorOnCodingFailure -> error $ prefix ++ "Not enough input"+            TransliterateCodingFailure -> YieldAndContinue replacementChar Done+            DropOnCodingFailure -> Done++    {-# INLINE_LATE step' #-}+    step' _ gst (UTF8DecodeInit st) = do+        r <- step (adaptState gst) st+        return $ case r of+            Yield x s -> Skip (UTF8DecodeInit1 s x)+            Skip s -> Skip (UTF8DecodeInit s)+            Stop   -> Skip Done++    step' _ _ (UTF8DecodeInit1 st x) = do+        -- 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 versions, we need a more reliable+        -- "likely" primitive to control branch predication.+        case x > 0x7f of+            False ->+                return $ Skip $ YieldAndContinue+                    (unsafeChr (fromIntegral x))+                    (UTF8DecodeInit st)+            -- Using a separate state here generates a jump to a+            -- separate code block in the core which seems to perform+            -- slightly better for the non-ascii case.+            True -> return $ Skip $ UTF8DecodeFirst st x++    -- XXX should we merge it with UTF8DecodeInit1?+    step' table _ (UTF8DecodeFirst st x) = do+        let (Tuple' sv cp) = decode0 table x+        return $+            case sv of+                12 ->+                    let msg = prefix ++ "Invalid first UTF8 byte " ++ show x+                     in Skip $ handleError msg (UTF8DecodeInit st)+                0 -> error "unreachable state"+                _ -> Skip (UTF8Decoding st sv cp)++    -- We recover by trying the new byte x as a starter of a new codepoint.+    -- XXX need to use the same recovery in array decoding routine as well+    step' table gst (UTF8Decoding st statePtr codepointPtr) = do+        r <- step (adaptState gst) st+        case r of+            Yield x s -> do+                let (Tuple' sv cp) = decode1 table statePtr codepointPtr x+                return $ case sv of+                    0 -> Skip $ YieldAndContinue+                            (unsafeChr cp) (UTF8DecodeInit s)+                    12 ->+                        let msg = prefix+                                ++ "Invalid subsequent UTF8 byte "+                                ++ show x+                                ++ " in state "+                                ++ show statePtr+                                ++ " accumulated value "+                                ++ show codepointPtr+                         in Skip $ handleError msg (UTF8DecodeInit1 s x)+                    _ -> Skip (UTF8Decoding s sv cp)+            Skip s -> return $+                Skip (UTF8Decoding s statePtr codepointPtr)+            Stop -> return $ Skip handleUnderflow++    step' _ _ (YieldAndContinue c s) = return $ Yield c s+    step' _ _ Done = return Stop++{-# INLINE decodeUtf8D #-}+decodeUtf8D :: Monad m => D.Stream m Word8 -> D.Stream m Char+decodeUtf8D = decodeUtf8WithD TransliterateCodingFailure++-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.+-- Any invalid codepoint encountered is replaced with the unicode replacement+-- character.+--+{-# INLINE decodeUtf8 #-}+decodeUtf8 :: Monad m => Stream m Word8 -> Stream m Char+decodeUtf8 = decodeUtf8D++{-# INLINE decodeUtf8D' #-}+decodeUtf8D' :: Monad m => D.Stream m Word8 -> D.Stream m Char+decodeUtf8D' = decodeUtf8WithD ErrorOnCodingFailure++-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.+-- The function throws an error if an invalid codepoint is encountered.+--+{-# INLINE decodeUtf8' #-}+decodeUtf8' :: Monad m => Stream m Word8 -> Stream m Char+decodeUtf8' = decodeUtf8D'++{-# INLINE decodeUtf8D_ #-}+decodeUtf8D_ :: Monad m => D.Stream m Word8 -> D.Stream m Char+decodeUtf8D_ = decodeUtf8WithD DropOnCodingFailure++-- | Decode a UTF-8 encoded bytestream to a stream of Unicode characters.+-- Any invalid codepoint encountered is dropped.+--+{-# INLINE decodeUtf8_ #-}+decodeUtf8_ :: Monad m => Stream m Word8 -> Stream m Char+decodeUtf8_ = decodeUtf8D_++-- | Same as 'decodeUtf8'+--+{-# DEPRECATED decodeUtf8Lax "Please use 'decodeUtf8' instead" #-}+{-# INLINE decodeUtf8Lax #-}+decodeUtf8Lax :: Monad m => Stream m Word8 -> Stream m Char+decodeUtf8Lax = decodeUtf8++-------------------------------------------------------------------------------+-- Decoding Array Streams+-------------------------------------------------------------------------------++#ifndef __GHCJS__+{-# ANN type FlattenState Fuse #-}+#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+        !DecodeState !CodePoint+    | YAndC !Char (FlattenState s)   -- These constructors can be+                                     -- encoded in the UTF8DecodeState+                                     -- type, I prefer to keep these+                                     -- flat even though that means+                                     -- coming up with new names+    | D++-- The normal decodeUtf8 above should fuse with flattenArrays+-- to create this exact code but it doesn't for some reason, as of now this+-- remains the fastest way I could figure out to decodeUtf8.+--+-- XXX Add Proper error messages+{-# INLINE_NORMAL decodeUtf8ArraysWithD #-}+decodeUtf8ArraysWithD ::+       MonadIO m+    => CodingFailureMode+    -> D.Stream m (Array Word8)+    -> D.Stream m Char+decodeUtf8ArraysWithD cfm (D.Stream step state) =+    D.Stream (step' utf8d) (OuterLoop state Nothing)+  where+    {-# INLINE transliterateOrError #-}+    transliterateOrError e s =+        case cfm of+            ErrorOnCodingFailure -> error e+            TransliterateCodingFailure -> YAndC replacementChar s+            DropOnCodingFailure -> s+    {-# INLINE inputUnderflow #-}+    inputUnderflow =+        case cfm of+            ErrorOnCodingFailure ->+                error $+                show "Streamly.Internal.Data.Stream.StreamD."+                ++ "decodeUtf8ArraysWith: Input Underflow"+            TransliterateCodingFailure -> YAndC replacementChar D+            DropOnCodingFailure -> D+    {-# INLINE_LATE step' #-}+    step' _ gst (OuterLoop st Nothing) = do+        r <- step (adaptState gst) st+        return $+            case r of+                Yield Array {..} s ->+                     Skip (InnerLoopDecodeInit s arrContents arrStart arrEnd)+                Skip s -> Skip (OuterLoop s Nothing)+                Stop -> Skip D+    step' _ gst (OuterLoop st dst@(Just (ds, cp))) = do+        r <- step (adaptState gst) st+        return $+            case r of+                Yield Array {..} s ->+                     Skip (InnerLoopDecoding s arrContents arrStart arrEnd ds cp)+                Skip s -> Skip (OuterLoop s dst)+                Stop -> Skip inputUnderflow+    step' _ _ (InnerLoopDecodeInit st _ p end)+        | p == end = do+            return $ Skip $ OuterLoop st Nothing+    step' _ _ (InnerLoopDecodeInit st contents p end) = do+        x <- liftIO $ peekWith contents p+        -- 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+        -- versions, we need a more reliable "likely" primitive to control+        -- branch predication.+        case x > 0x7f of+            False ->+                return $ Skip $ YAndC+                    (unsafeChr (fromIntegral x))+                    (InnerLoopDecodeInit st contents (p + 1) end)+            -- Using a separate state here generates a jump to a separate code+            -- block in the core which seems to perform slightly better for the+            -- non-ascii case.+            True -> return $ Skip $ InnerLoopDecodeFirst st contents p end x++    step' table _ (InnerLoopDecodeFirst st contents p end x) = do+        let (Tuple' sv cp) = decode0 table x+        return $+            case sv of+                12 ->+                    Skip $+                    transliterateOrError+                        (+                           "Streamly.Internal.Data.Stream.StreamD."+                        ++ "decodeUtf8ArraysWith: Invalid UTF8"+                        ++ " codepoint encountered"+                        )+                        (InnerLoopDecodeInit st contents (p + 1) end)+                0 -> error "unreachable state"+                _ -> Skip (InnerLoopDecoding st contents (p + 1) end sv cp)+    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+        let (Tuple' sv cp) = decode1 table statePtr codepointPtr x+        return $+            case sv of+                0 ->+                    Skip $+                    YAndC+                        (unsafeChr cp)+                        (InnerLoopDecodeInit st contents (p + 1) end)+                12 ->+                    Skip $+                    transliterateOrError+                        (+                           "Streamly.Internal.Data.Stream.StreamD."+                        ++ "decodeUtf8ArraysWith: Invalid UTF8"+                        ++ " codepoint encountered"+                        )+                        (InnerLoopDecodeInit st contents (p + 1) end)+                _ ->+                    Skip+                    (InnerLoopDecoding st contents (p + 1) end sv cp)+    step' _ _ (YAndC c s) = return $ Yield c s+    step' _ _ D = return Stop++-- | Like 'decodeUtf8' but for a chunked stream. It may be slightly faster than+-- flattening the stream and then decoding with 'decodeUtf8'.+{-# INLINE decodeUtf8Chunks #-}+decodeUtf8Chunks ::+       MonadIO m+    => D.Stream m (Array Word8)+    -> D.Stream m Char+decodeUtf8Chunks = decodeUtf8ArraysWithD TransliterateCodingFailure++-- | Like 'decodeUtf8\'' but for a chunked stream. It may be slightly faster+-- than flattening the stream and then decoding with 'decodeUtf8\''.+{-# INLINE decodeUtf8Chunks' #-}+decodeUtf8Chunks' ::+       MonadIO m+    => D.Stream m (Array Word8)+    -> D.Stream m Char+decodeUtf8Chunks' = decodeUtf8ArraysWithD ErrorOnCodingFailure++-- | Like 'decodeUtf8_' but for a chunked stream. It may be slightly faster+-- than flattening the stream and then decoding with 'decodeUtf8_'.+{-# INLINE decodeUtf8Chunks_ #-}+decodeUtf8Chunks_ ::+       MonadIO m+    => D.Stream m (Array Word8)+    -> D.Stream m Char+decodeUtf8Chunks_ = decodeUtf8ArraysWithD DropOnCodingFailure++-------------------------------------------------------------------------------+-- Encoding Unicode (UTF-8) Characters+-------------------------------------------------------------------------------++data WList = WCons !Word8 !WList | WNil++-- UTF-8 primitives, Lifted from GHC.IO.Encoding.UTF8.++{-# INLINE ord2 #-}+ord2 :: Char -> WList+ord2 c = assert (n >= 0x80 && n <= 0x07ff) (WCons x1 (WCons x2 WNil))+  where+    n = ord c+    x1 = fromIntegral $ (n `shiftR` 6) + 0xC0+    x2 = fromIntegral $ (n .&. 0x3F) + 0x80++{-# INLINE ord3 #-}+ord3 :: Char -> WList+ord3 c = assert (n >= 0x0800 && n <= 0xffff) (WCons x1 (WCons x2 (WCons x3 WNil)))+  where+    n = ord c+    x1 = fromIntegral $ (n `shiftR` 12) + 0xE0+    x2 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+    x3 = fromIntegral $ (n .&. 0x3F) + 0x80++{-# INLINE ord4 #-}+ord4 :: Char -> WList+ord4 c = assert (n >= 0x10000)  (WCons x1 (WCons x2 (WCons x3 (WCons x4 WNil))))+  where+    n = ord c+    x1 = fromIntegral $ (n `shiftR` 18) + 0xF0+    x2 = fromIntegral $ ((n `shiftR` 12) .&. 0x3F) + 0x80+    x3 = fromIntegral $ ((n `shiftR` 6) .&. 0x3F) + 0x80+    x4 = fromIntegral $ (n .&. 0x3F) + 0x80++{-# INLINE_NORMAL readCharUtf8With #-}+readCharUtf8With :: Monad m => WList -> Unfold m Char Word8+readCharUtf8With surr = Unfold step inject++    where++    inject c =+        return $ case ord c of+            x | x <= 0x7F -> fromIntegral x `WCons` WNil+              | x <= 0x7FF -> ord2 c+              | x <= 0xFFFF -> if isSurrogate c then surr else ord3 c+              | otherwise -> ord4 c++    {-# INLINE_LATE step #-}+    step WNil = return Stop+    step (WCons x xs) = return $ Yield x xs++{-# INLINE_NORMAL readCharUtf8' #-}+readCharUtf8' :: Monad m => Unfold m Char Word8+readCharUtf8' =+    readCharUtf8With $+        error "Streamly.Internal.Unicode.readCharUtf8': Encountered a surrogate"++-- More yield points improve performance, but I am not sure if they can cause+-- too much code bloat or some trouble with fusion. So keeping only two yield+-- points for now, one for the ascii chars (fast path) and one for all other+-- paths (slow path).+{-# INLINE_NORMAL encodeUtf8D' #-}+encodeUtf8D' :: Monad m => D.Stream m Char -> D.Stream m Word8+encodeUtf8D' = D.unfoldMany 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+-- function errors out.+--+{-# INLINE encodeUtf8' #-}+encodeUtf8' :: Monad m => Stream m Char -> Stream m Word8+encodeUtf8' = encodeUtf8D'++{-# INLINE_NORMAL readCharUtf8 #-}+readCharUtf8 :: Monad m => Unfold m Char Word8+readCharUtf8 = readCharUtf8With $ WCons 239 (WCons 191 (WCons 189 WNil))++-- | See section "3.9 Unicode Encoding Forms" in+-- https://www.unicode.org/versions/Unicode13.0.0/UnicodeStandard-13.0.pdf+--+{-# INLINE_NORMAL encodeUtf8D #-}+encodeUtf8D :: Monad m => D.Stream m Char -> D.Stream m Word8+encodeUtf8D = D.unfoldMany 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+-- Unicode replacement character U+FFFD.+--+{-# INLINE encodeUtf8 #-}+encodeUtf8 :: Monad m => Stream m Char -> Stream m Word8+encodeUtf8 = encodeUtf8D++{-# INLINE_NORMAL readCharUtf8_ #-}+readCharUtf8_ :: Monad m => Unfold m Char Word8+readCharUtf8_ = readCharUtf8With WNil++{-# INLINE_NORMAL encodeUtf8D_ #-}+encodeUtf8D_ :: Monad m => D.Stream m Char -> D.Stream m Word8+encodeUtf8D_ = D.unfoldMany 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.+--+{-# INLINE encodeUtf8_ #-}+encodeUtf8_ :: Monad m => Stream m Char -> Stream m Word8+encodeUtf8_ = encodeUtf8D_++-- | Same as 'encodeUtf8'+--+{-# DEPRECATED encodeUtf8Lax "Please use 'encodeUtf8' instead" #-}+{-# INLINE encodeUtf8Lax #-}+encodeUtf8Lax :: Monad m => Stream m Char -> Stream m Word8+encodeUtf8Lax = encodeUtf8++-------------------------------------------------------------------------------+-- Decoding string literals+-------------------------------------------------------------------------------++-- | 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.+--+-- /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 (Unicode.fromStr# "Haskell"#)+-- "Haskell"+--+{-# INLINE fromStr# #-}+fromStr# :: MonadIO m => Addr# -> Stream m Char+fromStr# addr = decodeUtf8 $ Stream.fromByteStr# addr++-------------------------------------------------------------------------------+-- Encode streams of containers+-------------------------------------------------------------------------------++-- | Encode a container to @Array Word8@ provided an unfold to covert it to a+-- Char stream and an encoding function.+--+-- /Internal/+{-# INLINE encodeObject #-}+encodeObject :: MonadIO m =>+       (Stream m Char -> Stream m Word8)+    -> Unfold m a Char+    -> a+    -> m (Array Word8)+encodeObject encode u = Stream.fold Array.write . encode . Stream.unfold u++-- | Encode a stream of container objects using the supplied encoding scheme.+-- Each object is encoded as an @Array Word8@.+--+-- /Internal/+{-# INLINE encodeObjects #-}+encodeObjects :: MonadIO m =>+       (Stream m Char -> Stream m Word8)+    -> Unfold m a Char+    -> Stream m a+    -> Stream m (Array Word8)+encodeObjects encode u = Stream.mapM (encodeObject encode u)++-- | Encode a stream of 'String' using the supplied encoding scheme. Each+-- string is encoded as an @Array Word8@.+--+{-# INLINE encodeStrings #-}+encodeStrings :: MonadIO m =>+       (Stream m Char -> Stream m Word8)+    -> Stream m String+    -> Stream m (Array Word8)+encodeStrings encode = encodeObjects encode Unfold.fromList++{-+-------------------------------------------------------------------------------+-- Utility operations on strings+-------------------------------------------------------------------------------++strip :: IsStream t => Stream m Char -> Stream m Char+strip = undefined++stripTail :: IsStream t => Stream m Char -> Stream m Char+stripTail = undefined+-}++-- | Remove leading whitespace from a string.+--+-- > stripHead = Stream.dropWhile isSpace+--+-- /Pre-release/+{-# INLINE stripHead #-}+stripHead :: Monad m => Stream m Char -> Stream m Char+stripHead = Stream.dropWhile isSpace++-- | 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","",""]+--+-- > lines = Stream.splitOnSuffix (== '\n')+--+-- /Pre-release/+{-# INLINE lines #-}+lines :: Monad m => Fold m Char b -> Stream m Char -> Stream m b+lines f = Stream.foldMany (Fold.takeEndBy_ (== '\n') f)++#if !MIN_VERSION_base(4,17,0)+foreign import ccall unsafe "u_iswspace"+  iswspace :: Int -> Int+#endif++-- | Code copied from base/Data.Char to INLINE it+{-# INLINE isSpace #-}+isSpace :: Char -> Bool+isSpace c+  | uc <= 0x377 = uc == 32 || uc - 0x9 <= 4 || uc == 0xa0+#if MIN_VERSION_base(4,17,0)+  | otherwise = generalCategory c == Space+#else+  | otherwise = iswspace (ord c) /= 0+#endif+  where+    uc = fromIntegral (ord c) :: Word++-- | Fold each word of the stream using the supplied 'Fold'+-- and stream the result.+--+-- >>>  Stream.fold Fold.toList $ words Fold.toList (Stream.fromList "fold these     words")+-- ["fold","these","words"]+--+-- > words = Stream.wordsBy isSpace+--+-- /Pre-release/+{-# INLINE words #-}+words :: Monad m => Fold m Char b -> Stream m Char -> Stream m b+words f = D.wordsBy isSpace f++-- | 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"+-- @+--+-- /Pre-release/+{-# INLINE unlines #-}+unlines :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char+unlines = Stream.interposeSuffix '\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 " "+-- @+--+-- /Pre-release/+{-# INLINE unwords #-}+unwords :: MonadIO m => Unfold m a Char -> Stream m a -> Stream m Char+unwords = Stream.interpose ' '
+ src/Streamly/Internal/Unicode/String.hs view
@@ -0,0 +1,153 @@+{-# LANGUAGE TemplateHaskell #-}+-- |+-- Module      : Streamly.Internal.Unicode.String+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : experimental+-- Portability : GHC+--+-- Convenient template Haskell quasiquoters to format strings.++-- Design Notes:+--+-- Essential requirements are:+--+-- Haskell expression expansion+-- Newline treatment (continue without introducing a newline)+-- Indentation treatment+--+-- We choose #{expr} for patching a Haskell expression's value in a string. "$"+-- instead of "#" was another option (like in neat-interpolation package) but+-- we did not use that to avoid conflict with strings that are used as shell+-- commands. Another option was to use just "{}" (like in PyF package) but we+-- did not use that to avoid conflict with "${}" used in shell.+--+-- We use a "#" at the end of line to continue the line. We could use a "\"+-- as well but that may interfere with CPP.+--+-- Stripping is not part of the quasiquoter as it can be done by a Haskell+-- function. Other type of formatting on the Haskell expression can be done+-- using Haskell functions.++module Streamly.Internal.Unicode.String+    ( str+    ) where+++import Control.Applicative (Alternative(..))+import Control.Exception (displayException)+import Data.Functor.Identity (runIdentity)+import Streamly.Internal.Data.Parser (Parser)++import Language.Haskell.TH+import Language.Haskell.TH.Quote++import qualified Streamly.Data.Fold as Fold+import qualified Streamly.Internal.Data.Parser as Parser+    (some, many, takeWhile1)+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+--+--------------------------------------------------------------------------------+-- Parsing+--------------------------------------------------------------------------------++data StrSegment+    = StrText String+    | StrVar String+    deriving (Show, Eq)++haskellIdentifier :: Monad m => Parser Char m String+haskellIdentifier =+    let p = Parser.alphaNum <|> Parser.char '\'' <|> Parser.char '_'+     in Parser.some p Fold.toList++strParser :: Monad m => Parser Char m [StrSegment]+strParser = Parser.many content Fold.toList++    where++    plainText = StrText <$> Parser.takeWhile1 (/= '#') Fold.toList+    escHash = StrText . (: []) <$> (Parser.char '#' *> Parser.char '#')+    lineCont = StrText [] <$ (Parser.char '#' *> Parser.char '\n')+    var = StrVar <$>+            (  Parser.char '#'+            *> Parser.char '{'+            *> haskellIdentifier+            <* Parser.char '}'+            )+    plainHash = StrText . (: []) <$> Parser.char '#'++    -- order is important+    content = plainText <|> escHash <|> lineCont <|> var <|> plainHash++strSegmentExp :: StrSegment -> Q Exp+strSegmentExp (StrText text) = stringE text+strSegmentExp (StrVar name) = do+    valueName <- lookupValueName name+    case valueName of+        Just vn -> varE vn+        Nothing ->+            fail+                $ "str quote: Haskell symbol `" ++ name+                ++ "` is not in scope"++strExp :: [StrSegment] -> Q Exp+strExp xs = appE [| concat |] $ listE $ map strSegmentExp xs++expandVars :: String -> Q Exp+expandVars ln =+    case runIdentity $ Stream.parse strParser (Stream.fromList ln) of+        Left e ->+            fail $ "str QuasiQuoter parse error: " ++ displayException e+        Right x ->+            strExp x++-- | A QuasiQuoter that treats the input as a string literal:+--+-- >>> [str|x|]+-- "x"+--+-- Any @#{symbol}@ is replaced by the value of the Haskell symbol @symbol@+-- which is in scope:+--+-- >>> x = "hello"+-- >>> [str|#{x} world!|]+-- "hello world!"+--+-- @##@ means a literal @#@ without the special meaning for referencing+-- haskell symbols:+--+-- >>> [str|##{x} world!|]+-- "#{x} world!"+--+-- A @#@ at the end of line means the line continues to the next line without+-- introducing a newline character:+--+-- >>> :{+-- [str|hello#+-- world!|]+-- :}+-- "hello world!"+--+-- Bugs: because of a bug in parsers, a lone # at the end of input gets+-- removed.+--+str :: QuasiQuoter+str =+    QuasiQuoter+        { quoteExp = expandVars+        , quotePat = notSupported+        , quoteType = notSupported+        , quoteDec = notSupported+        }++    where++    notSupported = error "str: Not supported."
+ src/Streamly/Unicode/Parser.hs view
@@ -0,0 +1,59 @@+-- |+-- Module      : Streamly.Unicode.Parser+-- Copyright   : (c) 2021 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- To parse a text input, use the decode routines from+-- "Streamly.Unicode.Stream" module to convert an input byte stream to a+-- Unicode Char stream and then use these parsers on the Char stream.++module Streamly.Unicode.Parser+    (+     -- * Single Chars++     -- Any char+      char+    , charIgnoreCase++    -- Char classes+    , alpha+    , alphaNum+    , letter+    , ascii+    , asciiLower+    , asciiUpper+    , latin1+    , lower+    , upper+    , mark+    , printable+    , punctuation+    , separator+    , space+    , symbol++    -- Digits+    , digit+    , octDigit+    , hexDigit+    , numeric++    -- * Char Sequences+    , string+    , stringIgnoreCase+    , dropSpace+    , dropSpace1++    -- * Digit Sequences (Numbers)+    , decimal+    , hexadecimal++    -- * Modifiers+    , signed+    )+where++import Streamly.Internal.Unicode.Parser
+ src/Streamly/Unicode/Stream.hs view
@@ -0,0 +1,107 @@+-- |+-- Module      : Streamly.Unicode.Stream+-- Copyright   : (c) 2020 Composewell Technologies+--+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- = Processing Unicode Strings+--+-- A 'Char' stream is the canonical representation to process Unicode strings.+-- It can be processed efficiently using regular stream processing operations.+-- A byte stream of Unicode text read from an IO device or from an+-- 'Streamly.Data.Array.Array' in memory can be decoded into a 'Char' stream+-- using the decoding routines in this module.  A 'String' (@[Char]@) can be+-- converted into a 'Char' stream using 'Streamly.Data.Stream.fromList'.  An+-- @Array Char@ can be 'Streamly.Data.Stream.unfold'ed into a stream using the+-- array 'Streamly.Data.Array.read' unfold.+--+-- = Storing Unicode Strings+--+-- A stream of 'Char' can be encoded into a byte stream using the encoding+-- 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+-- '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+-- 'encodeUtf8'' on the 'Char' stream before writing it to an 'Array' providing+-- an even more compact representation.+--+-- = String Literals+--+-- @Stream Identity Char@ and @Array Char@ are instances of 'IsString' and+-- 'IsList', therefore, 'OverloadedStrings' and 'OverloadedLists' extensions+-- can be used for convenience when specifying unicode strings literals using+-- these types.+--+-- = Idioms+--+-- Some simple text processing operations can be represented simply as+-- operations on Char streams. Follow the links for the following idioms:+--+-- * 'Streamly.Internal.Unicode.Stream.lines'+-- * 'Streamly.Internal.Unicode.Stream.words'+-- * 'Streamly.Internal.Unicode.Stream.unlines'+-- * 'Streamly.Internal.Unicode.Stream.unwords'+--+-- = Pitfalls+--+-- * Case conversion: Some unicode characters translate to more than one code+-- point on case conversion. The 'toUpper' and 'toLower' functions in @base@+-- package do not handle such characters. Therefore, operations like @map+-- toUpper@ on a character stream or character array may not always perform+-- correct conversion.+-- * String comparison: In some cases, visually identical strings may have+-- different unicode representations, therefore, a character stream or+-- character array cannot be directly compared. A normalized comparison may be+-- needed to check string equivalence correctly.+--+-- = Experimental APIs+--+-- 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+    (+    -- * Construction (Decoding)+      decodeLatin1+    , decodeUtf8+    , decodeUtf8'+    , decodeUtf8Chunks++    -- * Elimination (Encoding)+    , encodeLatin1+    , encodeLatin1'+    , encodeUtf8+    , encodeUtf8'+    , encodeStrings+    {-+    -- * Operations on character strings+    , strip -- (dropAround isSpace)+    , stripEnd+    , stripStart+    -}+    -- Not exposing these yet as we have consider these with respect to Unicode+    -- segmentation routines which are yet to be implemented.+    -- -- * Transformation+    -- , lines+    -- , words+    -- , unlines+    -- , unwords+    )+where++import Streamly.Internal.Unicode.Stream+import Prelude hiding (lines, words, unlines, unwords)
+ src/Streamly/Unicode/String.hs view
@@ -0,0 +1,16 @@+-- |+-- Module      : Streamly.Unicode.String+-- Copyright   : (c) 2022 Composewell Technologies+-- License     : BSD-3-Clause+-- Maintainer  : streamly@composewell.com+-- Stability   : released+-- Portability : GHC+--+-- Convenient template Haskell quasiquoters to format strings.++module Streamly.Unicode.String+    ( str+    )+where++import Streamly.Internal.Unicode.String
+ src/assert.hs view
@@ -0,0 +1,6 @@+-- A convenient macro to assert in a do block. We cannot define this as a+-- Haskell function because then the compiler reports the assert location+-- inside the wrapper function rather than the original location.++import Control.Exception (assert)+#define assertM(p) assert (p) (return ())
+ src/config.h.in view
@@ -0,0 +1,57 @@+/* src/config.h.in.  Generated from configure.ac by autoheader.  */++/* 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. */+#undef HAVE_INTTYPES_H++/* Define to 1 if you have the <stdint.h> header file. */+#undef HAVE_STDINT_H++/* Define to 1 if you have the <stdio.h> header file. */+#undef HAVE_STDIO_H++/* Define to 1 if you have the <stdlib.h> header file. */+#undef HAVE_STDLIB_H++/* Define to 1 if you have the <strings.h> header file. */+#undef HAVE_STRINGS_H++/* Define to 1 if you have the <string.h> header file. */+#undef HAVE_STRING_H++/* Define to 1 if you have the <sys/stat.h> header file. */+#undef HAVE_SYS_STAT_H++/* Define to 1 if you have the <sys/types.h> header file. */+#undef HAVE_SYS_TYPES_H++/* Define to 1 if you have the <time.h> header file. */+#undef HAVE_TIME_H++/* Define to 1 if you have the <unistd.h> header file. */+#undef HAVE_UNISTD_H++/* Define to the address where bug reports for this package should be sent. */+#undef PACKAGE_BUGREPORT++/* Define to the full name of this package. */+#undef PACKAGE_NAME++/* Define to the full name and version of this package. */+#undef PACKAGE_STRING++/* Define to the one symbol short name of this package. */+#undef PACKAGE_TARNAME++/* Define to the home page for this package. */+#undef PACKAGE_URL++/* 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+   required in a freestanding environment). This macro is provided for+   backward compatibility; new code need not use it. */+#undef STDC_HEADERS
+ src/inline.hs view
@@ -0,0 +1,27 @@+-- We use fromStreamK/toStreamK to convert the direct style stream to CPS+-- style. In the first phase we try fusing the fromStreamK/toStreamK using:+--+-- {-# RULES "fromStreamK/toStreamK fusion"+--     forall s. toStreamK (fromStreamK s) = s #-}+--+-- If for some reason some of the operations could not be fused then we have+-- fallback rules in the second phase. For example:+--+-- {-# INLINE_EARLY unfoldr #-}+-- unfoldr :: (Monad m, IsStream t) => (b -> Maybe (a, b)) -> b -> t m a+-- unfoldr step seed = fromStreamD (S.unfoldr step seed)+-- {-# RULES "unfoldr fallback to StreamK" [1]+--     forall a b. S.toStreamK (S.unfoldr a b) = K.unfoldr a b #-}```+--+-- Then, fromStreamK/toStreamK are inlined in the last phase:+--+-- {-# INLINE_LATE toStreamK #-}+-- toStreamK :: Monad m => Stream m a -> K.StreamK m a```+--+-- The fallback rules make sure that if we could not fuse the direct style+-- operations then better use the CPS style operation, because unfused direct+-- style would have worse performance than the CPS style ops.++#define INLINE_EARLY  INLINE [2]+#define INLINE_NORMAL INLINE [1]+#define INLINE_LATE   INLINE [0]
+ streamly-core.cabal view
@@ -0,0 +1,479 @@+cabal-version:      2.2+name:               streamly-core+version:            0.1.0+synopsis:           Streaming, parsers, arrays 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>.+  .+  This package provides streams, arrays, parsers, unicode text, file+  IO, and console IO functionality.+  .+  Note: The dependencies "heaps" and "monad-control" are included in+  the package solely for backward compatibility, and will be removed in+  future versions.++homepage:            https://streamly.composewell.com+bug-reports:         https://github.com/composewell/streamly/issues+license:             BSD-3-Clause+license-file:        LICENSE+tested-with:         GHC==8.6.5+                   , GHC==8.8.4+                   , GHC==8.10.7+                   , GHC==9.0.2+                   , GHC==9.2.7+                   , GHC==9.4.4+author:              Composewell Technologies+maintainer:          streamly@composewell.com+copyright:           2017 Composewell Technologies+category:+    Streamly, Streaming, Dataflow, Pipes, List,+    Logic, Non-determinism, Parsing, Array, Time+stability:           Stable+build-type:          Configure++extra-source-files:+    configure+    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++    -- This is duplicated+    src/Streamly/Internal/Data/Array/ArrayMacros.h+    src/assert.hs+    src/inline.hs++    src/Streamly/Internal/Data/Time/Clock/config-clock.h+    src/config.h.in++extra-tmp-files:+    config.log+    config.status+    autom4te.cache+    src/config.h++extra-doc-files:+    Changelog.md+    docs/*.md+    docs/ApiChangelogs/0.1.0.txt++source-repository head+    type: git+    location: https://github.com/composewell/streamly++flag debug+  description: Debug build with asserts enabled+  manual: True+  default: False++flag dev+  description: Development build+  manual: True+  default: False++flag has-llvm+  description: Use llvm backend for code generation+  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+  default: True++flag limit-build-mem+  description: Limits memory when building+  manual: True+  default: False++flag use-unliftio+  description: Use unliftio-core instead of monad-control+  manual: True+  default: False++flag use-unfolds+  description: Use unfolds for generation everywhere+  manual: True+  default: False++flag use-folds+  description: Use folds for elimination everywhere+  manual: True+  default: False++-------------------------------------------------------------------------------+-- Common stanzas+-------------------------------------------------------------------------------++common compile-options+    default-language: Haskell2010++    if flag(no-fusion)+      cpp-options:    -DDISABLE_FUSION++    if flag(dev)+      cpp-options:    -DDEVBUILD++    if flag(use-unfolds)+      cpp-options:    -DUSE_UNFOLDS_EVERYWHERE++    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+                    -Wno-missing-exported-signatures+                    -Wno-missing-import-lists+                    -Wno-missing-local-signatures+                    -Wno-missing-safe-haskell-mode+                    -Wno-missed-specialisations+                    -Wno-all-missed-specialisations+                    -Wno-monomorphism-restriction+                    -Wno-prepositive-qualified-module+                    -Wno-unsafe+                    -Rghc-timing++    if impl(ghc >= 9.2)+      ghc-options:+        -Wno-missing-kind-signatures+        -Wno-redundant-bang-patterns+        -Wno-operator-whitespace++    if flag(has-llvm)+      ghc-options: -fllvm++    if flag(dev)+      ghc-options:    -Wmissed-specialisations+                      -Wall-missed-specialisations++    if flag(limit-build-mem)+        ghc-options: +RTS -M1000M -RTS++    if flag(use-unliftio)+      cpp-options: -DUSE_UNLIFTIO++common default-extensions+    default-extensions:+        BangPatterns+        CApiFFI+        CPP+        ConstraintKinds+        DeriveDataTypeable+        DeriveGeneric+        DeriveTraversable+        ExistentialQuantification+        FlexibleContexts+        FlexibleInstances+        GeneralizedNewtypeDeriving+        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,+        -- otherwise TypeFamilies will enable it again.+        NoMonoLocalBinds++        -- UndecidableInstances -- Does not show any perf impact+        -- UnboxedTuples        -- interferes with (#.)++common optimization-options+  if flag(opt)+    ghc-options: -O2+                 -fdicts-strict+                 -fspec-constr-recursive=16+                 -fmax-worker-args=16++  -- For this to be effective it must come after the -O2 option+  if flag(dev) || flag(debug) || !flag(opt)+    ghc-options: -fno-ignore-asserts++common threading-options+  ghc-options:  -threaded+                -with-rtsopts=-N++-- We need optimization options here to optimize internal (non-inlined)+-- versions of functions. Also, we have some benchmarking inspection tests+-- part of the library when built with --benchmarks flag. Thos tests fail+-- if we do not use optimization options here. It was observed that due to+-- -O2 here some concurrent/nested benchmarks improved and others regressed.+-- We can investigate a bit more here why the regression occurred.+common lib-options+  import: compile-options, optimization-options, default-extensions++-------------------------------------------------------------------------------+-- Library+-------------------------------------------------------------------------------++library+    import: lib-options++    if impl(ghc >= 8.6)+      default-extensions: QuantifiedConstraints++    js-sources: jsbits/clock.js++    include-dirs:+          src+        , src/Streamly/Internal/Data/Array+        , src/Streamly/Internal/Data/Stream++    if os(windows)+      c-sources:     src/Streamly/Internal/Data/Time/Clock/Windows.c++    if os(darwin)+      include-dirs:  src/Streamly/Internal+      c-sources:     src/Streamly/Internal/Data/Time/Clock/Darwin.c++    hs-source-dirs:    src+    exposed-modules:+                     -- Internal modules, listed roughly in bottom up+                     -- dependency order To view dependency graph:+                     -- graphmod | dot -Tps > deps.ps++                     -- streamly-base+                       Streamly.Internal.BaseCompat+                     , Streamly.Internal.Control.Exception+                     , Streamly.Internal.Control.Monad+                     , Streamly.Internal.Control.ForkIO+                       Streamly.Internal.Data.IsMap+                     , Streamly.Internal.System.IO++                     -- streamly-strict-data+                     , Streamly.Internal.Data.Tuple.Strict+                     , Streamly.Internal.Data.Maybe.Strict+                     , Streamly.Internal.Data.Either.Strict++                     , Streamly.Internal.Data.IOFinalizer++                     -- streamly-time+                     , Streamly.Internal.Data.Time.TimeSpec+                     , Streamly.Internal.Data.Time.Units+                     , Streamly.Internal.Data.Time.Clock.Type+                     , Streamly.Internal.Data.Time.Clock++                     -- streamly-core-stream-types+                     , Streamly.Internal.Data.SVar.Type+                     , Streamly.Internal.Data.Stream.StreamK.Type+                     , Streamly.Internal.Data.Fold.Step+                     , Streamly.Internal.Data.Refold.Type+                     , Streamly.Internal.Data.Fold.Type+                     , Streamly.Internal.Data.Stream.StreamD.Step+                     , Streamly.Internal.Data.Stream.StreamD.Type+                     , Streamly.Internal.Data.Unfold.Type+                     , Streamly.Internal.Data.Producer.Type+                     , Streamly.Internal.Data.Producer+                     , Streamly.Internal.Data.Producer.Source+                     , Streamly.Internal.Data.Parser.ParserK.Type+                     , Streamly.Internal.Data.Parser.ParserD.Type+                     , Streamly.Internal.Data.Pipe.Type++                     -- streamly-core-array-types+                     , Streamly.Internal.Data.Unboxed+                    -- Unboxed IORef+                     , Streamly.Internal.Data.IORef.Unboxed+                     -- 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-core-streams+                     , Streamly.Internal.Data.Stream.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.Pipe++                     -- streamly-transformers (non-base)+                     , Streamly.Internal.Data.Stream.StreamD.Transformer+                     , Streamly.Internal.Data.Stream.StreamK.Transformer++                     -- streamly-containers (non-base)+                     , Streamly.Internal.Data.Stream.StreamD.Container+                     , Streamly.Internal.Data.Fold.Container++                     , Streamly.Internal.Data.Stream.Chunked++                     -- streamly-core-data-arrays+                     , Streamly.Internal.Data.Array.Generic+                     , Streamly.Internal.Data.Array+                     , Streamly.Internal.Data.Array.Mut.Stream++                     -- streamly-serde+                     , Streamly.Internal.Serialize.FromBytes+                     , Streamly.Internal.Serialize.ToBytes++                    -- streamly-unicode-core+                     , Streamly.Internal.Unicode.Stream+                     , Streamly.Internal.Unicode.String+                     , Streamly.Internal.Unicode.Parser+                     , Streamly.Internal.Unicode.Array++                     -- Filesystem/IO+                     , Streamly.Internal.FileSystem.Handle+                     , Streamly.Internal.FileSystem.File+                     , Streamly.Internal.FileSystem.Dir++                    -- Ring Arrays+                     , Streamly.Internal.Data.Ring.Unboxed+                     , Streamly.Internal.Data.Ring++                     -- 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.List+                     -- , Streamly.Data.Binary.Decode+                     -- , Streamly.FileSystem.File+                     -- , Streamly.FileSystem.Dir+                     -- , Streamly.Data.Time.Units+                     -- , Streamly.Data.Time.Clock+                     -- , Streamly.Data.Tuple.Strict+                     -- , Streamly.Data.Maybe.Strict+                     -- , Streamly.Data.Either.Strict++                     -- streamly-core released modules in alphabetic order+                     -- NOTE: these must be added to streamly.cabal as well+                     , Streamly.Console.Stdio+                     , Streamly.Data.Array+                     , Streamly.Data.Array.Generic+                     , Streamly.Data.MutArray+                     , Streamly.Data.MutArray.Generic+                     , Streamly.Data.Fold+                     , Streamly.Data.Parser+                     , Streamly.Data.ParserK+                     , Streamly.Data.Stream+                     , Streamly.Data.StreamK+                     , Streamly.Data.Unfold+                     , Streamly.FileSystem.Dir+                     , Streamly.FileSystem.File+                     , Streamly.FileSystem.Handle+                     , Streamly.Unicode.Parser+                     , Streamly.Unicode.Stream+                     , Streamly.Unicode.String++    if flag(dev)+      exposed-modules:+                        Streamly.Internal.Data.Stream.StreamK.Alt+                      , Streamly.Internal.Data.Stream.Type+                      , Streamly.Internal.Data.Stream.Eliminate+                      , Streamly.Internal.Data.Stream.Enumerate+                      , Streamly.Internal.Data.Stream.Generate+                      , Streamly.Internal.Data.Stream.Transform+                      , Streamly.Internal.Data.Stream.Bottom+                      , Streamly.Internal.Data.Stream.Exception+                      , Streamly.Internal.Data.Stream.Expand+                      , Streamly.Internal.Data.Stream.Lift+                      , Streamly.Internal.Data.Stream.Reduce+                      , Streamly.Internal.Data.Stream.Transformer+                      , Streamly.Internal.Data.Stream.StreamDK+                      , Streamly.Internal.Data.Stream.Zip+                      , Streamly.Internal.Data.Stream.Cross+                      , Streamly.Internal.Data.List+                      , Streamly.Data.Stream.Zip+                      --, Streamly.Internal.Data.Parser.ParserDK++    build-depends:+                    -- streamly-base+                    --+                    -- These dependencies can be reversed if we want+                    -- streamly-base to depend only on base.+                    --+                    -- Core libraries shipped with ghc, the min and max+                    -- constraints of these libraries should match with+                    -- the GHC versions we support. This is to make sure that+                    -- 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+                     , fusion-plugin-types >= 0.1 && < 0.2+                     , base              >= 4.12  && < 4.19+                     , 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++                     -- XXX to be removed+                     , containers        >= 0.6.0 && < 0.7+                     , heaps             >= 0.3   && < 0.5+    if !flag(use-unliftio)+      build-depends:   monad-control     >= 1.0 && < 1.1